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

merge from guile master

Browse source 
Had to fix up .gitignore for some conflicts.
This commit is contained in:
Andy Wingo 2008-08-26 12:51:19 -07:00
commit fdc0a82263
205 changed files with 6262 additions and 2236 deletions
Download patch file Download diff file Expand all files Collapse all files

2
.gitignore vendored
View file

@ -69,3 +69,5 @@ guile-config/guile-config
guile-readline/guile-readline-config.h
guile-readline/guile-readline-config.h.in
*.go
TAGS
guile-1.8.pc

64
ChangeLog
View file

@ -1,3 +1,67 @@
2008-08-25 Ludovic Courtès <ludo@gnu.org>
* configure.in (GCC_CFLAGS): New variable. Store GCC flags like
`-Werror' inside it so that they are not used when compiling
Gnulib modules.
2008-08-21 Ludovic Courtès <ludo@gnu.org>
* autogen.sh: Don't use `gnulib-tool', use the Gnulib files
available in the repository.
2008-08-07 Neil Jerram <neil@ossau.uklinux.net>
* configure.in (SCM_I_GSC_STACK_GROWS_UP): Remove use of
AC_CACHE_CHECK, which was inadvertently causing
SCM_I_GSC_STACK_GROWS_UP _always_ to be 0.
2008-07-17 Neil Jerram <neil@ossau.uklinux.net>
* configure.in: Update stack direction test to be like that in
Autoconf _AC_LIBOBJ_ALLOCA and Gnulib; specifically in involving a
function calling itself.
2008-07-16 Ludovic Courtès <ludo@gnu.org>
* configure.in: Look for `struct dirent64' and `readdir64_r ()',
not available on HP-UX 11.11.
2008-07-06 Ludovic Courtès <ludo@gnu.org>
* configure.in: Update to Autoconf 2.61.
2008-06-28 Ludovic Courtès <ludo@gnu.org>
* configure.in: Use Automake with `-Wall -Wno-override'.
2008-05-07 Ludovic Courtès <ludo@gnu.org>
Guile 1.8.5 released.
* GUILE-VERSION (LIBGUILE_INTERFACE_CURRENT): Increment due to
the addition of an inlined version of `scm getc ()' and friends.
(LIBGUILE_INTERFACE_AGE): Increment.
(LIBGUILE_INTERFACE_REVISION): Zeroed.
(LIBGUILE_SRFI_SRFI_1_INTERFACE_REVISION): Increment.
2008-05-04 Ludovic Courtès <ludo@gnu.org>
Add `pkg-config' support. Suggested by Aaron VanDevender, Greg
Troxel, and others.
* configure.in: Substitute `sitedir', produce `guile-1.8.pc'.
* Makefile.am (EXTRA_DIST): Add `guile-1.8.pc.in'.
(pkgconfigdir, pkgconfig_DATA): New.
2008-04-26 Ludovic Courtès <ludo@gnu.org>
* configure.in (BUILD_PTHREAD_SUPPORT): New Automake
conditional.
2008-04-26 Ludovic Courtès <ludo@gnu.org>
* Makefile.am (EXTRA_DIST): Remove `ANON-CVS' and `SNAPSHOTS'.
2008-02-23 Neil Jerram <neil@ossau.uklinux.net>
* FAQ: New file.

11
Makefile.am
View file

@ -1,6 +1,6 @@
## Process this file with automake to produce Makefile.in.
##
## Copyright (C) 1998, 1999, 2000, 2001, 2002, 2006, 2007 Free Software Foundation, Inc.
## Copyright (C) 1998, 1999, 2000, 2001, 2002, 2006, 2007, 2008 Free Software Foundation, Inc.
##
## This file is part of GUILE.
##
@ -32,10 +32,8 @@ bin_SCRIPTS = guile-tools
include_HEADERS = libguile.h
# automake sometimes forgets to distribute acconfig.h,
# apparently depending on the phase of the moon.
EXTRA_DIST = LICENSE HACKING GUILE-VERSION ANON-CVS SNAPSHOTS \
m4/ChangeLog FAQ
EXTRA_DIST = LICENSE HACKING GUILE-VERSION \
m4/ChangeLog FAQ guile-1.8.pc.in
TESTS = check-guile
@ -43,4 +41,7 @@ ACLOCAL_AMFLAGS = -I guile-config -I m4
DISTCLEANFILES = check-guile.log
pkgconfigdir = $(libdir)/pkgconfig
pkgconfig_DATA = guile-1.8.pc
# Makefile.am ends here

59
NEWS
View file

@ -11,6 +11,7 @@ Changes in 1.9.0:
* New modules (see the manual for details)
** `(srfi srfi-18)', multithreading support
** The `(ice-9 i18n)' module provides internationalization support
* Changes to the distribution
@ -35,6 +36,34 @@ See `cancel-thread', `set-thread-cleanup!', and `thread-cleanup'.
indicating length of the `scm_t_option' array.
Changes in 1.8.6 (since 1.8.5)
* New features (see the manual for details)
** New convenience function `scm_c_symbol_length ()'
** Single stepping through code from Emacs
When you use GDS to evaluate Scheme code from Emacs, you can now use
`C-u' to indicate that you want to single step through that code. See
`Evaluating Scheme Code' in the manual for more details.
* Bugs fixed
** Internal `scm_i_' functions now have "hidden" linkage with GCC/ELF
This makes these internal functions technically not callable from
application code.
** `guile-config link' now prints `-L$libdir' before `-lguile'
** Fix memory corruption involving GOOPS' `class-redefinition'
** Fix build issue on Tru64 and ia64-hp-hpux11.23 (`SCM_UNPACK' macro)
** Fix build issue on mips, mipsel, powerpc and ia64 (stack direction)
** Fix build issue on hppa2.0w-hp-hpux11.11 (`dirent64' and `readdir64_r')
** Fix misleading output from `(help rationalize)'
** Fix build failure on Debian hppa architecture (bad stack growth detection)
Changes in 1.8.5 (since 1.8.4)
@ -46,6 +75,31 @@ The new repository can be accessed using
"git-clone git://git.sv.gnu.org/guile.git", or can be browsed on-line at
http://git.sv.gnu.org/gitweb/?p=guile.git . See `README' for details.
** Add support for `pkg-config'
See "Autoconf Support" in the manual for details.
* New modules (see the manual for details)
** `(srfi srfi-88)'
* New features (see the manual for details)
** New `postfix' read option, for SRFI-88 keyword syntax
** Some I/O primitives have been inlined, which improves I/O performance
** New object-based traps infrastructure
This is a GOOPS-based infrastructure that builds on Guile's low-level
evaluator trap calls and facilitates the development of debugging
features like single-stepping, breakpoints, tracing and profiling.
See the `Traps' node of the manual for details.
** New support for working on Guile code from within Emacs
Guile now incorporates the `GDS' library (previously distributed
separately) for working on Guile code from within Emacs. See the
`Using Guile In Emacs' node of the manual for details.
* Bugs fixed
** `scm_add_slot ()' no longer segfaults (fixes bug #22369)
@ -60,9 +114,12 @@ would trigger an unbound variable error for `match:andmap'.
Previously, parsing short option names of argument-less options would
lead to a stack overflow.
** `(srfi srfi-35)' is now visible through `cond-expand'
** Fixed type-checking for the second argument of `eval'
** Fixed type-checking for SRFI-1 `partition'
** Fixed `struct-ref' and `struct-set!' on "light structs"
** Honor struct field access rights in GOOPS
** Changed the storage strategy of source properties, which fixes a deadlock
** Allow compilation of Guile-using programs in C99 mode with GCC 4.3 and later
** Fixed build issue for GNU/Linux on IA64
** Fixed build issues on NetBSD 1.6
@ -70,6 +127,8 @@ lead to a stack overflow.
** Fixed build issue with DEC/Compaq/HP's compiler
** Fixed `scm_from_complex_double' build issue on FreeBSD
** Fixed `alloca' build issue on FreeBSD 6
** Removed use of non-portable makefile constructs
** Fixed shadowing of libc's <random.h> on Tru64, which broke compilation
** Make sure all tests honor `$TMPDIR'
* Changes to the distribution

4
THANKS
View file

@ -37,12 +37,14 @@ For fixes or providing information which led to a fix:
Charles Gagnon
Peter Gavin
Eric Gillespie, Jr
Didier Godefroy
John Goerzen
Mike Gran
Szavai Gyula
Sven Hartrumpf
Eric Hanchrow
Sam Hocevar
Patrick Horgan
Ales Hvezda
Peter Ivanyi
Wolfgang Jaehrling
@ -67,6 +69,7 @@ For fixes or providing information which led to a fix:
Hrvoje Nikšić
Stefan Nordhausen
Roland Orre
Peter O'Gorman
Pieter Pareit
Jack Pavlovsky
Arno Peters
@ -79,6 +82,7 @@ For fixes or providing information which led to a fix:
Werner Scheinast
Bill Schottstaedt
Frank Schwidom
Thiemo Seufer
Scott Shedden
Alex Shinn
Daniel Skarda

3
autogen.sh
View file

@ -19,13 +19,10 @@ libtool --version
echo ""
${M4:-/usr/bin/m4} --version
echo ""
gnulib-tool --version
echo ""
######################################################################
### update infrastructure
gnulib-tool --update && \
autoreconf -i --force --verbose
echo "guile-readline..."

5
benchmark-suite/ChangeLog
View file

@ -1,3 +1,8 @@
2008-04-17 Ludovic Courtès <ludo@gnu.org>
* Makefile.am (SCM_BENCHMARKS): Add `benchmarks/read.bm'.
* benchmarks/read.bm: New file.
2008-01-22 Neil Jerram <neil@ossau.uklinux.net>
* COPYING: Removed.

9
benchmark-suite/Makefile.am
View file

@ -1,6 +1,7 @@
SCM_BENCHMARKS = benchmarks/0-reference.bm \
benchmarks/continuations.bm \
benchmarks/if.bm \
benchmarks/logand.bm
SCM_BENCHMARKS = benchmarks/0-reference.bm \
benchmarks/continuations.bm \
benchmarks/if.bm \
benchmarks/logand.bm \
benchmarks/read.bm
EXTRA_DIST = guile-benchmark lib.scm $(SCM_BENCHMARKS)

62
benchmark-suite/benchmarks/read.bm Normal file
View file

@ -0,0 +1,62 @@
;;; read.bm --- Exercise the reader. -*- Scheme -*-
;;;
;;; Copyright (C) 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
;;; 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 General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with this software; see the file COPYING. If not, write to
;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;;; Boston, MA 02110-1301 USA
(define-module (benchmarks read)
:use-module (benchmark-suite lib))
(define %files-to-load
;; Various large Scheme files.
(map %search-load-path
'("ice-9/boot-9.scm" "ice-9/common-list.scm"
"ice-9/format.scm" "ice-9/optargs.scm"
"ice-9/session.scm" "ice-9/getopt-long.scm"
"ice-9/psyntax.pp")))
(define (load-file-with-reader file-name reader buffering)
(with-input-from-file file-name
(lambda ()
(apply setvbuf (current-input-port) buffering)
(let loop ((sexp (reader)))
(if (eof-object? sexp)
#t
(loop (reader)))))))
(define (exercise-read buffering)
(for-each (lambda (file)
(load-file-with-reader file read buffering))
%files-to-load))
(with-benchmark-prefix "read"
(benchmark "_IONBF" 5 ;; this one is very slow
(exercise-read (list _IONBF)))
(benchmark "_IOLBF" 100
(exercise-read (list _IOLBF)))
(benchmark "_IOFBF 4096" 100
(exercise-read (list _IOFBF 4096)))
(benchmark "_IOFBF 8192" 100
(exercise-read (list _IOFBF 8192)))
(benchmark "_IOFBF 16384" 100
(exercise-read (list _IOFBF 16384))))

28
build-aux/link-warning.h Normal file
View file

@ -0,0 +1,28 @@
/* GL_LINK_WARNING("literal string") arranges to emit the literal string as
a linker warning on most glibc systems.
We use a linker warning rather than a preprocessor warning, because
#warning cannot be used inside macros. */
#ifndef GL_LINK_WARNING
/* This works on platforms with GNU ld and ELF object format.
Testing __GLIBC__ is sufficient for asserting that GNU ld is in use.
Testing __ELF__ guarantees the ELF object format.
Testing __GNUC__ is necessary for the compound expression syntax. */
# if defined __GLIBC__ && defined __ELF__ && defined __GNUC__
# define GL_LINK_WARNING(message) \
GL_LINK_WARNING1 (__FILE__, __LINE__, message)
# define GL_LINK_WARNING1(file, line, message) \
GL_LINK_WARNING2 (file, line, message) /* macroexpand file and line */
# define GL_LINK_WARNING2(file, line, message) \
GL_LINK_WARNING3 (file ":" #line ": warning: " message)
# define GL_LINK_WARNING3(message) \
({ static const char warning[sizeof (message)] \
__attribute__ ((__unused__, \
__section__ (".gnu.warning"), \
__aligned__ (1))) \
= message "\n"; \
(void)0; \
})
# else
# define GL_LINK_WARNING(message) ((void) 0)
# endif
#endif

221
configure.in
View file

@ -25,7 +25,7 @@ Boston, MA 02110-1301, USA.
]])
AC_PREREQ(2.59)
AC_PREREQ(2.61)
dnl `patsubst' here deletes the newline which "echo" prints. We can't use
dnl "echo -n" since -n is not portable (see autoconf manual "Limitations of
@ -41,7 +41,7 @@ AC_CONFIG_AUX_DIR([build-aux])
AC_CONFIG_MACRO_DIR([m4])
AC_CONFIG_SRCDIR(GUILE-VERSION)
AM_INIT_AUTOMAKE([gnu no-define check-news])
AM_INIT_AUTOMAKE([gnu no-define check-news -Wall -Wno-override])
AC_COPYRIGHT(GUILE_CONFIGURE_COPYRIGHT)
AC_CONFIG_SRCDIR([GUILE-VERSION])
@ -49,7 +49,7 @@ AC_CONFIG_SRCDIR([GUILE-VERSION])
. $srcdir/GUILE-VERSION
AM_MAINTAINER_MODE
AM_CONFIG_HEADER([config.h])
AC_CONFIG_HEADERS([config.h])
AH_TOP(/*GUILE_CONFIGURE_COPYRIGHT*/)
#--------------------------------------------------------------------
@ -62,8 +62,11 @@ AC_CONFIG_SUBDIRS(guile-readline)
#--------------------------------------------------------------------
AC_LANG([C])
dnl Some more checks for Win32
AC_CYGWIN
AC_CANONICAL_HOST
AC_LIBTOOL_WIN32_DLL
AC_PROG_INSTALL
@ -75,7 +78,8 @@ AC_PROG_AWK
dnl Gnulib.
gl_INIT
AM_PROG_CC_STDC
AC_PROG_CC_C89
# for per-target cflags in the libguile subdir
AM_PROG_CC_C_O
@ -124,7 +128,7 @@ AC_ARG_ENABLE(debug-malloc,
SCM_I_GSC_GUILE_DEBUG=0
AC_ARG_ENABLE(guile-debug,
[AC_HELP_STRING([--enable-guile-debug],
[AS_HELP_STRING([--enable-guile-debug],
[include internal debugging functions])],
if test "$enable_guile_debug" = y || test "$enable_guile_debug" = yes; then
SCM_I_GSC_GUILE_DEBUG=1
@ -143,7 +147,7 @@ AC_ARG_ENABLE(regex,
enable_regex=yes)
AC_ARG_ENABLE([discouraged],
AC_HELP_STRING([--disable-discouraged],[omit discouraged features]))
AS_HELP_STRING([--disable-discouraged],[omit discouraged features]))
if test "$enable_discouraged" = no; then
SCM_I_GSC_ENABLE_DISCOURAGED=0
@ -152,7 +156,7 @@ else
fi
AC_ARG_ENABLE([deprecated],
AC_HELP_STRING([--disable-deprecated],[omit deprecated features]))
AS_HELP_STRING([--disable-deprecated],[omit deprecated features]))
if test "$enable_deprecated" = no; then
SCM_I_GSC_ENABLE_DEPRECATED=0
@ -198,7 +202,7 @@ dnl For now, --without-64-calls allows Guile to build on OSs where it
dnl wasn't building before.
AC_MSG_CHECKING([whether to use system and library "64" calls])
AC_ARG_WITH([64-calls],
AC_HELP_STRING([--without-64-calls],
AS_HELP_STRING([--without-64-calls],
[don't attempt to use system and library calls with "64" in their names]),
[use_64_calls=$withval],
[use_64_calls=yes
@ -581,9 +585,38 @@ AC_SUBST([SCM_I_GSC_NEEDS_STDINT_H])
AC_SUBST([SCM_I_GSC_NEEDS_INTTYPES_H])
AC_HEADER_STDC
AC_HEADER_DIRENT
AC_HEADER_TIME
AC_HEADER_SYS_WAIT
AC_HEADER_DIRENT
# Reason for checking:
#
# HP-UX 11.11 (at least) doesn't provide `struct dirent64', even
# with `_LARGEFILE64_SOURCE', so check whether it's available.
#
AC_CHECK_MEMBER([struct dirent64.d_name],
[SCM_I_GSC_HAVE_STRUCT_DIRENT64=1], [SCM_I_GSC_HAVE_STRUCT_DIRENT64=0],
[ #ifndef _LARGEFILE64_SOURCE
# define _LARGEFILE64_SOURCE
#endif
/* Per Autoconf manual. */
#include <sys/types.h>
#ifdef HAVE_DIRENT_H
# include <dirent.h>
#else
# define dirent direct
# ifdef HAVE_SYS_NDIR_H
# include <sys/ndir.h>
# endif
# ifdef HAVE_SYS_DIR_H
# include <sys/dir.h>
# endif
# ifdef HAVE_NDIR_H
# include <ndir.h>
# endif
#endif ])
AC_SUBST([SCM_I_GSC_HAVE_STRUCT_DIRENT64])
# Reasons for testing:
# complex.h - new in C99
@ -682,6 +715,7 @@ AC_CHECK_HEADERS([assert.h crt_externs.h])
# pipe - not in mingw
# _pipe - specific to mingw, taking 3 args
# readdir_r - recent posix, not on old systems
# readdir64_r - not available on HP-UX 11.11
# stat64 - SuS largefile stuff, not on old systems
# sysconf - not on old systems
# truncate - not in mingw
@ -690,7 +724,7 @@ AC_CHECK_HEADERS([assert.h crt_externs.h])
# strcoll_l, newlocale - GNU extensions (glibc), also available on Darwin
# nl_langinfo - X/Open, not available on Windows.
#
AC_CHECK_FUNCS([DINFINITY DQNAN cexp chsize clog clog10 ctermid fesetround ftime ftruncate fchown getcwd geteuid gettimeofday gmtime_r ioctl lstat mkdir mknod nice pipe _pipe readdir_r readlink rename rmdir select setegid seteuid setlocale setpgid setsid sigaction siginterrupt stat64 strftime strptime symlink sync sysconf tcgetpgrp tcsetpgrp times uname waitpid strdup system usleep atexit on_exit chown link fcntl ttyname getpwent getgrent kill getppid getpgrp fork setitimer getitimer strchr strcmp index bcopy memcpy rindex truncate unsetenv isblank _NSGetEnviron strcoll strcoll_l newlocale nl_langinfo])
AC_CHECK_FUNCS([DINFINITY DQNAN cexp chsize clog clog10 ctermid fesetround ftime ftruncate fchown getcwd geteuid gettimeofday gmtime_r ioctl lstat mkdir mknod nice pipe _pipe readdir_r readdir64_r readlink rename rmdir select setegid seteuid setlocale setpgid setsid sigaction siginterrupt stat64 strftime strptime symlink sync sysconf tcgetpgrp tcsetpgrp times uname waitpid strdup system usleep atexit on_exit chown link fcntl ttyname getpwent getgrent kill getppid getpgrp fork setitimer getitimer strchr strcmp index bcopy memcpy rindex truncate unsetenv isblank _NSGetEnviron strcoll strcoll_l newlocale nl_langinfo])
# Reasons for testing:
# netdb.h - not in mingw
@ -729,24 +763,28 @@ AC_SEARCH_LIBS(crypt, crypt,
# is a workaround for the failure of some systems to conform to C99.
if test "$ac_cv_type_complex_double" = yes; then
AC_MSG_CHECKING([for i])
AC_TRY_COMPILE([
AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[
#if HAVE_COMPLEX_H
#include <complex.h>
#endif
complex double z;
],[
]], [[
z = _Complex_I;
],[AC_DEFINE(GUILE_I,_Complex_I,[The imaginary unit (positive square root of -1).])
AC_MSG_RESULT([_Complex_I])],[AC_TRY_COMPILE([
]])],
[AC_DEFINE(GUILE_I,_Complex_I,[The imaginary unit (positive square root of -1).])
AC_MSG_RESULT([_Complex_I])],
[AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[
#if HAVE_COMPLEX_H
#include <complex.h>
#endif
complex double z;
],[
]],[[
z = 1.0fi;
],[AC_DEFINE(GUILE_I,1.0fi)
AC_MSG_RESULT([1.0fi])],[ac_cv_type_complex_double=no
AC_MSG_RESULT([not available])])])
]])],
[AC_DEFINE(GUILE_I,1.0fi)
AC_MSG_RESULT([1.0fi])],
[ac_cv_type_complex_double=no
AC_MSG_RESULT([not available])])])
fi
# glibc 2.3.6 (circa 2006) and various prior versions had a bug where
@ -757,7 +795,7 @@ if test "$ac_cv_type_complex_double" = yes; then
AC_CACHE_CHECK([whether csqrt is usable],
guile_cv_use_csqrt,
[AC_TRY_RUN([
[AC_RUN_IFELSE([AC_LANG_SOURCE([[
#include <complex.h>
/* "volatile" is meant to prevent gcc from calculating the sqrt as a
constant, we want to test libc. */
@ -770,7 +808,7 @@ main (void)
return 0; /* good */
else
return 1; /* bad */
}],
}]])],
[guile_cv_use_csqrt=yes],
[guile_cv_use_csqrt="no, glibc 2.3 bug"],
[guile_cv_use_csqrt="yes, hopefully (cross-compiling)"])])
@ -787,8 +825,9 @@ AC_CHECK_LIB([gmp], [__gmpz_init], ,
[AC_MSG_ERROR([GNU MP not found, see README])])
# mpz_import is a macro so we need to include <gmp.h>
AC_TRY_LINK([#include <gmp.h>],
[mpz_import (0, 0, 0, 0, 0, 0, 0);] , ,
AC_LINK_IFELSE([AC_LANG_PROGRAM([[#include <gmp.h>]],
[[mpz_import (0, 0, 0, 0, 0, 0, 0); ]])],
[],
[AC_MSG_ERROR([At least GNU MP 4.1 is required, see README])])
dnl i18n tests
@ -866,11 +905,11 @@ AC_CHECK_MEMBERS([struct sockaddr.sin_len],,,
AC_MSG_CHECKING(for __libc_stack_end)
AC_CACHE_VAL(guile_cv_have_libc_stack_end,
[AC_TRY_LINK([#include <stdio.h>
extern char *__libc_stack_end;],
[printf("%p", (char*) __libc_stack_end);],
guile_cv_have_libc_stack_end=yes,
guile_cv_have_libc_stack_end=no)])
[AC_LINK_IFELSE([AC_LANG_PROGRAM([[#include <stdio.h>
extern char *__libc_stack_end;]],
[[printf("%p", (char*) __libc_stack_end);]])],
[guile_cv_have_libc_stack_end=yes],
[guile_cv_have_libc_stack_end=no])])
AC_MSG_RESULT($guile_cv_have_libc_stack_end)
if test $guile_cv_have_libc_stack_end = yes; then
@ -883,9 +922,10 @@ dnl macro. With cygwin it may be in a DLL.
AC_MSG_CHECKING(whether netdb.h declares h_errno)
AC_CACHE_VAL(guile_cv_have_h_errno,
[AC_TRY_COMPILE([#include <netdb.h>],
[int a = h_errno;],
guile_cv_have_h_errno=yes, guile_cv_have_h_errno=no)])
[AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include <netdb.h>]],
[[int a = h_errno;]])],
[guile_cv_have_h_errno=yes],
[guile_cv_have_h_errno=no])])
AC_MSG_RESULT($guile_cv_have_h_errno)
if test $guile_cv_have_h_errno = yes; then
AC_DEFINE(HAVE_H_ERRNO, 1, [Define if h_errno is declared in netdb.h.])
@ -893,15 +933,16 @@ fi
AC_MSG_CHECKING(whether uint32_t is defined)
AC_CACHE_VAL(guile_cv_have_uint32_t,
[AC_TRY_COMPILE([#include <sys/types.h>
[AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include <sys/types.h>
#if HAVE_STDINT_H
#include <stdint.h>
#endif
#ifndef HAVE_NETDB_H
#include <netdb.h>
#endif],
[uint32_t a;],
guile_cv_have_uint32_t=yes, guile_cv_have_uint32_t=no)])
#endif]],
[[uint32_t a;]])],
[guile_cv_have_uint32_t=yes],
[guile_cv_have_uint32_t=no])])
AC_MSG_RESULT($guile_cv_have_uint32_t)
if test $guile_cv_have_uint32_t = yes; then
AC_DEFINE(HAVE_UINT32_T, 1,
@ -910,14 +951,15 @@ fi
AC_MSG_CHECKING(for working IPv6 support)
AC_CACHE_VAL(guile_cv_have_ipv6,
[AC_TRY_COMPILE([
[AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[
#ifdef HAVE_SYS_TYPES_H
#include <sys/types.h>
#endif
#include <netinet/in.h>
#include <sys/socket.h>],
[struct sockaddr_in6 a; a.sin6_family = AF_INET6;],
guile_cv_have_ipv6=yes, guile_cv_have_ipv6=no)])
#include <sys/socket.h>]],
[[struct sockaddr_in6 a; a.sin6_family = AF_INET6;]])],
[guile_cv_have_ipv6=yes],
[guile_cv_have_ipv6=no])])
AC_MSG_RESULT($guile_cv_have_ipv6)
if test $guile_cv_have_ipv6 = yes; then
AC_DEFINE(HAVE_IPV6, 1, [Define if you want support for IPv6.])
@ -926,13 +968,14 @@ fi
# included in rfc2553 but not in older implementations, e.g., glibc 2.1.3.
AC_MSG_CHECKING(whether sockaddr_in6 has sin6_scope_id)
AC_CACHE_VAL(guile_cv_have_sin6_scope_id,
[AC_TRY_COMPILE([
[AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[
#ifdef HAVE_SYS_TYPES_H
#include <sys/types.h>
#endif
#include <netinet/in.h>],
[struct sockaddr_in6 sok; sok.sin6_scope_id = 0;],
guile_cv_have_sin6_scope_id=yes, guile_cv_have_sin6_scope_id=no)])
#include <netinet/in.h>]],
[[struct sockaddr_in6 sok; sok.sin6_scope_id = 0;]])],
[guile_cv_have_sin6_scope_id=yes],
[guile_cv_have_sin6_scope_id=no])])
AC_MSG_RESULT($guile_cv_have_sin6_scope_id)
if test $guile_cv_have_sin6_scope_id = yes; then
AC_DEFINE(HAVE_SIN6_SCOPE_ID, 1,
@ -949,7 +992,7 @@ AC_CHECK_MEMBERS([struct sockaddr_in6.sin6_len],,,
AC_MSG_CHECKING(whether localtime caches TZ)
AC_CACHE_VAL(guile_cv_localtime_cache,
[if test x$ac_cv_func_tzset = xyes; then
AC_TRY_RUN([#include <time.h>
AC_RUN_IFELSE([AC_LANG_SOURCE([[#include <time.h>
#if STDC_HEADERS
# include <stdlib.h>
#endif
@ -980,7 +1023,9 @@ main()
if (localtime (&now)->tm_hour != hour_unset)
exit (1);
exit (0);
}], guile_cv_localtime_cache=no, guile_cv_localtime_cache=yes,
}]])],
[guile_cv_localtime_cache=no],
[guile_cv_localtime_cache=yes],
[# If we have tzset, assume the worst when cross-compiling.
guile_cv_localtime_cache=yes])
else
@ -1098,15 +1143,42 @@ GUILE_STRUCT_UTIMBUF
#
# Which way does the stack grow?
#
# Following code comes from Autoconf 2.61's internal _AC_LIBOBJ_ALLOCA
# macro (/usr/share/autoconf/autoconf/functions.m4). Gnulib has
# very similar code, so in future we could look at using that.
#
# An important detail is that the code involves find_stack_direction
# calling _itself_ - which means that find_stack_direction (or at
# least the second find_stack_direction() call) cannot be inlined.
# If the code could be inlined, that might cause the test to give
# an incorrect answer.
#--------------------------------------------------------------------
SCM_I_GSC_STACK_GROWS_UP=0
AC_TRY_RUN(aux (l) unsigned long l;
{ int x; exit (l >= ((unsigned long)&x)); }
main () { int q; aux((unsigned long)&q); },
[SCM_I_GSC_STACK_GROWS_UP=1],
[],
[AC_MSG_WARN(Guessing that stack grows down -- see scmconfig.h)])
AC_RUN_IFELSE([AC_LANG_SOURCE(
[AC_INCLUDES_DEFAULT
int
find_stack_direction ()
{
static char *addr = 0;
auto char dummy;
if (addr == 0)
{
addr = &dummy;
return find_stack_direction ();
}
else
return (&dummy > addr) ? 1 : -1;
}
int
main ()
{
return find_stack_direction () < 0;
}])],
[SCM_I_GSC_STACK_GROWS_UP=1],
[],
[AC_MSG_WARN(Guessing that stack grows down -- see scmconfig.h)])
AC_CHECK_SIZEOF(float)
if test "$ac_cv_sizeof_float" -le "$ac_cv_sizeof_long"; then
@ -1116,12 +1188,12 @@ fi
AC_MSG_CHECKING(for struct linger)
AC_CACHE_VAL(scm_cv_struct_linger,
AC_TRY_COMPILE([
AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[
#include <sys/types.h>
#include <sys/socket.h>],
[struct linger lgr; lgr.l_linger = 100],
scm_cv_struct_linger="yes",
scm_cv_struct_linger="no"))
#include <sys/socket.h>]],
[[struct linger lgr; lgr.l_linger = 100]])],
[scm_cv_struct_linger="yes"],
[scm_cv_struct_linger="no"]))
AC_MSG_RESULT($scm_cv_struct_linger)
if test $scm_cv_struct_linger = yes; then
AC_DEFINE(HAVE_STRUCT_LINGER, 1,
@ -1134,14 +1206,13 @@ fi
#
AC_MSG_CHECKING(for struct timespec)
AC_CACHE_VAL(scm_cv_struct_timespec,
AC_TRY_COMPILE([
AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[
#include <time.h>
#if HAVE_PTHREAD_H
#include <pthread.h>
#endif],
[struct timespec t; t.tv_nsec = 100],
scm_cv_struct_timespec="yes",
scm_cv_struct_timespec="no"))
#endif]], [[struct timespec t; t.tv_nsec = 100]])],
[scm_cv_struct_timespec="yes"],
[scm_cv_struct_timespec="no"]))
AC_MSG_RESULT($scm_cv_struct_timespec)
if test $scm_cv_struct_timespec = yes; then
AC_DEFINE(HAVE_STRUCT_TIMESPEC, 1,
@ -1168,6 +1239,9 @@ AC_SUBST(SCM_I_GSC_NEED_BRACES_ON_PTHREAD_MUTEX_INITIALIZER, 0)
case "$with_threads" in
"yes" | "pthread" | "pthreads" | "pthread-threads" | "")
build_pthread_support="yes"
ACX_PTHREAD(CC="$PTHREAD_CC"
LIBS="$PTHREAD_LIBS $LIBS"
SCM_I_GSC_USE_PTHREAD_THREADS=1
@ -1247,6 +1321,10 @@ esac
AC_MSG_CHECKING(what kind of threads to support)
AC_MSG_RESULT($with_threads)
AM_CONDITIONAL([BUILD_PTHREAD_SUPPORT],
[test "x$build_pthread_support" = "xyes"])
## Check whether pthread_attr_getstack works for the main thread
if test "$with_threads" = pthreads; then
@ -1254,8 +1332,7 @@ if test "$with_threads" = pthreads; then
AC_MSG_CHECKING(whether pthread_attr_getstack works for the main thread)
old_CFLAGS="$CFLAGS"
CFLAGS="$PTHREAD_CFLAGS $CFLAGS"
AC_TRY_RUN(
[
AC_RUN_IFELSE([AC_LANG_SOURCE([[
#if HAVE_PTHREAD_ATTR_GETSTACK
#include <pthread.h>
@ -1280,10 +1357,11 @@ int main ()
return 1;
}
#endif
],
]])],
[works=yes
AC_DEFINE(PTHREAD_ATTR_GETSTACK_WORKS, [1], [Define when pthread_att_get_stack works for the main thread])],
[works=no])
[works=no],
[])
CFLAGS="$old_CFLAGS"
AC_MSG_RESULT($works)
@ -1341,17 +1419,19 @@ case "$GCC" in
## less than exasperating.
## -Wpointer-arith was here too, but something changed in gcc/glibc
## and it became equally exasperating (gcc 2.95 and/or glibc 2.1.2).
CFLAGS="$CFLAGS -Wall -Wmissing-prototypes"
GCC_CFLAGS="-Wall -Wmissing-prototypes"
# Do this here so we don't screw up any of the tests above that might
# not be "warning free"
if test "${GUILE_ERROR_ON_WARNING}" = yes
then
CFLAGS="${CFLAGS} -Werror"
GCC_CFLAGS="${GCC_CFLAGS} -Werror"
enable_compile_warnings=no
fi
;;
esac
AC_SUBST(GCC_CFLAGS)
## If we're creating a shared library (using libtool!), then we'll
## need to generate a list of .lo files corresponding to the .o files
## given in LIBOBJS. We'll call it LIBLOBJS.
@ -1425,6 +1505,12 @@ AC_SUBST(top_builddir_absolute)
top_srcdir_absolute=`(cd $srcdir && pwd)`
AC_SUBST(top_srcdir_absolute)
dnl We need `sitedir' in `guile-1.8.pc'.
dnl Note: `sitedir' must be kept in sync with `GUILE_SITE_DIR' in `guile.m4'.
pkgdatadir="$datadir/guile"
sitedir="$pkgdatadir/site"
AC_SUBST([sitedir])
# Additional SCM_I_GSC definitions are above.
AC_SUBST([SCM_I_GSC_GUILE_DEBUG])
AC_SUBST([SCM_I_GSC_GUILE_DEBUG_FREELIST])
@ -1481,6 +1567,7 @@ AC_CONFIG_FILES([
testsuite/Makefile
])
AC_CONFIG_FILES([guile-1.8.pc])
AC_CONFIG_FILES([check-guile], [chmod +x check-guile])
AC_CONFIG_FILES([benchmark-guile], [chmod +x benchmark-guile])
AC_CONFIG_FILES([guile-tools], [chmod +x guile-tools])

4
doc/ChangeLog
View file

@ -1,3 +1,7 @@
2008-04-26 Ludovic Courtès <ludo@gnu.org>
* Makefile.am (EXAMPLE_SMOB_FILES): Remove `COPYING'.
2008-01-22 Neil Jerram <neil@ossau.uklinux.net>
* COPYING: Removed.

4
doc/Makefile.am
View file

@ -1,6 +1,6 @@
## Process this file with Automake to create Makefile.in
##
## Copyright (C) 1998, 2002, 2006 Free Software Foundation, Inc.
## Copyright (C) 1998, 2002, 2006, 2008 Free Software Foundation, Inc.
##
## This file is part of GUILE.
##
@ -27,7 +27,7 @@ SUBDIRS = ref tutorial goops r5rs
# man_MANS = guile.1
EXAMPLE_SMOB_FILES = \
ChangeLog Makefile README COPYING image-type.c image-type.h myguile.c
ChangeLog Makefile README image-type.c image-type.h myguile.c
OLDFMT = oldfmt.c

136
doc/ref/ChangeLog
View file

@ -1,3 +1,71 @@
2008-07-17 Neil Jerram <neil@ossau.uklinux.net>
* scheme-using.texi (Evaluating Scheme Code): Document use of
`C-u' prefix with evaluation commands.
2008-07-05 Ludovic Courtès <ludo@gnu.org>
* api-data.texi (Symbol Primitives): Add `scm_c_symbol_length ()'.
2008-06-30 Julian Graham <joolean@gmail.com>
* srfi-modules.texi (SRFI-18): New section.
(SRFI-19 Time): Mention SRFI-18's `current-time'.
2008-06-28 Ludovic Courtès <ludo@gnu.org>
* api-modules.texi (Using Guile Modules): Substitute "syntax
transformer" to "system transformer". Reported by Sebastian
Tennant <sebyte@smolny.plus.com>.
2008-06-01 Ludovic Courtès <ludo@gnu.org>
* srfi-modules.texi (SRFI-88): Fix URL.
2008-05-14 Julian Graham <joolean@gmail.com>
* api-scheduling.texi (Mutexes and Condition Variables): Add
documentation for new functions "scm_mutex_owner",
"scm_mutex_level", and "scm_mutex_locked_p". Update
documentation for function "scm_lock_mutex_timed" to reflect
addition of optional ownership argument.
2008-05-07 Ludovic Courtès <ludo@gnu.org>
* Makefile.am (autoconf-macros.texi): Avoid use of GNU Make
specific `$<' variable. This broke with BSD Make as found on
FreeBSD 6.2.
2008-05-05 Neil Jerram <neil@ossau.uklinux.net>
* scheme-using.texi (Using Guile in Emacs): Add concept index
entries `GDS' and `Emacs'.
* api-debug.texi (Debugging): Add concept index entry `Debugging'.
2008-05-04 Ludovic Courtès <ludo@gnu.org>
* guile.texi (Guile Modules): Include `autoconf.texi'.
* autoconf.texi (Autoconf Support): Mention `pkg-config'.
(Autoconf Macros): Document `pkg-config' support.
2008-04-26 Ludovic Courtès <ludo@gnu.org>
* srfi-modules.texi (SRFI-88): New section.
* api-data.texi (Keyword Read Syntax): Add reference to
`SRFI-88'.
2008-04-17 Neil Jerram <neil@ossau.uklinux.net>
* posix.texi (File System): New doc for file-exists?.
2008-04-15 Ludovic Courtès <ludo@gnu.org>
* api-data.texi (Keywords): Mention postfix syntax.
(Keyword Read Syntax): Document `postfix' read option.
* api-options.texi (Reader options): Update examples.
(Examples of option use): Likewise.
2008-03-28 Neil Jerram <neil@ossau.uklinux.net>
* libguile-concepts.texi (Multi-Threading): Fix typo.
@ -6,7 +74,7 @@
Applying patch from Julian Graham, containing minor fixes to his
thread enhancements:
* api-scheduling.texi (Mutexes and Condition Variables): Change
`flag' to `flags' in docstring.
@ -42,14 +110,14 @@
(Examples): Moved to api-debug.texi.
(Tracing, Old Tracing): Promoted one level.
(New Tracing, Tracing Compared): Removed.
2008-03-08 Julian Graham <joolean@gmail.com>
* api-scheduling.texi (Threads): Add documentation for new
* api-scheduling.texi (Threads): Add documentation for new
functions "scm_thread_p" and new "scm_join_thread_timed".
(Mutexes and Condition Variables): Add documentation for new
functions "scm_make_mutex_with_flags", "scm_mutex_p",
"scm_lock_mutex_timed", "scm_unlock_mutex_timed", and
(Mutexes and Condition Variables): Add documentation for new
functions "scm_make_mutex_with_flags", "scm_mutex_p",
"scm_lock_mutex_timed", "scm_unlock_mutex_timed", and
"scm_condition_variable_p".
2008-02-11 Neil Jerram <neil@ossau.uklinux.net>
@ -211,7 +279,7 @@
(lib-version.texi): New target.
* guile.texi: Include `lib-version.texi'.
* api-data.texi (Conversion): Link to `The ice-9 i18n Module' when
describing `string->number'.
(String Comparison): Likewise.
@ -399,7 +467,7 @@
* api-debug.texi (Debug on Error): Note need to handling of errors
in C.
* api-debug.texi (Debugging): New intro text. New subsection
"Evaluation Model". Moved existing subsections "Capturing the
Stack or Innermost Stack Frame", "Examining the Stack", "Examining
@ -435,7 +503,7 @@
* api-evaluation.texi (Fly Evaluation): Add scm_c_eval_string.
(Loading): Add scm_c_primitive_load.
Reported by Jon Wilson.
2006-06-25 Kevin Ryde <user42@zip.com.au>
* posix.texi (Time): In tm:gmtoff, give example values, note not the
@ -569,7 +637,7 @@
* api-data.texi (Operations Related to Symbols):
Documented `scm_take_locale_symbol ()'.
2005-12-15 Kevin Ryde <user42@zip.com.au>
* api-evaluation.texi (Fly Evaluation): Add scm_call_4, suggested by
@ -660,7 +728,7 @@
* misc-modules.texi (Formatted Output): Show modifiers like ~:d
instead of in words.
2005-08-06 Kevin Ryde <user42@zip.com.au>
* api-compound.texi (List Modification): In filter, return may share a
@ -1007,7 +1075,7 @@
* api-i18n.texi: New file.
* Makefile.am (guile_TEXINFOS): Added it.
* guile.texi: Include it.
2004-09-16 Kevin Ryde <user42@zip.com.au>
* api-utility.texi (Equality): Revise for clarity.
@ -1062,16 +1130,16 @@
Ran a (docstring-process-module "(guile)") and moved entries from
new-docstrings.texi to their appropriate place.
* api-undocumented.texi: New file.
2004-08-21 Marius Vollmer <mvo@zagadka.de>
From Richard Todd, Thanks!
* scheme-scripts.texi (Invoking Guile): documented new '-L'
switch.
2004-08-20 Marius Vollmer <mvo@zagadka.de>
* gh.texi: Updated transition section with new recommended things.
@ -1082,7 +1150,7 @@
mutation-sharing substrings.
(Symbols): Document scm_from_locale_symbol and
scm_from_locale_symboln.
2004-08-18 Kevin Ryde <user42@zip.com.au>
* posix.texi (Network Sockets and Communication): Add SOCK_RDM and
@ -1144,7 +1212,7 @@
scm_is_complex, scm_is_number, scm_c_make_rectangular,
scm_c_make_polar, scm_c_real_part, scm_c_imag_part,
scm_c_magnitude, and scm_c_angle.
2004-08-02 Marius Vollmer <marius.vollmer@uni-dortmund.de>
* gh.texi: Replaced references to scm_num2* with scm_to_* and
@ -1180,7 +1248,7 @@
* api-deprecated.texi: Removed.
* intro.texi (Discouraged and Deprecated): General information
about deprecation, etc.
2004-07-30 Marius Vollmer <marius.vollmer@uni-dortmund.de>
* misc-modules.texi (Formatted Output): Changed @w to @w{} in
@ -1265,7 +1333,7 @@
* Makefile.am (CLEANFILES): Remove guile.cps guile.fns guile.rns
guile.tps guile.vrs guile.tmp, cleaned by automake these days.
2004-05-06 Marius Vollmer <marius.vollmer@uni-dortmund.de>
* scheme-smobs.texi: Updated for new SCM_SMOB_* macros.
@ -1348,7 +1416,7 @@
* scheme-control.texi (while do): Expand and clarify `do', in
particular note iteration binds fresh locations, rather than values
"stored".
* srfi-modules.texi (SRFI-4): Revise for clarity, give each function
explicitly rather than showing TAG so Emacs info-look can find them,
merge "SRFI-4 - Read Syntax" and "SRFI-4 - Procedures" into just one
@ -1378,7 +1446,7 @@
2004-01-21 Marius Vollmer <mvo@zagadka.de>
Added copyright notices to all TeXinfo files.
* fdl.texi: New.
* guile.texi: Include it as an appendix.
* preface.texi: State that the manual is FDL.
@ -1400,7 +1468,7 @@
* misc-modules.texi (Queues): New chapter.
* guile.texi (Top): Add it.
2004-01-09 Kevin Ryde <user42@zip.com.au>
* scheme-compound.texi (Bit Vectors): Revise for clarity, following
@ -1455,7 +1523,7 @@
* scheme-data.texi: Include exact rationals.
From Stephen Compall. Thanks!
* intro.texi (What is Guile?): Add @acronym for POSIX, R5RS, GUI,
and HTTP. Conclude linking libguile. Say what one can find *for*.
@ -1536,7 +1604,7 @@
* data-rep.texi, scheme-memory.texi (scm_remember_upto_here_1,
scm_remember_upto_here_2): Moved from data-rep.texi to
scheme-memory.texi.
2003-10-02 Kevin Ryde <user42@zip.com.au>
* scheme-io.texi (String Ports): In call-with-output-string, note proc
@ -1867,7 +1935,7 @@
remainder and modulo round their results.
* scheme-io.texi (Reading): In read-char and peek-char, fix typos "?"
in @rnindex. In port-column, use @: after i.e.
in @rnindex. In port-column, use @: after i.e.
(Writing): In get-print-state, two spaces after full stop. Add write,
revise display.
@ -1886,7 +1954,7 @@
2003-04-30 Marius Vollmer <marius.vollmer@uni-dortmund.de>
* posix.texi (scm_c_port_for_each): Added.
* posix.texi (scm_c_port_for_each): Added.
2003-04-26 Neil Jerram <neil@ossau.uklinux.net>
@ -2017,7 +2085,7 @@
Configuration.
The following doc updates are from Ian Sheldon - thanks!
* scheme-data.texi (Appending Strings, Regexp Functions, Match
Structures): Add examples.
(Regular Expressions): Add instruction to use (ice-9 regex)
@ -2055,7 +2123,7 @@
* intro.texi: Updated GNu ftp server name. Use "-lguile" instead
of "libguile.a". Some small fixes/improvements.
* scheme-reading.texi: Added www.schemers.org. Removed foldoc,
it's too generic. Updated 'teach yourself ...' URL.
@ -2066,7 +2134,7 @@
2002-08-14 Marius Vollmer <mvo@zagadka.ping.de>
* scheme-evaluation.texi (eval-string): Updated.
* scheme-evaluation.texi (eval-string): Updated.
* scheme-scheduling.texi (Fluids): Touched up a bit, added
with-fluids.
@ -2106,7 +2174,7 @@
* scheme-memory.texi (Memory Blocks): add scm_calloc, scm_gc_calloc.
correct typos.
2002-08-05 Marius Vollmer <marius.vollmer@uni-dortmund.de>
* intro.texi, srfi-modules.texi: Added (use-modules (ice-9
@ -2150,7 +2218,7 @@
rather than deprecated section. Hence this change. Added
`@deftp' for scm_t_bits data type so that a proper index entry is
added for this. Thanks to Richard Y. Kim!
* data-rep.texi (Subrs): Changed scm_make_gsubr to
scm_c_define_gsubr. Thanks to Richard Y. Kim!
@ -2187,13 +2255,13 @@
* scheme-debug.texi (Debugging): Rename chapter `Debugging
Infrastructure' and reorganize its contents.
* scheme-debug.texi (Debugging), scheme-control.texi (Handling
Errors): Move display-error to error-focussed section.
* scheme-debug.texi (Debugging), debugging.texi (Backtrace): Move
backtrace to user-level debugging chapter.
* scheme-debug.texi (Debugging), scheme-procedures.texi (Procedure
Properties): Move procedure-name, procedure-source and
procedure-environment to procedures chapter.
@ -2276,7 +2344,7 @@
* scheme-utility.texi (Hooks): Further updates. New material on
GC hooks.
* scheme-evaluation.texi (Fly Evaluation): Note disappearance of
eval2 and read-and-eval!.

5
doc/ref/Makefile.am
View file

@ -1,6 +1,6 @@
## Process this file with Automake to create Makefile.in
##
## Copyright (C) 1998, 2004, 2006 Free Software Foundation, Inc.
## Copyright (C) 1998, 2004, 2006, 2008 Free Software Foundation, Inc.
##
## This file is part of GUILE.
##
@ -86,7 +86,8 @@ include $(top_srcdir)/am/pre-inst-guile
autoconf.texi: autoconf-macros.texi
autoconf-macros.texi: $(top_srcdir)/guile-config/guile.m4
$(preinstguiletool)/snarf-guile-m4-docs $< > $(srcdir)/$@
$(preinstguiletool)/snarf-guile-m4-docs $(top_srcdir)/guile-config/guile.m4 \
> $(srcdir)/$@
lib-version.texi: $(top_srcdir)/GUILE-VERSION
cat "$^" | grep '^LIBGUILE_.*_MAJOR' | \

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

@ -4647,6 +4647,11 @@ immediately after creating the Scheme string. In certain cases, Guile
can then use @var{str} directly as its internal representation.
@end deftypefn
The size of a symbol can also be obtained from C:
@deftypefn {C Function} size_t scm_c_symbol_length (SCM sym)
Return the number of characters in @var{sym}.
@end deftypefn
Finally, some applications, especially those that generate new Scheme
code dynamically, need to generate symbols for use in the generated
@ -4901,7 +4906,7 @@ makes them easy to type.
Guile's keyword support conforms to R5RS, and adds a (switchable) read
syntax extension to permit keywords to begin with @code{:} as well as
@code{#:}.
@code{#:}, or to end with @code{:}.
@menu
* Why Use Keywords?:: Motivation for keyword usage.
@ -5046,9 +5051,16 @@ If the @code{keyword} read option is set to @code{'prefix}, Guile also
recognizes the alternative read syntax @code{:NAME}. Otherwise, tokens
of the form @code{:NAME} are read as symbols, as required by R5RS.
@cindex SRFI-88 keyword syntax
If the @code{keyword} read option is set to @code{'postfix}, Guile
recognizes the SRFI-88 read syntax @code{NAME:} (@pxref{SRFI-88}).
Otherwise, tokens of this form are read as symbols.
To enable and disable the alternative non-R5RS keyword syntax, you use
the @code{read-set!} procedure documented in @ref{User level options
interfaces} and @ref{Reader options}.
interfaces} and @ref{Reader options}. Note that the @code{prefix} and
@code{postfix} syntax are mutually exclusive.
@smalllisp
(read-set! keywords 'prefix)
@ -5061,6 +5073,16 @@ interfaces} and @ref{Reader options}.
@result{}
#:type
(read-set! keywords 'postfix)
type:
@result{}
#:type
:type
@result{}
:type
(read-set! keywords #f)
#:type

1
doc/ref/api-debug.texi
View file

@ -8,6 +8,7 @@
@node Debugging
@section Debugging Infrastructure
@cindex Debugging
In order to understand Guile's debugging facilities, you first need to
understand a little about how the evaluator works and what the Scheme
stack is. With that in place we explain the low level trap calls that

10
doc/ref/api-modules.texi
View file

@ -1,6 +1,6 @@
@c -*-texinfo-*-
@c This is part of the GNU Guile Reference Manual.
@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2007
@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2007, 2008
@c Free Software Foundation, Inc.
@c See the file guile.texi for copying conditions.
@ -329,12 +329,12 @@ Signal error if module name is not resolvable.
@c FIXME::martin: Is this correct, and is there more to say?
@c FIXME::martin: Define term and concept `system transformer' somewhere.
@c FIXME::martin: Define term and concept `syntax transformer' somewhere.
@deffn syntax use-syntax module-name
Load the module @code{module-name} and use its system
transformer as the system transformer for the currently defined module,
as well as installing it as the current system transformer.
Load the module @code{module-name} and use its syntax
transformer as the syntax transformer for the currently defined module,
as well as installing it as the current syntax transformer.
@end deffn
@deffn syntax @@ module-name binding-name

6
doc/ref/api-options.texi
View file

@ -1,6 +1,6 @@
@c -*-texinfo-*-
@c This is part of the GNU Guile Reference Manual.
@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2005, 2006
@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2008
@c Free Software Foundation, Inc.
@c See the file guile.texi for copying conditions.
@ -491,7 +491,7 @@ Here is the list of reader options generated by typing
values.
@smalllisp
keywords #f Style of keyword recognition: #f or 'prefix
keywords #f Style of keyword recognition: #f, 'prefix or 'postfix
case-insensitive no Convert symbols to lower case.
positions yes Record positions of source code expressions.
copy no Copy source code expressions.
@ -729,7 +729,7 @@ ABORT: (misc-error)
Type "(backtrace)" to get more information.
guile> (read-options 'help)
keywords #f Style of keyword recognition: #f or 'prefix
keywords #f Style of keyword recognition: #f, 'prefix or 'postfix
case-insensitive no Convert symbols to lower case.
positions yes Record positions of source code expressions.
copy no Copy source code expressions.

77
doc/ref/api-scheduling.texi
View file

@ -90,8 +90,8 @@ execution and triggering this execution. They will not be executed
automatically.
@menu
* System asyncs::
* User asyncs::
* System asyncs::
* User asyncs::
@end menu
@node System asyncs
@ -279,11 +279,11 @@ Return @code{#t} iff @var{obj} is a thread; otherwise, return
@deffnx {C Function} scm_join_thread_timed (thread, timeout, timeoutval)
Wait for @var{thread} to terminate and return its exit value. Threads
that have not been created with @code{call-with-new-thread} or
@code{scm_spawn_thread} have an exit value of @code{#f}. When
@code{scm_spawn_thread} have an exit value of @code{#f}. When
@var{timeout} is given, it specifies a point in time where the waiting
should be aborted. It can be either an integer as returned by
@code{current-time} or a pair as returned by @code{gettimeofday}.
When the waiting is aborted, @var{timeoutval} is returned (if it is
should be aborted. It can be either an integer as returned by
@code{current-time} or a pair as returned by @code{gettimeofday}.
When the waiting is aborted, @var{timeoutval} is returned (if it is
specified; @code{#f} is returned otherwise).
@end deffn
@ -378,9 +378,9 @@ in all threads is one way to avoid such problems.
@deffn {Scheme Procedure} make-mutex . flags
@deffnx {C Function} scm_make_mutex ()
@deffnx {C Function} scm_make_mutex_with_flags (SCM flags)
Return a new mutex. It is initially unlocked. If @var{flags} is
Return a new mutex. It is initially unlocked. If @var{flags} is
specified, it must be a list of symbols specifying configuration flags
for the newly-created mutex. The supported flags are:
for the newly-created mutex. The supported flags are:
@table @code
@item unchecked-unlock
Unless this flag is present, a call to `unlock-mutex' on the returned
@ -398,7 +398,7 @@ The returned mutex will be recursive.
@deffn {Scheme Procedure} mutex? obj
@deffnx {C Function} scm_mutex_p (obj)
Return @code{#t} iff @var{obj} is a mutex; otherwise, return
Return @code{#t} iff @var{obj} is a mutex; otherwise, return
@code{#f}.
@end deffn
@ -409,16 +409,20 @@ function is equivalent to calling `make-mutex' and specifying the
@code{recursive} flag.
@end deffn
@deffn {Scheme Procedure} lock-mutex mutex [timeout]
@deffn {Scheme Procedure} lock-mutex mutex [timeout [owner]]
@deffnx {C Function} scm_lock_mutex (mutex)
@deffnx {C Function} scm_lock_mutex_timed (mutex, timeout)
Lock @var{mutex}. If the mutex is already locked by another thread
then block and return only when @var{mutex} has been acquired.
@deffnx {C Function} scm_lock_mutex_timed (mutex, timeout, owner)
Lock @var{mutex}. If the mutex is already locked, then block and
return only when @var{mutex} has been acquired.
When @var{timeout} is given, it specifies a point in time where the
waiting should be aborted. It can be either an integer as returned
by @code{current-time} or a pair as returned by @code{gettimeofday}.
When the waiting is aborted, @code{#f} is returned.
When @var{timeout} is given, it specifies a point in time where the
waiting should be aborted. It can be either an integer as returned
by @code{current-time} or a pair as returned by @code{gettimeofday}.
When the waiting is aborted, @code{#f} is returned.
When @var{owner} is given, it specifies an owner for @var{mutex} other
than the calling thread. @var{owner} may also be @code{#f},
indicating that the mutex should be locked but left unowned.
For standard mutexes (@code{make-mutex}), and error is signalled if
the thread has itself already locked @var{mutex}.
@ -429,7 +433,7 @@ call increments the lock count. An additional @code{unlock-mutex}
will be required to finally release.
If @var{mutex} was locked by a thread that exited before unlocking it,
the next attempt to lock @var{mutex} will succeed, but
the next attempt to lock @var{mutex} will succeed, but
@code{abandoned-mutex-error} will be signalled.
When a system async (@pxref{System asyncs}) is activated for a thread
@ -441,7 +445,7 @@ executed. When the async returns, the wait resumes.
Arrange for @var{mutex} to be locked whenever the current dynwind
context is entered and to be unlocked when it is exited.
@end deftypefn
@deffn {Scheme Procedure} try-mutex mx
@deffnx {C Function} scm_try_mutex (mx)
Try to lock @var{mutex} as per @code{lock-mutex}. If @var{mutex} can
@ -454,23 +458,44 @@ the return is @code{#f}.
@deffnx {C Function} scm_unlock_mutex (mutex)
@deffnx {C Function} scm_unlock_mutex_timed (mutex, condvar, timeout)
Unlock @var{mutex}. An error is signalled if @var{mutex} is not locked
and was not created with the @code{unchecked-unlock} flag set, or if
and was not created with the @code{unchecked-unlock} flag set, or if
@var{mutex} is locked by a thread other than the calling thread and was
not created with the @code{allow-external-unlock} flag set.
If @var{condvar} is given, it specifies a condition variable upon
which the calling thread will wait to be signalled before returning.
(This behavior is very similar to that of
(This behavior is very similar to that of
@code{wait-condition-variable}, except that the mutex is left in an
unlocked state when the function returns.)
When @var{timeout} is also given, it specifies a point in time where
the waiting should be aborted. It can be either an integer as
returned by @code{current-time} or a pair as returned by
@code{gettimeofday}. When the waiting is aborted, @code{#f} is
When @var{timeout} is also given, it specifies a point in time where
the waiting should be aborted. It can be either an integer as
returned by @code{current-time} or a pair as returned by
@code{gettimeofday}. When the waiting is aborted, @code{#f} is
returned. Otherwise the function returns @code{#t}.
@end deffn
@deffn {Scheme Procedure} mutex-owner mutex
@deffnx {C Function} scm_mutex_owner (mutex)
Return the current owner of @var{mutex}, in the form of a thread or
@code{#f} (indicating no owner). Note that a mutex may be unowned but
still locked.
@end deffn
@deffn {Scheme Procedure} mutex-level mutex
@deffnx {C Function} scm_mutex_level (mutex)
Return the current lock level of @var{mutex}. If @var{mutex} is
currently unlocked, this value will be 0; otherwise, it will be the
number of times @var{mutex} has been recursively locked by its current
owner.
@end deffn
@deffn {Scheme Procedure} mutex-locked? mutex
@deffnx {C Function} scm_mutex_locked_p (mutex)
Return @code{#t} if @var{mutex} is locked, regardless of ownership;
otherwise, return @code{#f}.
@end deffn
@deffn {Scheme Procedure} make-condition-variable
@deffnx {C Function} scm_make_condition_variable ()
Return a new condition variable.
@ -478,7 +503,7 @@ Return a new condition variable.
@deffn {Scheme Procedure} condition-variable? obj
@deffnx {C Function} scm_condition_variable_p (obj)
Return @code{#t} iff @var{obj} is a condition variable; otherwise,
Return @code{#t} iff @var{obj} is a condition variable; otherwise,
return @code{#f}.
@end deffn

41
doc/ref/autoconf.texi
View file

@ -8,10 +8,10 @@
@node Autoconf Support
@chapter Autoconf Support
When Guile is installed, a set of autoconf macros is also installed as
PREFIX/share/aclocal/guile.m4. This chapter documents the macros provided in
that file, as well as the high-level guile-tool Autofrisk. @xref{Top,The GNU
Autoconf Manual,,autoconf}, for more info.
When Guile is installed, a pkg-config description file and a set of
Autoconf macros is installed. This chapter documents pkg-config and
Autoconf support, as well as the high-level guile-tool Autofrisk.
@xref{Top,The GNU Autoconf Manual,,autoconf}, for more info.
@menu
* Autoconf Background:: Why use autoconf?
@ -45,7 +45,38 @@ checks.
@node Autoconf Macros
@section Autoconf Macros
The macro names all begin with "GUILE_".
@cindex pkg-config
@cindex autoconf
GNU Guile provides a @dfn{pkg-config} description file, installed as
@file{@var{prefix}/lib/pkgconfig/guile-1.8.pc}, which contains all the
information necessary to compile and link C applications that use Guile.
The @code{pkg-config} program is able to read this file and provide this
information to application programmers; it can be obtained at
@url{http://pkg-config.freedesktop.org/}.
The following command lines give respectively the C compilation and link
flags needed to build Guile-using programs:
@example
pkg-config guile-1.8 --cflags
pkg-config guile-1.8 --libs
@end example
To ease use of pkg-config with Autoconf, pkg-config comes with a
convenient Autoconf macro. The following example looks for Guile and
sets the @code{GUILE_CFLAGS} and @code{GUILE_LIBS} variables
accordingly, or prints an error and exits if Guile was not found:
@findex PKG_CHECK_MODULES
@example
PKG_CHECK_MODULES([GUILE], [guile-1.8])
@end example
Guile comes with additional Autoconf macros providing more information,
installed as @file{@var{prefix}/share/aclocal/guile.m4}. Their names
all begin with @code{GUILE_}.
@c see Makefile.am
@include autoconf-macros.texi

4
doc/ref/guile.texi
View file

@ -177,6 +177,8 @@ x
* Guile Modules::
* Autoconf Support::
Appendices
* Data Representation:: All the details.
@ -362,6 +364,8 @@ available through both Scheme and C interfaces.
@include scsh.texi
@include scheme-debugging.texi
@include autoconf.texi
@include data-rep.texi
@include fdl.texi

5
doc/ref/posix.texi
View file

@ -956,6 +956,11 @@ If @var{suffix} is provided, and is equal to the end of
@end lisp
@end deffn
@deffn {Scheme Procedure} file-exists? filename
Return @code{#t} if the file named @var{filename} exists, @code{#f} if
not.
@end deffn
@node User Information
@subsection User Information

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

@ -359,6 +359,8 @@ debugger to continue.)
@node Using Guile in Emacs
@section Using Guile in Emacs
@cindex GDS
@cindex Emacs
There are several options for working on Guile Scheme code in Emacs.
The simplest are to use Emacs's standard @code{scheme-mode} for
editing code, and to run the interpreter when you need it by typing
@ -986,6 +988,14 @@ region contains a balanced expression, or try to expand the region so
that it does; it uses the region exactly as it is.
@end table
If you type @kbd{C-u} before one of these commands, GDS will
immediately pop up a Scheme stack buffer, showing the requested
evaluation, so that you can single step through it. (This is achieved
by setting a @code{<source-trap>} trap at the start of the requested
evaluation; see @ref{Source Traps} for more on how those work.) The
Scheme stack display, and the options for continuing through the code,
are described in the next two sections.
@node Displaying the Scheme Stack
@subsection Displaying the Scheme Stack

398
doc/ref/srfi-modules.texi
View file

@ -1,6 +1,6 @@
@c -*-texinfo-*-
@c This is part of the GNU Guile Reference Manual.
@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2006, 2007
@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2006, 2007, 2008
@c Free Software Foundation, Inc.
@c See the file guile.texi for copying conditions.
@ -34,6 +34,7 @@ get the relevant SRFI documents from the SRFI home page
* SRFI-14:: Character-set library.
* SRFI-16:: case-lambda
* SRFI-17:: Generalized set!
* SRFI-18:: Multithreading support
* SRFI-19:: Time/Date library.
* SRFI-26:: Specializing parameters
* SRFI-31:: A special form `rec' for recursive evaluation
@ -45,6 +46,7 @@ get the relevant SRFI documents from the SRFI home page
* SRFI-60:: Integers as bits.
* SRFI-61:: A more general `cond' clause
* SRFI-69:: Basic hash tables.
* SRFI-88:: Keyword objects.
@end menu
@ -1677,6 +1679,344 @@ The same as the Guile core @code{make-procedure-with-setter}
@end defun
@node SRFI-18
@subsection SRFI-18 - Multithreading support
@cindex SRFI-18
This is an implementation of the SRFI-18 threading and synchronization
library. The functions and variables described here are provided by
@example
(use-modules (srfi srfi-18))
@end example
As a general rule, the data types and functions in this SRFI-18
implementation are compatible with the types and functions in Guile's
core threading code. For example, mutexes created with the SRFI-18
@code{make-mutex} function can be passed to the built-in Guile
function @code{lock-mutex} (@pxref{Mutexes and Condition Variables}),
and mutexes created with the built-in Guile function @code{make-mutex}
can be passed to the SRFI-18 function @code{mutex-lock!}. Cases in
which this does not hold true are noted in the following sections.
@menu
* SRFI-18 Threads:: Executing code
* SRFI-18 Mutexes:: Mutual exclusion devices
* SRFI-18 Condition variables:: Synchronizing of groups of threads
* SRFI-18 Time:: Representation of times and durations
* SRFI-18 Exceptions:: Signalling and handling errors
@end menu
@node SRFI-18 Threads
@subsubsection SRFI-18 Threads
Threads created by SRFI-18 differ in two ways from threads created by
Guile's built-in thread functions. First, a thread created by SRFI-18
@code{make-thread} begins in a blocked state and will not start
execution until @code{thread-start!} is called on it. Second, SRFI-18
threads are constructed with a top-level exception handler that
captures any exceptions that are thrown on thread exit. In all other
regards, SRFI-18 threads are identical to normal Guile threads.
@defun current-thread
Returns the thread that called this function. This is the same
procedure as the same-named built-in procedure @code{current-thread}
(@pxref{Threads}).
@end defun
@defun thread? obj
Returns @code{#t} if @var{obj} is a thread, @code{#f} otherwise. This
is the same procedure as the same-named built-in procedure
@code{thread?} (@pxref{Threads}).
@end defun
@defun make-thread thunk [name]
Call @code{thunk} in a new thread and with a new dynamic state,
returning the new thread and optionally assigning it the object name
@var{name}, which may be any Scheme object.
Note that the name @code{make-thread} conflicts with the
@code{(ice-9 threads)} function @code{make-thread}. Applications
wanting to use both of these functions will need to refer to them by
different names.
@end defun
@defun thread-name thread
Returns the name assigned to @var{thread} at the time of its creation,
or @code{#f} if it was not given a name.
@end defun
@defun thread-specific thread
@defunx thread-specific-set! thread obj
Get or set the ``object-specific'' property of @var{thread}. In
Guile's implementation of SRFI-18, this value is stored as an object
property, and will be @code{#f} if not set.
@end defun
@defun thread-start! thread
Unblocks @var{thread} and allows it to begin execution if it has not
done so already.
@end defun
@defun thread-yield!
If one or more threads are waiting to execute, calling
@code{thread-yield!} forces an immediate context switch to one of them.
Otherwise, @code{thread-yield!} has no effect. @code{thread-yield!}
behaves identically to the Guile built-in function @code{yield}.
@end defun
@defun thread-sleep! timeout
The current thread waits until the point specified by the time object
@var{timeout} is reached (@pxref{SRFI-18 Time}). This blocks the
thread only if @var{timeout} represents a point in the future. it is
an error for @var{timeout} to be @code{#f}.
@end defun
@defun thread-terminate! thread
Causes an abnormal termination of @var{thread}. If @var{thread} is
not already terminated, all mutexes owned by @var{thread} become
unlocked/abandoned. If @var{thread} is the current thread,
@code{thread-terminate!} does not return. Otherwise
@code{thread-terminate!} returns an unspecified value; the termination
of @var{thread} will occur before @code{thread-terminate!} returns.
Subsequent attempts to join on @var{thread} will cause a ``terminated
thread exception'' to be raised.
@code{thread-terminate!} is compatible with the thread cancellation
procedures in the core threads API (@pxref{Threads}) in that if a
cleanup handler has been installed for the target thread, it will be
called before the thread exits and its return value (or exception, if
any) will be stored for later retrieval via a call to
@code{thread-join!}.
@end defun
@defun thread-join! thread [timeout [timeout-val]]
Wait for @var{thread} to terminate and return its exit value. When a
time value @var{timeout} is given, it specifies a point in time where
the waiting should be aborted. When the waiting is aborted,
@var{timeoutval} is returned if it is specified; otherwise, a
@code{join-timeout-exception} exception is raised
(@pxref{SRFI-18 Exceptions}). Exceptions may also be raised if the
thread was terminated by a call to @code{thread-terminate!}
(@code{terminated-thread-exception} will be raised) or if the thread
exited by raising an exception that was handled by the top-level
exception handler (@code{uncaught-exception} will be raised; the
original exception can be retrieved using
@code{uncaught-exception-reason}).
@end defun
@node SRFI-18 Mutexes
@subsubsection SRFI-18 Mutexes
The behavior of Guile's built-in mutexes is parameterized via a set of
flags passed to the @code{make-mutex} procedure in the core
(@pxref{Mutexes and Condition Variables}). To satisfy the requirements
for mutexes specified by SRFI-18, the @code{make-mutex} procedure
described below sets the following flags:
@itemize @bullet
@item
@code{recursive}: the mutex can be locked recursively
@item
@code{unchecked-unlock}: attempts to unlock a mutex that is already
unlocked will not raise an exception
@item
@code{allow-external-unlock}: the mutex can be unlocked by any thread,
not just the thread that locked it originally
@end itemize
@defun make-mutex [name]
Returns a new mutex, optionally assigning it the object name
@var{name}, which may be any Scheme object. The returned mutex will be
created with the configuration described above. Note that the name
@code{make-mutex} conflicts with Guile core function @code{make-mutex}.
Applications wanting to use both of these functions will need to refer
to them by different names.
@end defun
@defun mutex-name mutex
Returns the name assigned to @var{mutex} at the time of its creation,
or @code{#f} if it was not given a name.
@end defun
@defun mutex-specific mutex
@defunx mutex-specific-set! mutex obj
Get or set the ``object-specific'' property of @var{mutex}. In Guile's
implementation of SRFI-18, this value is stored as an object property,
and will be @code{#f} if not set.
@end defun
@defun mutex-state mutex
Returns information about the state of @var{mutex}. Possible values
are:
@itemize @bullet
@item
thread @code{T}: the mutex is in the locked/owned state and thread T
is the owner of the mutex
@item
symbol @code{not-owned}: the mutex is in the locked/not-owned state
@item
symbol @code{abandoned}: the mutex is in the unlocked/abandoned state
@item
symbol @code{not-abandoned}: the mutex is in the
unlocked/not-abandoned state
@end itemize
@end defun
@defun mutex-lock! mutex [timeout [thread]]
Lock @var{mutex}, optionally specifying a time object @var{timeout}
after which to abort the lock attempt and a thread @var{thread} giving
a new owner for @var{mutex} different than the current thread. This
procedure has the same behavior as the @code{lock-mutex} procedure in
the core library.
@end defun
@defun mutex-unlock! mutex [condition-variable [timeout]]
Unlock @var{mutex}, optionally specifying a condition variable
@var{condition-variable} on which to wait, either indefinitely or,
optionally, until the time object @var{timeout} has passed, to be
signalled. This procedure has the same behavior as the
@code{unlock-mutex} procedure in the core library.
@end defun
@node SRFI-18 Condition variables
@subsubsection SRFI-18 Condition variables
SRFI-18 does not specify a ``wait'' function for condition variables.
Waiting on a condition variable can be simulated using the SRFI-18
@code{mutex-unlock!} function described in the previous section, or
Guile's built-in @code{wait-condition-variable} procedure can be used.
@defun condition-variable? obj
Returns @code{#t} if @var{obj} is a condition variable, @code{#f}
otherwise. This is the same procedure as the same-named built-in
procedure
(@pxref{Mutexes and Condition Variables, @code{condition-variable?}}).
@end defun
@defun make-condition-variable [name]
Returns a new condition variable, optionally assigning it the object
name @var{name}, which may be any Scheme object. This procedure
replaces a procedure of the same name in the core library.
@end defun
@defun condition-variable-name condition-variable
Returns the name assigned to @var{thread} at the time of its creation,
or @code{#f} if it was not given a name.
@end defun
@defun condition-variable-specific condition-variable
@defunx condition-variable-specific-set! condition-variable obj
Get or set the ``object-specific'' property of
@var{condition-variable}. In Guile's implementation of SRFI-18, this
value is stored as an object property, and will be @code{#f} if not
set.
@end defun
@defun condition-variable-signal! condition-variable
@defunx condition-variable-broadcast! condition-variable
Wake up one thread that is waiting for @var{condition-variable}, in
the case of @code{condition-variable-signal!}, or all threads waiting
for it, in the case of @code{condition-variable-broadcast!}. The
behavior of these procedures is equivalent to that of the procedures
@code{signal-condition-variable} and
@code{broadcast-condition-variable} in the core library.
@end defun
@node SRFI-18 Time
@subsubsection SRFI-18 Time
The SRFI-18 time functions manipulate time in two formats: a
``time object'' type that represents an absolute point in time in some
implementation-specific way; and the number of seconds since some
unspecified ``epoch''. In Guile's implementation, the epoch is the
Unix epoch, 00:00:00 UTC, January 1, 1970.
@defun current-time
Return the current time as a time object. This procedure replaces
the procedure of the same name in the core library, which returns the
current time in seconds since the epoch.
@end defun
@defun time? obj
Returns @code{#t} if @var{obj} is a time object, @code{#f} otherwise.
@end defun
@defun time->seconds time
@defunx seconds->time seconds
Convert between time objects and numerical values representing the
number of seconds since the epoch. When converting from a time object
to seconds, the return value is the number of seconds between
@var{time} and the epoch. When converting from seconds to a time
object, the return value is a time object that represents a time
@var{seconds} seconds after the epoch.
@end defun
@node SRFI-18 Exceptions
@subsubsection SRFI-18 Exceptions
SRFI-18 exceptions are identical to the exceptions provided by
Guile's implementation of SRFI-34. The behavior of exception
handlers invoked to handle exceptions thrown from SRFI-18 functions,
however, differs from the conventional behavior of SRFI-34 in that
the continuation of the handler is the same as that of the call to
the function. Handlers are called in a tail-recursive manner; the
exceptions do not ``bubble up''.
@defun current-exception-handler
Returns the current exception handler.
@end defun
@defun with-exception-handler handler thunk
Installs @var{handler} as the current exception handler and calls the
procedure @var{thunk} with no arguments, returning its value as the
value of the exception. @var{handler} must be a procedure that accepts
a single argument. The current exception handler at the time this
procedure is called will be restored after the call returns.
@end defun
@defun raise obj
Raise @var{obj} as an exception. This is the same procedure as the
same-named procedure defined in SRFI 34.
@end defun
@defun join-timeout-exception? obj
Returns @code{#t} if @var{obj} is an exception raised as the result of
performing a timed join on a thread that does not exit within the
specified timeout, @code{#f} otherwise.
@end defun
@defun abandoned-mutex-exception? obj
Returns @code{#t} if @var{obj} is an exception raised as the result of
attempting to lock a mutex that has been abandoned by its owner thread,
@code{#f} otherwise.
@end defun
@defun terminated-thread-exception? obj
Returns @code{#t} if @var{obj} is an exception raised as the result of
joining on a thread that exited as the result of a call to
@code{thread-terminate!}.
@end defun
@defun uncaught-exception? obj
@defunx uncaught-exception-reason exc
@code{uncaught-exception?} returns @code{#t} if @var{obj} is an
exception thrown as the result of joining a thread that exited by
raising an exception that was handled by the top-level exception
handler installed by @code{make-thread}. When this occurs, the
original exception is preserved as part of the exception thrown by
@code{thread-join!} and can be accessed by calling
@code{uncaught-exception-reason} on that exception. Note that
because this exception-preservation mechanism is a side-effect of
@code{make-thread}, joining on threads that exited as described above
but were created by other means will not raise this
@code{uncaught-exception} error.
@end defun
@node SRFI-19
@subsection SRFI-19 - Time/Date Library
@cindex SRFI-19
@ -1844,8 +2184,10 @@ Return the current time of the given @var{type}. The default
@var{type} is @code{time-utc}.
Note that the name @code{current-time} conflicts with the Guile core
@code{current-time} function (@pxref{Time}). Applications wanting to
use both will need to use a different name for one of them.
@code{current-time} function (@pxref{Time}) as well as the SRFI-18
@code{current-time} function (@pxref{SRFI-18 Time}). Applications
wanting to use more than one of these functions will need to refer to
them by different names.
@end defun
@defun time-resolution [type]
@ -3216,6 +3558,56 @@ Answer a hash value appropriate for equality predicate @code{equal?},
@code{hash} is a backwards-compatible replacement for Guile's built-in
@code{hash}.
@node SRFI-88
@subsection SRFI-88 Keyword Objects
@cindex SRFI-88
@cindex keyword objects
@uref{http://srfi.schemers.org/srfi-88/srfi-88.html, SRFI-88} provides
@dfn{keyword objects}, which are equivalent to Guile's keywords
(@pxref{Keywords}). SRFI-88 keywords can be entered using the
@dfn{postfix keyword syntax}, which consists of an identifier followed
by @code{:} (@pxref{Reader options, @code{postfix} keyword syntax}).
SRFI-88 can be made available with:
@example
(use-modules (srfi srfi-88))
@end example
Doing so installs the right reader option for keyword syntax, using
@code{(read-set! keywords 'postfix)}. It also provides the procedures
described below.
@deffn {Scheme Procedure} keyword? obj
Return @code{#t} if @var{obj} is a keyword. This is the same procedure
as the same-named built-in procedure (@pxref{Keyword Procedures,
@code{keyword?}}).
@example
(keyword? foo:) @result{} #t
(keyword? 'foo:) @result{} #t
(keyword? "foo") @result{} #f
@end example
@end deffn
@deffn {Scheme Procedure} keyword->string kw
Return the name of @var{kw} as a string, i.e., without the trailing
colon. The returned string may not be modified, e.g., with
@code{string-set!}.
@example
(keyword->string foo:) @result{} "foo"
@end example
@end deffn
@deffn {Scheme Procedure} string->keyword str
Return the keyword object whose name is @var{str}.
@example
(keyword->string (string->keyword "a b c")) @result{} "a b c"
@end example
@end deffn
@c srfi-modules.texi ends here

6
emacs/ChangeLog
View file

@ -1,3 +1,9 @@
2008-07-17 Neil Jerram <neil@ossau.uklinux.net>
* gds-scheme.el (gds-eval-region, gds-eval-expression)
(gds-eval-defun, gds-eval-last-sexp): Support `C-u' prefix,
meaning that user wants to single step through the code.
2007-02-06 Clinton Ebadi <clinton@unknownlamer.org>
* gds-scheme.el (gds-display-results): Use save-selected-window

50
emacs/gds-scheme.el
View file

@ -279,9 +279,12 @@ region's code."
(setq line (count-lines (point-min) (point))))
(cons line column)))
(defun gds-eval-region (start end)
"Evaluate the current region."
(interactive "r")
(defun gds-eval-region (start end &optional debugp)
"Evaluate the current region. If invoked with `C-u' prefix (or, in
a program, with optional DEBUGP arg non-nil), pause and pop up the
stack at the start of the evaluation, so that the user can single-step
through the code."
(interactive "r\nP")
(or gds-client
(gds-auto-associate-buffer)
(call-interactively 'gds-associate-buffer))
@ -289,24 +292,29 @@ region's code."
(port-name (gds-port-name start end))
(lc (gds-line-and-column start)))
(let ((code (buffer-substring-no-properties start end)))
(gds-send (format "eval (region . %S) %s %S %d %d %S"
(gds-send (format "eval (region . %S) %s %S %d %d %S %s"
(gds-abbreviated code)
(if module (prin1-to-string module) "#f")
port-name (car lc) (cdr lc)
code)
code
(if debugp '(debug) '(none)))
gds-client))))
(defun gds-eval-expression (expr &optional correlator)
"Evaluate the supplied EXPR (a string)."
(interactive "sEvaluate expression: \nP")
(defun gds-eval-expression (expr &optional correlator debugp)
"Evaluate the supplied EXPR (a string). If invoked with `C-u'
prefix (or, in a program, with optional DEBUGP arg non-nil), pause and
pop up the stack at the start of the evaluation, so that the user can
single-step through the code."
(interactive "sEvaluate expression: \ni\nP")
(or gds-client
(gds-auto-associate-buffer)
(call-interactively 'gds-associate-buffer))
(set-text-properties 0 (length expr) nil expr)
(gds-send (format "eval (%S . %S) #f \"Emacs expression\" 0 0 %S"
(gds-send (format "eval (%S . %S) #f \"Emacs expression\" 0 0 %S %s"
(or correlator 'expression)
(gds-abbreviated expr)
expr)
expr
(if debugp '(debug) '(none)))
gds-client))
(defconst gds-abbreviated-length 35)
@ -325,19 +333,25 @@ region's code."
(concat (substring code 0 (- gds-abbreviated-length 3)) "...")
code))
(defun gds-eval-defun ()
"Evaluate the defun (top-level form) at point."
(interactive)
(defun gds-eval-defun (&optional debugp)
"Evaluate the defun (top-level form) at point. If invoked with
`C-u' prefix (or, in a program, with optional DEBUGP arg non-nil),
pause and pop up the stack at the start of the evaluation, so that the
user can single-step through the code."
(interactive "P")
(save-excursion
(end-of-defun)
(let ((end (point)))
(beginning-of-defun)
(gds-eval-region (point) end))))
(gds-eval-region (point) end debugp))))
(defun gds-eval-last-sexp ()
"Evaluate the sexp before point."
(interactive)
(gds-eval-region (save-excursion (backward-sexp) (point)) (point)))
(defun gds-eval-last-sexp (&optional debugp)
"Evaluate the sexp before point. If invoked with `C-u' prefix (or,
in a program, with optional DEBUGP arg non-nil), pause and pop up the
stack at the start of the evaluation, so that the user can single-step
through the code."
(interactive "P")
(gds-eval-region (save-excursion (backward-sexp) (point)) (point) debugp))
;;;; Help.

15
guile-1.8.pc.in Normal file
View file

@ -0,0 +1,15 @@
prefix=@prefix@
exec_prefix=@exec_prefix@
libdir=@libdir@
includedir=@includedir@
datarootdir=@datarootdir@
datadir=@datadir@
sitedir=@sitedir@
libguileinterface=@LIBGUILE_INTERFACE@
Name: GNU Guile
Description: GNU's Ubiquitous Intelligent Language for Extension
Version: @GUILE_VERSION@
Libs: -L${libdir} -lguile @GUILE_LIBS@
Cflags: -I${includedir} @GUILE_CFLAGS@

5
guile-config/ChangeLog
View file

@ -1,3 +1,8 @@
2008-06-02 Ludovic Courtès <ludo@gnu.org>
* guile-config.in (build-link): Show `-L' before `-lguile'.
Reported by Peter O'Gorman <pogma@thewrittenword.com>.
2008-01-22 Neil Jerram <neil@ossau.uklinux.net>
* COPYING: Removed.

4
guile-config/guile-config.in
View file

@ -4,7 +4,7 @@
;;;; guile-config --- utility for linking programs with Guile
;;;; Jim Blandy <jim@red-bean.com> --- September 1997
;;;;
;;;; Copyright (C) 1998, 2001, 2004, 2005, 2006 Free Software Foundation, Inc.
;;;; Copyright (C) 1998, 2001, 2004, 2005, 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
@ -151,11 +151,11 @@
(display (string-join
(list
(get-build-info 'CFLAGS)
"-lguile -lltdl"
(if (or (string=? libdir "/usr/lib")
(string=? libdir "/usr/lib/"))
""
(string-append "-L" (get-build-info 'libdir)))
"-lguile -lltdl"
(string-join other-flags)
)))

165
guile-config/qthreads.m4
View file

@ -1,165 +0,0 @@
dnl Autoconf macros for configuring the QuickThreads package
dnl Jim Blandy <jimb@red-bean.com> --- July 1998
dnl
dnl Copyright (C) 1998, 1999, 2006 Free Software Foundation, Inc.
dnl
dnl This file is part of GUILE.
dnl
dnl GUILE is free software; you can redistribute it and/or modify
dnl it under the terms of the GNU General Public License as
dnl published by the Free Software Foundation; either version 2, or
dnl (at your option) any later version.
dnl
dnl GUILE is distributed in the hope that it will be useful, but
dnl WITHOUT ANY WARRANTY; without even the implied warranty of
dnl MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
dnl GNU General Public License for more details.
dnl
dnl You should have received a copy of the GNU General Public
dnl License along with GUILE; see the file COPYING. If not, write
dnl to the Free Software Foundation, Inc., 51 Franklin Street, Fifth
dnl Floor, Boston, MA 02110-1301 USA
dnl QTHREADS_CONFIGURE configures the QuickThreads package. The QT
dnl sources should be in $srcdir/qt. If configuration succeeds, this
dnl macro creates the appropriate symlinks in the qt object directory,
dnl and sets the following variables, used in building libqthreads.a:
dnl QTHREAD_LTLIBS --- set to libqthreads.la if configuration
dnl succeeds, or the empty string if configuration fails.
dnl qtmd_h, qtmds_s, qtmdc_c, qtdmdb_s --- the names of the machine-
dnl dependent source files.
dnl qthread_asflags --- flags to pass to the compiler when processing
dnl assembly-language files.
dnl
dnl It also sets the following variables, which describe how clients
dnl can link against libqthreads.a:
dnl THREAD_PACKAGE --- set to "QT" if configuration succeeds, or
dnl the empty string if configuration fails.
dnl THREAD_LIBS_LOCAL --- linker options for use in this source tree
dnl THREAD_LIBS_INSTALLED --- linker options for use after this package
dnl is installed
dnl It would be nice if all thread configuration packages for Guile
dnl followed the same conventions.
dnl
dnl All of the above variables will be substituted into Makefiles in
dnl the usual autoconf fashion.
dnl
dnl We distinguish between THREAD_LIBS_LOCAL and
dnl THREAD_LIBS_INSTALLED because the thread library might be in
dnl this tree, and be built using libtool. This means that:
dnl 1) when building other executables in this tree, one must
dnl pass the relative path to the ../libfoo.la file, but
dnl 2) once the whole package has been installed, users should
dnl link using -lfoo.
dnl Normally, we only care about the first case, but since the
dnl guile-config script needs to give users all the flags they need
dnl to link programs against guile, the GUILE_WITH_THREADS macro
dnl needs to supply the second piece of information as well.
dnl
dnl This whole thing is a little confused about what ought to be
dnl done in the top-level configure script, and what ought to be
dnl taken care of in the subdirectory. For example, qtmds_s and
dnl friends really ought not to be even mentioned in the top-level
dnl configure script, but here they are.
AC_DEFUN([QTHREADS_CONFIGURE],[
AC_REQUIRE([AC_PROG_LN_S])
AC_MSG_CHECKING(QuickThreads configuration)
changequote(,)dnl We use [ and ] in a regexp in the case
THREAD_PACKAGE=QT
qthread_asflags=''
case "$host" in
i[3456]86-*-*)
port_name=i386
qtmd_h=md/i386.h
qtmds_s=md/i386.s
qtmdc_c=md/null.c
qtdmdb_s=
case "$host" in
*-*-netbsd* )
## NetBSD needs to be told to pass the assembly code through
## the C preprocessor. Other GCC installations seem to do
## this by default, but NetBSD's doesn't. We could get the
## same effect by giving the file a name ending with .S
## instead of .s, but I don't see how to tell automake to do
## that.
qthread_asflags='-x assembler-with-cpp'
;;
esac
;;
mips-sgi-irix[56]*)
port_name=irix
qtmd_h=md/mips.h
qtmds_s=md/mips-irix5.s
qtmdc_c=md/null.c
qtdmdb_s=md/mips_b.s
;;
mips-*-*)
port_name=mips
qtmd_h=md/mips.h
qtmds_s=md/mips.s
qtmdc_c=md/null.c
qtdmdb_s=md/mips_b.s
;;
sparc-*-sunos*)
port_name=sparc-sunos
qtmd_h=md/sparc.h
qtmds_s=md/_sparc.s
qtmdc_c=md/null.c
qtdmdb_s=md/_sparc_b.s
;;
sparc*-*-*)
port_name=sparc
qtmd_h=md/sparc.h
qtmds_s=md/sparc.s
qtmdc_c=md/null.c
qtdmdb_s=md/sparc_b.s
;;
alpha*-*-*)
port_name=alpha
qtmd_h=md/axp.h
qtmds_s=md/axp.s
qtmdc_c=md/null.c
qtdmdb_s=md/axp_b.s
;;
arm*-*-*)
port_name=arm
qtmd_h=md/arm.h
qtmds_s=md/arm.s
qtmdc_c=md/null.c
qtdmdb_s=
;;
*)
echo "Unknown configuration; threads package disabled"
THREAD_PACKAGE=""
;;
esac
changequote([, ])
# Did configuration succeed?
if test -n "$THREAD_PACKAGE"; then
AC_MSG_RESULT($port_name)
QTHREAD_LTLIBS=libqthreads.la
THREAD_LIBS_LOCAL="../qt/libqthreads.la"
THREAD_LIBS_INSTALLED="-lqthreads"
else
AC_MSG_RESULT(none; disabled)
fi
AC_SUBST(QTHREAD_LTLIBS)
AC_SUBST(qtmd_h)
AC_SUBST(qtmds_s)
AC_SUBST(qtmdc_c)
AC_SUBST(qtdmdb_s)
AC_SUBST(qthread_asflags)
AC_SUBST(THREAD_PACKAGE)
AC_SUBST(THREAD_LIBS_LOCAL)
AC_SUBST(THREAD_LIBS_INSTALLED)
])
dnl qthreads.m4 ends here

11
guile-readline/ChangeLog
View file

@ -1,3 +1,14 @@
2008-05-07 Ludovic Courtès <ludo@gnu.org>
* ice-9/Makefile.am (guile_pdd): Don't use `patsubst': it's GNU
Make and broke BSD Make as found on FreeBSD 6.2.
2008-04-16 Ludovic Courtès <ludo@gnu.org>
* configure.in (AC_INIT): Don't use "echo -n", which is not
available on MacOS X; use `patsubst' instead to remove the
newline. Reported by Steven Wu <wus@qwest.net>.
2008-02-16 Ludovic Courtès <ludo@gnu.org>
* LIBGUILEREADLINE-VERSION

7
guile-readline/configure.in
View file

@ -1,7 +1,12 @@
AC_PREREQ(2.50)
dnl Don't use "echo -n", which is not portable (e.g., not available on
dnl MacOS X). Instead, use `patsubst' to remove the newline.
AC_INIT(guile-readline,
m4_esyscmd(. ../GUILE-VERSION && echo -n ${GUILE_VERSION}))
patsubst(m4_esyscmd(. ../GUILE-VERSION && echo ${GUILE_VERSION}), [
]),
[bug-guile@gnu.org])
AC_CONFIG_AUX_DIR([.])
AC_CONFIG_SRCDIR(readline.c)
AM_CONFIG_HEADER([guile-readline-config.h])

7
guile-readline/ice-9/Makefile.am
View file

@ -1,7 +1,6 @@
## Process this file with Automake to create Makefile.in
##
## Copyright (C) 1998, 1999, 2000, 2001, 2006 Free Software Foundation, Inc.
## Copyright (C) 2002, 2003, 2004, 2006 Free Software Foundation, Inc.
## Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2006, 2008 Free Software Foundation, Inc.
##
## This file is part of GUILE.
##
@ -20,7 +19,9 @@
## to the Free Software Foundation, Inc., 51 Franklin Street, Fifth
## Floor, Boston, MA 02110-1301 USA
guile_pdd = $(patsubst %/guile-readline,%/guile,$(pkgdatadir))
# Guile's `pkgdatadir'.
guile_pdd = $(datadir)/guile
ice9dir = $(guile_pdd)/$(GUILE_EFFECTIVE_VERSION)/ice-9
ice9_DATA = readline.scm
ETAGS_ARGS = $(ice9_DATA)

10
ice-9/ChangeLog
View file

@ -1,3 +1,13 @@
2008-07-17 Neil Jerram <neil@ossau.uklinux.net>
* gds-client.scm (handle-nondebug-protocol): Add support for
setting a trap on code that is about to be evaluated.
2008-04-14 Neil Jerram <neil@ossau.uklinux.net>
* gds-client.scm (gds-debug-trap): Ensure that frame index passed
to Emacs is always positive.
2008-03-19 Neil Jerram <neil@ossau.uklinux.net>
* debugging/ice-9-debugger-extensions.scm (command-loop): Use

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

@ -73,7 +73,9 @@
(slot-ref (car fired-traps) 'depth)))))
;; Write current stack to the frontend.
(write-form (list 'stack
(or special-index 0)
(if (and special-index (> special-index 0))
special-index
0)
(stack->emacs-readable stack)
(append (flags->emacs-readable flags)
(slot-ref trap-context
@ -352,7 +354,7 @@ Thanks!\n\n"
((eval)
(set! last-lazy-trap-context #f)
(apply (lambda (correlator module port-name line column code)
(apply (lambda (correlator module port-name line column code flags)
(with-input-from-string code
(lambda ()
(set-port-filename! (current-input-port) port-name)
@ -382,6 +384,11 @@ Thanks!\n\n"
;; it to the list.
(begin
(for-each-breakpoint setup-after-read x)
(if (and (pair? x)
(memq 'debug flags))
(install-trap (make <source-trap>
#:expression x
#:behaviour gds-debug-trap)))
(loop (cons x exprs) (read))))))
(lambda (key . args)
(write-form `(eval-results

9
lang/elisp/ChangeLog
View file

@ -1,3 +1,12 @@
2008-04-14 Neil Jerram <neil@ossau.uklinux.net>
* primitives/symprop.scm (get): Use lambda->nil.
* primitives/strings.scm (aset): New primitive.
* internals/load.scm (load): Use in-vicinity (instead of
string-append) to add a slash if needed.
2004-02-08 Mikael Djurfeldt <djurfeldt@nada.kth.se>
* primitives/Makefile.am (TAGS_FILES), internals/Makefile.am

5
lang/elisp/internals/load.scm
View file

@ -15,9 +15,8 @@
'("")
load-path)))
(cond ((null? dirs) #f)
((file-exists? (string-append (car dirs)
filename))
(string-append (car dirs) filename))
((file-exists? (in-vicinity (car dirs) filename))
(in-vicinity (car dirs) filename))
(else (loop (cdr dirs)))))))
(if pathname
(begin

6
lang/elisp/primitives/strings.scm
View file

@ -29,6 +29,12 @@
((string? array) (char->integer (string-ref array idx)))
(else (wta 'arrayp array 1)))))
(fset 'aset
(lambda (array idx newelt)
(cond ((vector? array) (vector-set! array idx newelt))
((string? array) (string-set! array idx (integer->char newelt)))
(else (wta 'arrayp array 1)))))
(fset 'stringp (lambda->nil string?))
(fset 'vector vector)

2
lang/elisp/primitives/symprop.scm
View file

@ -9,7 +9,7 @@
(fset 'put set-symbol-property!)
(fset 'get symbol-property)
(fset 'get (lambda->nil symbol-property))
(fset 'set set)

7
lib/.gitignore vendored
View file

@ -1,7 +0,0 @@
Makefile.am
alloca.c
alloca.in.h
dummy.c
strcasecmp.c
strings.in.h
strncasecmp.c

119
lib/Makefile.am Normal file
View file

@ -0,0 +1,119 @@
## DO NOT EDIT! GENERATED AUTOMATICALLY!
## Process this file with automake to produce Makefile.in.
# Copyright (C) 2002-2008 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
# Public License, this file may be distributed as part of a program
# that contains a configuration script generated by Autoconf, under
# 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 --aux-dir=build-aux --lgpl --libtool --macro-prefix=gl alloca extensions strcase
AUTOMAKE_OPTIONS = 1.5 gnits
noinst_HEADERS =
noinst_LIBRARIES =
noinst_LTLIBRARIES =
EXTRA_DIST =
BUILT_SOURCES =
SUFFIXES =
MOSTLYCLEANFILES = core *.stackdump
MOSTLYCLEANDIRS =
CLEANFILES =
DISTCLEANFILES =
MAINTAINERCLEANFILES =
AM_CPPFLAGS =
noinst_LTLIBRARIES += libgnu.la
libgnu_la_SOURCES =
libgnu_la_LIBADD = $(gl_LTLIBOBJS)
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)
# We need the following in order to create <alloca.h> when the system
# doesn't have one that works with the given compiler.
alloca.h: alloca.in.h
{ echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */'; \
cat $(srcdir)/alloca.in.h; \
} > $@-t
mv -f $@-t $@
MOSTLYCLEANFILES += alloca.h alloca.h-t
EXTRA_DIST += alloca.in.h
## end gnulib module alloca-opt
## begin gnulib module link-warning
LINK_WARNING_H=$(top_srcdir)/build-aux/link-warning.h
EXTRA_DIST += $(top_srcdir)/build-aux/link-warning.h
## end gnulib module link-warning
## begin gnulib module strcase
EXTRA_DIST += strcasecmp.c strncasecmp.c
EXTRA_libgnu_la_SOURCES += strcasecmp.c strncasecmp.c
## end gnulib module strcase
## begin gnulib module strings
BUILT_SOURCES += strings.h
# We need the following in order to create <strings.h> when the system
# doesn't have one that works with the given compiler.
strings.h: strings.in.h
rm -f $@-t $@
{ echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */' && \
sed -e 's/@''INCLUDE_NEXT''@/$(INCLUDE_NEXT)/g' \
-e 's|@''NEXT_STRINGS_H''@|$(NEXT_STRINGS_H)|g' \
-e 's|@''HAVE_STRCASECMP''@|$(HAVE_STRCASECMP)|g' \
-e 's|@''HAVE_DECL_STRNCASECMP''@|$(HAVE_DECL_STRNCASECMP)|g' \
-e '/definition of GL_LINK_WARNING/r $(LINK_WARNING_H)' \
< $(srcdir)/strings.in.h; \
} > $@-t
mv $@-t $@
MOSTLYCLEANFILES += strings.h strings.h-t
EXTRA_DIST += strings.in.h
## end gnulib module strings
## begin gnulib module dummy
libgnu_la_SOURCES += dummy.c
## end gnulib module dummy
mostlyclean-local: mostlyclean-generic
@for dir in '' $(MOSTLYCLEANDIRS); do \
if test -n "$$dir" && test -d $$dir; then \
echo "rmdir $$dir"; rmdir $$dir; \
fi; \
done; \
:

489
lib/alloca.c Normal file
View file

@ -0,0 +1,489 @@
/* 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 */

56
lib/alloca.in.h Normal file
View file

@ -0,0 +1,56 @@
/* Memory allocation on the stack.
Copyright (C) 1995, 1999, 2001-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
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. */
/* Avoid using the symbol _ALLOCA_H here, as Bison assumes _ALLOCA_H
means there is a real alloca function. */
#ifndef _GL_ALLOCA_H
#define _GL_ALLOCA_H
/* alloca (N) returns a pointer to N bytes of memory
allocated on the stack, which will last until the function returns.
Use of alloca should be avoided:
- inside arguments of function calls - undefined behaviour,
- in inline functions - the allocation may actually last until the
calling function returns,
- for huge N (say, N >= 65536) - you never know how large (or small)
the stack is, and when the stack cannot fulfill the memory allocation
request, the program just crashes.
*/
#ifndef alloca
# ifdef __GNUC__
# define alloca __builtin_alloca
# elif defined _AIX
# define alloca __alloca
# elif defined _MSC_VER
# include <malloc.h>
# define alloca _alloca
# elif defined __DECC && defined __VMS
# define alloca __ALLOCA
# else
# include <stddef.h>
# ifdef __cplusplus
extern "C"
# endif
void *alloca (size_t);
# endif
#endif
#endif /* _GL_ALLOCA_H */

42
lib/dummy.c Normal file
View file

@ -0,0 +1,42 @@
/* A dummy file, to prevent empty libraries from breaking builds.
Copyright (C) 2004, 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/>. */
/* Some systems, reportedly OpenBSD and Mac OS X, refuse to create
libraries without any object files. You might get an error like:
> ar cru .libs/libgl.a
> ar: no archive members specified
Compiling this file, and adding its object file to the library, will
prevent the library from being empty. */
/* Some systems, such as Solaris with cc 5.0, refuse to work with libraries
that don't export any symbol. You might get an error like:
> cc ... libgnu.a
> ild: (bad file) garbled symbol table in archive ../gllib/libgnu.a
Compiling this file, and adding its object file to the library, will
prevent the library from exporting no symbols. */
#ifdef __sun
/* This declaration ensures that the library will export at least 1 symbol. */
int gl_dummy_symbol;
#else
/* This declaration is solely to ensure that after preprocessing
this file is never empty. */
typedef int dummy;
#endif

63
lib/strcasecmp.c Normal file
View file

@ -0,0 +1,63 @@
/* Case-insensitive string comparison function.
Copyright (C) 1998-1999, 2005-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 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. */
#include <config.h>
/* Specification. */
#include <string.h>
#include <ctype.h>
#include <limits.h>
#define TOLOWER(Ch) (isupper (Ch) ? tolower (Ch) : (Ch))
/* Compare strings S1 and S2, ignoring case, returning less than, equal to or
greater than zero if S1 is lexicographically less than, equal to or greater
than S2.
Note: This function does not work with multibyte strings! */
int
strcasecmp (const char *s1, const char *s2)
{
const unsigned char *p1 = (const unsigned char *) s1;
const unsigned char *p2 = (const unsigned char *) s2;
unsigned char c1, c2;
if (p1 == p2)
return 0;
do
{
c1 = TOLOWER (*p1);
c2 = TOLOWER (*p2);
if (c1 == '\0')
break;
++p1;
++p2;
}
while (c1 == c2);
if (UCHAR_MAX <= INT_MAX)
return c1 - c2;
else
/* On machines where 'char' and 'int' are types of the same size, the
difference of two 'unsigned char' values - including the sign bit -
doesn't fit in an 'int'. */
return (c1 > c2 ? 1 : c1 < c2 ? -1 : 0);
}

86
lib/strings.in.h Normal file
View file

@ -0,0 +1,86 @@
/* A substitute <strings.h>.
Copyright (C) 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 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 _GL_STRINGS_H
/* The include_next requires a split double-inclusion guard. */
#@INCLUDE_NEXT@ @NEXT_STRINGS_H@
#ifndef _GL_STRINGS_H
#define _GL_STRINGS_H
/* The definition of GL_LINK_WARNING is copied here. */
#ifdef __cplusplus
extern "C" {
#endif
/* Compare strings S1 and S2, ignoring case, returning less than, equal to or
greater than zero if S1 is lexicographically less than, equal to or greater
than S2.
Note: This function does not work in multibyte locales. */
#if ! @HAVE_STRCASECMP@
extern int strcasecmp (char const *s1, char const *s2);
#endif
#if defined GNULIB_POSIXCHECK
/* strcasecmp() does not work with multibyte strings:
POSIX says that it operates on "strings", and "string" in POSIX is defined
as a sequence of bytes, not of characters. */
# undef strcasecmp
# define strcasecmp(a,b) \
(GL_LINK_WARNING ("strcasecmp cannot work correctly on character strings " \
"in multibyte locales - " \
"use mbscasecmp if you care about " \
"internationalization, or use c_strcasecmp (from " \
"gnulib module c-strcase) if you want a locale " \
"independent function"), \
strcasecmp (a, b))
#endif
/* Compare no more than N bytes of strings S1 and S2, ignoring case,
returning less than, equal to or greater than zero if S1 is
lexicographically less than, equal to or greater than S2.
Note: This function cannot work correctly in multibyte locales. */
#if ! @HAVE_DECL_STRNCASECMP@
extern int strncasecmp (char const *s1, char const *s2, size_t n);
#endif
#if defined GNULIB_POSIXCHECK
/* strncasecmp() does not work with multibyte strings:
POSIX says that it operates on "strings", and "string" in POSIX is defined
as a sequence of bytes, not of characters. */
# undef strncasecmp
# define strncasecmp(a,b,n) \
(GL_LINK_WARNING ("strncasecmp cannot work correctly on character " \
"strings in multibyte locales - " \
"use mbsncasecmp or mbspcasecmp if you care about " \
"internationalization, or use c_strncasecmp (from " \
"gnulib module c-strcase) if you want a locale " \
"independent function"), \
strncasecmp (a, b, n))
#endif
#ifdef __cplusplus
}
#endif
#endif /* _GL_STRING_H */
#endif /* _GL_STRING_H */

63
lib/strncasecmp.c Normal file
View file

@ -0,0 +1,63 @@
/* strncasecmp.c -- case insensitive string comparator
Copyright (C) 1998-1999, 2005-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 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. */
#include <config.h>
/* Specification. */
#include <string.h>
#include <ctype.h>
#include <limits.h>
#define TOLOWER(Ch) (isupper (Ch) ? tolower (Ch) : (Ch))
/* Compare no more than N bytes of strings S1 and S2, ignoring case,
returning less than, equal to or greater than zero if S1 is
lexicographically less than, equal to or greater than S2.
Note: This function cannot work correctly in multibyte locales. */
int
strncasecmp (const char *s1, const char *s2, size_t n)
{
register const unsigned char *p1 = (const unsigned char *) s1;
register const unsigned char *p2 = (const unsigned char *) s2;
unsigned char c1, c2;
if (p1 == p2 || n == 0)
return 0;
do
{
c1 = TOLOWER (*p1);
c2 = TOLOWER (*p2);
if (--n == 0 || c1 == '\0')
break;
++p1;
++p2;
}
while (c1 == c2);
if (UCHAR_MAX <= INT_MAX)
return c1 - c2;
else
/* On machines where 'char' and 'int' are types of the same size, the
difference of two 'unsigned char' values - including the sign bit -
doesn't fit in an 'int'. */
return (c1 > c2 ? 1 : c1 < c2 ? -1 : 0);
}

660
libguile/ChangeLog
View file

File diff suppressed because it is too large Load diff

34
libguile/Makefile.am
View file

@ -1,6 +1,6 @@
## Process this file with Automake to create Makefile.in
##
## Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2006, 2007 Free Software Foundation, Inc.
## Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2006, 2007, 2008 Free Software Foundation, Inc.
##
## This file is part of GUILE.
##
@ -23,11 +23,19 @@ AUTOMAKE_OPTIONS = gnu
## Prevent automake from adding extra -I options
DEFS = @DEFS@
# Override Automake's `DEFAULT_INCLUDES'. By default, it contains
# "-I$(srcdir)", which causes problems on Tru64 where our "random.h"
# is picked up by <stdlib.h> instead of the libc's <random.h>.
DEFAULT_INCLUDES =
## Check for headers in $(srcdir)/.., so that #include
## <libguile/MUMBLE.h> will find MUMBLE.h in this dir when we're
## building. Also look for Gnulib headers in `lib'.
INCLUDES = -I.. -I$(top_srcdir) \
-I$(top_srcdir)/lib -I$(top_builddir)/lib
AM_CPPFLAGS = -I$(top_srcdir) -I$(top_builddir) \
-I$(top_srcdir)/lib -I$(top_builddir)/lib
AM_CFLAGS = $(GCC_CFLAGS)
## The Gnulib Libtool archive.
gnulib_library = $(top_builddir)/lib/libgnu.la
@ -47,7 +55,7 @@ gen_scmconfig_SOURCES = gen-scmconfig.c
## For some reason, OBJEXT does not include the dot
gen-scmconfig.$(OBJEXT): gen-scmconfig.c
if [ "$(cross_compiling)" = "yes" ]; then \
$(CC_FOR_BUILD) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) -c -o $@ $<; \
$(CC_FOR_BUILD) $(DEFS) $(DEFAULT_INCLUDES) $(AM_CPPFLAGS) -c -o $@ $<; \
else \
$(COMPILE) -c -o $@ $<; \
fi
@ -75,7 +83,7 @@ guile_filter_doc_snarfage_SOURCES = c-tokenize.c
## For some reason, OBJEXT does not include the dot
c-tokenize.$(OBJEXT): c-tokenize.c
if [ "$(cross_compiling)" = "yes" ]; then \
$(CC_FOR_BUILD) $(DEFS) $(INCLUDES) -c -o $@ $<; \
$(CC_FOR_BUILD) $(DEFS) $(AM_CPPFLAGS) -c -o $@ $<; \
else \
$(filter-out -Werror,$(COMPILE)) -c -o $@ $<; \
fi
@ -91,18 +99,18 @@ guile_filter_doc_snarfage$(EXEEXT): $(guile_filter_doc_snarfage_OBJECTS) $(guile
guile_SOURCES = guile.c
guile_CFLAGS = $(GUILE_CFLAGS)
guile_CFLAGS = $(GUILE_CFLAGS) $(AM_CFLAGS)
guile_LDADD = libguile.la
guile_LDFLAGS = @DLPREOPEN@ $(GUILE_CFLAGS)
libguile_la_CFLAGS = $(GUILE_CFLAGS)
libguile_la_CFLAGS = $(GUILE_CFLAGS) $(AM_CFLAGS)
libguile_la_SOURCES = alist.c arbiters.c async.c backtrace.c boolean.c \
chars.c continuations.c convert.c debug.c deprecation.c \
deprecated.c discouraged.c dynwind.c eq.c error.c \
eval.c evalext.c extensions.c feature.c fluids.c fports.c \
futures.c gc.c gc-mark.c gc-segment.c gc-malloc.c gc-card.c \
gc-freelist.c gc_os_dep.c gdbint.c gettext.c \
gc-freelist.c gc_os_dep.c gdbint.c gettext.c gc-segment-table.c \
gh_data.c gh_eval.c gh_funcs.c \
gh_init.c gh_io.c gh_list.c gh_predicates.c goops.c gsubr.c \
guardians.c hash.c hashtab.c hooks.c init.c inline.c \
@ -132,7 +140,7 @@ DOT_X_FILES = alist.x arbiters.x async.x backtrace.x boolean.x chars.x \
dynl.x dynwind.x eq.x error.x eval.x evalext.x \
extensions.x feature.x fluids.x fports.x futures.x gc.x gc-mark.x \
gc-segment.x gc-malloc.x gc-card.x gettext.x goops.x \
gsubr.x guardians.x \
gsubr.x guardians.x gc-segment-table.x \
hash.x hashtab.x hooks.x i18n.x init.x ioext.x keywords.x lang.x \
list.x load.x macros.x mallocs.x modules.x numbers.x objects.x \
objprop.x options.x pairs.x ports.x print.x procprop.x procs.x \
@ -152,8 +160,8 @@ DOT_DOC_FILES = alist.doc arbiters.doc async.doc backtrace.doc \
deprecated.doc discouraged.doc dynl.doc dynwind.doc \
eq.doc error.doc eval.doc evalext.doc \
extensions.doc feature.doc fluids.doc fports.doc futures.doc \
gc.doc goops.doc gsubr.doc gc-mark.doc gc-segment.doc \
gc-malloc.doc gc-card.doc gettext.doc \
gc.doc goops.doc gsubr.doc gc-mark.doc gc-segment.doc \
gc-malloc.doc gc-card.doc gettext.doc gc-segment-table.doc \
guardians.doc hash.doc hashtab.doc \
hooks.doc i18n.doc init.doc ioext.doc keywords.doc lang.doc \
list.doc load.doc macros.doc mallocs.doc modules.doc numbers.doc \
@ -301,7 +309,7 @@ libpath.h: $(srcdir)/Makefile.in $(top_builddir)/config.status
@mv libpath.tmp libpath.h
snarfcppopts = $(DEFS) $(INCLUDES) $(CPPFLAGS) $(CFLAGS)
snarfcppopts = $(DEFS) $(AM_CPPFLAGS) $(CPPFLAGS) $(CFLAGS)
SUFFIXES = .x .doc
.c.x:
@ -351,7 +359,7 @@ schemelibdir = $(pkgdatadir)/$(GUILE_EFFECTIVE_VERSION)
schemelib_DATA = guile-procedures.txt
## Add -MG to make the .x magic work with auto-dep code.
MKDEP = gcc -M -MG $(DEFS) $(INCLUDES) $(CPPFLAGS) $(CFLAGS)
MKDEP = gcc -M -MG $(DEFS) $(AM_CPPFLAGS) $(CPPFLAGS) $(CFLAGS)
cpp_err_symbols.c: cpp_err_symbols.in cpp_cnvt.awk
$(AWK) -f $(srcdir)/cpp_cnvt.awk < $(srcdir)/cpp_err_symbols.in > \

27
libguile/__scm.h
View file

@ -97,6 +97,15 @@
#define SCM_LIKELY(_expr) SCM_EXPECT ((_expr), 1)
#define SCM_UNLIKELY(_expr) SCM_EXPECT ((_expr), 0)
/* The SCM_INTERNAL macro makes it possible to explicitly declare a function
* as having "internal" linkage. */
#if (defined __GNUC__) && \
((__GNUC__ >= 4) || (__GNUC__ == 3 && __GNUC_MINOR__ == 3))
# define SCM_INTERNAL extern __attribute__ ((__visibility__ ("internal")))
#else
# define SCM_INTERNAL extern
#endif
/* {Supported Options}
@ -402,7 +411,23 @@
# define setjmp setjump
# define longjmp longjump
# else /* ndef _CRAY1 */
# include <setjmp.h>
# if defined (__ia64__)
/* For IA64, emulate the setjmp API using getcontext. */
# include <signal.h>
# include <ucontext.h>
typedef struct {
ucontext_t ctx;
int fresh;
} jmp_buf;
# define setjmp(JB) \
( (JB).fresh = 1, \
getcontext (&((JB).ctx)), \
((JB).fresh ? ((JB).fresh = 0, 0) : 1) )
# define longjmp(JB,VAL) scm_ia64_longjmp (&(JB), VAL)
void scm_ia64_longjmp (jmp_buf *, int);
# else /* ndef __ia64__ */
# include <setjmp.h>
# endif /* ndef __ia64__ */
# endif /* ndef _CRAY1 */
#endif /* ndef vms */

12
libguile/_scm.h
View file

@ -113,7 +113,11 @@
#endif
/* These names are a bit long, but they make it clear what they represent. */
#define dirent_or_dirent64 CHOOSE_LARGEFILE(dirent,dirent64)
#if SCM_HAVE_STRUCT_DIRENT64 == 1
# define dirent_or_dirent64 CHOOSE_LARGEFILE(dirent,dirent64)
#else
# define dirent_or_dirent64 dirent
#endif
#define fstat_or_fstat64 CHOOSE_LARGEFILE(fstat,fstat64)
#define ftruncate_or_ftruncate64 CHOOSE_LARGEFILE(ftruncate,ftruncate64)
#define lseek_or_lseek64 CHOOSE_LARGEFILE(lseek,lseek64)
@ -121,7 +125,11 @@
#define off_t_or_off64_t CHOOSE_LARGEFILE(off_t,off64_t)
#define open_or_open64 CHOOSE_LARGEFILE(open,open64)
#define readdir_or_readdir64 CHOOSE_LARGEFILE(readdir,readdir64)
#define readdir_r_or_readdir64_r CHOOSE_LARGEFILE(readdir_r,readdir64_r)
#if SCM_HAVE_READDIR64_R == 1
# define readdir_r_or_readdir64_r CHOOSE_LARGEFILE(readdir_r,readdir64_r)
#else
# define readdir_r_or_readdir64_r readdir_r
#endif
#define stat_or_stat64 CHOOSE_LARGEFILE(stat,stat64)
#define truncate_or_truncate64 CHOOSE_LARGEFILE(truncate,truncate64)
#define scm_from_off_t_or_off64_t CHOOSE_LARGEFILE(scm_from_off_t,scm_from_int64)

4
libguile/alist.h
View file

@ -3,7 +3,7 @@
#ifndef SCM_ALIST_H
#define SCM_ALIST_H
/* Copyright (C) 1995,1996,2000, 2006 Free Software Foundation, Inc.
/* Copyright (C) 1995,1996,2000, 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
@ -42,7 +42,7 @@ SCM_API SCM scm_assoc_set_x (SCM alist, SCM key, SCM val);
SCM_API SCM scm_assq_remove_x (SCM alist, SCM key);
SCM_API SCM scm_assv_remove_x (SCM alist, SCM key);
SCM_API SCM scm_assoc_remove_x (SCM alist, SCM key);
SCM_API void scm_init_alist (void);
SCM_INTERNAL void scm_init_alist (void);
#endif /* SCM_ALIST_H */

4
libguile/arbiters.h
View file

@ -3,7 +3,7 @@
#ifndef SCM_ARBITERS_H
#define SCM_ARBITERS_H
/* Copyright (C) 1995,1996,2000, 2006 Free Software Foundation, Inc.
/* Copyright (C) 1995,1996,2000, 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
@ -29,7 +29,7 @@
SCM_API SCM scm_make_arbiter (SCM name);
SCM_API SCM scm_try_arbiter (SCM arb);
SCM_API SCM scm_release_arbiter (SCM arb);
SCM_API void scm_init_arbiters (void);
SCM_INTERNAL void scm_init_arbiters (void);
#endif /* SCM_ARBITERS_H */

13
libguile/async.h
View file

@ -3,7 +3,7 @@
#ifndef SCM_ASYNC_H
#define SCM_ASYNC_H
/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2002, 2004, 2005, 2006 Free Software Foundation, Inc.
/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2002, 2004, 2005, 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
@ -38,10 +38,11 @@ SCM_API SCM scm_async (SCM thunk);
SCM_API SCM scm_async_mark (SCM a);
SCM_API SCM scm_system_async_mark (SCM a);
SCM_API SCM scm_system_async_mark_for_thread (SCM a, SCM thread);
SCM_API void scm_i_queue_async_cell (SCM cell, scm_i_thread *);
SCM_API int scm_i_setup_sleep (scm_i_thread *,
SCM obj, scm_i_pthread_mutex_t *m, int fd);
SCM_API void scm_i_reset_sleep (scm_i_thread *);
SCM_INTERNAL void scm_i_queue_async_cell (SCM cell, scm_i_thread *);
SCM_INTERNAL int scm_i_setup_sleep (scm_i_thread *,
SCM obj, scm_i_pthread_mutex_t *m,
int fd);
SCM_INTERNAL void scm_i_reset_sleep (scm_i_thread *);
SCM_API SCM scm_run_asyncs (SCM list_of_a);
SCM_API SCM scm_noop (SCM args);
SCM_API SCM scm_call_with_blocked_asyncs (SCM proc);
@ -77,7 +78,7 @@ extern int scm_i_critical_section_level;
scm_async_click (); \
} while (0)
SCM_API void scm_init_async (void);
SCM_INTERNAL void scm_init_async (void);
#if (SCM_ENABLE_DEPRECATED == 1)

7
libguile/backtrace.h
View file

@ -3,7 +3,7 @@
#ifndef SCM_BACKTRACE_H
#define SCM_BACKTRACE_H
/* Copyright (C) 1996,1998,1999,2000,2001, 2004, 2006 Free Software Foundation, Inc.
/* Copyright (C) 1996,1998,1999,2000,2001, 2004, 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
@ -27,7 +27,8 @@
SCM_API SCM scm_the_last_stack_fluid_var;
SCM_API void scm_display_error_message (SCM message, SCM args, SCM port);
SCM_API void scm_i_display_error (SCM stack, SCM port, SCM subr, SCM message, SCM args, SCM rest);
SCM_INTERNAL void scm_i_display_error (SCM stack, SCM port, SCM subr,
SCM message, SCM args, SCM rest);
SCM_API SCM scm_display_error (SCM stack, SCM port, SCM subr, SCM message, SCM args, SCM rest);
SCM_API SCM scm_display_application (SCM frame, SCM port, SCM indent);
SCM_API SCM scm_display_backtrace (SCM stack, SCM port, SCM first, SCM depth);
@ -38,7 +39,7 @@ SCM_API SCM scm_backtrace_with_highlights (SCM highlights);
SCM_API SCM scm_set_print_params_x (SCM params);
#endif
SCM_API void scm_init_backtrace (void);
SCM_INTERNAL void scm_init_backtrace (void);
#endif /* SCM_BACKTRACE_H */

4
libguile/boolean.h
View file

@ -3,7 +3,7 @@
#ifndef SCM_BOOLEAN_H
#define SCM_BOOLEAN_H
/* Copyright (C) 1995,1996,2000, 2006 Free Software Foundation, Inc.
/* Copyright (C) 1995,1996,2000, 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
@ -43,7 +43,7 @@ SCM_API int scm_to_bool (SCM x);
SCM_API SCM scm_not (SCM x);
SCM_API SCM scm_boolean_p (SCM obj);
SCM_API void scm_init_boolean (void);
SCM_INTERNAL void scm_init_boolean (void);
#endif /* SCM_BOOLEAN_H */

7
libguile/c-tokenize.lex
View file

@ -18,7 +18,12 @@ INTQUAL (l|L|ll|LL|lL|Ll|u|U)
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
/* Prevent compilation of static input() function in generated scanner
code. This function is never actually used, and GCC 4.3 will emit
an error for that. */
#define YY_NO_INPUT
int yylex(void);
int yyget_lineno (void);

4
libguile/chars.h
View file

@ -3,7 +3,7 @@
#ifndef SCM_CHARS_H
#define SCM_CHARS_H
/* Copyright (C) 1995,1996,2000,2001,2004, 2006 Free Software Foundation, Inc.
/* Copyright (C) 1995,1996,2000,2001,2004, 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
@ -62,7 +62,7 @@ SCM_API SCM scm_char_upcase (SCM chr);
SCM_API SCM scm_char_downcase (SCM chr);
SCM_API int scm_c_upcase (unsigned int c);
SCM_API int scm_c_downcase (unsigned int c);
SCM_API void scm_init_chars (void);
SCM_INTERNAL void scm_init_chars (void);
#endif /* SCM_CHARS_H */

58
libguile/continuations.c
View file

@ -124,47 +124,30 @@ scm_make_continuation (int *first)
continuation->offset = continuation->stack - src;
memcpy (continuation->stack, src, sizeof (SCM_STACKITEM) * stack_size);
#ifdef __ia64__
continuation->fresh = 1;
getcontext (&continuation->ctx);
if (continuation->fresh)
*first = !setjmp (continuation->jmpbuf);
if (*first)
{
#ifdef __ia64__
continuation->backing_store_size =
(char *) scm_ia64_ar_bsp(&continuation->ctx)
(char *) scm_ia64_ar_bsp(&continuation->jmpbuf.ctx)
-
(char *) scm_ia64_register_backing_store_base ();
(char *) thread->register_backing_store_base;
continuation->backing_store = NULL;
continuation->backing_store =
scm_gc_malloc (continuation->backing_store_size,
"continuation backing store");
memcpy (continuation->backing_store,
(void *) scm_ia64_register_backing_store_base (),
(void *) thread->register_backing_store_base,
continuation->backing_store_size);
*first = 1;
continuation->fresh = 0;
#endif /* __ia64__ */
return cont;
}
else
{
SCM ret = continuation->throw_value;
*first = 0;
continuation->throw_value = SCM_BOOL_F;
return ret;
}
#else /* !__ia64__ */
if (setjmp (continuation->jmpbuf))
{
SCM ret = continuation->throw_value;
*first = 0;
continuation->throw_value = SCM_BOOL_F;
return ret;
}
else
{
*first = 1;
return cont;
}
#endif /* !__ia64__ */
}
#undef FUNC_NAME
@ -218,6 +201,9 @@ copy_stack (void *data)
copy_stack_data *d = (copy_stack_data *)data;
memcpy (d->dst, d->continuation->stack,
sizeof (SCM_STACKITEM) * d->continuation->num_stack_items);
#ifdef __ia64__
SCM_I_CURRENT_THREAD->pending_rbs_continuation = d->continuation;
#endif
}
static void
@ -235,16 +221,26 @@ copy_stack_and_call (scm_t_contregs *continuation, SCM val,
scm_i_set_last_debug_frame (continuation->dframe);
continuation->throw_value = val;
#ifdef __ia64__
memcpy (scm_ia64_register_backing_store_base (),
continuation->backing_store,
continuation->backing_store_size);
setcontext (&continuation->ctx);
#else
longjmp (continuation->jmpbuf, 1);
#endif
}
#ifdef __ia64__
void
scm_ia64_longjmp (jmp_buf *JB, int VAL)
{
scm_i_thread *t = SCM_I_CURRENT_THREAD;
if (t->pending_rbs_continuation)
{
memcpy (t->register_backing_store_base,
t->pending_rbs_continuation->backing_store,
t->pending_rbs_continuation->backing_store_size);
t->pending_rbs_continuation = NULL;
}
setcontext (&JB->ctx);
}
#endif
/* Call grow_stack until the stack space is large enough, then, as the current
* stack frame might get overwritten, let copy_stack_and_call perform the
* actual copying and continuation calling.

19
libguile/continuations.h
View file

@ -3,7 +3,7 @@
#ifndef SCM_CONTINUATIONS_H
#define SCM_CONTINUATIONS_H
/* Copyright (C) 1995,1996,2000,2001, 2006 Free Software Foundation, Inc.
/* Copyright (C) 1995,1996,2000,2001, 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
@ -46,8 +46,6 @@ typedef struct
jmp_buf jmpbuf;
SCM dynenv;
#ifdef __ia64__
ucontext_t ctx;
int fresh;
void *backing_store;
unsigned long backing_store_size;
#endif /* __ia64__ */
@ -92,14 +90,15 @@ SCM_API SCM scm_make_continuation (int *first);
SCM_API void *scm_c_with_continuation_barrier (void *(*func)(void*), void *);
SCM_API SCM scm_with_continuation_barrier (SCM proc);
SCM_API SCM scm_i_with_continuation_barrier (scm_t_catch_body body,
void *body_data,
scm_t_catch_handler handler,
void *handler_data,
scm_t_catch_handler pre_unwind_handler,
void *pre_unwind_handler_data);
SCM_INTERNAL SCM
scm_i_with_continuation_barrier (scm_t_catch_body body,
void *body_data,
scm_t_catch_handler handler,
void *handler_data,
scm_t_catch_handler pre_unwind_handler,
void *pre_unwind_handler_data);
SCM_API void scm_init_continuations (void);
SCM_INTERNAL void scm_init_continuations (void);
#endif /* SCM_CONTINUATIONS_H */

4
libguile/coop-pthreads.h
View file

@ -3,7 +3,7 @@
#ifndef SCM_COOP_PTHREADS_H
#define SCM_COOP_PTHREADS_H
/* Copyright (C) 2002, 2006 Free Software Foundation, Inc.
/* 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
@ -70,7 +70,7 @@ SCM_API int scm_i_switch_counter;
#define SCM_SET_THREAD_LOCAL_DATA(ptr) (scm_i_copt_set_thread_data (ptr))
SCM_API void *scm_i_copt_thread_data;
SCM_API void scm_i_copt_set_thread_data (void *data);
SCM_INTERNAL void scm_i_copt_set_thread_data (void *data);
#endif /* SCM_COOP_PTHREAD_H */

6
libguile/debug-malloc.h
View file

@ -3,7 +3,7 @@
#ifndef SCM_DEBUG_MALLOC_H
#define SCM_DEBUG_MALLOC_H
/* Copyright (C) 2000,2001, 2006 Free Software Foundation, Inc.
/* Copyright (C) 2000,2001, 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
@ -32,8 +32,8 @@ SCM_API void scm_malloc_reregister (void *obj, void *new, const char *what);
SCM_API SCM scm_malloc_stats (void);
SCM_API void scm_debug_malloc_prehistory (void);
SCM_API void scm_init_debug_malloc (void);
SCM_INTERNAL void scm_debug_malloc_prehistory (void);
SCM_INTERNAL void scm_init_debug_malloc (void);
#endif /* SCM_DEBUG_MALLOC_H */

6
libguile/debug.h
View file

@ -3,7 +3,7 @@
#ifndef SCM_DEBUG_H
#define SCM_DEBUG_H
/* Copyright (C) 1995,1996,1998,1999,2000,2001,2002,2004
/* Copyright (C) 1995,1996,1998,1999,2000,2001,2002,2004,2008
* Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
@ -150,8 +150,8 @@ SCM_API SCM scm_evaluator_traps (SCM setting);
SCM_API SCM scm_debug_options (SCM setting);
SCM_API SCM scm_make_debugobj (scm_t_debug_frame *debug);
SCM_API SCM scm_i_unmemoize_expr (SCM memoized);
SCM_API void scm_init_debug (void);
SCM_INTERNAL SCM scm_i_unmemoize_expr (SCM memoized);
SCM_INTERNAL void scm_init_debug (void);
#ifdef GUILE_DEBUG
SCM_API SCM scm_memcons (SCM car, SCM cdr, SCM env);

10
libguile/deprecated.c
View file

@ -2,7 +2,7 @@
deprecate something, move it here when that is feasible.
*/
/* Copyright (C) 2003, 2004, 2006 Free Software Foundation, Inc.
/* Copyright (C) 2003, 2004, 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
@ -319,14 +319,14 @@ scm_load_scheme_module (SCM name)
static void
maybe_close_port (void *data, SCM port)
{
SCM except = (SCM)data;
SCM except_set = (SCM) data;
while (!scm_is_null (except))
while (!scm_is_null (except_set))
{
SCM p = SCM_COERCE_OUTPORT (SCM_CAR (except));
SCM p = SCM_COERCE_OUTPORT (SCM_CAR (except_set));
if (scm_is_eq (p, port))
return;
except = SCM_CDR (except);
except_set = SCM_CDR (except_set);
}
scm_close_port (port);

4
libguile/deprecation.h
View file

@ -3,7 +3,7 @@
#ifndef SCM_DEPRECATION_H
#define SCM_DEPRECATION_H
/* Copyright (C) 2001, 2006 Free Software Foundation, Inc.
/* Copyright (C) 2001, 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
@ -41,7 +41,7 @@ SCM_API SCM scm_issue_deprecation_warning (SCM msgs);
#endif
SCM_API SCM scm_include_deprecated_features (void);
SCM_API void scm_init_deprecation (void);
SCM_INTERNAL void scm_init_deprecation (void);
#endif /* SCM_DEPRECATION_H */

141
libguile/discouraged.c
View file

@ -23,33 +23,128 @@
#if (SCM_ENABLE_DISCOURAGED == 1)
#define DEFFROM(t,f1,f2) SCM f1(t x) { return f2 (x); }
#define DEFTO(t,f1,f2) t f1(SCM x, unsigned long pos, const char *s_caller) \
{ return f2 (x); }
SCM
scm_short2num (short x)
{
return scm_from_short (x);
}
DEFFROM (short, scm_short2num, scm_from_short);
DEFFROM (unsigned short, scm_ushort2num, scm_from_ushort);
DEFFROM (int, scm_int2num, scm_from_int);
DEFFROM (unsigned int, scm_uint2num, scm_from_uint);
DEFFROM (long, scm_long2num, scm_from_long);
DEFFROM (unsigned long, scm_ulong2num, scm_from_ulong);
DEFFROM (size_t, scm_size2num, scm_from_size_t);
DEFFROM (ptrdiff_t, scm_ptrdiff2num, scm_from_ssize_t);
SCM
scm_ushort2num (unsigned short x)
{
return scm_from_ushort (x);
}
DEFTO (short, scm_num2short, scm_to_short);
DEFTO (unsigned short, scm_num2ushort, scm_to_ushort);
DEFTO (int, scm_num2int, scm_to_int);
DEFTO (unsigned int, scm_num2uint, scm_to_uint);
DEFTO (long, scm_num2long, scm_to_long);
DEFTO (unsigned long, scm_num2ulong, scm_to_ulong);
DEFTO (size_t, scm_num2size, scm_to_size_t);
DEFTO (ptrdiff_t, scm_num2ptrdiff, scm_to_ssize_t);
SCM
scm_int2num (int x)
{
return scm_from_int (x);
}
SCM
scm_uint2num (unsigned int x)
{
return scm_from_uint (x);
}
SCM
scm_long2num (long x)
{
return scm_from_long (x);
}
SCM
scm_ulong2num (unsigned long x)
{
return scm_from_ulong (x);
}
SCM
scm_size2num (size_t x)
{
return scm_from_size_t (x);
}
SCM
scm_ptrdiff2num (ptrdiff_t x)
{
return scm_from_ssize_t (x);
}
short
scm_num2short (SCM x, unsigned long pos, const char *s_caller)
{
return scm_to_short (x);
}
unsigned short
scm_num2ushort (SCM x, unsigned long pos, const char *s_caller)
{
return scm_to_ushort (x);
}
int
scm_num2int (SCM x, unsigned long pos, const char *s_caller)
{
return scm_to_int (x);
}
unsigned int
scm_num2uint (SCM x, unsigned long pos, const char *s_caller)
{
return scm_to_uint (x);
}
long
scm_num2long (SCM x, unsigned long pos, const char *s_caller)
{
return scm_to_long (x);
}
unsigned long
scm_num2ulong (SCM x, unsigned long pos, const char *s_caller)
{
return scm_to_ulong (x);
}
size_t
scm_num2size (SCM x, unsigned long pos, const char *s_caller)
{
return scm_to_size_t (x);
}
ptrdiff_t
scm_num2ptrdiff (SCM x, unsigned long pos, const char *s_caller)
{
return scm_to_ssize_t (x);
}
#if SCM_SIZEOF_LONG_LONG != 0
DEFFROM (long long, scm_long_long2num, scm_from_long_long);
DEFFROM (unsigned long long, scm_ulong_long2num, scm_from_ulong_long);
DEFTO (long long, scm_num2long_long, scm_to_long_long);
DEFTO (unsigned long long, scm_num2ulong_long, scm_to_ulong_long);
SCM
scm_long_long2num (long long x)
{
return scm_from_long_long (x);
}
SCM
scm_ulong_long2num (unsigned long long x)
{
return scm_from_ulong_long (x);
}
long long
scm_num2long_long (SCM x, unsigned long pos, const char *s_caller)
{
return scm_to_long_long (x);
}
unsigned long long
scm_num2ulong_long (SCM x, unsigned long pos, const char *s_caller)
{
return scm_to_ulong_long (x);
}
#endif
SCM

4
libguile/dynl.h
View file

@ -3,7 +3,7 @@
#ifndef SCM_DYNL_H
#define SCM_DYNL_H
/* Copyright (C) 1996,1998,2000,2001, 2006 Free Software Foundation, Inc.
/* Copyright (C) 1996,1998,2000,2001, 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
@ -33,7 +33,7 @@ SCM_API SCM scm_dynamic_func (SCM symb, SCM dobj);
SCM_API SCM scm_dynamic_call (SCM symb, SCM dobj);
SCM_API SCM scm_dynamic_args_call (SCM symb, SCM dobj, SCM args);
SCM_API void scm_init_dynamic_linking (void);
SCM_INTERNAL void scm_init_dynamic_linking (void);
#endif /* SCM_DYNL_H */

8
libguile/dynwind.h
View file

@ -3,7 +3,7 @@
#ifndef SCM_DYNWIND_H
#define SCM_DYNWIND_H
/* Copyright (C) 1995,1996,1998,1999,2000,2003,2004, 2006 Free Software Foundation, Inc.
/* Copyright (C) 1995,1996,1998,1999,2000,2003,2004, 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
@ -36,9 +36,9 @@ SCM_API SCM scm_internal_dynamic_wind (scm_t_guard before,
void *inner_data,
void *guard_data);
SCM_API void scm_dowinds (SCM to, long delta);
SCM_API void scm_i_dowinds (SCM to, long delta,
void (*turn_func) (void *), void *data);
SCM_API void scm_init_dynwind (void);
SCM_INTERNAL void scm_i_dowinds (SCM to, long delta,
void (*turn_func) (void *), void *data);
SCM_INTERNAL void scm_init_dynwind (void);
SCM_API void scm_swap_bindings (SCM vars, SCM vals);

6
libguile/environments.h
View file

@ -3,7 +3,7 @@
#ifndef SCM_ENVIRONMENTS_H
#define SCM_ENVIRONMENTS_H
/* Copyright (C) 1999,2000, 2006 Free Software Foundation, Inc.
/* Copyright (C) 1999,2000, 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
@ -122,8 +122,8 @@ SCM_API SCM scm_environment_observe_weak (SCM env, SCM proc);
SCM_API SCM scm_c_environment_observe (SCM env, scm_environment_observer proc, SCM data, int weak_p);
SCM_API SCM scm_environment_unobserve (SCM token);
SCM_API void scm_environments_prehistory (void);
SCM_API void scm_init_environments (void);
SCM_INTERNAL void scm_environments_prehistory (void);
SCM_INTERNAL void scm_init_environments (void);

4
libguile/eq.h
View file

@ -3,7 +3,7 @@
#ifndef SCM_EQ_H
#define SCM_EQ_H
/* Copyright (C) 1995,1996,2000, 2006 Free Software Foundation, Inc.
/* Copyright (C) 1995,1996,2000, 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
@ -29,7 +29,7 @@
SCM_API SCM scm_eq_p (SCM x, SCM y);
SCM_API SCM scm_eqv_p (SCM x, SCM y);
SCM_API SCM scm_equal_p (SCM x, SCM y);
SCM_API void scm_init_eq (void);
SCM_INTERNAL void scm_init_eq (void);
#endif /* SCM_EQ_H */

4
libguile/error.h
View file

@ -3,7 +3,7 @@
#ifndef SCM_ERROR_H
#define SCM_ERROR_H
/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2002, 2006 Free Software Foundation, Inc.
/* Copyright (C) 1995,1996,1997,1998,2000,2001, 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
@ -57,7 +57,7 @@ SCM_API void scm_wrong_type_arg_msg (const char *subr, int pos,
SCM_API void scm_memory_error (const char *subr) SCM_NORETURN;
SCM_API void scm_misc_error (const char *subr, const char *message,
SCM args) SCM_NORETURN;
SCM_API void scm_init_error (void);
SCM_INTERNAL void scm_init_error (void);
#endif /* SCM_ERROR_H */

2
libguile/eval.c
View file

@ -18,8 +18,6 @@
#define _GNU_SOURCE
/* SECTION: This code is compiled once.
*/

18
libguile/eval.h
View file

@ -3,7 +3,7 @@
#ifndef SCM_EVAL_H
#define SCM_EVAL_H
/* Copyright (C) 1995,1996,1998,1999,2000,2001,2002,2003,2004
/* Copyright (C) 1995,1996,1998,1999,2000,2001,2002,2003,2004,2008
* Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
@ -152,7 +152,7 @@ SCM_API SCM scm_apply_0 (SCM proc, SCM args);
SCM_API SCM scm_apply_1 (SCM proc, SCM arg1, SCM args);
SCM_API SCM scm_apply_2 (SCM proc, SCM arg1, SCM arg2, SCM args);
SCM_API SCM scm_apply_3 (SCM proc, SCM arg1, SCM arg2, SCM arg3, SCM args);
SCM_API SCM scm_i_call_closure_0 (SCM proc);
SCM_INTERNAL SCM scm_i_call_closure_0 (SCM proc);
SCM_API scm_t_trampoline_0 scm_trampoline_0 (SCM proc);
SCM_API scm_t_trampoline_1 scm_trampoline_1 (SCM proc);
SCM_API scm_t_trampoline_2 scm_trampoline_2 (SCM proc);
@ -167,18 +167,18 @@ SCM_API SCM scm_force (SCM x);
SCM_API SCM scm_promise_p (SCM x);
SCM_API SCM scm_cons_source (SCM xorig, SCM x, SCM y);
SCM_API SCM scm_copy_tree (SCM obj);
SCM_API SCM scm_i_eval_x (SCM exp, SCM env);
SCM_API SCM scm_i_eval (SCM exp, SCM env);
SCM_API SCM scm_i_eval_x (SCM exp, SCM env) /* not internal */;
SCM_INTERNAL SCM scm_i_eval (SCM exp, SCM env);
SCM_API SCM scm_primitive_eval (SCM exp);
SCM_API SCM scm_primitive_eval_x (SCM exp);
SCM_API SCM scm_eval (SCM exp, SCM module);
SCM_API SCM scm_eval_x (SCM exp, SCM module);
SCM_API void scm_i_print_iloc (SCM /*iloc*/, SCM /*port*/);
SCM_API void scm_i_print_isym (SCM /*isym*/, SCM /*port*/);
SCM_API SCM scm_i_unmemocopy_expr (SCM expr, SCM env);
SCM_API SCM scm_i_unmemocopy_body (SCM forms, SCM env);
SCM_API void scm_init_eval (void);
SCM_INTERNAL void scm_i_print_iloc (SCM /*iloc*/, SCM /*port*/);
SCM_INTERNAL void scm_i_print_isym (SCM /*isym*/, SCM /*port*/);
SCM_INTERNAL SCM scm_i_unmemocopy_expr (SCM expr, SCM env);
SCM_INTERNAL SCM scm_i_unmemocopy_body (SCM forms, SCM env);
SCM_INTERNAL void scm_init_eval (void);
#if (SCM_ENABLE_DEPRECATED == 1)

4
libguile/evalext.h
View file

@ -3,7 +3,7 @@
#ifndef SCM_EVALEXT_H
#define SCM_EVALEXT_H
/* Copyright (C) 1998,1999,2000, 2003, 2006 Free Software Foundation, Inc.
/* Copyright (C) 1998,1999,2000, 2003, 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
@ -28,7 +28,7 @@
SCM_API SCM scm_defined_p (SCM sym, SCM env);
SCM_API SCM scm_self_evaluating_p (SCM obj);
SCM_API void scm_init_evalext (void);
SCM_INTERNAL void scm_init_evalext (void);
#if (SCM_ENABLE_DEPRECATED == 1)

4
libguile/extensions.h
View file

@ -3,7 +3,7 @@
#ifndef SCM_EXTENSIONS_H
#define SCM_EXTENSIONS_H
/* Copyright (C) 2001, 2006 Free Software Foundation, Inc.
/* Copyright (C) 2001, 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
@ -32,7 +32,7 @@ SCM_API void scm_c_register_extension (const char *lib, const char *init,
SCM_API void scm_c_load_extension (const char *lib, const char *init);
SCM_API SCM scm_load_extension (SCM lib, SCM init);
SCM_API void scm_init_extensions (void);
SCM_INTERNAL void scm_init_extensions (void);
#endif /* SCM_EXTENSIONS_H */

4
libguile/feature.h
View file

@ -3,7 +3,7 @@
#ifndef SCM_FEATURE_H
#define SCM_FEATURE_H
/* Copyright (C) 1995,1996,1999,2000,2001, 2006, 2007 Free Software Foundation, Inc.
/* Copyright (C) 1995,1996,1999,2000,2001, 2006, 2007, 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
@ -28,7 +28,7 @@ SCM_API void scm_add_feature (const char* str);
SCM_API SCM scm_program_arguments (void);
SCM_API void scm_set_program_arguments (int argc, char **argv, char *first);
SCM_API SCM scm_set_program_arguments_scm (SCM lst);
SCM_API void scm_init_feature (void);
SCM_INTERNAL void scm_init_feature (void);
#endif /* SCM_FEATURE_H */

1
libguile/filesys.c
View file

@ -19,7 +19,6 @@
/* See stime.c for comments on why _POSIX_C_SOURCE is not always defined. */
#define _GNU_SOURCE /* ask glibc for everything */
#define _LARGEFILE64_SOURCE /* ask for stat64 etc */
#ifdef __hpux
#define _POSIX_C_SOURCE 199506L /* for readdir_r */

4
libguile/filesys.h
View file

@ -3,7 +3,7 @@
#ifndef SCM_FILESYS_H
#define SCM_FILESYS_H
/* Copyright (C) 1995,1997,1998,1999,2000,2001, 2006 Free Software Foundation, Inc.
/* Copyright (C) 1995,1997,1998,1999,2000,2001, 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
@ -65,7 +65,7 @@ SCM_API SCM scm_copy_file (SCM oldfile, SCM newfile);
SCM_API SCM scm_dirname (SCM filename);
SCM_API SCM scm_basename (SCM filename, SCM suffix);
SCM_API void scm_init_filesys (void);
SCM_INTERNAL void scm_init_filesys (void);
#endif /* SCM_FILESYS_H */

8
libguile/fluids.h
View file

@ -3,7 +3,7 @@
#ifndef SCM_FLUIDS_H
#define SCM_FLUIDS_H
/* Copyright (C) 1996,2000,2001, 2006 Free Software Foundation, Inc.
/* Copyright (C) 1996,2000,2001, 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
@ -82,10 +82,10 @@ SCM_API void *scm_c_with_dynamic_state (SCM state,
void *(*func)(void *), void *data);
SCM_API SCM scm_with_dynamic_state (SCM state, SCM proc);
SCM_API SCM scm_i_make_initial_dynamic_state (void);
SCM_INTERNAL SCM scm_i_make_initial_dynamic_state (void);
SCM_API void scm_fluids_prehistory (void);
SCM_API void scm_init_fluids (void);
SCM_INTERNAL void scm_fluids_prehistory (void);
SCM_INTERNAL void scm_init_fluids (void);
#endif /* SCM_FLUIDS_H */

10
libguile/fports.h
View file

@ -3,7 +3,7 @@
#ifndef SCM_FPORTS_H
#define SCM_FPORTS_H
/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2006 Free Software Foundation, Inc.
/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 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
@ -53,13 +53,13 @@ SCM_API void scm_evict_ports (int fd);
SCM_API SCM scm_open_file (SCM filename, SCM modes);
SCM_API SCM scm_fdes_to_port (int fdes, char *mode, SCM name);
SCM_API SCM scm_file_port_p (SCM obj);
SCM_API void scm_init_fports (void);
SCM_INTERNAL void scm_init_fports (void);
/* internal functions */
SCM_API SCM scm_i_fdes_to_port (int fdes, long mode_bits, SCM name);
SCM_API int scm_i_fport_truncate (SCM, SCM);
SCM_API SCM scm_i_fport_seek (SCM, SCM, int);
SCM_INTERNAL SCM scm_i_fdes_to_port (int fdes, long mode_bits, SCM name);
SCM_INTERNAL int scm_i_fport_truncate (SCM, SCM);
SCM_INTERNAL SCM scm_i_fport_seek (SCM, SCM, int);
#endif /* SCM_FPORTS_H */

4
libguile/futures.h
View file

@ -3,7 +3,7 @@
#ifndef SCM_FUTURES_H
#define SCM_FUTURES_H
/* Copyright (C) 2002, 2003, 2006 Free Software Foundation, Inc.
/* Copyright (C) 2002, 2003, 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
@ -73,7 +73,7 @@ SCM_API scm_t_bits scm_tc16_future;
extern SCM *scm_loc_sys_thread_handler;
SCM_API SCM scm_i_make_future (SCM thunk);
SCM_INTERNAL SCM scm_i_make_future (SCM thunk);
SCM_API SCM scm_make_future (SCM thunk);
SCM_API SCM scm_future_ref (SCM future);

130
libguile/gc-card.c
View file

@ -15,31 +15,31 @@
* Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
*/
#include <assert.h>
#include <stdio.h>
#include <gmp.h>
#include "libguile/_scm.h"
#include "libguile/eval.h"
#include "libguile/numbers.h"
#include "libguile/stime.h"
#include "libguile/stackchk.h"
#include "libguile/struct.h"
#include "libguile/smob.h"
#include "libguile/unif.h"
#include "libguile/async.h"
#include "libguile/deprecation.h"
#include "libguile/eval.h"
#include "libguile/gc.h"
#include "libguile/hashtab.h"
#include "libguile/numbers.h"
#include "libguile/ports.h"
#include "libguile/private-gc.h"
#include "libguile/root.h"
#include "libguile/smob.h"
#include "libguile/srfi-4.h"
#include "libguile/stackchk.h"
#include "libguile/stime.h"
#include "libguile/strings.h"
#include "libguile/struct.h"
#include "libguile/tags.h"
#include "libguile/unif.h"
#include "libguile/validate.h"
#include "libguile/vectors.h"
#include "libguile/weaks.h"
#include "libguile/hashtab.h"
#include "libguile/tags.h"
#include "libguile/private-gc.h"
#include "libguile/validate.h"
#include "libguile/deprecation.h"
#include "libguile/gc.h"
#include "libguile/srfi-4.h"
#include "libguile/private-gc.h"
@ -50,27 +50,23 @@ long int scm_i_deprecated_memory_return;
*/
SCM scm_i_structs_to_free;
/*
Init all the free cells in CARD, prepending to *FREE_LIST.
Return: number of free cells found in this card.
Return: FREE_COUNT, the number of cells collected. This is
typically the length of the *FREE_LIST, but for some special cases,
we do not actually free the cell. To make the numbers match up, we
do increase the FREE_COUNT.
It would be cleaner to have a separate function sweep_value(), but
It would be cleaner to have a separate function sweep_value (), but
that is too slow (functions with switch statements can't be
inlined).
NOTE:
This function is quite efficient. However, for many types of cells,
allocation and a de-allocation involves calling malloc() and
free().
This is costly for small objects (due to malloc/free overhead.)
(should measure this).
For many types of cells, allocation and a de-allocation involves
calling malloc () and free (). This is costly for small objects (due
to malloc/free overhead.) (should measure this).
It might also be bad for threads: if several threads are allocating
strings concurrently, then mallocs for both threads may have to
@ -82,15 +78,16 @@ SCM scm_i_structs_to_free;
--hwn.
*/
int
scm_i_sweep_card (scm_t_cell * p, SCM *free_list, scm_t_heap_segment*seg)
scm_i_sweep_card (scm_t_cell *card, SCM *free_list, scm_t_heap_segment *seg)
#define FUNC_NAME "sweep_card"
{
scm_t_c_bvec_long *bitvec = SCM_GC_CARD_BVEC(p);
scm_t_cell * end = p + SCM_GC_CARD_N_CELLS;
scm_t_c_bvec_long *bitvec = SCM_GC_CARD_BVEC (card);
scm_t_cell *end = card + SCM_GC_CARD_N_CELLS;
scm_t_cell *p = card;
int span = seg->span;
int offset =SCM_MAX (SCM_GC_CARD_N_HEADER_CELLS, span);
int free_count = 0;
int offset = SCM_MAX (SCM_GC_CARD_N_HEADER_CELLS, span);
int free_count = 0;
/*
I tried something fancy with shifting by one bit every word from
the bitvec in turn, but it wasn't any faster, but quite a bit
@ -101,7 +98,7 @@ scm_i_sweep_card (scm_t_cell * p, SCM *free_list, scm_t_heap_segment*seg)
SCM scmptr = PTR2SCM (p);
if (SCM_C_BVEC_GET (bitvec, offset))
continue;
free_count++;
switch (SCM_TYP7 (scmptr))
{
case scm_tcs_struct:
@ -178,13 +175,13 @@ scm_i_sweep_card (scm_t_cell * p, SCM *free_list, scm_t_heap_segment*seg)
if (!(k < scm_numptob))
{
fprintf (stderr, "undefined port type");
abort();
abort ();
}
#endif
/* Keep "revealed" ports alive. */
if (scm_revealed_count (scmptr) > 0)
continue;
/* Yes, I really do mean scm_ptobs[k].free */
/* rather than ftobs[k].close. .close */
/* is for explicit CLOSE-PORT by user */
@ -214,7 +211,6 @@ scm_i_sweep_card (scm_t_cell * p, SCM *free_list, scm_t_heap_segment*seg)
switch SCM_TYP16 (scmptr)
{
case scm_tc_free_cell:
free_count --;
break;
default:
{
@ -224,7 +220,7 @@ scm_i_sweep_card (scm_t_cell * p, SCM *free_list, scm_t_heap_segment*seg)
if (!(k < scm_numsmob))
{
fprintf (stderr, "undefined smob type");
abort();
abort ();
}
#endif
if (scm_smobs[k].free)
@ -242,7 +238,7 @@ scm_i_sweep_card (scm_t_cell * p, SCM *free_list, scm_t_heap_segment*seg)
SCM_SMOBNAME (k));
scm_i_deprecated_memory_return += mm;
#else
abort();
abort ();
#endif
}
}
@ -252,15 +248,14 @@ scm_i_sweep_card (scm_t_cell * p, SCM *free_list, scm_t_heap_segment*seg)
break;
default:
fprintf (stderr, "unknown type");
abort();
abort ();
}
SCM_GC_SET_CELL_WORD (scmptr, 0, scm_tc_free_cell);
SCM_SET_FREE_CELL_CDR (scmptr, PTR2SCM (*free_list));
*free_list = scmptr;
free_count ++;
}
return free_count;
}
#undef FUNC_NAME
@ -270,17 +265,17 @@ scm_i_sweep_card (scm_t_cell * p, SCM *free_list, scm_t_heap_segment*seg)
Like sweep, but no complicated logic to do the sweeping.
*/
int
scm_i_init_card_freelist (scm_t_cell * card, SCM *free_list,
scm_t_heap_segment*seg)
scm_i_init_card_freelist (scm_t_cell *card, SCM *free_list,
scm_t_heap_segment *seg)
{
int span = seg->span;
scm_t_cell *end = card + SCM_GC_CARD_N_CELLS;
scm_t_cell *p = end - span;
scm_t_c_bvec_long * bvec_ptr = (scm_t_c_bvec_long* ) seg->bounds[1];
int collected = 0;
scm_t_c_bvec_long *bvec_ptr = (scm_t_c_bvec_long*) seg->bounds[1];
int idx = (card - seg->bounds[0]) / SCM_GC_CARD_N_CELLS;
bvec_ptr += idx *SCM_GC_CARD_BVEC_SIZE_IN_LONGS;
bvec_ptr += idx * SCM_GC_CARD_BVEC_SIZE_IN_LONGS;
SCM_GC_SET_CELL_BVEC (card, bvec_ptr);
/*
@ -292,16 +287,47 @@ scm_i_init_card_freelist (scm_t_cell * card, SCM *free_list,
SCM_GC_SET_CELL_WORD (scmptr, 0, scm_tc_free_cell);
SCM_SET_FREE_CELL_CDR (scmptr, PTR2SCM (*free_list));
*free_list = scmptr;
collected ++;
}
return SCM_GC_CARD_N_CELLS - SCM_MAX(span, SCM_GC_CARD_N_HEADER_CELLS);
return collected;
}
/*
Classic MIT Hack, see e.g. http://www.tekpool.com/?cat=9
*/
int scm_i_uint_bit_count (unsigned int u)
{
unsigned int u_count = u
- ((u >> 1) & 033333333333)
- ((u >> 2) & 011111111111);
return
((u_count + (u_count >> 3))
& 030707070707) % 63;
}
/*
Amount of cells marked in this cell, measured in 1-cells.
*/
int
scm_i_card_marked_count (scm_t_cell *card, int span)
{
scm_t_c_bvec_long* bvec = SCM_GC_CARD_BVEC (card);
scm_t_c_bvec_long* bvec_end = (bvec + SCM_GC_CARD_BVEC_SIZE_IN_LONGS);
int count = 0;
while (bvec < bvec_end)
{
count += scm_i_uint_bit_count (*bvec);
bvec ++;
}
return count * span;
}
void
scm_i_card_statistics (scm_t_cell *p, SCM hashtab, scm_t_heap_segment *seg)
{
scm_t_c_bvec_long *bitvec = SCM_GC_CARD_BVEC(p);
scm_t_c_bvec_long *bitvec = SCM_GC_CARD_BVEC (p);
scm_t_cell * end = p + SCM_GC_CARD_N_CELLS;
int span = seg->span;
int offset = SCM_MAX (SCM_GC_CARD_N_HEADER_CELLS, span);
@ -411,7 +437,7 @@ scm_i_tag_name (scm_t_bits tag)
case scm_tc7_smob:
/* scm_tc_free_cell is smob 0, the name field in that scm_smobs[]
entry should be ok for our return here */
return scm_smobs[SCM_TC2SMOBNUM(tag)].name;
return scm_smobs[SCM_TC2SMOBNUM (tag)].name;
}
return NULL;
@ -443,7 +469,7 @@ int
scm_dbg_gc_marked_p (SCM obj)
{
if (!SCM_IMP (obj))
return SCM_GC_MARK_P(obj);
return SCM_GC_MARK_P (obj);
else
return 0;
}
@ -452,7 +478,7 @@ scm_t_cell *
scm_dbg_gc_get_card (SCM obj)
{
if (!SCM_IMP (obj))
return SCM_GC_CELL_CARD(obj);
return SCM_GC_CELL_CARD (obj);
else
return NULL;
}

158
libguile/gc-freelist.c
View file

@ -26,9 +26,6 @@
scm_t_cell_type_statistics scm_i_master_freelist;
scm_t_cell_type_statistics scm_i_master_freelist2;
/*
In older versions of GUILE GC there was extensive support for
@ -38,8 +35,6 @@ the list. Mark bits are now separate, and checking for sane cell
access can be done much more easily by simply checking if the mark bit
is unset before allocation. --hwn
*/
#if (SCM_ENABLE_DEPRECATED == 1)
@ -69,78 +64,53 @@ SCM_DEFINE (scm_gc_set_debug_check_freelist_x, "gc-set-debug-check-freelist!", 1
#endif /* defined (GUILE_DEBUG) */
#endif /* deprecated */
/* Adjust FREELIST variables to decide wether or not to allocate more heap in
the next GC run based on SWEEP_STATS on SWEEP_STATS_1 (statistics
collected after the two last full GC). */
void
scm_i_adjust_min_yield (scm_t_cell_type_statistics *freelist,
scm_t_sweep_statistics sweep_stats,
scm_t_sweep_statistics sweep_stats_1)
{
/* min yield is adjusted upwards so that next predicted total yield
* (allocated cells actually freed by GC) becomes
* `min_yield_fraction' of total heap size. Note, however, that
* the absolute value of min_yield will correspond to `collected'
* on one master (the one which currently is triggering GC).
*
* The reason why we look at total yield instead of cells collected
* on one list is that we want to take other freelists into account.
* On this freelist, we know that (local) yield = collected cells,
* but that's probably not the case on the other lists.
*
* (We might consider computing a better prediction, for example
* by computing an average over multiple GC:s.)
*/
if (freelist->min_yield_fraction)
{
/* Pick largest of last two yields. */
long delta = ((SCM_HEAP_SIZE * freelist->min_yield_fraction / 100)
- (long) SCM_MAX (sweep_stats.collected,
sweep_stats_1.collected));
#ifdef DEBUGINFO
fprintf (stderr, " after GC = %lu, delta = %ld\n",
(unsigned long) scm_cells_allocated,
(long) delta);
#endif
if (delta > 0)
freelist->min_yield += delta;
}
}
static void
scm_init_freelist (scm_t_cell_type_statistics *freelist,
int span,
int min_yield)
int span,
int min_yield_percentage)
{
if (min_yield < 1)
min_yield = 1;
if (min_yield > 99)
min_yield = 99;
if (min_yield_percentage < 1)
min_yield_percentage = 1;
if (min_yield_percentage > 99)
min_yield_percentage = 99;
freelist->heap_segment_idx = -1;
freelist->min_yield = 0;
freelist->min_yield_fraction = min_yield;
freelist->min_yield_fraction = min_yield_percentage / 100.0;
freelist->span = span;
freelist->swept = 0;
freelist->collected = 0;
freelist->collected_1 = 0;
freelist->heap_size = 0;
freelist->heap_total_cells = 0;
}
#if (SCM_ENABLE_DEPRECATED == 1)
size_t scm_default_init_heap_size_1;
int scm_default_min_yield_1;
size_t scm_default_init_heap_size_2;
int scm_default_min_yield_2;
size_t scm_default_max_segment_size;
size_t scm_default_init_heap_size_1;
int scm_default_min_yield_1;
size_t scm_default_init_heap_size_2;
int scm_default_min_yield_2;
size_t scm_default_max_segment_size;
static void
check_deprecated_heap_vars (void) {
if (scm_default_init_heap_size_1 ||
scm_default_min_yield_1||
scm_default_init_heap_size_2||
scm_default_min_yield_2||
scm_default_max_segment_size)
{
scm_c_issue_deprecation_warning ("Tuning heap parameters with C variables is deprecated. Use environment variables instead.");
}
}
#else
static void check_deprecated_heap_vars (void) { }
#endif
void
scm_gc_init_freelist (void)
{
const char *error_message =
"Could not allocate initial heap of %uld.\n"
"Try adjusting GUILE_INIT_SEGMENT_SIZE_%d\n";
int init_heap_size_1
= scm_getenv_int ("GUILE_INIT_SEGMENT_SIZE_1", SCM_DEFAULT_INIT_HEAP_SIZE_1);
int init_heap_size_2
@ -155,38 +125,62 @@ scm_gc_init_freelist (void)
if (scm_max_segment_size <= 0)
scm_max_segment_size = SCM_DEFAULT_MAX_SEGMENT_SIZE;
scm_i_make_initial_segment (init_heap_size_1, &scm_i_master_freelist);
scm_i_make_initial_segment (init_heap_size_2, &scm_i_master_freelist2);
#if (SCM_ENABLE_DEPRECATED == 1)
if ( scm_default_init_heap_size_1 ||
scm_default_min_yield_1||
scm_default_init_heap_size_2||
scm_default_min_yield_2||
scm_default_max_segment_size)
{
scm_c_issue_deprecation_warning ("Tuning heap parameters with C variables is deprecated. Use environment variables instead.");
}
#endif
if (scm_i_get_new_heap_segment (&scm_i_master_freelist,
init_heap_size_1, return_on_error) == -1) {
fprintf (stderr, error_message, init_heap_size_1, 1);
abort ();
}
if (scm_i_get_new_heap_segment (&scm_i_master_freelist2,
init_heap_size_2, return_on_error) == -1) {
fprintf (stderr, error_message, init_heap_size_2, 2);
abort ();
}
check_deprecated_heap_vars ();
}
void
scm_i_gc_sweep_freelist_reset (scm_t_cell_type_statistics *freelist)
{
freelist->collected_1 = freelist->collected;
freelist->collected = 0;
freelist->swept = 0;
/*
at the end we simply start with the lowest segment again.
*/
freelist->heap_segment_idx = -1;
}
int
scm_i_gc_grow_heap_p (scm_t_cell_type_statistics * freelist)
/*
Returns how many more cells we should allocate according to our
policy. May return negative if we don't need to allocate more.
The new yield should at least equal gc fraction of new heap size, i.e.
c + dh > f * (h + dh)
c : collected
f : min yield fraction
h : heap size
dh : size of new heap segment
this gives dh > (f * h - c) / (1 - f).
*/
float
scm_i_gc_heap_size_delta (scm_t_cell_type_statistics * freelist)
{
return SCM_MAX (freelist->collected,freelist->collected_1) < freelist->min_yield;
float f = freelist->min_yield_fraction;
float collected = freelist->collected;
float swept = freelist->swept;
float delta = ((f * swept - collected) / (1.0 - f));
assert (freelist->heap_total_cells >= freelist->collected);
assert (freelist->swept == freelist->heap_total_cells);
assert (swept >= collected);
return delta;
}

48
libguile/gc-malloc.c
View file

@ -84,8 +84,8 @@ scm_gc_init_malloc (void)
{
scm_mtrigger = scm_getenv_int ("GUILE_INIT_MALLOC_LIMIT",
SCM_DEFAULT_INIT_MALLOC_LIMIT);
scm_i_minyield_malloc = scm_getenv_int ("GUILE_MIN_YIELD_MALLOC",
SCM_DEFAULT_MALLOC_MINYIELD);
scm_i_minyield_malloc = scm_getenv_int ("GUILE_MIN_YIELD_MALLOC",
SCM_DEFAULT_MALLOC_MINYIELD);
if (scm_i_minyield_malloc >= 100)
scm_i_minyield_malloc = 99;
@ -105,7 +105,6 @@ void *
scm_realloc (void *mem, size_t size)
{
void *ptr;
scm_t_sweep_statistics sweep_stats;
SCM_SYSCALL (ptr = realloc (mem, size));
if (ptr)
@ -114,19 +113,17 @@ scm_realloc (void *mem, size_t size)
scm_i_scm_pthread_mutex_lock (&scm_i_sweep_mutex);
scm_gc_running_p = 1;
scm_i_sweep_all_segments ("realloc", &sweep_stats);
SCM_SYSCALL (ptr = realloc (mem, size));
if (ptr)
{
scm_gc_running_p = 0;
scm_i_pthread_mutex_unlock (&scm_i_sweep_mutex);
return ptr;
}
scm_i_gc ("realloc");
scm_i_sweep_all_segments ("realloc", &sweep_stats);
/*
We don't want these sweep statistics to influence results for
cell GC, so we don't collect statistics.
realloc () failed, so we're really desparate to free memory. Run a
full sweep.
*/
scm_i_sweep_all_segments ("realloc", NULL);
scm_gc_running_p = 0;
scm_i_pthread_mutex_unlock (&scm_i_sweep_mutex);
@ -231,19 +228,22 @@ increase_mtrigger (size_t size, const char *what)
{
unsigned long prev_alloced;
float yield;
scm_t_sweep_statistics sweep_stats;
scm_i_scm_pthread_mutex_lock (&scm_i_sweep_mutex);
scm_gc_running_p = 1;
prev_alloced = mallocated;
prev_alloced = mallocated;
/* The GC will finish the pending sweep. For that reason, we
don't execute a complete sweep after GC, although that might
free some more memory.
*/
scm_i_gc (what);
scm_i_sweep_all_segments ("mtrigger", &sweep_stats);
yield = (((float) prev_alloced - (float) scm_mallocated)
/ (float) prev_alloced);
scm_gc_malloc_yield_percentage = (int) (100 * yield);
scm_gc_malloc_yield_percentage = (int) (100 * yield);
#ifdef DEBUGINFO
fprintf (stderr, "prev %lud , now %lud, yield %4.2lf, want %d",
@ -271,7 +271,7 @@ increase_mtrigger (size_t size, const char *what)
if (no_overflow_trigger >= (float) ULONG_MAX)
scm_mtrigger = ULONG_MAX;
else
scm_mtrigger = (unsigned long) no_overflow_trigger;
scm_mtrigger = (unsigned long) no_overflow_trigger;
#ifdef DEBUGINFO
fprintf (stderr, "Mtrigger sweep: ineffective. New trigger %d\n",
@ -314,7 +314,7 @@ scm_gc_malloc (size_t size, const char *what)
again in scm_gc_register_collectable_memory. We don't really
want the second GC since it will not find new garbage.
Note: this is a theoretical peeve. In reality, malloc() never
Note: this is a theoretical peeve. In reality, malloc () never
returns NULL. Usually, memory is overcommitted, and when you try
to write it the program is killed with signal 11. --hwn
*/
@ -342,10 +342,10 @@ scm_gc_realloc (void *mem, size_t old_size, size_t new_size, const char *what)
/*
scm_realloc() may invalidate the block pointed to by WHERE, eg. by
scm_realloc () may invalidate the block pointed to by WHERE, eg. by
unmapping it from memory or altering the contents. Since
increase_mtrigger() might trigger a GC that would scan
MEM, it is crucial that this call precedes realloc().
increase_mtrigger () might trigger a GC that would scan
MEM, it is crucial that this call precedes realloc ().
*/
decrease_mtrigger (old_size, what);

34
libguile/gc-mark.c
View file

@ -73,11 +73,12 @@ scm_mark_all (void)
long j;
int loops;
scm_i_marking = 1;
scm_i_init_weak_vectors_for_gc ();
scm_i_init_guardians_for_gc ();
scm_i_clear_mark_space ();
scm_i_find_heap_calls = 0;
/* Mark every thread's stack and registers */
scm_threads_mark_stacks ();
@ -139,8 +140,6 @@ scm_mark_all (void)
break;
}
/* fprintf (stderr, "%d loops\n", loops); */
/* Remove all unmarked entries from the weak vectors.
*/
scm_i_remove_weaks_from_weak_vectors ();
@ -148,6 +147,7 @@ scm_mark_all (void)
/* Bring hashtables upto date.
*/
scm_i_scan_weak_hashtables ();
scm_i_marking = 0;
}
/* {Mark/Sweep}
@ -169,6 +169,12 @@ scm_gc_mark (SCM ptr)
scm_gc_mark_dependencies (ptr);
}
void
ensure_marking (void)
{
assert (scm_i_marking);
}
/*
Mark the dependencies of an object.
@ -177,7 +183,7 @@ Prefetching:
Should prefetch objects before marking, i.e. if marking a cell, we
should prefetch the car, and then mark the cdr. This will improve CPU
cache misses, because the car is more likely to be in core when we
cache misses, because the car is more likely to be in cache when we
finish the cdr.
See http://www.hpl.hp.com/techreports/2000/HPL-2000-99.pdf, reducing
@ -333,10 +339,10 @@ scm_gc_mark_dependencies (SCM p)
if (!(i < scm_numptob))
{
fprintf (stderr, "undefined port type");
abort();
abort ();
}
#endif
if (SCM_PTAB_ENTRY(ptr))
if (SCM_PTAB_ENTRY (ptr))
scm_gc_mark (SCM_FILENAME (ptr));
if (scm_ptobs[i].mark)
{
@ -360,7 +366,7 @@ scm_gc_mark_dependencies (SCM p)
if (!(i < scm_numsmob))
{
fprintf (stderr, "undefined smob type");
abort();
abort ();
}
#endif
if (scm_smobs[i].mark)
@ -374,7 +380,7 @@ scm_gc_mark_dependencies (SCM p)
break;
default:
fprintf (stderr, "unknown type");
abort();
abort ();
}
/*
@ -398,21 +404,19 @@ scm_gc_mark_dependencies (SCM p)
{
/* We are in debug mode. Check the ptr exhaustively. */
valid_cell = valid_cell && (scm_i_find_heap_segment_containing_object (ptr) >= 0);
valid_cell = valid_cell && scm_in_heap_p (ptr);
}
#endif
if (!valid_cell)
{
fprintf (stderr, "rogue pointer in heap");
abort();
abort ();
}
}
if (SCM_GC_MARK_P (ptr))
{
if (SCM_GC_MARK_P (ptr))
return;
}
SCM_SET_GC_MARK (ptr);
@ -422,8 +426,6 @@ scm_gc_mark_dependencies (SCM p)
#undef FUNC_NAME
/* Mark a region conservatively */
void
scm_mark_locations (SCM_STACKITEM x[], unsigned long n)
@ -501,7 +503,7 @@ scm_deprecated_newcell2 (void)
void
scm_gc_init_mark(void)
scm_gc_init_mark (void)
{
#if SCM_ENABLE_DEPRECATED == 1
scm_tc16_allocated = scm_make_smob_type ("allocated cell", 0);

295
libguile/gc-segment-table.c Normal file
View file

@ -0,0 +1,295 @@
/* 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
*/
#include <assert.h>
#include <stdio.h>
#include <string.h>
#include "libguile/_scm.h"
#include "libguile/pairs.h"
#include "libguile/gc.h"
#include "libguile/private-gc.h"
/*
Heap segment table.
The table is sorted by the address of the data itself. This makes
for easy lookups. This is not portable: according to ANSI C,
pointers can only be compared within the same object (i.e. the same
block of malloced memory.). For machines with weird architectures,
this should be revised.
(Apparently, for this reason 1.6 and earlier had macros for pointer
comparison. )
perhaps it is worthwhile to remove the 2nd level of indirection in
the table, but this certainly makes for cleaner code.
*/
scm_t_heap_segment **scm_i_heap_segment_table;
size_t scm_i_heap_segment_table_size;
static scm_t_cell *lowest_cell;
static scm_t_cell *highest_cell;
/*
RETURN: index of inserted segment.
*/
int
scm_i_insert_segment (scm_t_heap_segment *seg)
{
size_t size = (scm_i_heap_segment_table_size + 1) * sizeof (scm_t_heap_segment *);
SCM_SYSCALL (scm_i_heap_segment_table
= ((scm_t_heap_segment **)
realloc ((char *)scm_i_heap_segment_table, size)));
/*
We can't alloc 4 more bytes. This is hopeless.
*/
if (!scm_i_heap_segment_table)
{
fprintf (stderr, "scm_i_get_new_heap_segment: Could not grow heap segment table.\n");
abort ();
}
if (!lowest_cell)
{
lowest_cell = seg->bounds[0];
highest_cell = seg->bounds[1];
}
else
{
lowest_cell = SCM_MIN (lowest_cell, seg->bounds[0]);
highest_cell = SCM_MAX (highest_cell, seg->bounds[1]);
}
{
int i = 0;
int j = 0;
while (i < scm_i_heap_segment_table_size
&& scm_i_heap_segment_table[i]->bounds[0] <= seg->bounds[0])
i++;
/*
We insert a new entry; if that happens to be before the
"current" segment of a freelist, we must move the freelist index
as well.
*/
if (scm_i_master_freelist.heap_segment_idx >= i)
scm_i_master_freelist.heap_segment_idx ++;
if (scm_i_master_freelist2.heap_segment_idx >= i)
scm_i_master_freelist2.heap_segment_idx ++;
for (j = scm_i_heap_segment_table_size; j > i; --j)
scm_i_heap_segment_table[j] = scm_i_heap_segment_table[j - 1];
scm_i_heap_segment_table[i] = seg;
scm_i_heap_segment_table_size ++;
return i;
}
}
/*
Determine whether the given value does actually represent a cell in
some heap segment. If this is the case, the number of the heap
segment is returned. Otherwise, -1 is returned. Binary search is
used to determine the heap segment that contains the cell.
I think this function is too long to be inlined. --hwn
*/
int
scm_i_find_heap_segment_containing_object (SCM obj)
{
if (!CELL_P (obj))
return -1;
scm_i_find_heap_calls ++;
if ((scm_t_cell *) obj < lowest_cell || (scm_t_cell *) obj >= highest_cell)
return -1;
{
scm_t_cell *ptr = SCM2PTR (obj);
unsigned int i = 0;
unsigned int j = scm_i_heap_segment_table_size - 1;
if (ptr < scm_i_heap_segment_table[i]->bounds[0])
return -1;
else if (scm_i_heap_segment_table[j]->bounds[1] <= ptr)
return -1;
else
{
while (i < j)
{
if (ptr < scm_i_heap_segment_table[i]->bounds[1])
{
break;
}
else if (scm_i_heap_segment_table[j]->bounds[0] <= ptr)
{
i = j;
break;
}
else
{
unsigned long int k = (i + j) / 2;
if (k == i)
return -1;
else if (ptr < scm_i_heap_segment_table[k]->bounds[1])
{
j = k;
++i;
if (ptr < scm_i_heap_segment_table[i]->bounds[0])
return -1;
}
else if (scm_i_heap_segment_table[k]->bounds[0] <= ptr)
{
i = k;
--j;
if (scm_i_heap_segment_table[j]->bounds[1] <= ptr)
return -1;
}
}
}
if (!SCM_DOUBLECELL_ALIGNED_P (obj) && scm_i_heap_segment_table[i]->span == 2)
return -1;
else if (SCM_GC_IN_CARD_HEADERP (ptr))
return -1;
else
return i;
}
}
}
int
scm_i_marked_count (void)
{
int i = 0;
int c = 0;
for (; i < scm_i_heap_segment_table_size; i++)
{
c += scm_i_heap_segment_marked_count (scm_i_heap_segment_table[i]);
}
return c;
}
SCM
scm_i_sweep_some_segments (scm_t_cell_type_statistics *freelist,
scm_t_sweep_statistics *sweep_stats)
{
int i = freelist->heap_segment_idx;
SCM collected = SCM_EOL;
if (i == -1) /* huh? --hwn */
i++;
for (;
i < scm_i_heap_segment_table_size; i++)
{
if (scm_i_heap_segment_table[i]->freelist != freelist)
continue;
collected = scm_i_sweep_some_cards (scm_i_heap_segment_table[i],
sweep_stats,
DEFAULT_SWEEP_AMOUNT);
if (collected != SCM_EOL) /* Don't increment i */
break;
}
freelist->heap_segment_idx = i;
return collected;
}
void
scm_i_reset_segments (void)
{
int i = 0;
for (; i < scm_i_heap_segment_table_size; i++)
{
scm_t_heap_segment *seg = scm_i_heap_segment_table[i];
seg->next_free_card = seg->bounds[0];
}
}
/*
Return a hashtab with counts of live objects, with tags as keys.
*/
SCM
scm_i_all_segments_statistics (SCM tab)
{
int i = 0;
for (; i < scm_i_heap_segment_table_size; i++)
{
scm_t_heap_segment *seg = scm_i_heap_segment_table[i];
scm_i_heap_segment_statistics (seg, tab);
}
return tab;
}
unsigned long*
scm_i_segment_table_info (int* size)
{
*size = scm_i_heap_segment_table_size;
unsigned long *bounds = malloc (sizeof (unsigned long) * *size * 2);
int i;
if (!bounds)
abort ();
for (i = *size; i-- > 0; )
{
bounds[2*i] = (unsigned long)scm_i_heap_segment_table[i]->bounds[0];
bounds[2*i+1] = (unsigned long)scm_i_heap_segment_table[i]->bounds[1];
}
return bounds;
}
void
scm_i_sweep_all_segments (char const *reason,
scm_t_sweep_statistics *sweep_stats)
{
unsigned i= 0;
for (i = 0; i < scm_i_heap_segment_table_size; i++)
{
scm_i_sweep_segment (scm_i_heap_segment_table[i], sweep_stats);
}
}
void
scm_i_clear_mark_space (void)
{
int i = 0;
for (; i < scm_i_heap_segment_table_size; i++)
{
scm_i_clear_segment_mark_space (scm_i_heap_segment_table[i]);
}
}

696
libguile/gc-segment.c
View file

@ -24,503 +24,35 @@
#include "libguile/gc.h"
#include "libguile/private-gc.h"
size_t scm_max_segment_size;
scm_t_heap_segment *
scm_i_make_empty_heap_segment (scm_t_cell_type_statistics *fl)
{
scm_t_heap_segment * shs = malloc (sizeof (scm_t_heap_segment));
if (!shs)
{
fprintf (stderr, "scm_i_get_new_heap_segment: out of memory.\n");
abort ();
}
shs->bounds[0] = NULL;
shs->bounds[1] = NULL;
shs->malloced = NULL;
shs->span = fl->span;
shs->freelist = fl;
shs->next_free_card = NULL;
return shs;
}
void
scm_i_heap_segment_statistics (scm_t_heap_segment *seg, SCM tab)
{
scm_t_cell *p = seg->bounds[0];
while (p < seg->bounds[1])
{
scm_i_card_statistics (p, tab, seg);
p += SCM_GC_CARD_N_CELLS;
}
}
/*
Fill SEGMENT with memory both for data and mark bits.
RETURN: 1 on success, 0 failure
*/
int
scm_i_initialize_heap_segment_data (scm_t_heap_segment * segment, size_t requested)
{
/*
round upwards
*/
int card_data_cell_count = (SCM_GC_CARD_N_CELLS - SCM_GC_CARD_N_HEADER_CELLS);
int card_count =1 + (requested / sizeof (scm_t_cell)) / card_data_cell_count;
/*
one card extra due to alignment
*/
size_t mem_needed = (1+card_count) * SCM_GC_SIZEOF_CARD
+ SCM_GC_CARD_BVEC_SIZE_IN_LONGS * card_count * SCM_SIZEOF_LONG
;
scm_t_c_bvec_long * bvec_ptr = 0;
scm_t_cell * memory = 0;
/*
We use calloc to alloc the heap. On GNU libc this is
equivalent to mmapping /dev/zero
*/
SCM_SYSCALL (memory = (scm_t_cell * ) calloc (1, mem_needed));
if (memory == NULL)
return 0;
segment->malloced = memory;
segment->bounds[0] = SCM_GC_CARD_UP (memory);
segment->bounds[1] = segment->bounds[0] + card_count * SCM_GC_CARD_N_CELLS;
segment->freelist->heap_size += scm_i_segment_cell_count (segment);
bvec_ptr = (scm_t_c_bvec_long*) segment->bounds[1];
/*
Don't init the mem or the bitvector. This is handled by lazy
sweeping.
*/
segment->next_free_card = segment->bounds[0];
segment->first_time = 1;
return 1;
}
int
scm_i_segment_card_count (scm_t_heap_segment * seg)
{
return (seg->bounds[1] - seg->bounds[0]) / SCM_GC_CARD_N_CELLS;
}
/*
Return the number of available single-cell data cells.
*/
int
scm_i_segment_cell_count (scm_t_heap_segment * seg)
{
return scm_i_segment_card_count (seg) * (SCM_GC_CARD_N_CELLS - SCM_GC_CARD_N_HEADER_CELLS)
+ ((seg->span == 2) ? -1 : 0);
}
void
scm_i_clear_segment_mark_space (scm_t_heap_segment *seg)
{
scm_t_cell * markspace = seg->bounds[1];
memset (markspace, 0x00,
scm_i_segment_card_count (seg) * SCM_GC_CARD_BVEC_SIZE_IN_LONGS * SCM_SIZEOF_LONG);
}
/* Sweep cards from SEG until we've gathered THRESHOLD cells. On return,
SWEEP_STATS contains the number of cells that have been visited and
collected. A freelist is returned, potentially empty. */
SCM
scm_i_sweep_some_cards (scm_t_heap_segment *seg,
scm_t_sweep_statistics *sweep_stats)
{
SCM cells = SCM_EOL;
int threshold = 512;
int collected = 0;
int (*sweeper) (scm_t_cell *, SCM *, scm_t_heap_segment* )
= (seg->first_time) ? &scm_i_init_card_freelist : &scm_i_sweep_card;
scm_t_cell * next_free = seg->next_free_card;
int cards_swept = 0;
while (collected < threshold && next_free < seg->bounds[1])
{
collected += (*sweeper) (next_free, &cells, seg);
next_free += SCM_GC_CARD_N_CELLS;
cards_swept ++;
}
sweep_stats->swept = cards_swept * seg->span
* (SCM_GC_CARD_N_CELLS - SCM_GC_CARD_N_HEADER_CELLS);
if (!seg->first_time)
{
/* scm_cells_allocated -= collected * seg->span; */
sweep_stats->collected = collected * seg->span;
}
else
sweep_stats->collected = 0;
seg->freelist->collected += collected * seg->span;
if(next_free == seg->bounds[1])
{
seg->first_time = 0;
}
seg->next_free_card = next_free;
return cells;
}
/*
Force a sweep of this entire segment. This doesn't modify sweep
statistics, it just frees the memory pointed to by to-be-swept
cells.
Implementation is slightly ugh.
FIXME: if you do scm_i_sweep_segment(), and then allocate from this
segment again, the statistics are off.
*/
void
scm_i_sweep_segment (scm_t_heap_segment *seg,
scm_t_sweep_statistics *sweep_stats)
{
scm_t_sweep_statistics sweep;
scm_t_cell * p = seg->next_free_card;
scm_i_sweep_statistics_init (sweep_stats);
scm_i_sweep_statistics_init (&sweep);
while (scm_i_sweep_some_cards (seg, &sweep) != SCM_EOL)
{
scm_i_sweep_statistics_sum (sweep_stats, sweep);
scm_i_sweep_statistics_init (&sweep);
}
seg->next_free_card =p;
}
void
scm_i_sweep_all_segments (char const *reason,
scm_t_sweep_statistics *sweep_stats)
{
unsigned i= 0;
scm_i_sweep_statistics_init (sweep_stats);
for (i = 0; i < scm_i_heap_segment_table_size; i++)
{
scm_t_sweep_statistics sweep;
scm_i_sweep_segment (scm_i_heap_segment_table[i], &sweep);
scm_i_sweep_statistics_sum (sweep_stats, sweep);
}
}
/*
Heap segment table.
The table is sorted by the address of the data itself. This makes
for easy lookups. This is not portable: according to ANSI C,
pointers can only be compared within the same object (i.e. the same
block of malloced memory.). For machines with weird architectures,
this should be revised.
(Apparently, for this reason 1.6 and earlier had macros for pointer
comparison. )
perhaps it is worthwhile to remove the 2nd level of indirection in
the table, but this certainly makes for cleaner code.
*/
scm_t_heap_segment ** scm_i_heap_segment_table;
size_t scm_i_heap_segment_table_size;
scm_t_cell *lowest_cell;
scm_t_cell *highest_cell;
void
scm_i_clear_mark_space (void)
{
int i = 0;
for (; i < scm_i_heap_segment_table_size; i++)
{
scm_i_clear_segment_mark_space (scm_i_heap_segment_table[i]);
}
}
/*
RETURN: index of inserted segment.
*/
int
scm_i_insert_segment (scm_t_heap_segment * seg)
{
size_t size = (scm_i_heap_segment_table_size + 1) * sizeof (scm_t_heap_segment *);
SCM_SYSCALL(scm_i_heap_segment_table = ((scm_t_heap_segment **)
realloc ((char *)scm_i_heap_segment_table, size)));
/*
We can't alloc 4 more bytes. This is hopeless.
*/
if (!scm_i_heap_segment_table)
{
fprintf (stderr, "scm_i_get_new_heap_segment: Could not grow heap segment table.\n");
abort ();
}
if (!lowest_cell)
{
lowest_cell = seg->bounds[0];
highest_cell = seg->bounds[1];
}
else
{
lowest_cell = SCM_MIN (lowest_cell, seg->bounds[0]);
highest_cell = SCM_MAX (highest_cell, seg->bounds[1]);
}
{
int i = 0;
int j = 0;
while (i < scm_i_heap_segment_table_size
&& scm_i_heap_segment_table[i]->bounds[0] <= seg->bounds[0])
i++;
/*
We insert a new entry; if that happens to be before the
"current" segment of a freelist, we must move the freelist index
as well.
*/
if (scm_i_master_freelist.heap_segment_idx >= i)
scm_i_master_freelist.heap_segment_idx ++;
if (scm_i_master_freelist2.heap_segment_idx >= i)
scm_i_master_freelist2.heap_segment_idx ++;
for (j = scm_i_heap_segment_table_size; j > i; --j)
scm_i_heap_segment_table[j] = scm_i_heap_segment_table[j - 1];
scm_i_heap_segment_table [i] = seg;
scm_i_heap_segment_table_size ++;
return i;
}
}
SCM
scm_i_sweep_some_segments (scm_t_cell_type_statistics *fl,
scm_t_sweep_statistics *sweep_stats)
{
int i = fl->heap_segment_idx;
SCM collected = SCM_EOL;
scm_i_sweep_statistics_init (sweep_stats);
if (i == -1)
i++;
for (;
i < scm_i_heap_segment_table_size; i++)
{
scm_t_sweep_statistics sweep;
if (scm_i_heap_segment_table[i]->freelist != fl)
continue;
scm_i_sweep_statistics_init (&sweep);
collected = scm_i_sweep_some_cards (scm_i_heap_segment_table[i],
&sweep);
scm_i_sweep_statistics_sum (sweep_stats, sweep);
if (collected != SCM_EOL) /* Don't increment i */
break;
}
fl->heap_segment_idx = i;
return collected;
}
void
scm_i_reset_segments (void)
{
int i = 0;
for (; i < scm_i_heap_segment_table_size; i++)
{
scm_t_heap_segment * seg = scm_i_heap_segment_table[i];
seg->next_free_card = seg->bounds[0];
}
}
/*
Return a hashtab with counts of live objects, with tags as keys.
*/
SCM
scm_i_all_segments_statistics (SCM tab)
{
int i = 0;
for (; i < scm_i_heap_segment_table_size; i++)
{
scm_t_heap_segment * seg = scm_i_heap_segment_table[i];
scm_i_heap_segment_statistics (seg, tab);
}
return tab;
}
/*
Determine whether the given value does actually represent a cell in
some heap segment. If this is the case, the number of the heap
segment is returned. Otherwise, -1 is returned. Binary search is
used to determine the heap segment that contains the cell.
I think this function is too long to be inlined. --hwn
*/
long int
scm_i_find_heap_segment_containing_object (SCM obj)
{
if (!CELL_P (obj))
return -1;
if ((scm_t_cell* ) obj < lowest_cell || (scm_t_cell*) obj >= highest_cell)
return -1;
{
scm_t_cell * ptr = SCM2PTR (obj);
unsigned long int i = 0;
unsigned long int j = scm_i_heap_segment_table_size - 1;
if (ptr < scm_i_heap_segment_table[i]->bounds[0])
return -1;
else if (scm_i_heap_segment_table[j]->bounds[1] <= ptr)
return -1;
else
{
while (i < j)
{
if (ptr < scm_i_heap_segment_table[i]->bounds[1])
{
break;
}
else if (scm_i_heap_segment_table[j]->bounds[0] <= ptr)
{
i = j;
break;
}
else
{
unsigned long int k = (i + j) / 2;
if (k == i)
return -1;
else if (ptr < scm_i_heap_segment_table[k]->bounds[1])
{
j = k;
++i;
if (ptr < scm_i_heap_segment_table[i]->bounds[0])
return -1;
}
else if (scm_i_heap_segment_table[k]->bounds[0] <= ptr)
{
i = k;
--j;
if (scm_i_heap_segment_table[j]->bounds[1] <= ptr)
return -1;
}
}
}
if (!SCM_DOUBLECELL_ALIGNED_P (obj) && scm_i_heap_segment_table[i]->span == 2)
return -1;
else if (SCM_GC_IN_CARD_HEADERP (ptr))
return -1;
else
return i;
}
}
}
/* Important entry point: try to grab some memory, and make it into a
segment; return the index of the segment. SWEEP_STATS should contain
global GC sweep statistics collected since the last full GC. */
global GC sweep statistics collected since the last full GC.
Returns the index of the segment. If error_policy !=
abort_on_error, we return -1 on failure.
*/
int
scm_i_get_new_heap_segment (scm_t_cell_type_statistics *freelist,
scm_t_sweep_statistics sweep_stats,
size_t len,
policy_on_error error_policy)
{
size_t len;
{
/* Assure that the new segment is predicted to be large enough.
*
* New yield should at least equal GC fraction of new heap size, i.e.
*
* y + dh > f * (h + dh)
*
* y : yield
* f : min yield fraction
* h : heap size
* dh : size of new heap segment
*
* This gives dh > (f * h - y) / (1 - f)
*/
float f = freelist->min_yield_fraction / 100.0;
float h = SCM_HEAP_SIZE;
float min_cells = (f * h - sweep_stats.collected) / (1.0 - f);
/* Make heap grow with factor 1.5 */
len = freelist->heap_size / 2;
#ifdef DEBUGINFO
fprintf (stderr, "(%ld < %ld)", (long) len, (long) min_cells);
#endif
if (len < min_cells)
len = (unsigned long) min_cells;
len *= sizeof (scm_t_cell);
/* force new sampling */
freelist->collected = LONG_MAX;
}
if (len > scm_max_segment_size)
len = scm_max_segment_size;
if (len < SCM_MIN_HEAP_SEG_SIZE)
len = SCM_MIN_HEAP_SEG_SIZE;
/* todo: consider having a more flexible lower bound. */
{
scm_t_heap_segment * seg = scm_i_make_empty_heap_segment (freelist);
scm_t_heap_segment *seg = scm_i_make_empty_heap_segment (freelist);
/* Allocate with decaying ambition. */
while (len >= SCM_MIN_HEAP_SEG_SIZE)
{
if (scm_i_initialize_heap_segment_data (seg, len))
{
return scm_i_insert_segment (seg);
}
return scm_i_insert_segment (seg);
len /= 2;
}
@ -534,30 +66,208 @@ scm_i_get_new_heap_segment (scm_t_cell_type_statistics *freelist,
return -1;
}
void
scm_i_make_initial_segment (int init_heap_size, scm_t_cell_type_statistics *freelist)
{
scm_t_heap_segment * seg = scm_i_make_empty_heap_segment (freelist);
if (init_heap_size < 1)
scm_t_heap_segment *
scm_i_make_empty_heap_segment (scm_t_cell_type_statistics *fl)
{
scm_t_heap_segment *shs = calloc (1, sizeof (scm_t_heap_segment));
if (!shs)
{
init_heap_size = SCM_DEFAULT_INIT_HEAP_SIZE_1;
fprintf (stderr, "scm_i_get_new_heap_segment: out of memory.\n");
abort ();
}
if (scm_i_initialize_heap_segment_data (seg, init_heap_size))
shs->span = fl->span;
shs->freelist = fl;
return shs;
}
void
scm_i_heap_segment_statistics (scm_t_heap_segment *seg, SCM tab)
{
scm_t_cell *p = seg->bounds[0];
while (p < seg->bounds[1])
{
freelist->heap_segment_idx = scm_i_insert_segment (seg);
scm_i_card_statistics (p, tab, seg);
p += SCM_GC_CARD_N_CELLS;
}
}
/*
count number of marked bits, so we know how much cells are live.
*/
int
scm_i_heap_segment_marked_count (scm_t_heap_segment *seg)
{
scm_t_c_bvec_long *bvec = (scm_t_c_bvec_long *) seg->bounds[1];
scm_t_c_bvec_long *bvec_end =
(bvec +
scm_i_segment_card_count (seg) * SCM_GC_CARD_BVEC_SIZE_IN_LONGS);
int count = 0;
while (bvec < bvec_end)
{
count += scm_i_uint_bit_count (*bvec);
bvec ++;
}
return count * seg->span;
}
int
scm_i_segment_card_number (scm_t_heap_segment *seg,
scm_t_cell *card)
{
return (card - seg->bounds[0]) / SCM_GC_CARD_N_CELLS;
}
/*
Fill SEGMENT with memory both for data and mark bits.
RETURN: 1 on success, 0 failure
*/
int
scm_i_initialize_heap_segment_data (scm_t_heap_segment *segment, size_t requested)
{
/*
round upwards
*/
int card_data_cell_count = (SCM_GC_CARD_N_CELLS - SCM_GC_CARD_N_HEADER_CELLS);
int card_count = 1 + (requested / sizeof (scm_t_cell)) / card_data_cell_count;
/*
Why the fuck try twice? --hwn
one card extra due to alignment
*/
size_t mem_needed = (1 + card_count) * SCM_GC_SIZEOF_CARD
+ SCM_GC_CARD_BVEC_SIZE_IN_LONGS * card_count * SCM_SIZEOF_LONG;
scm_t_cell *memory = 0;
/*
We use calloc to alloc the heap, so it is nicely initialized.
*/
if (!seg->malloced)
SCM_SYSCALL (memory = (scm_t_cell *) calloc (1, mem_needed));
if (memory == NULL)
return 0;
segment->malloced = memory;
segment->bounds[0] = SCM_GC_CARD_UP (memory);
segment->bounds[1] = segment->bounds[0] + card_count * SCM_GC_CARD_N_CELLS;
segment->freelist->heap_total_cells += scm_i_segment_cell_count (segment);
/*
Don't init the mem or the bitvector. This is handled by lazy
sweeping.
*/
segment->next_free_card = segment->bounds[0];
segment->first_time = 1;
return 1;
}
int
scm_i_segment_card_count (scm_t_heap_segment *seg)
{
return (seg->bounds[1] - seg->bounds[0]) / SCM_GC_CARD_N_CELLS;
}
/*
Return the number of available single-cell data cells.
*/
int
scm_i_segment_cell_count (scm_t_heap_segment *seg)
{
return scm_i_segment_card_count (seg)
* scm_i_segment_cells_per_card (seg);
}
int
scm_i_segment_cells_per_card (scm_t_heap_segment *seg)
{
return (SCM_GC_CARD_N_CELLS - SCM_GC_CARD_N_HEADER_CELLS
+ ((seg->span == 2) ? -1 : 0));
}
void
scm_i_clear_segment_mark_space (scm_t_heap_segment *seg)
{
scm_t_cell *markspace = seg->bounds[1];
memset (markspace, 0x00,
scm_i_segment_card_count (seg) * SCM_GC_CARD_BVEC_SIZE_IN_LONGS * SCM_SIZEOF_LONG);
}
/*
Force a sweep of this entire segment.
*/
void
scm_i_sweep_segment (scm_t_heap_segment *seg,
scm_t_sweep_statistics *sweep_stats)
{
int infinity = 1 << 30;
scm_t_cell *remember = seg->next_free_card;
while (scm_i_sweep_some_cards (seg, sweep_stats, infinity) != SCM_EOL)
;
seg->next_free_card = remember;
}
/* Sweep cards from SEG until we've gathered THRESHOLD cells. On
return, SWEEP_STATS, if non-NULL, contains the number of cells that
have been visited and collected. A freelist is returned,
potentially empty. */
SCM
scm_i_sweep_some_cards (scm_t_heap_segment *seg,
scm_t_sweep_statistics *sweep_stats,
int threshold)
{
SCM cells = SCM_EOL;
int collected = 0;
int (*sweeper) (scm_t_cell *, SCM *, scm_t_heap_segment *)
= (seg->first_time) ? &scm_i_init_card_freelist : &scm_i_sweep_card;
scm_t_cell *next_free = seg->next_free_card;
int cards_swept = 0;
while (collected < threshold && next_free < seg->bounds[1])
{
scm_i_initialize_heap_segment_data (seg, SCM_HEAP_SEG_SIZE);
collected += (*sweeper) (next_free, &cells, seg);
next_free += SCM_GC_CARD_N_CELLS;
cards_swept ++;
}
if (freelist->min_yield_fraction)
freelist->min_yield = (freelist->heap_size * freelist->min_yield_fraction
/ 100);
if (sweep_stats != NULL)
{
int swept = cards_swept
* ((SCM_GC_CARD_N_CELLS - SCM_GC_CARD_N_HEADER_CELLS)
- seg->span + 1);
int collected_cells = collected * seg->span;
sweep_stats->swept += swept;
sweep_stats->collected += collected_cells;
}
if (next_free == seg->bounds[1])
{
seg->first_time = 0;
}
seg->next_free_card = next_free;
return cells;
}
SCM
scm_i_sweep_for_freelist (scm_t_cell_type_statistics *freelist)
{
scm_t_sweep_statistics stats = { 0 };
SCM result = scm_i_sweep_some_segments (freelist, &stats);
scm_i_gc_sweep_stats.collected += stats.collected;
scm_i_gc_sweep_stats.swept += stats.swept;
freelist->collected += stats.collected;
freelist->swept += stats.swept;
return result;
}

313
libguile/gc.c
View file

@ -15,8 +15,6 @@
* Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
*/
#define _GNU_SOURCE
/* #define DEBUGINFO */
#if HAVE_CONFIG_H
@ -210,18 +208,17 @@ unsigned long scm_mtrigger;
unsigned long scm_cells_allocated = 0;
unsigned long scm_last_cells_allocated = 0;
unsigned long scm_mallocated = 0;
long int scm_i_find_heap_calls = 0;
/* Global GC sweep statistics since the last full GC. */
static scm_t_sweep_statistics scm_i_gc_sweep_stats = { 0, 0 };
static scm_t_sweep_statistics scm_i_gc_sweep_stats_1 = { 0, 0 };
scm_t_sweep_statistics scm_i_gc_sweep_stats = { 0, 0 };
/* Total count of cells marked/swept. */
static double scm_gc_cells_marked_acc = 0.;
static double scm_gc_cells_marked_conservatively_acc = 0.;
static double scm_gc_cells_swept_acc = 0.;
static double scm_gc_cells_allocated_acc = 0.;
static unsigned long scm_gc_time_taken = 0;
static unsigned long t_before_gc;
static unsigned long scm_gc_mark_time_taken = 0;
static unsigned long scm_gc_times = 0;
@ -243,6 +240,7 @@ SCM_SYMBOL (sym_gc_time_taken, "gc-time-taken");
SCM_SYMBOL (sym_gc_mark_time_taken, "gc-mark-time-taken");
SCM_SYMBOL (sym_times, "gc-times");
SCM_SYMBOL (sym_cells_marked, "cells-marked");
SCM_SYMBOL (sym_cells_marked_conservatively, "cells-marked-conservatively");
SCM_SYMBOL (sym_cells_swept, "cells-swept");
SCM_SYMBOL (sym_malloc_yield, "malloc-yield");
SCM_SYMBOL (sym_cell_yield, "cell-yield");
@ -318,50 +316,43 @@ SCM_DEFINE (scm_gc_stats, "gc-stats", 0, 0, 0,
unsigned long int local_protected_obj_count;
double local_scm_gc_cells_swept;
double local_scm_gc_cells_marked;
double local_scm_gc_cells_marked_conservatively;
double local_scm_total_cells_allocated;
SCM answer;
unsigned long *bounds = 0;
int table_size = scm_i_heap_segment_table_size;
int table_size = 0;
SCM_CRITICAL_SECTION_START;
/*
temporarily store the numbers, so as not to cause GC.
*/
bounds = malloc (sizeof (unsigned long) * table_size * 2);
if (!bounds)
abort();
for (i = table_size; i--; )
{
bounds[2*i] = (unsigned long)scm_i_heap_segment_table[i]->bounds[0];
bounds[2*i+1] = (unsigned long)scm_i_heap_segment_table[i]->bounds[1];
}
bounds = scm_i_segment_table_info (&table_size);
/* Below, we cons to produce the resulting list. We want a snapshot of
* the heap situation before consing.
*/
local_scm_mtrigger = scm_mtrigger;
local_scm_mallocated = scm_mallocated;
local_scm_heap_size = SCM_HEAP_SIZE;
local_scm_heap_size =
(scm_i_master_freelist.heap_total_cells + scm_i_master_freelist2.heap_total_cells);
local_scm_cells_allocated = scm_cells_allocated;
local_scm_cells_allocated =
scm_cells_allocated + scm_i_gc_sweep_stats.collected;
local_scm_gc_time_taken = scm_gc_time_taken;
local_scm_gc_mark_time_taken = scm_gc_mark_time_taken;
local_scm_gc_times = scm_gc_times;
local_scm_gc_malloc_yield_percentage = scm_gc_malloc_yield_percentage;
local_scm_gc_cell_yield_percentage= scm_gc_cell_yield_percentage;
local_scm_gc_cell_yield_percentage = scm_gc_cell_yield_percentage;
local_protected_obj_count = protected_obj_count;
local_scm_gc_cells_swept =
(double) scm_gc_cells_swept_acc
+ (double) scm_i_gc_sweep_stats.swept;
local_scm_gc_cells_marked = scm_gc_cells_marked_acc
+(double) scm_i_gc_sweep_stats.swept
-(double) scm_i_gc_sweep_stats.collected;
+ (double) scm_i_gc_sweep_stats.swept
- (double) scm_i_gc_sweep_stats.collected;
local_scm_gc_cells_marked_conservatively
= scm_gc_cells_marked_conservatively_acc;
local_scm_total_cells_allocated = scm_gc_cells_allocated_acc
+ (double) (scm_cells_allocated - scm_last_cells_allocated);
+ (double) scm_i_gc_sweep_stats.collected;
for (i = table_size; i--;)
{
@ -369,6 +360,7 @@ SCM_DEFINE (scm_gc_stats, "gc-stats", 0, 0, 0,
scm_from_ulong (bounds[2*i+1])),
heap_segs);
}
/* njrev: can any of these scm_cons's or scm_list_n signal a memory
error? If so we need a frame here. */
answer =
@ -380,6 +372,8 @@ SCM_DEFINE (scm_gc_stats, "gc-stats", 0, 0, 0,
scm_from_double (local_scm_total_cells_allocated)),
scm_cons (sym_heap_size,
scm_from_ulong (local_scm_heap_size)),
scm_cons (sym_cells_marked_conservatively,
scm_from_ulong (local_scm_gc_cells_marked_conservatively)),
scm_cons (sym_mallocated,
scm_from_ulong (local_scm_mallocated)),
scm_cons (sym_mtrigger,
@ -393,13 +387,12 @@ SCM_DEFINE (scm_gc_stats, "gc-stats", 0, 0, 0,
scm_cons (sym_cells_swept,
scm_from_double (local_scm_gc_cells_swept)),
scm_cons (sym_malloc_yield,
scm_from_long(local_scm_gc_malloc_yield_percentage)),
scm_from_long (local_scm_gc_malloc_yield_percentage)),
scm_cons (sym_cell_yield,
scm_from_long (local_scm_gc_cell_yield_percentage)),
scm_cons (sym_protected_objects,
scm_from_ulong (local_protected_obj_count)),
scm_cons (sym_heap_segments, heap_segs),
SCM_UNDEFINED);
SCM_CRITICAL_SECTION_END;
@ -408,63 +401,27 @@ SCM_DEFINE (scm_gc_stats, "gc-stats", 0, 0, 0,
}
#undef FUNC_NAME
/* Update the global sweeping/collection statistics by adding SWEEP_STATS to
SCM_I_GC_SWEEP_STATS and updating related variables. */
static inline void
gc_update_stats (scm_t_sweep_statistics sweep_stats)
/*
Update nice-to-know-statistics.
*/
static void
gc_end_stats ()
{
/* CELLS SWEPT is another word for the number of cells that were examined
during GC. YIELD is the number that we cleaned out. MARKED is the number
that weren't cleaned. */
scm_gc_cell_yield_percentage = (sweep_stats.collected * 100) / SCM_HEAP_SIZE;
scm_i_sweep_statistics_sum (&scm_i_gc_sweep_stats, sweep_stats);
if ((scm_i_gc_sweep_stats.collected > scm_i_gc_sweep_stats.swept)
|| (scm_cells_allocated < sweep_stats.collected))
{
printf ("internal GC error, please report to `"
PACKAGE_BUGREPORT "'\n");
abort ();
}
scm_gc_cell_yield_percentage = (scm_i_gc_sweep_stats.collected * 100) /
(scm_i_master_freelist.heap_total_cells + scm_i_master_freelist2.heap_total_cells);
scm_gc_cells_allocated_acc +=
(double) (scm_cells_allocated - scm_last_cells_allocated);
scm_cells_allocated -= sweep_stats.collected;
scm_last_cells_allocated = scm_cells_allocated;
}
static void
gc_start_stats (const char *what SCM_UNUSED)
{
t_before_gc = scm_c_get_internal_run_time ();
scm_gc_malloc_collected = 0;
}
static void
gc_end_stats (scm_t_sweep_statistics sweep_stats)
{
unsigned long t = scm_c_get_internal_run_time ();
scm_gc_time_taken += (t - t_before_gc);
/* Reset the number of cells swept/collected since the last full GC. */
scm_i_gc_sweep_stats_1 = scm_i_gc_sweep_stats;
scm_i_gc_sweep_stats.collected = scm_i_gc_sweep_stats.swept = 0;
gc_update_stats (sweep_stats);
scm_gc_cells_marked_acc += (double) scm_i_gc_sweep_stats.swept
- (double) scm_i_gc_sweep_stats.collected;
(double) scm_i_gc_sweep_stats.collected;
scm_gc_cells_marked_acc += (double) scm_cells_allocated;
scm_gc_cells_marked_conservatively_acc += (double) scm_i_find_heap_calls;
scm_gc_cells_swept_acc += (double) scm_i_gc_sweep_stats.swept;
++scm_gc_times;
}
SCM_DEFINE (scm_object_address, "object-address", 1, 0, 0,
(SCM obj),
"Return an integer that for the lifetime of @var{obj} is uniquely\n"
@ -511,58 +468,50 @@ scm_gc_for_newcell (scm_t_cell_type_statistics *freelist, SCM *free_cells)
{
SCM cell;
int did_gc = 0;
scm_t_sweep_statistics sweep_stats;
scm_i_scm_pthread_mutex_lock (&scm_i_sweep_mutex);
scm_gc_running_p = 1;
*free_cells = scm_i_sweep_some_segments (freelist, &sweep_stats);
gc_update_stats (sweep_stats);
if (*free_cells == SCM_EOL && scm_i_gc_grow_heap_p (freelist))
*free_cells = scm_i_sweep_for_freelist (freelist);
if (*free_cells == SCM_EOL)
{
freelist->heap_segment_idx =
scm_i_get_new_heap_segment (freelist,
scm_i_gc_sweep_stats,
abort_on_error);
float delta = scm_i_gc_heap_size_delta (freelist);
if (delta > 0.0)
{
size_t bytes = ((unsigned long) delta) * sizeof (scm_t_cell);
freelist->heap_segment_idx =
scm_i_get_new_heap_segment (freelist, bytes, abort_on_error);
*free_cells = scm_i_sweep_some_segments (freelist, &sweep_stats);
gc_update_stats (sweep_stats);
*free_cells = scm_i_sweep_for_freelist (freelist);
}
}
if (*free_cells == SCM_EOL)
{
/*
with the advent of lazy sweep, GC yield is only known just
before doing the GC.
*/
scm_i_adjust_min_yield (freelist,
scm_i_gc_sweep_stats,
scm_i_gc_sweep_stats_1);
/*
out of fresh cells. Try to get some new ones.
*/
char reason[] = "0-cells";
reason[0] += freelist->span;
did_gc = 1;
scm_i_gc ("cells");
scm_i_gc (reason);
*free_cells = scm_i_sweep_some_segments (freelist, &sweep_stats);
gc_update_stats (sweep_stats);
*free_cells = scm_i_sweep_for_freelist (freelist);
}
if (*free_cells == SCM_EOL)
{
/*
failed getting new cells. Get new juice or die.
*/
*/
float delta = scm_i_gc_heap_size_delta (freelist);
assert (delta > 0.0);
size_t bytes = ((unsigned long) delta) * sizeof (scm_t_cell);
freelist->heap_segment_idx =
scm_i_get_new_heap_segment (freelist,
scm_i_gc_sweep_stats,
abort_on_error);
scm_i_get_new_heap_segment (freelist, bytes, abort_on_error);
*free_cells = scm_i_sweep_some_segments (freelist, &sweep_stats);
gc_update_stats (sweep_stats);
*free_cells = scm_i_sweep_for_freelist (freelist);
}
if (*free_cells == SCM_EOL)
@ -588,46 +537,9 @@ scm_t_c_hook scm_before_sweep_c_hook;
scm_t_c_hook scm_after_sweep_c_hook;
scm_t_c_hook scm_after_gc_c_hook;
/* Must be called while holding scm_i_sweep_mutex.
*/
void
scm_i_gc (const char *what)
static void
scm_check_deprecated_memory_return ()
{
scm_t_sweep_statistics sweep_stats;
scm_i_thread_put_to_sleep ();
scm_c_hook_run (&scm_before_gc_c_hook, 0);
#ifdef DEBUGINFO
fprintf (stderr,"gc reason %s\n", what);
fprintf (stderr,
scm_is_null (*SCM_FREELIST_LOC (scm_i_freelist))
? "*"
: (scm_is_null (*SCM_FREELIST_LOC (scm_i_freelist2)) ? "o" : "m"));
#endif
gc_start_stats (what);
/*
Set freelists to NULL so scm_cons() always triggers gc, causing
the assertion above to fail.
*/
*SCM_FREELIST_LOC (scm_i_freelist) = SCM_EOL;
*SCM_FREELIST_LOC (scm_i_freelist2) = SCM_EOL;
/*
Let's finish the sweep. The conservative GC might point into the
garbage, and marking that would create a mess.
*/
scm_i_sweep_all_segments ("GC", &sweep_stats);
/* Invariant: the number of cells collected (i.e., freed) must always be
lower than or equal to the number of cells "swept" (i.e., visited). */
assert (sweep_stats.collected <= sweep_stats.swept);
if (scm_mallocated < scm_i_deprecated_memory_return)
{
/* The byte count of allocated objects has underflowed. This is
@ -642,14 +554,68 @@ scm_i_gc (const char *what)
abort ();
}
scm_mallocated -= scm_i_deprecated_memory_return;
scm_i_deprecated_memory_return = 0;
}
/* Must be called while holding scm_i_sweep_mutex.
This function is fairly long, but it touches various global
variables. To not obscure the side effects on global variables,
this function has not been split up.
*/
void
scm_i_gc (const char *what)
{
unsigned long t_before_gc = 0;
/* Mark */
scm_i_thread_put_to_sleep ();
scm_c_hook_run (&scm_before_gc_c_hook, 0);
#ifdef DEBUGINFO
fprintf (stderr,"gc reason %s\n", what);
fprintf (stderr,
scm_is_null (*SCM_FREELIST_LOC (scm_i_freelist))
? "*"
: (scm_is_null (*SCM_FREELIST_LOC (scm_i_freelist2)) ? "o" : "m"));
#endif
t_before_gc = scm_c_get_internal_run_time ();
scm_gc_malloc_collected = 0;
/*
Set freelists to NULL so scm_cons () always triggers gc, causing
the assertion above to fail.
*/
*SCM_FREELIST_LOC (scm_i_freelist) = SCM_EOL;
*SCM_FREELIST_LOC (scm_i_freelist2) = SCM_EOL;
/*
Let's finish the sweep. The conservative GC might point into the
garbage, and marking that would create a mess.
*/
scm_i_sweep_all_segments ("GC", &scm_i_gc_sweep_stats);
scm_check_deprecated_memory_return ();
/* Sanity check our numbers. */
/* If this was not true, someone touched mark bits outside of the
mark phase. */
assert (scm_cells_allocated == scm_i_marked_count ());
assert (scm_i_gc_sweep_stats.swept
== (scm_i_master_freelist.heap_total_cells
+ scm_i_master_freelist2.heap_total_cells));
assert (scm_i_gc_sweep_stats.collected + scm_cells_allocated
== scm_i_gc_sweep_stats.swept);
/* Mark */
scm_c_hook_run (&scm_before_mark_c_hook, 0);
scm_mark_all ();
scm_gc_mark_time_taken += (scm_c_get_internal_run_time () - t_before_gc);
scm_cells_allocated = scm_i_marked_count ();
/* Sweep
TODO: the after_sweep hook should probably be moved to just before
@ -675,18 +641,36 @@ scm_i_gc (const char *what)
distinct classes of hook functions since this can prevent some
bad interference when several modules adds gc hooks.
*/
scm_c_hook_run (&scm_before_sweep_c_hook, 0);
scm_gc_sweep ();
scm_c_hook_run (&scm_after_sweep_c_hook, 0);
gc_end_stats (sweep_stats);
scm_i_thread_wake_up ();
/*
Nothing here: lazy sweeping.
*/
scm_i_reset_segments ();
*SCM_FREELIST_LOC (scm_i_freelist) = SCM_EOL;
*SCM_FREELIST_LOC (scm_i_freelist2) = SCM_EOL;
/* Invalidate the freelists of other threads. */
scm_i_thread_invalidate_freelists ();
scm_c_hook_run (&scm_after_sweep_c_hook, 0);
gc_end_stats ();
scm_i_gc_sweep_stats.collected = scm_i_gc_sweep_stats.swept = 0;
scm_i_gc_sweep_freelist_reset (&scm_i_master_freelist);
scm_i_gc_sweep_freelist_reset (&scm_i_master_freelist2);
/* Arguably, this statistic is fairly useless: marking will dominate
the time taken.
*/
scm_gc_time_taken += (scm_c_get_internal_run_time () - t_before_gc);
scm_i_thread_wake_up ();
/*
For debugging purposes, you could do
scm_i_sweep_all_segments("debug"), but then the remains of the
scm_i_sweep_all_segments ("debug"), but then the remains of the
cell aren't left to analyse.
*/
}
@ -790,7 +774,7 @@ scm_permanent_object (SCM obj)
*/
/* Implementation note: For every object X, there is a counter which
scm_gc_protect_object(X) increments and scm_gc_unprotect_object(X) decrements.
scm_gc_protect_object (X) increments and scm_gc_unprotect_object (X) decrements.
*/
@ -965,11 +949,9 @@ scm_init_storage ()
while (j)
scm_sys_protects[--j] = SCM_BOOL_F;
scm_gc_init_freelist();
scm_gc_init_freelist ();
scm_gc_init_malloc ();
j = SCM_HEAP_SEG_SIZE;
#if 0
/* We can't have a cleanup handler since we have no thread to run it
in. */
@ -1089,7 +1071,7 @@ void *
scm_ia64_ar_bsp (const void *ctx)
{
uint64_t bsp;
__uc_get_ar_bsp(ctx, &bsp);
__uc_get_ar_bsp (ctx, &bsp);
return (void *) bsp;
}
# endif /* hpux */
@ -1114,21 +1096,6 @@ void
scm_gc_sweep (void)
#define FUNC_NAME "scm_gc_sweep"
{
scm_i_deprecated_memory_return = 0;
scm_i_gc_sweep_freelist_reset (&scm_i_master_freelist);
scm_i_gc_sweep_freelist_reset (&scm_i_master_freelist2);
/*
NOTHING HERE: LAZY SWEEPING !
*/
scm_i_reset_segments ();
*SCM_FREELIST_LOC (scm_i_freelist) = SCM_EOL;
*SCM_FREELIST_LOC (scm_i_freelist2) = SCM_EOL;
/* Invalidate the freelists of other threads. */
scm_i_thread_invalidate_freelists ();
}
#undef FUNC_NAME

14
libguile/gc.h
View file

@ -3,7 +3,7 @@
#ifndef SCM_GC_H
#define SCM_GC_H
/* Copyright (C) 1995,1996,1998,1999,2000,2001, 2002, 2003, 2004, 2006 Free Software Foundation, Inc.
/* Copyright (C) 1995,1996,1998,1999,2000,2001, 2002, 2003, 2004, 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
@ -155,6 +155,8 @@ typedef unsigned long scm_t_c_bvec_long;
/* testing and changing GC marks */
#define SCM_GC_MARK_P(x) SCM_GC_CELL_GET_BIT (x)
void ensure_marking(void);
#define SCM_SET_GC_MARK(x) SCM_GC_CELL_SET_BIT (x)
#define SCM_CLEAR_GC_MARK(x) SCM_GC_CELL_CLEAR_BIT (x)
@ -241,10 +243,10 @@ SCM_API int scm_debug_cells_gc_interval ;
void scm_i_expensive_validation_check (SCM cell);
#endif
SCM_API scm_i_pthread_mutex_t scm_i_gc_admin_mutex;
SCM_INTERNAL scm_i_pthread_mutex_t scm_i_gc_admin_mutex;
#define scm_gc_running_p (SCM_I_CURRENT_THREAD->gc_running_p)
SCM_API scm_i_pthread_mutex_t scm_i_sweep_mutex;
SCM_INTERNAL scm_i_pthread_mutex_t scm_i_sweep_mutex;
#ifdef __ia64__
void *scm_ia64_register_backing_store_base (void);
@ -283,8 +285,6 @@ SCM_API int scm_gc_malloc_yield_percentage;
SCM_API unsigned long scm_mallocated;
SCM_API unsigned long scm_mtrigger;
SCM_API SCM scm_after_gc_hook;
SCM_API scm_t_c_hook scm_before_gc_c_hook;
@ -320,7 +320,7 @@ SCM_API SCM scm_gc_live_object_stats (void);
SCM_API SCM scm_gc (void);
SCM_API void scm_gc_for_alloc (struct scm_t_cell_type_statistics *freelist);
SCM_API SCM scm_gc_for_newcell (struct scm_t_cell_type_statistics *master, SCM *freelist);
SCM_API void scm_i_gc (const char *what);
SCM_INTERNAL void scm_i_gc (const char *what);
SCM_API void scm_gc_mark (SCM p);
SCM_API void scm_gc_mark_dependencies (SCM p);
SCM_API void scm_mark_locations (SCM_STACKITEM x[], unsigned long n);
@ -384,7 +384,7 @@ SCM_API void scm_gc_unregister_roots (SCM *b, unsigned long n);
SCM_API void scm_storage_prehistory (void);
SCM_API int scm_init_storage (void);
SCM_API void *scm_get_stack_base (void);
SCM_API void scm_init_gc (void);
SCM_INTERNAL void scm_init_gc (void);
#if SCM_ENABLE_DEPRECATED == 1

23
libguile/gc_os_dep.c
View file

@ -1008,19 +1008,18 @@ scm_get_stack_base ()
# ifdef MIPS
# define MACH_TYPE "MIPS"
/* # define STACKBOTTOM ((ptr_t)0x7fff8000) sometimes also works. */
# ifdef LINUX
/* This was developed for a linuxce style platform. Probably */
/* needs to be tweaked for workstation class machines. */
# define OS_TYPE "LINUX"
extern int __data_start;
# define DATASTART ((ptr_t)(&__data_start))
# define ALIGNMENT 4
# define USE_GENERIC_PUSH_REGS 1
# define STACKBOTTOM 0x80000000
/* In many cases, this should probably use LINUX_STACKBOTTOM */
/* instead. But some kernel versions seem to give the wrong */
/* value from /proc. */
# define CPP_WORDSZ _MIPS_SZPTR
# define OS_TYPE "LINUX"
# define ALIGNMENT 4
# define ALIGN_DOUBLE
extern int _fdata;
# define DATASTART ((ptr_t)(&_fdata))
extern int _end;
# define DATAEND ((ptr_t)(&_end))
# define STACKBOTTOM ((ptr_t)0x7fff8000)
# define USE_GENERIC_PUSH_REGS 1
# define DYNAMIC_LOADING
# endif /* Linux */
# ifdef ULTRIX
# define HEURISTIC2

4
libguile/gdbint.h
View file

@ -3,7 +3,7 @@
#ifndef SCM_GDBINT_H
#define SCM_GDBINT_H
/* Copyright (C) 1996,2000, 2006 Free Software Foundation, Inc.
/* Copyright (C) 1996,2000, 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
@ -28,7 +28,7 @@
SCM_API int scm_print_carefully_p;
SCM_API void scm_init_gdbint (void);
SCM_INTERNAL void scm_init_gdbint (void);
#endif /* SCM_GDBINT_H */

15
libguile/gen-scmconfig.c
View file

@ -121,7 +121,7 @@
# include <config.h>
#endif
#include "gen-scmconfig.h"
#include <libguile/gen-scmconfig.h>
#include <stdio.h>
#include <string.h>
@ -387,6 +387,19 @@ main (int argc, char *argv[])
pf ("#define SCM_NEED_BRACES_ON_PTHREAD_MUTEX_INITIALIZER %d /* 0 or 1 */\n",
SCM_I_GSC_NEED_BRACES_ON_PTHREAD_MUTEX_INITIALIZER);
pf ("\n\n/*** File system access ***/\n");
pf ("/* Define to 1 if `struct dirent64' is available. */\n");
pf ("#define SCM_HAVE_STRUCT_DIRENT64 %d /* 0 or 1 */\n",
SCM_I_GSC_HAVE_STRUCT_DIRENT64);
pf ("/* Define to 1 if `readdir64_r ()' is available. */\n");
#ifdef HAVE_READDIR64_R
pf ("#define SCM_HAVE_READDIR64_R 1 /* 0 or 1 */\n");
#else
pf ("#define SCM_HAVE_READDIR64_R 0 /* 0 or 1 */\n");
#endif
#if USE_DLL_IMPORT
pf ("\n");
pf ("/* Define some additional CPP macros on Win32 platforms. */\n");

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

@ -30,6 +30,7 @@
#define SCM_I_GSC_USE_NULL_THREADS @SCM_I_GSC_USE_NULL_THREADS@
#define SCM_I_GSC_NEED_BRACES_ON_PTHREAD_ONCE_INIT @SCM_I_GSC_NEED_BRACES_ON_PTHREAD_ONCE_INIT@
#define SCM_I_GSC_NEED_BRACES_ON_PTHREAD_MUTEX_INITIALIZER @SCM_I_GSC_NEED_BRACES_ON_PTHREAD_MUTEX_INITIALIZER@
#define SCM_I_GSC_HAVE_STRUCT_DIRENT64 @SCM_I_GSC_HAVE_STRUCT_DIRENT64@
/*
Local Variables:

6
libguile/gettext.h
View file

@ -3,7 +3,7 @@
#ifndef SCM_GETTEXT_H
#define SCM_GETTEXT_H
/* Copyright (C) 2004, 2006 Free Software Foundation, Inc.
/* Copyright (C) 2004, 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
@ -28,9 +28,9 @@ SCM_API SCM scm_textdomain (SCM domainname);
SCM_API SCM scm_bindtextdomain (SCM domainname, SCM directory);
SCM_API SCM scm_bind_textdomain_codeset (SCM domainname, SCM encoding);
SCM_API int scm_i_to_lc_category (SCM category, int allow_lc_all);
SCM_INTERNAL int scm_i_to_lc_category (SCM category, int allow_lc_all);
SCM_API void scm_init_gettext (void);
SCM_INTERNAL void scm_init_gettext (void);
#endif /* SCM_GETTEXT_H */

10
libguile/goops.c
View file

@ -25,6 +25,7 @@
*/
#include <stdio.h>
#include <assert.h>
#include "libguile/_scm.h"
#include "libguile/alist.h"
@ -1705,11 +1706,10 @@ go_to_hell (void *o)
{
SCM obj = SCM_PACK ((scm_t_bits) o);
scm_lock_mutex (hell_mutex);
if (n_hell == hell_size)
if (n_hell >= hell_size)
{
long new_size = 2 * hell_size;
hell = scm_realloc (hell, new_size);
hell_size = new_size;
hell_size *= 2;
hell = scm_realloc (hell, hell_size * sizeof(*hell));
}
hell[n_hell++] = SCM_STRUCT_DATA (obj);
scm_unlock_mutex (hell_mutex);
@ -2995,7 +2995,7 @@ scm_init_goops_builtins (void)
list_of_no_method = scm_permanent_object (scm_list_1 (sym_no_method));
hell = scm_malloc (hell_size);
hell = scm_calloc (hell_size * sizeof (*hell));
hell_mutex = scm_permanent_object (scm_make_mutex ());
create_basic_classes ();

9
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 Free Software Foundation, Inc.
/* Copyright (C) 1998,1999,2000,2001,2002,2003, 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
@ -254,7 +254,8 @@ SCM_API SCM scm_pure_generic_p (SCM obj);
#endif
SCM_API SCM scm_sys_compute_slots (SCM c);
SCM_API SCM scm_i_get_keyword (SCM key, SCM l, long len, SCM default_value, const char *subr);
SCM_INTERNAL SCM scm_i_get_keyword (SCM key, SCM l, long len,
SCM default_value, const char *subr);
SCM_API SCM scm_get_keyword (SCM key, SCM l, SCM default_value);
SCM_API SCM scm_sys_initialize_object (SCM obj, SCM initargs);
SCM_API SCM scm_sys_prep_layout_x (SCM c);
@ -297,8 +298,8 @@ SCM_API SCM scm_make (SCM args);
SCM_API SCM scm_find_method (SCM args);
SCM_API SCM scm_sys_method_more_specific_p (SCM m1, SCM m2, SCM targs);
SCM_API SCM scm_init_goops_builtins (void);
SCM_API void scm_init_goops (void);
SCM_INTERNAL SCM scm_init_goops_builtins (void);
SCM_INTERNAL void scm_init_goops (void);
#if (SCM_ENABLE_DEPRECATED == 1)

4
libguile/gsubr.h
View file

@ -3,7 +3,7 @@
#ifndef SCM_GSUBR_H
#define SCM_GSUBR_H
/* Copyright (C) 1995,1996,1998,2000,2001, 2006 Free Software Foundation, Inc.
/* Copyright (C) 1995,1996,1998,2000,2001, 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
@ -51,7 +51,7 @@ SCM_API SCM scm_c_define_gsubr_with_generic (const char *name,
SCM (*fcn) (), SCM *gf);
SCM_API SCM scm_gsubr_apply (SCM args);
SCM_API void scm_init_gsubr (void);
SCM_INTERNAL void scm_init_gsubr (void);
#endif /* SCM_GSUBR_H */

10
libguile/guardians.h
View file

@ -3,7 +3,7 @@
#ifndef SCM_GUARDIANS_H
#define SCM_GUARDIANS_H
/* Copyright (C) 1998,2000,2001, 2006 Free Software Foundation, Inc.
/* Copyright (C) 1998,2000,2001, 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
@ -26,11 +26,11 @@
SCM_API SCM scm_make_guardian (void);
SCM_API void scm_i_init_guardians_for_gc (void);
SCM_API void scm_i_identify_inaccessible_guardeds (void);
SCM_API int scm_i_mark_inaccessible_guardeds (void);
SCM_INTERNAL void scm_i_init_guardians_for_gc (void);
SCM_INTERNAL void scm_i_identify_inaccessible_guardeds (void);
SCM_INTERNAL int scm_i_mark_inaccessible_guardeds (void);
SCM_API void scm_init_guardians (void);
SCM_INTERNAL void scm_init_guardians (void);
#endif /* SCM_GUARDIANS_H */

4
libguile/hash.h
View file

@ -3,7 +3,7 @@
#ifndef SCM_HASH_H
#define SCM_HASH_H
/* Copyright (C) 1995,1996,2000, 2006 Free Software Foundation, Inc.
/* Copyright (C) 1995,1996,2000, 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
@ -34,7 +34,7 @@ SCM_API unsigned long scm_ihashv (SCM obj, unsigned long n);
SCM_API SCM scm_hashv (SCM obj, SCM n);
SCM_API unsigned long scm_ihash (SCM obj, unsigned long n);
SCM_API SCM scm_hash (SCM obj, SCM n);
SCM_API void scm_init_hash (void);
SCM_INTERNAL void scm_init_hash (void);
#endif /* SCM_HASH_H */

Some files were not shown because too many files have changed in this diff Show more