mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-07 18:30:25 +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

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 */

2
libguile/hashtab.c
View file

@ -215,8 +215,6 @@ hashtable_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED)
return 1;
}
#define UNMARKED_CELL_P(x) (SCM_NIMP(x) && !SCM_GC_MARK_P (x))
/* keep track of hash tables that need to shrink after scan */
static SCM to_rehash = SCM_EOL;

11
libguile/hashtab.h
View file

@ -3,7 +3,7 @@
#ifndef SCM_HASHTAB_H
#define SCM_HASHTAB_H
/* Copyright (C) 1995,1996,1999,2000,2001, 2003, 2004, 2006 Free Software Foundation, Inc.
/* Copyright (C) 1995,1996,1999,2000,2001, 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
@ -96,8 +96,9 @@ SCM_API SCM scm_weak_key_hash_table_p (SCM h);
SCM_API SCM scm_weak_value_hash_table_p (SCM h);
SCM_API SCM scm_doubly_weak_hash_table_p (SCM h);
SCM_API void scm_i_rehash (SCM table, unsigned long (*hash_fn)(), void *closure, const char*func_name);
SCM_API void scm_i_scan_weak_hashtables (void);
SCM_INTERNAL void scm_i_rehash (SCM table, unsigned long (*hash_fn)(),
void *closure, const char *func_name);
SCM_INTERNAL void scm_i_scan_weak_hashtables (void);
SCM_API SCM scm_hash_fn_get_handle (SCM table, SCM obj, unsigned long (*hash_fn) (), SCM (*assoc_fn) (), void * closure);
SCM_API SCM scm_hash_fn_create_handle_x (SCM table, SCM obj, SCM init, unsigned long (*hash_fn) (), SCM (*assoc_fn) (), void * closure);
@ -132,8 +133,8 @@ SCM_API SCM scm_hash_fold (SCM proc, SCM init, SCM hash);
SCM_API SCM scm_hash_for_each (SCM proc, SCM hash);
SCM_API SCM scm_hash_for_each_handle (SCM proc, SCM hash);
SCM_API SCM scm_hash_map_to_list (SCM proc, SCM hash);
SCM_API void scm_hashtab_prehistory (void);
SCM_API void scm_init_hashtab (void);
SCM_INTERNAL void scm_hashtab_prehistory (void);
SCM_INTERNAL void scm_init_hashtab (void);
#endif /* SCM_HASHTAB_H */

4
libguile/hooks.h
View file

@ -3,7 +3,7 @@
#ifndef SCM_HOOKS_H
#define SCM_HOOKS_H
/* Copyright (C) 1995,1996,1999,2000,2001, 2006 Free Software Foundation, Inc.
/* Copyright (C) 1995,1996,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
@ -87,7 +87,7 @@ SCM_API SCM scm_reset_hook_x (SCM hook);
SCM_API SCM scm_run_hook (SCM hook, SCM args);
SCM_API void scm_c_run_hook (SCM hook, SCM args);
SCM_API SCM scm_hook_to_list (SCM hook);
SCM_API void scm_init_hooks (void);
SCM_INTERNAL void scm_init_hooks (void);
#endif /* SCM_HOOKS_H */

2
libguile/i18n.h
View file

@ -3,7 +3,7 @@
#ifndef SCM_I18N_H
#define SCM_I18N_H
/* Copyright (C) 2006 Free Software Foundation, Inc.
/* Copyright (C) 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

6
libguile/init.h
View file

@ -3,7 +3,7 @@
#ifndef SCM_INIT_H
#define SCM_INIT_H
/* Copyright (C) 1995,1996,1997,2000, 2006 Free Software Foundation, Inc.
/* Copyright (C) 1995,1996,1997,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
@ -26,7 +26,7 @@
#include "libguile/threads.h"
SCM_API scm_i_pthread_mutex_t scm_i_init_mutex;
SCM_INTERNAL scm_i_pthread_mutex_t scm_i_init_mutex;
SCM_API int scm_initialized_p;
SCM_API void scm_init_guile (void);
@ -37,7 +37,7 @@ SCM_API void scm_boot_guile (int argc, char **argv,
char **argv),
void *closure);
SCM_API void scm_i_init_guile (SCM_STACKITEM *base);
SCM_INTERNAL void scm_i_init_guile (SCM_STACKITEM *base);
SCM_API void scm_load_startup_files (void);

117
libguile/inline.h
View file

@ -25,17 +25,17 @@
"inline.c".
*/
#include "libguile/__scm.h"
#if (SCM_DEBUG_CELL_ACCESSES == 1)
#include <stdio.h>
#endif
#include <string.h>
#include "libguile/__scm.h"
#include "libguile/pairs.h"
#include "libguile/gc.h"
#include "libguile/threads.h"
#include "libguile/unif.h"
#include "libguile/pairs.h"
#include "libguile/ports.h"
#include "libguile/error.h"
#ifndef SCM_INLINE_C_INCLUDING_INLINE_H
@ -55,6 +55,7 @@
inline" in that case. */
# if (defined __GNUC__) && (!(__APPLE_CC__ > 5400 && __STDC_VERSION__ >= 199901L))
# define SCM_C_USE_EXTERN_INLINE 1
# if (defined __GNUC_STDC_INLINE__) || (__GNUC__ == 4 && __GNUC_MINOR__ == 2)
# define SCM_C_EXTERN_INLINE \
extern __inline__ __attribute__ ((__gnu_inline__))
@ -68,12 +69,12 @@
#endif /* SCM_INLINE_C_INCLUDING_INLINE_H */
#if ((!defined SCM_C_INLINE) && (!defined SCM_INLINE_C_INCLUDING_INLINE_H)) \
|| (defined __GNUC__)
#if (!defined SCM_C_INLINE) || (defined SCM_INLINE_C_INCLUDING_INLINE_H) \
|| (defined SCM_C_USE_EXTERN_INLINE)
/* The `extern' declarations. They should only appear when used from
"inline.c", when `inline' is not supported at all or when GCC's "extern
inline" is used. */
"inline.c", when `inline' is not supported at all or when "extern inline"
is used. */
SCM_API SCM scm_cell (scm_t_bits car, scm_t_bits cdr);
SCM_API SCM scm_double_cell (scm_t_bits car, scm_t_bits cbr,
@ -84,10 +85,14 @@ SCM_API void scm_array_handle_set (scm_t_array_handle *h, ssize_t pos, SCM val);
SCM_API int scm_is_pair (SCM x);
SCM_API int scm_getc (SCM port);
SCM_API void scm_putc (char c, SCM port);
SCM_API void scm_puts (const char *str_data, SCM port);
#endif
#if defined SCM_C_INLINE || defined SCM_INLINE_C_INCLUDING_INLINE_H
#if defined SCM_C_EXTERN_INLINE || defined SCM_INLINE_C_INCLUDING_INLINE_H
/* either inlining, or being included from inline.c. We use (and
repeat) this long #if test here and below so that we don't have to
introduce any extraneous symbols into the public namespace. We
@ -97,7 +102,7 @@ extern unsigned scm_newcell2_count;
extern unsigned scm_newcell_count;
#if defined SCM_C_EXTERN_INLINE && ! defined SCM_INLINE_C_INCLUDING_INLINE_H
#ifndef SCM_INLINE_C_INCLUDING_INLINE_H
SCM_C_EXTERN_INLINE
#endif
SCM
@ -114,13 +119,6 @@ scm_cell (scm_t_bits car, scm_t_bits cdr)
*freelist = SCM_FREE_CELL_CDR (*freelist);
}
/*
We update scm_cells_allocated from this function. If we don't
update this explicitly, we will have to walk a freelist somewhere
later on, which seems a lot more expensive.
*/
scm_cells_allocated += 1;
#if (SCM_DEBUG_CELL_ACCESSES == 1)
if (scm_debug_cell_accesses_p)
{
@ -147,7 +145,6 @@ scm_cell (scm_t_bits car, scm_t_bits cdr)
threading. What if another thread is doing GC at this point
... ?
*/
#endif
@ -167,7 +164,7 @@ scm_cell (scm_t_bits car, scm_t_bits cdr)
return z;
}
#if defined SCM_C_EXTERN_INLINE && ! defined SCM_INLINE_C_INCLUDING_INLINE_H
#ifndef SCM_INLINE_C_INCLUDING_INLINE_H
SCM_C_EXTERN_INLINE
#endif
SCM
@ -185,8 +182,6 @@ scm_double_cell (scm_t_bits car, scm_t_bits cbr,
*freelist = SCM_FREE_CELL_CDR (*freelist);
}
scm_cells_allocated += 2;
/* Initialize the type slot last so that the cell is ignored by the
GC until it is completely initialized. This is only relevant
when the GC can actually run during this code, which it can't
@ -236,7 +231,7 @@ scm_double_cell (scm_t_bits car, scm_t_bits cbr,
return z;
}
#if defined SCM_C_EXTERN_INLINE && ! defined SCM_INLINE_C_INCLUDING_INLINE_H
#ifndef SCM_INLINE_C_INCLUDING_INLINE_H
SCM_C_EXTERN_INLINE
#endif
SCM
@ -245,7 +240,7 @@ scm_array_handle_ref (scm_t_array_handle *h, ssize_t p)
return h->ref (h, p);
}
#if defined SCM_C_EXTERN_INLINE && ! defined SCM_INLINE_C_INCLUDING_INLINE_H
#ifndef SCM_INLINE_C_INCLUDING_INLINE_H
SCM_C_EXTERN_INLINE
#endif
void
@ -254,7 +249,7 @@ scm_array_handle_set (scm_t_array_handle *h, ssize_t p, SCM v)
h->set (h, p, v);
}
#if defined SCM_C_EXTERN_INLINE && ! defined SCM_INLINE_C_INCLUDING_INLINE_H
#ifndef SCM_INLINE_C_INCLUDING_INLINE_H
SCM_C_EXTERN_INLINE
#endif
int
@ -284,5 +279,77 @@ scm_is_pair (SCM x)
return SCM_I_CONSP (x);
}
/* Port I/O. */
#ifndef SCM_INLINE_C_INCLUDING_INLINE_H
SCM_C_EXTERN_INLINE
#endif
int
scm_getc (SCM port)
{
int c;
scm_t_port *pt = SCM_PTAB_ENTRY (port);
if (pt->rw_active == SCM_PORT_WRITE)
/* may be marginally faster than calling scm_flush. */
scm_ptobs[SCM_PTOBNUM (port)].flush (port);
if (pt->rw_random)
pt->rw_active = SCM_PORT_READ;
if (pt->read_pos >= pt->read_end)
{
if (scm_fill_input (port) == EOF)
return EOF;
}
c = *(pt->read_pos++);
switch (c)
{
case '\a':
break;
case '\b':
SCM_DECCOL (port);
break;
case '\n':
SCM_INCLINE (port);
break;
case '\r':
SCM_ZEROCOL (port);
break;
case '\t':
SCM_TABCOL (port);
break;
default:
SCM_INCCOL (port);
break;
}
return c;
}
#ifndef SCM_INLINE_C_INCLUDING_INLINE_H
SCM_C_EXTERN_INLINE
#endif
void
scm_putc (char c, SCM port)
{
SCM_ASSERT_TYPE (SCM_OPOUTPORTP (port), port, 0, NULL, "output port");
scm_lfwrite (&c, 1, port);
}
#ifndef SCM_INLINE_C_INCLUDING_INLINE_H
SCM_C_EXTERN_INLINE
#endif
void
scm_puts (const char *s, SCM port)
{
SCM_ASSERT_TYPE (SCM_OPOUTPORTP (port), port, 0, NULL, "output port");
scm_lfwrite (s, strlen (s), port);
}
#endif
#endif

4
libguile/ioext.h
View file

@ -3,7 +3,7 @@
#ifndef SCM_IOEXT_H
#define SCM_IOEXT_H
/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2006 Free Software Foundation, Inc.
/* Copyright (C) 1995,1996,1997,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
@ -35,7 +35,7 @@ SCM_API SCM scm_isatty_p (SCM port);
SCM_API SCM scm_fdopen (SCM fdes, SCM modes);
SCM_API SCM scm_primitive_move_to_fdes (SCM port, SCM fd);
SCM_API SCM scm_fdes_to_ports (SCM fd);
SCM_API void scm_init_ioext (void);
SCM_INTERNAL void scm_init_ioext (void);
#endif /* SCM_IOEXT_H */

4
libguile/keywords.h
View file

@ -3,7 +3,7 @@
#ifndef SCM_KEYWORDS_H
#define SCM_KEYWORDS_H
/* Copyright (C) 1995,1996,1999,2000,2001, 2006 Free Software Foundation, Inc.
/* Copyright (C) 1995,1996,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
@ -38,7 +38,7 @@ SCM_API int scm_is_keyword (SCM val);
SCM_API SCM scm_from_locale_keyword (const char *str);
SCM_API SCM scm_from_locale_keywordn (const char *str, size_t len);
SCM_API void scm_init_keywords (void);
SCM_INTERNAL void scm_init_keywords (void);
#endif /* SCM_KEYWORDS_H */

4
libguile/lang.h
View file

@ -3,7 +3,7 @@
#ifndef SCM_LANG_H
#define SCM_LANG_H
/* Copyright (C) 1998, 2004, 2006 Free Software Foundation, Inc.
/* Copyright (C) 1998, 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
@ -30,7 +30,7 @@
#define SCM_NILP(x) (scm_is_eq ((x), SCM_ELISP_NIL))
SCM_API void scm_init_lang (void);
SCM_INTERNAL void scm_init_lang (void);
#else /* ! SCM_ENABLE_ELISP */

6
libguile/list.h
View file

@ -3,7 +3,7 @@
#ifndef SCM_LIST_H
#define SCM_LIST_H
/* Copyright (C) 1995,1996,1997,2000,2001,2003,2004,2005,2006
/* Copyright (C) 1995,1996,1997,2000,2001,2003,2004,2005,2006,2008
* Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
@ -71,8 +71,8 @@ SCM_API SCM scm_filter_x (SCM pred, SCM list);
/* Guile internal functions */
SCM_API SCM scm_i_finite_list_copy (SCM /* a list known to be finite */);
SCM_API void scm_init_list (void);
SCM_INTERNAL SCM scm_i_finite_list_copy (SCM /* a list known to be finite */);
SCM_INTERNAL void scm_init_list (void);
#endif /* SCM_LIST_H */

6
libguile/load.h
View file

@ -3,7 +3,7 @@
#ifndef SCM_LOAD_H
#define SCM_LOAD_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
@ -26,7 +26,6 @@
SCM_API SCM scm_parse_path (SCM path, SCM tail);
SCM_API void scm_init_load_path (void);
SCM_API SCM scm_primitive_load (SCM filename);
SCM_API SCM scm_c_primitive_load (const char *filename);
SCM_API SCM scm_sys_package_data_dir (void);
@ -36,7 +35,8 @@ SCM_API SCM scm_search_path (SCM path, SCM filename, SCM exts);
SCM_API SCM scm_sys_search_load_path (SCM filename);
SCM_API SCM scm_primitive_load_path (SCM filename);
SCM_API SCM scm_c_primitive_load_path (const char *filename);
SCM_API void scm_init_load (void);
SCM_INTERNAL void scm_init_load_path (void);
SCM_INTERNAL void scm_init_load (void);
#endif /* SCM_LOAD_H */

6
libguile/macros.h
View file

@ -3,7 +3,7 @@
#ifndef SCM_MACROS_H
#define SCM_MACROS_H
/* Copyright (C) 1998,2000,2001,2002,2003, 2006 Free Software Foundation, Inc.
/* Copyright (C) 1998,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
@ -36,7 +36,7 @@
SCM_API scm_t_bits scm_tc16_macro;
SCM_API SCM scm_i_makbimacro (SCM code);
SCM_INTERNAL SCM scm_i_makbimacro (SCM code);
SCM_API SCM scm_makmmacro (SCM code);
SCM_API SCM scm_makacro (SCM code);
SCM_API SCM scm_macro_p (SCM obj);
@ -46,7 +46,7 @@ SCM_API SCM scm_macro_transformer (SCM m);
SCM_API SCM scm_make_synt (const char *name,
SCM (*macroizer) (SCM),
SCM (*fcn) ());
SCM_API void scm_init_macros (void);
SCM_INTERNAL void scm_init_macros (void);
#if SCM_ENABLE_DEPRECATED == 1
SCM_API SCM scm_makmacro (SCM code);

4
libguile/mallocs.h
View file

@ -3,7 +3,7 @@
#ifndef SCM_MALLOCS_H
#define SCM_MALLOCS_H
/* Copyright (C) 1995,2000, 2006 Free Software Foundation, Inc.
/* Copyright (C) 1995,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 scm_t_bits scm_tc16_malloc;
SCM_API SCM scm_malloc_obj (size_t n);
SCM_API void scm_init_mallocs (void);
SCM_INTERNAL void scm_init_mallocs (void);
#endif /* SCM_MALLOCS_H */

6
libguile/modules.h
View file

@ -3,7 +3,7 @@
#ifndef SCM_MODULES_H
#define SCM_MODULES_H
/* Copyright (C) 1998, 2000, 2001, 2002, 2003, 2006, 2007 Free Software Foundation, Inc.
/* Copyright (C) 1998, 2000, 2001, 2002, 2003, 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
@ -116,8 +116,8 @@ SCM_API SCM scm_env_module (SCM env);
SCM_API SCM scm_top_level_env (SCM thunk);
SCM_API SCM scm_system_module_env_p (SCM env);
SCM_API void scm_modules_prehistory (void);
SCM_API void scm_init_modules (void);
SCM_INTERNAL void scm_modules_prehistory (void);
SCM_INTERNAL void scm_init_modules (void);
#endif /* SCM_MODULES_H */

4
libguile/net_db.h
View file

@ -3,7 +3,7 @@
#ifndef SCM_NET_DB_H
#define SCM_NET_DB_H
/* Copyright (C) 1995,2000,2001, 2006 Free Software Foundation, Inc.
/* Copyright (C) 1995,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
@ -34,7 +34,7 @@ SCM_API SCM scm_sethost (SCM arg);
SCM_API SCM scm_setnet (SCM arg);
SCM_API SCM scm_setproto (SCM arg);
SCM_API SCM scm_setserv (SCM arg);
SCM_API void scm_init_net_db (void);
SCM_INTERNAL void scm_init_net_db (void);
#endif /* SCM_NET_DB_H */

27
libguile/numbers.c
View file

@ -40,9 +40,6 @@
*/
/* tell glibc (2.3) to give prototype for C99 trunc(), csqrt(), etc */
#define _GNU_SOURCE
#if HAVE_CONFIG_H
# include <config.h>
#endif
@ -170,8 +167,10 @@ xisnan (double x)
#define SCM_COMPLEX_VALUE(z) \
(SCM_COMPLEX_REAL (z) + GUILE_I * SCM_COMPLEX_IMAG (z))
static inline SCM scm_from_complex_double (complex double z) SCM_UNUSED;
/* Convert a C "complex double" to an SCM value. */
static SCM
static inline SCM
scm_from_complex_double (complex double z)
{
return scm_c_make_rectangular (creal (z), cimag (z));
@ -5597,8 +5596,18 @@ SCM_DEFINE (scm_inexact_to_exact, "inexact->exact", 1, 0, 0,
#undef FUNC_NAME
SCM_DEFINE (scm_rationalize, "rationalize", 2, 0, 0,
(SCM x, SCM err),
"Return an exact number that is within @var{err} of @var{x}.")
(SCM x, SCM eps),
"Returns the @emph{simplest} rational number differing\n"
"from @var{x} by no more than @var{eps}.\n"
"\n"
"As required by @acronym{R5RS}, @code{rationalize} only returns an\n"
"exact result when both its arguments are exact. Thus, you might need\n"
"to use @code{inexact->exact} on the arguments.\n"
"\n"
"@lisp\n"
"(rationalize (inexact->exact 1.2) 1/100)\n"
"@result{} 6/5\n"
"@end lisp")
#define FUNC_NAME s_scm_rationalize
{
if (SCM_I_INUMP (x))
@ -5630,7 +5639,7 @@ SCM_DEFINE (scm_rationalize, "rationalize", 2, 0, 0,
converges after less than a dozen iterations.
*/
err = scm_abs (err);
eps = scm_abs (eps);
while (++i < 1000000)
{
a = scm_sum (scm_product (a1, tt), a2); /* a = a1*tt + a2 */
@ -5638,11 +5647,11 @@ SCM_DEFINE (scm_rationalize, "rationalize", 2, 0, 0,
if (scm_is_false (scm_zero_p (b)) && /* b != 0 */
scm_is_false
(scm_gr_p (scm_abs (scm_difference (ex, scm_divide (a, b))),
err))) /* abs(x-a/b) <= err */
eps))) /* abs(x-a/b) <= eps */
{
SCM res = scm_sum (int_part, scm_divide (a, b));
if (scm_is_false (scm_exact_p (x))
|| scm_is_false (scm_exact_p (err)))
|| scm_is_false (scm_exact_p (eps)))
return scm_exact_to_inexact (res);
else
return res;

32
libguile/numbers.h
View file

@ -3,7 +3,7 @@
#ifndef SCM_NUMBERS_H
#define SCM_NUMBERS_H
/* Copyright (C) 1995,1996,1998,2000,2001,2002,2003,2004,2005, 2006 Free Software Foundation, Inc.
/* Copyright (C) 1995,1996,1998,2000,2001,2002,2003,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
@ -261,15 +261,15 @@ SCM_API SCM scm_exp (SCM z);
SCM_API SCM scm_sqrt (SCM z);
/* bignum internal functions */
SCM_API SCM scm_i_mkbig (void);
SCM_API SCM scm_i_normbig (SCM x);
SCM_API int scm_i_bigcmp (SCM a, SCM b);
SCM_API SCM scm_i_dbl2big (double d);
SCM_API SCM scm_i_dbl2num (double d);
SCM_API double scm_i_big2dbl (SCM b);
SCM_API SCM scm_i_long2big (long n);
SCM_API SCM scm_i_ulong2big (unsigned long n);
SCM_API SCM scm_i_clonebig (SCM src_big, int same_sign_p);
SCM_INTERNAL SCM scm_i_mkbig (void);
SCM_API /* FIXME: not internal */ SCM scm_i_normbig (SCM x);
SCM_INTERNAL int scm_i_bigcmp (SCM a, SCM b);
SCM_INTERNAL SCM scm_i_dbl2big (double d);
SCM_INTERNAL SCM scm_i_dbl2num (double d);
SCM_API /* FIXME: not internal */ double scm_i_big2dbl (SCM b);
SCM_API /* FIXME: not internal */ SCM scm_i_long2big (long n);
SCM_API /* FIXME: not internal */ SCM scm_i_ulong2big (unsigned long n);
SCM_API /* FIXME: not internal */ SCM scm_i_clonebig (SCM src_big, int same_sign_p);
/* ratio functions */
SCM_API SCM scm_rationalize (SCM x, SCM err);
@ -277,13 +277,13 @@ SCM_API SCM scm_numerator (SCM z);
SCM_API SCM scm_denominator (SCM z);
/* fraction internal functions */
SCM_API double scm_i_fraction2double (SCM z);
SCM_API SCM scm_i_fraction_equalp (SCM x, SCM y);
SCM_API int scm_i_print_fraction (SCM sexp, SCM port, scm_print_state *pstate);
SCM_INTERNAL double scm_i_fraction2double (SCM z);
SCM_INTERNAL SCM scm_i_fraction_equalp (SCM x, SCM y);
SCM_INTERNAL int scm_i_print_fraction (SCM sexp, SCM port, scm_print_state *pstate);
/* general internal functions */
SCM_API void scm_i_print_double (double val, SCM port);
SCM_API void scm_i_print_complex (double real, double imag, SCM port);
SCM_INTERNAL void scm_i_print_double (double val, SCM port);
SCM_INTERNAL void scm_i_print_complex (double real, double imag, SCM port);
/* conversion functions for integers */
@ -480,7 +480,7 @@ SCM_API double scm_c_angle (SCM z);
SCM_API int scm_is_number (SCM val);
SCM_API void scm_init_numbers (void);
SCM_INTERNAL void scm_init_numbers (void);
#endif /* SCM_NUMBERS_H */

10
libguile/objects.h
View file

@ -3,7 +3,7 @@
#ifndef SCM_OBJECTS_H
#define SCM_OBJECTS_H
/* Copyright (C) 1996,1999,2000,2001, 2003, 2006 Free Software Foundation, Inc.
/* Copyright (C) 1996,1999,2000,2001, 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
@ -181,7 +181,7 @@ SCM_API SCM scm_metaclass_operator;
/* Goops functions. */
SCM_API SCM scm_make_extended_class (char const *type_name, int applicablep);
SCM_API void scm_i_inherit_applicable (SCM c);
SCM_INTERNAL void scm_i_inherit_applicable (SCM c);
SCM_API void scm_make_port_classes (long ptobnum, char *type_name);
SCM_API void scm_change_object_class (SCM, SCM, SCM);
SCM_API SCM scm_memoize_method (SCM x, SCM args);
@ -205,9 +205,9 @@ SCM_API SCM scm_object_procedure (SCM obj);
SCM_API SCM scm_make_class_object (SCM metaclass, SCM layout);
SCM_API SCM scm_make_subclass_object (SCM c, SCM layout);
SCM_API SCM scm_i_make_class_object (SCM metaclass, SCM layout_string,
unsigned long flags);
SCM_API void scm_init_objects (void);
SCM_INTERNAL SCM scm_i_make_class_object (SCM metaclass, SCM layout_string,
unsigned long flags);
SCM_INTERNAL void scm_init_objects (void);
#endif /* SCM_OBJECTS_H */

4
libguile/objprop.h
View file

@ -3,7 +3,7 @@
#ifndef SCM_OBJPROP_H
#define SCM_OBJPROP_H
/* Copyright (C) 1995,2000,2001, 2006 Free Software Foundation, Inc.
/* Copyright (C) 1995,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
@ -30,7 +30,7 @@ SCM_API SCM scm_object_properties (SCM obj);
SCM_API SCM scm_set_object_properties_x (SCM obj, SCM plist);
SCM_API SCM scm_object_property (SCM obj, SCM key);
SCM_API SCM scm_set_object_property_x (SCM obj, SCM key, SCM val);
SCM_API void scm_init_objprop (void);
SCM_INTERNAL void scm_init_objprop (void);
#endif /* SCM_OBJPROP_H */

4
libguile/options.h
View file

@ -3,7 +3,7 @@
#ifndef SCM_OPTIONS_H
#define SCM_OPTIONS_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
@ -43,7 +43,7 @@ typedef struct scm_t_option
SCM_API SCM scm_options_try (SCM args, scm_t_option options[], const char *s, int dry_run);
SCM_API SCM scm_options (SCM, scm_t_option [], const char*);
SCM_API void scm_init_opts (SCM (*) (SCM), scm_t_option []);
SCM_API void scm_init_options (void);
SCM_INTERNAL void scm_init_options (void);
#endif /* SCM_OPTIONS_H */

2
libguile/pairs.h
View file

@ -148,7 +148,7 @@ SCM_API SCM scm_i_chase_pairs (SCM x, scm_t_uint32 pattern);
#define scm_caaadr(x) scm_i_chase_pairs ((x), SCM_I_AAAD_PAT)
#define scm_caaaar(x) scm_i_chase_pairs ((x), SCM_I_AAAA_PAT)
SCM_API void scm_init_pairs (void);
SCM_INTERNAL void scm_init_pairs (void);
#endif /* SCM_PAIRS_H */

60
libguile/ports.c
View file

@ -1,4 +1,4 @@
/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2003, 2004, 2006, 2007 Free Software Foundation, Inc.
/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2003, 2004, 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
@ -960,64 +960,6 @@ scm_fill_input (SCM port)
return scm_ptobs[SCM_PTOBNUM (port)].fill_input (port);
}
int
scm_getc (SCM port)
{
int c;
scm_t_port *pt = SCM_PTAB_ENTRY (port);
if (pt->rw_active == SCM_PORT_WRITE)
/* may be marginally faster than calling scm_flush. */
scm_ptobs[SCM_PTOBNUM (port)].flush (port);
if (pt->rw_random)
pt->rw_active = SCM_PORT_READ;
if (pt->read_pos >= pt->read_end)
{
if (scm_fill_input (port) == EOF)
return EOF;
}
c = *(pt->read_pos++);
switch (c)
{
case '\a':
break;
case '\b':
SCM_DECCOL (port);
break;
case '\n':
SCM_INCLINE (port);
break;
case '\r':
SCM_ZEROCOL (port);
break;
case '\t':
SCM_TABCOL (port);
break;
default:
SCM_INCCOL (port);
break;
}
return c;
}
void
scm_putc (char c, SCM port)
{
SCM_ASSERT_TYPE (SCM_OPOUTPORTP (port), port, 0, NULL, "output port");
scm_lfwrite (&c, 1, port);
}
void
scm_puts (const char *s, SCM port)
{
SCM_ASSERT_TYPE (SCM_OPOUTPORTP (port), port, 0, NULL, "output port");
scm_lfwrite (s, strlen (s), port);
}
/* scm_lfwrite
*

19
libguile/ports.h
View file

@ -3,7 +3,7 @@
#ifndef SCM_PORTS_H
#define SCM_PORTS_H
/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2003, 2004, 2006 Free Software Foundation, Inc.
/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 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
@ -109,8 +109,8 @@ typedef struct
} scm_t_port;
SCM_API scm_i_pthread_mutex_t scm_i_port_table_mutex;
SCM_API SCM scm_i_port_weak_hash;
SCM_INTERNAL scm_i_pthread_mutex_t scm_i_port_table_mutex;
SCM_INTERNAL SCM scm_i_port_weak_hash;
#define SCM_READ_BUFFER_EMPTY_P(c_port) (c_port->read_pos >= c_port->read_end)
@ -195,7 +195,7 @@ typedef struct scm_t_ptob_descriptor
SCM_API scm_t_ptob_descriptor *scm_ptobs;
SCM_API long scm_numptob;
SCM_API long scm_i_port_table_room;
SCM_INTERNAL long scm_i_port_table_room;
@ -241,7 +241,7 @@ SCM_API void scm_dynwind_current_input_port (SCM port);
SCM_API void scm_dynwind_current_output_port (SCM port);
SCM_API void scm_dynwind_current_error_port (SCM port);
SCM_API SCM scm_new_port_table_entry (scm_t_bits tag);
SCM_API void scm_i_remove_port (SCM port);
SCM_INTERNAL void scm_i_remove_port (SCM port);
SCM_API void scm_grow_port_cbuf (SCM port, size_t requested);
SCM_API SCM scm_pt_size (void);
SCM_API SCM scm_pt_member (SCM member);
@ -264,15 +264,12 @@ SCM_API SCM scm_eof_object_p (SCM x);
SCM_API SCM scm_force_output (SCM port);
SCM_API SCM scm_flush_all_ports (void);
SCM_API SCM scm_read_char (SCM port);
SCM_API void scm_putc (char c, SCM port);
SCM_API void scm_puts (const char *str_data, SCM port);
SCM_API size_t scm_c_read (SCM port, void *buffer, size_t size);
SCM_API void scm_c_write (SCM port, const void *buffer, size_t size);
SCM_API void scm_lfwrite (const char *ptr, size_t size, SCM port);
SCM_API void scm_flush (SCM port);
SCM_API void scm_end_input (SCM port);
SCM_API int scm_fill_input (SCM port);
SCM_API int scm_getc (SCM port);
SCM_API void scm_ungetc (int c, SCM port);
SCM_API void scm_ungets (const char *s, int n, SCM port);
SCM_API SCM scm_peek_char (SCM port);
@ -291,7 +288,7 @@ SCM_API void scm_print_port_mode (SCM exp, SCM port);
SCM_API void scm_ports_prehistory (void);
SCM_API SCM scm_void_port (char * mode_str);
SCM_API SCM scm_sys_make_void_port (SCM mode);
SCM_API void scm_init_ports (void);
SCM_INTERNAL void scm_init_ports (void);
#if SCM_ENABLE_DEPRECATED==1
@ -305,8 +302,8 @@ SCM_API SCM scm_pt_member (SCM member);
/* internal */
SCM_API long scm_i_mode_bits (SCM modes);
SCM_API void scm_i_dynwind_current_load_port (SCM port);
SCM_INTERNAL long scm_i_mode_bits (SCM modes);
SCM_INTERNAL void scm_i_dynwind_current_load_port (SCM port);
#endif /* SCM_PORTS_H */

2
libguile/posix.c
View file

@ -1,4 +1,4 @@
/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2004, 2005, 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

4
libguile/posix.h
View file

@ -3,7 +3,7 @@
#ifndef SCM_POSIX_H
#define SCM_POSIX_H
/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2003, 2006 Free Software Foundation, Inc.
/* Copyright (C) 1995,1996,1997,1998,2000,2001, 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
@ -84,7 +84,7 @@ SCM_API SCM scm_getpass (SCM prompt);
SCM_API SCM scm_flock (SCM file, SCM operation);
SCM_API SCM scm_sethostname (SCM name);
SCM_API SCM scm_gethostname (void);
SCM_API void scm_init_posix (void);
SCM_INTERNAL void scm_init_posix (void);
SCM_API scm_i_pthread_mutex_t scm_i_locale_mutex;

6
libguile/print.h
View file

@ -3,7 +3,7 @@
#ifndef SCM_PRINT_H
#define SCM_PRINT_H
/* Copyright (C) 1995,1996,1998,2000,2001, 2003, 2004, 2006 Free Software Foundation, Inc.
/* Copyright (C) 1995,1996,1998,2000,2001, 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
@ -75,7 +75,7 @@ SCM_API scm_t_bits scm_tc16_port_with_ps;
SCM_API SCM scm_print_options (SCM setting);
SCM_API SCM scm_make_print_state (void);
SCM_API void scm_free_print_state (SCM print_state);
SCM scm_i_port_with_print_state (SCM port, SCM print_state);
SCM_INTERNAL SCM scm_i_port_with_print_state (SCM port, SCM print_state);
SCM_API void scm_intprint (scm_t_intmax n, int radix, SCM port);
SCM_API void scm_uintprint (scm_t_uintmax n, int radix, SCM port);
SCM_API void scm_ipruk (char *hdr, SCM ptr, SCM port);
@ -92,7 +92,7 @@ SCM_API SCM scm_printer_apply (SCM proc, SCM exp, SCM port, scm_print_state *);
SCM_API SCM scm_port_with_print_state (SCM port, SCM pstate);
SCM_API SCM scm_get_print_state (SCM port);
SCM_API int scm_valid_oport_value_p (SCM val);
SCM_API void scm_init_print (void);
SCM_INTERNAL void scm_init_print (void);
#ifdef GUILE_DEBUG
SCM_API SCM scm_current_pstate (void);

175
libguile/private-gc.h
View file

@ -1,7 +1,7 @@
/*
* private-gc.h - private declarations for garbage collection.
*
* Copyright (C) 2002, 03, 04, 05, 06, 07 Free Software Foundation, Inc.
* Copyright (C) 2002, 03, 04, 05, 06, 07, 08 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,18 +32,6 @@
* 64 bit machine. The units of the _SIZE parameters are bytes.
* Cons pairs and object headers occupy one heap cell.
*
* SCM_INIT_HEAP_SIZE is the initial size of heap. If this much heap is
* allocated initially the heap will grow by half its current size
* each subsequent time more heap is needed.
*
* If SCM_INIT_HEAP_SIZE heap cannot be allocated initially, SCM_HEAP_SEG_SIZE
* will be used, and the heap will grow by SCM_HEAP_SEG_SIZE when more
* heap is needed. SCM_HEAP_SEG_SIZE must fit into type size_t. This code
* is in scm_init_storage() and alloc_some_heap() in sys.c
*
* If SCM_INIT_HEAP_SIZE can be allocated initially, the heap will grow by
* SCM_EXPHEAP(scm_heap_size) when more heap is needed.
*
* SCM_MIN_HEAP_SEG_SIZE is minimum size of heap to accept when more heap
* is needed.
*/
@ -66,6 +54,12 @@
#define SCM_DEFAULT_MIN_YIELD_1 40
#define SCM_DEFAULT_INIT_HEAP_SIZE_2 32*1024
/*
How many cells to collect during one sweep call. This is the pool
size of each thread.
*/
#define DEFAULT_SWEEP_AMOUNT 512
/* The following value may seem large, but note that if we get to GC at
* all, this means that we have a numerically intensive application
*/
@ -73,12 +67,9 @@
#define SCM_DEFAULT_MAX_SEGMENT_SIZE (20*1024*1024L)
#define SCM_MIN_HEAP_SEG_SIZE (8 * SCM_GC_SIZEOF_CARD)
#define SCM_HEAP_SEG_SIZE (16384L * sizeof (scm_t_cell))
#define SCM_DOUBLECELL_ALIGNED_P(x) (((2 * sizeof (scm_t_cell) - 1) & SCM_UNPACK (x)) == 0)
@ -87,49 +78,44 @@
#define SCM_GC_IN_CARD_HEADERP(x) \
(scm_t_cell *) (x) < SCM_GC_CELL_CARD (x) + SCM_GC_CARD_N_HEADER_CELLS
int scm_i_uint_bit_count (unsigned int u);
int scm_getenv_int (const char *var, int def);
typedef enum { return_on_error, abort_on_error } policy_on_error;
/* gc-freelist*/
/* gc-freelist */
/*
FREELIST:
A struct holding GC statistics on a particular type of cells.
Counts in cells are mainly for heap statistics, and for
double-cells, they are still measured in single-cell units.
*/
typedef struct scm_t_cell_type_statistics {
/*
heap segment where the last cell was allocated
*/
int heap_segment_idx;
/* minimum yield on this list in order not to grow the heap
/* defines min_yield as fraction of total heap size
*/
long min_yield;
/* defines min_yield as percent of total heap size
*/
int min_yield_fraction;
float min_yield_fraction;
/* number of cells per object on this list */
int span;
/* number of collected cells during last GC */
/* number of collected cells during last GC. */
unsigned long collected;
/* number of collected cells during penultimate GC */
unsigned long collected_1;
/* total number of cells in heap segments
* belonging to this list.
*/
unsigned long heap_size;
unsigned long swept;
/*
Total number of cells in heap segments belonging to this list.
*/
unsigned long heap_total_cells;
} scm_t_cell_type_statistics;
@ -140,38 +126,24 @@ typedef struct scm_sweep_statistics
unsigned swept;
/* Number of cells collected during the sweep operation. This number must
alsways be lower than or equal to SWEPT. */
always be lower than or equal to SWEPT. */
unsigned collected;
} scm_t_sweep_statistics;
#define scm_i_sweep_statistics_init(_stats) \
do \
{ \
(_stats)->swept = (_stats)->collected = 0; \
} \
while (0)
#define scm_i_sweep_statistics_sum(_sum, _addition) \
do \
{ \
(_sum)->swept += (_addition).swept; \
(_sum)->collected += (_addition).collected; \
} \
while (0)
SCM_INTERNAL scm_t_sweep_statistics scm_i_gc_sweep_stats;
extern scm_t_cell_type_statistics scm_i_master_freelist;
extern scm_t_cell_type_statistics scm_i_master_freelist2;
SCM_INTERNAL
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);
SCM_INTERNAL
void scm_i_gc_sweep_freelist_reset (scm_t_cell_type_statistics *freelist);
int scm_i_gc_grow_heap_p (scm_t_cell_type_statistics * freelist);
#define SCM_HEAP_SIZE \
(scm_i_master_freelist.heap_size + scm_i_master_freelist2.heap_size)
SCM_INTERNAL float
scm_i_gc_heap_size_delta (scm_t_cell_type_statistics * freelist);
#define SCM_MAX(A, B) ((A) > (B) ? (A) : (B))
@ -193,24 +165,21 @@ int scm_i_gc_grow_heap_p (scm_t_cell_type_statistics * freelist);
gc-mark
*/
/* this can be used to ensure that set/clear gc marks only happen when
allowed. */
int scm_i_marking;
void scm_mark_all (void);
/*
gc-segment:
*/
/*
Cells are stored in a heap-segment: it is a contiguous chunk of
memory, that associated with one freelist.
*/
typedef struct scm_t_heap_segment
{
/*
@ -229,10 +198,9 @@ typedef struct scm_t_heap_segment
(not that we do that, but anyway.)
*/
void *malloced;
void* malloced;
scm_t_cell * next_free_card;
scm_t_cell *next_free_card;
/* address of the head-of-freelist pointer for this segment's cells.
All segments usually point to the same one, scm_i_freelist. */
@ -241,64 +209,73 @@ typedef struct scm_t_heap_segment
/* number of cells per object in this segment */
int span;
/*
Is this the first time that the cells are accessed?
*/
int first_time;
} scm_t_heap_segment;
/*
A table of segment records is kept that records the upper and
lower extents of the segment; this is used during the conservative
phase of gc to identify probably gc roots (because they point
into valid segments at reasonable offsets).
*/
extern scm_t_heap_segment ** scm_i_heap_segment_table;
extern size_t scm_i_heap_segment_table_size;
int scm_i_init_card_freelist (scm_t_cell * card, SCM *free_list,scm_t_heap_segment*);
int scm_i_sweep_card (scm_t_cell * card, SCM *free_list, scm_t_heap_segment*);
void scm_i_card_statistics (scm_t_cell *p, SCM hashtab, scm_t_heap_segment *seg);
char const *scm_i_tag_name (scm_t_bits tag); /* MOVEME */
SCM_INTERNAL int scm_i_init_card_freelist (scm_t_cell * card, SCM *free_list,
scm_t_heap_segment*);
SCM_INTERNAL int scm_i_sweep_card (scm_t_cell *card, SCM *free_list,
scm_t_heap_segment *);
SCM_INTERNAL int scm_i_card_marked_count (scm_t_cell *card, int span);
SCM_INTERNAL void scm_i_card_statistics (scm_t_cell *p, SCM hashtab,
scm_t_heap_segment *seg);
SCM_INTERNAL char const *scm_i_tag_name (scm_t_bits tag); /* MOVEME */
int scm_i_initialize_heap_segment_data (scm_t_heap_segment * segment, size_t requested);
int scm_i_segment_card_count (scm_t_heap_segment * seg);
int scm_i_segment_cell_count (scm_t_heap_segment * seg);
SCM_INTERNAL int scm_i_initialize_heap_segment_data (scm_t_heap_segment *seg,
size_t requested);
void scm_i_clear_segment_mark_space (scm_t_heap_segment *seg);
scm_t_heap_segment * scm_i_make_empty_heap_segment (scm_t_cell_type_statistics*);
SCM scm_i_sweep_some_cards (scm_t_heap_segment *seg,
scm_t_sweep_statistics *sweep_stats);
void scm_i_sweep_segment (scm_t_heap_segment *seg,
scm_t_sweep_statistics *sweep_stats);
SCM_INTERNAL int scm_i_segment_cells_per_card (scm_t_heap_segment *seg);
SCM_INTERNAL int scm_i_segment_card_number (scm_t_heap_segment *seg,
scm_t_cell *card);
SCM_INTERNAL int scm_i_segment_card_count (scm_t_heap_segment *seg);
SCM_INTERNAL int scm_i_segment_cell_count (scm_t_heap_segment *seg);
SCM_INTERNAL int scm_i_heap_segment_marked_count (scm_t_heap_segment *seg);
SCM_INTERNAL void scm_i_clear_segment_mark_space (scm_t_heap_segment *seg);
SCM_INTERNAL scm_t_heap_segment *
scm_i_make_empty_heap_segment (scm_t_cell_type_statistics*);
SCM_INTERNAL SCM scm_i_sweep_for_freelist (scm_t_cell_type_statistics *seg);
SCM_INTERNAL SCM scm_i_sweep_some_cards (scm_t_heap_segment *seg,
scm_t_sweep_statistics *sweep_stats,
int threshold);
SCM_INTERNAL void scm_i_sweep_segment (scm_t_heap_segment *seg,
scm_t_sweep_statistics *sweep_stats);
void scm_i_heap_segment_statistics (scm_t_heap_segment *seg, SCM tab);
SCM_INTERNAL void scm_i_heap_segment_statistics (scm_t_heap_segment *seg,
SCM tab);
int scm_i_insert_segment (scm_t_heap_segment * seg);
long int scm_i_find_heap_segment_containing_object (SCM obj);
int scm_i_get_new_heap_segment (scm_t_cell_type_statistics *,
scm_t_sweep_statistics,
policy_on_error);
void scm_i_clear_mark_space (void);
void scm_i_sweep_segments (void);
SCM scm_i_sweep_some_segments (scm_t_cell_type_statistics *fl,
scm_t_sweep_statistics *sweep_stats);
void scm_i_reset_segments (void);
void scm_i_sweep_all_segments (char const *reason,
scm_t_sweep_statistics *sweep_stats);
SCM scm_i_all_segments_statistics (SCM hashtab);
void scm_i_make_initial_segment (int init_heap_size, scm_t_cell_type_statistics *freelist);
SCM_INTERNAL int scm_i_insert_segment (scm_t_heap_segment *seg);
SCM_INTERNAL int scm_i_find_heap_segment_containing_object (SCM obj);
SCM_INTERNAL int scm_i_get_new_heap_segment (scm_t_cell_type_statistics *freelist,
size_t length,
policy_on_error);
SCM_INTERNAL int scm_i_marked_count (void);
SCM_INTERNAL void scm_i_clear_mark_space (void);
SCM_INTERNAL void scm_i_sweep_segments (void);
SCM_INTERNAL SCM scm_i_sweep_some_segments (scm_t_cell_type_statistics *fl,
scm_t_sweep_statistics *sweep_stats);
SCM_INTERNAL void scm_i_reset_segments (void);
SCM_INTERNAL void scm_i_sweep_all_segments (char const *reason,
scm_t_sweep_statistics *sweep_stats);
SCM_INTERNAL SCM scm_i_all_segments_statistics (SCM hashtab);
SCM_INTERNAL unsigned long *scm_i_segment_table_info(int *size);
extern long int scm_i_deprecated_memory_return;
extern long int scm_i_find_heap_calls;
/*
global init funcs.

6
libguile/procprop.h
View file

@ -3,7 +3,7 @@
#ifndef SCM_PROCPROP_H
#define SCM_PROCPROP_H
/* Copyright (C) 1995,1996,1998,2000, 2006 Free Software Foundation, Inc.
/* Copyright (C) 1995,1996,1998,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
@ -32,12 +32,12 @@ SCM_API SCM scm_sym_system_procedure;
SCM_API SCM scm_i_procedure_arity (SCM proc);
SCM_INTERNAL SCM scm_i_procedure_arity (SCM proc);
SCM_API SCM scm_procedure_properties (SCM proc);
SCM_API SCM scm_set_procedure_properties_x (SCM proc, SCM new_val);
SCM_API SCM scm_procedure_property (SCM p, SCM k);
SCM_API SCM scm_set_procedure_property_x (SCM p, SCM k, SCM v);
SCM_API void scm_init_procprop (void);
SCM_INTERNAL void scm_init_procprop (void);
#endif /* SCM_PROCPROP_H */

6
libguile/procs.h
View file

@ -3,7 +3,7 @@
#ifndef SCM_PROCS_H
#define SCM_PROCS_H
/* Copyright (C) 1995,1996,1998,1999,2000,2001, 2006 Free Software Foundation, Inc.
/* Copyright (C) 1995,1996,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
@ -154,8 +154,8 @@ SCM_API SCM scm_procedure_with_setter_p (SCM obj);
SCM_API SCM scm_make_procedure_with_setter (SCM procedure, SCM setter);
SCM_API SCM scm_procedure (SCM proc);
SCM_API SCM scm_setter (SCM proc);
SCM_API void scm_init_subr_table (void);
SCM_API void scm_init_procs (void);
SCM_INTERNAL void scm_init_subr_table (void);
SCM_INTERNAL void scm_init_procs (void);
#ifdef GUILE_DEBUG
SCM_API SCM scm_make_cclo (SCM proc, SCM len);

4
libguile/properties.h
View file

@ -3,7 +3,7 @@
#ifndef SCM_PROPERTIES_H
#define SCM_PROPERTIES_H
/* Copyright (C) 1995,1996,1998,2000, 2006 Free Software Foundation, Inc.
/* Copyright (C) 1995,1996,1998,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_primitive_property_ref (SCM prop, SCM obj);
SCM_API SCM scm_primitive_property_set_x (SCM prop, SCM obj, SCM val);
SCM_API SCM scm_primitive_property_del_x (SCM prop, SCM obj);
SCM_API void scm_init_properties (void);
SCM_INTERNAL void scm_init_properties (void);
#endif /* SCM_PROPERTIES_H */

4
libguile/ramap.h
View file

@ -3,7 +3,7 @@
#ifndef SCM_RAMAP_H
#define SCM_RAMAP_H
/* Copyright (C) 1995,1996,1997,2000, 2006 Free Software Foundation, Inc.
/* Copyright (C) 1995,1996,1997,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
@ -47,7 +47,7 @@ SCM_API SCM scm_array_for_each (SCM proc, SCM ra0, SCM lra);
SCM_API SCM scm_array_index_map_x (SCM ra, SCM proc);
SCM_API SCM scm_raequal (SCM ra0, SCM ra1);
SCM_API SCM scm_array_equal_p (SCM ra0, SCM ra1);
SCM_API void scm_init_ramap (void);
SCM_INTERNAL void scm_init_ramap (void);
#endif /* SCM_RAMAP_H */

10
libguile/random.h
View file

@ -3,7 +3,7 @@
#ifndef SCM_RANDOM_H
#define SCM_RANDOM_H
/* Copyright (C) 1999,2000,2001, 2006 Free Software Foundation, Inc.
/* Copyright (C) 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
@ -62,9 +62,9 @@ typedef struct scm_t_i_rstate {
unsigned long c;
} scm_t_i_rstate;
SCM_API unsigned long scm_i_uniform32 (scm_t_i_rstate *);
SCM_API void scm_i_init_rstate (scm_t_i_rstate *, const char *seed, int n);
SCM_API scm_t_i_rstate *scm_i_copy_rstate (scm_t_i_rstate *);
SCM_INTERNAL unsigned long scm_i_uniform32 (scm_t_i_rstate *);
SCM_INTERNAL void scm_i_init_rstate (scm_t_i_rstate *, const char *seed, int n);
SCM_INTERNAL scm_t_i_rstate *scm_i_copy_rstate (scm_t_i_rstate *);
/*
@ -99,7 +99,7 @@ SCM_API SCM scm_random_hollow_sphere_x (SCM v, SCM state);
SCM_API SCM scm_random_normal (SCM state);
SCM_API SCM scm_random_normal_vector_x (SCM v, SCM state);
SCM_API SCM scm_random_exp (SCM state);
SCM_API void scm_init_random (void);
SCM_INTERNAL void scm_init_random (void);
#endif /* SCM_RANDOM_H */

4
libguile/rdelim.h
View file

@ -3,7 +3,7 @@
#ifndef SCM_RDELIM_H
#define SCM_RDELIM_H
/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2006 Free Software Foundation, Inc.
/* Copyright (C) 1995,1996,1997,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
@ -30,7 +30,7 @@ SCM_API SCM scm_read_line (SCM port);
SCM_API SCM scm_write_line (SCM obj, SCM port);
SCM_API SCM scm_init_rdelim_builtins (void);
SCM_API void scm_init_rdelim (void);
SCM_INTERNAL void scm_init_rdelim (void);
#endif /* SCM_RDELIM_H */

28
libguile/read.c
View file

@ -53,6 +53,7 @@
SCM_GLOBAL_SYMBOL (scm_sym_dot, ".");
SCM_SYMBOL (scm_keyword_prefix, "prefix");
SCM_SYMBOL (scm_keyword_postfix, "postfix");
scm_t_option scm_read_opts[] = {
{ SCM_OPTION_BOOLEAN, "copy", 0,
@ -62,7 +63,7 @@ scm_t_option scm_read_opts[] = {
{ SCM_OPTION_BOOLEAN, "case-insensitive", 0,
"Convert symbols to lower case."},
{ SCM_OPTION_SCM, "keywords", SCM_UNPACK (SCM_BOOL_F),
"Style of keyword recognition: #f or 'prefix."},
"Style of keyword recognition: #f, 'prefix or 'postfix."},
#if SCM_ENABLE_ELISP
{ SCM_OPTION_BOOLEAN, "elisp-vectors", 0,
"Support Elisp vector syntax, namely `[...]'."},
@ -291,7 +292,7 @@ scm_read_sexp (int chr, SCM port)
register int c;
register SCM tmp;
register SCM tl, ans = SCM_EOL;
SCM tl2 = SCM_EOL, ans2 = SCM_EOL, copy = SCM_BOOL_F;;
SCM tl2 = SCM_EOL, ans2 = SCM_EOL, copy = SCM_BOOL_F;
static const int terminating_char = ')';
/* Need to capture line and column numbers here. */
@ -531,15 +532,19 @@ static SCM
scm_read_mixed_case_symbol (int chr, SCM port)
{
SCM result, str = SCM_EOL;
int overflow = 0;
int overflow = 0, ends_with_colon = 0;
char buffer[READER_BUFFER_SIZE];
size_t read = 0;
int postfix = scm_is_eq (SCM_PACK (SCM_KEYWORD_STYLE), scm_keyword_postfix);
scm_ungetc (chr, port);
do
{
overflow = read_token (port, buffer, sizeof (buffer), &read);
if (read > 0)
ends_with_colon = (buffer[read - 1] == ':');
if ((overflow) || (scm_is_pair (str)))
str = scm_cons (scm_from_locale_stringn (buffer, read), str);
}
@ -549,12 +554,21 @@ scm_read_mixed_case_symbol (int chr, SCM port)
{
str = scm_string_concatenate (scm_reverse_x (str, SCM_EOL));
result = scm_string_to_symbol (str);
/* Per SRFI-88, `:' alone is an identifier, not a keyword. */
if (postfix && ends_with_colon && (scm_c_string_length (result) > 1))
result = scm_symbol_to_keyword (result);
}
else
/* For symbols smaller than `sizeof (buffer)', we don't need to recur to
Scheme strings. Therefore, we only create one Scheme object (a
symbol) per symbol read. */
result = scm_from_locale_symboln (buffer, read);
{
/* For symbols smaller than `sizeof (buffer)', we don't need to recur
to Scheme strings. Therefore, we only create one Scheme object (a
symbol) per symbol read. */
if (postfix && ends_with_colon && (read > 1))
result = scm_from_locale_keywordn (buffer, read - 1);
else
result = scm_from_locale_symboln (buffer, read);
}
return result;
}

8
libguile/read.h
View file

@ -3,7 +3,7 @@
#ifndef SCM_READ_H
#define SCM_READ_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
@ -56,11 +56,11 @@ SCM_API SCM scm_read (SCM port);
SCM_API size_t scm_read_token (int ic, SCM * tok_buf, SCM port, int weird);
SCM_API SCM scm_read_hash_extend (SCM chr, SCM proc);
SCM_API void scm_i_input_error (const char *func, SCM port,
const char *message, SCM arg)
SCM_INTERNAL void scm_i_input_error (const char *func, SCM port,
const char *message, SCM arg)
SCM_NORETURN;
SCM_API void scm_init_read (void);
SCM_INTERNAL void scm_init_read (void);
#endif /* SCM_READ_H */

4
libguile/regex-posix.h
View file

@ -3,7 +3,7 @@
#ifndef SCM_REGEX_POSIX_H
#define SCM_REGEX_POSIX_H
/* Copyright (C) 1997,1998,2000,2001, 2006 Free Software Foundation, Inc.
/* Copyright (C) 1997,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
@ -31,7 +31,7 @@ SCM_API scm_t_bits scm_tc16_regex;
SCM_API SCM scm_make_regexp (SCM pat, SCM flags);
SCM_API SCM scm_regexp_p (SCM x);
SCM_API SCM scm_regexp_exec (SCM rx, SCM str, SCM start, SCM flags);
SCM_API void scm_init_regex_posix (void);
SCM_INTERNAL void scm_init_regex_posix (void);
#endif /* SCM_REGEX_POSIX_H */

4
libguile/root.h
View file

@ -3,7 +3,7 @@
#ifndef SCM_ROOT_H
#define SCM_ROOT_H
/* Copyright (C) 1996,1998,2000,2001, 2002, 2006 Free Software Foundation, Inc.
/* Copyright (C) 1996,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
@ -55,7 +55,7 @@ SCM_API SCM scm_internal_cwdr (scm_t_catch_body body,
SCM_API SCM scm_call_with_dynamic_root (SCM thunk, SCM handler);
SCM_API SCM scm_dynamic_root (void);
SCM_API SCM scm_apply_with_dynamic_root (SCM proc, SCM a1, SCM args, SCM handler);
SCM_API void scm_init_root (void);
SCM_INTERNAL void scm_init_root (void);
#endif /* SCM_ROOT_H */

6
libguile/rw.h
View file

@ -3,7 +3,7 @@
#ifndef SCM_RW_H
#define SCM_RW_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
@ -29,8 +29,8 @@ SCM_API SCM scm_read_string_x_partial (SCM str, SCM port_or_fdes, SCM start,
SCM_API SCM scm_write_string_partial (SCM str, SCM port_or_fdes, SCM start,
SCM end);
SCM_API SCM scm_init_rw_builtins (void);
SCM_API void scm_init_rw (void);
SCM_INTERNAL SCM scm_init_rw_builtins (void);
SCM_INTERNAL void scm_init_rw (void);
#endif /* SCM_RW_H */

10
libguile/scmsigs.h
View file

@ -3,7 +3,7 @@
#ifndef SCM_SCMSIGS_H
#define SCM_SCMSIGS_H
/* Copyright (C) 1995,1996,1997,1998,2000, 2002, 2006, 2007 Free Software Foundation, Inc.
/* Copyright (C) 1995,1996,1997,1998,2000, 2002, 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
@ -40,12 +40,12 @@ SCM_API SCM scm_pause (void);
SCM_API SCM scm_sleep (SCM i);
SCM_API SCM scm_usleep (SCM i);
SCM_API SCM scm_raise (SCM sig);
SCM_API void scm_init_scmsigs (void);
SCM_INTERNAL void scm_init_scmsigs (void);
SCM_API void scm_i_close_signal_pipe (void);
SCM_API void scm_i_ensure_signal_delivery_thread (void);
SCM_INTERNAL void scm_i_close_signal_pipe (void);
SCM_INTERNAL void scm_i_ensure_signal_delivery_thread (void);
SCM_API scm_i_thread *scm_i_signal_delivery_thread;
SCM_INTERNAL scm_i_thread *scm_i_signal_delivery_thread;
#endif /* SCM_SCMSIGS_H */

4
libguile/script.h
View file

@ -3,7 +3,7 @@
#ifndef SCM_SCRIPT_H
#define SCM_SCRIPT_H
/* Copyright (C) 1997,1998,2000, 2006 Free Software Foundation, Inc.
/* Copyright (C) 1997,1998,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
@ -36,7 +36,7 @@ SCM_API void scm_shell_usage (int fatal, char *message);
SCM_API SCM scm_compile_shell_switches (int argc, char **argv);
SCM_API void scm_shell (int argc, char **argv);
SCM_API char *scm_usage_name;
SCM_API void scm_init_script (void);
SCM_INTERNAL void scm_init_script (void);
#endif /* SCM_SCRIPT_H */

4
libguile/simpos.h
View file

@ -3,7 +3,7 @@
#ifndef SCM_SIMPOS_H
#define SCM_SIMPOS_H
/* Copyright (C) 1995,1996,1997,1998,2000, 2006 Free Software Foundation, Inc.
/* Copyright (C) 1995,1996,1997,1998,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
@ -31,7 +31,7 @@ SCM_API SCM scm_system_star (SCM cmds);
SCM_API SCM scm_getenv (SCM nam);
SCM_API SCM scm_primitive_exit (SCM status);
SCM_API SCM scm_primitive__exit (SCM status);
SCM_API void scm_init_simpos (void);
SCM_INTERNAL void scm_init_simpos (void);
#endif /* SCM_SIMPOS_H */

4
libguile/socket.h
View file

@ -3,7 +3,7 @@
#ifndef SCM_SOCKET_H
#define SCM_SOCKET_H
/* Copyright (C) 1995,1996,1997,2000,2001, 2004, 2005, 2006 Free Software Foundation, Inc.
/* Copyright (C) 1995,1996,1997,2000,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
@ -52,7 +52,7 @@ SCM_API SCM scm_recv (SCM sockfd, SCM buff_or_size, SCM flags);
SCM_API SCM scm_send (SCM sockfd, SCM message, SCM flags);
SCM_API SCM scm_recvfrom (SCM sockfd, SCM buff_or_size, SCM flags, SCM offset, SCM length);
SCM_API SCM scm_sendto (SCM sockfd, SCM message, SCM fam, SCM address, SCM args_and_flags);
SCM_API void scm_init_socket (void);
SCM_INTERNAL void scm_init_socket (void);
/* Wrapping/unwrapping address objects. */
struct sockaddr;

4
libguile/sort.h
View file

@ -3,7 +3,7 @@
#ifndef SCM_SORT_H
#define SCM_SORT_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
@ -39,7 +39,7 @@ SCM_API SCM scm_stable_sort (SCM ls, SCM less);
SCM_API SCM scm_stable_sort_x (SCM ls, SCM less);
SCM_API SCM scm_sort_list (SCM ls, SCM less);
SCM_API SCM scm_sort_list_x (SCM ls, SCM less);
SCM_API void scm_init_sort (void);
SCM_INTERNAL void scm_init_sort (void);
#endif /* SCM_SORT_H */

4
libguile/srcprop.h
View file

@ -3,7 +3,7 @@
#ifndef SCM_SRCPROP_H
#define SCM_SRCPROP_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
@ -70,7 +70,7 @@ SCM_API SCM scm_set_source_property_x (SCM obj, SCM key, SCM datum);
SCM_API SCM scm_source_properties (SCM obj);
SCM_API SCM scm_set_source_properties_x (SCM obj, SCM props);
SCM_API void scm_finish_srcprop (void);
SCM_API void scm_init_srcprop (void);
SCM_INTERNAL void scm_init_srcprop (void);
#if SCM_ENABLE_DEPRECATED == 1
#define SRCBRKP(x) (scm_source_property_breakpoint_p (x))

6
libguile/srfi-13.h
View file

@ -3,7 +3,7 @@
/* srfi-13.c --- SRFI-13 procedures for Guile
*
* Copyright (C) 2001, 2004, 2006 Free Software Foundation, Inc.
* Copyright (C) 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
@ -113,7 +113,7 @@ SCM_API SCM scm_string_split (SCM s, SCM chr);
SCM_API SCM scm_string_filter (SCM s, SCM char_pred, SCM start, SCM end);
SCM_API SCM scm_string_delete (SCM s, SCM char_pred, SCM start, SCM end);
SCM_API void scm_init_srfi_13 (void);
SCM_API void scm_init_srfi_13_14 (void);
SCM_INTERNAL void scm_init_srfi_13 (void);
SCM_INTERNAL void scm_init_srfi_13_14 (void);
#endif /* SCM_SRFI_13_H */

6
libguile/srfi-14.h
View file

@ -3,7 +3,7 @@
/* srfi-14.c --- SRFI-14 procedures for Guile
*
* Copyright (C) 2001, 2004, 2006 Free Software Foundation, Inc.
* Copyright (C) 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
@ -106,7 +106,7 @@ SCM_API SCM scm_char_set_ascii;
SCM_API SCM scm_char_set_empty;
SCM_API SCM scm_char_set_full;
SCM_API void scm_srfi_14_compute_char_sets (void);
SCM_API void scm_init_srfi_14 (void);
SCM_INTERNAL void scm_srfi_14_compute_char_sets (void);
SCM_INTERNAL void scm_init_srfi_14 (void);
#endif /* SCM_SRFI_14_H */

12
libguile/srfi-4.h
View file

@ -2,7 +2,7 @@
#define SCM_SRFI_4_H
/* srfi-4.c --- Homogeneous numeric vector datatypes.
*
* Copyright (C) 2001, 2004, 2006 Free Software Foundation, Inc.
* Copyright (C) 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
@ -303,10 +303,10 @@ SCM_API double *scm_c64vector_writable_elements (SCM uvec,
size_t *lenp,
ssize_t *incp);
SCM_API SCM scm_i_generalized_vector_type (SCM vec);
SCM_API const char *scm_i_uniform_vector_tag (SCM uvec);
SCM_API scm_i_t_array_ref scm_i_uniform_vector_ref_proc (SCM uvec);
SCM_API scm_i_t_array_set scm_i_uniform_vector_set_proc (SCM uvec);
SCM_INTERNAL SCM scm_i_generalized_vector_type (SCM vec);
SCM_INTERNAL const char *scm_i_uniform_vector_tag (SCM uvec);
SCM_INTERNAL scm_i_t_array_ref scm_i_uniform_vector_ref_proc (SCM uvec);
SCM_INTERNAL scm_i_t_array_set scm_i_uniform_vector_set_proc (SCM uvec);
#if SCM_ENABLE_DEPRECATED
@ -318,6 +318,6 @@ SCM_API size_t scm_uniform_element_size (SCM obj);
#endif
SCM_API void scm_init_srfi_4 (void);
SCM_INTERNAL void scm_init_srfi_4 (void);
#endif /* SCM_SRFI_4_H */

4
libguile/stackchk.h
View file

@ -3,7 +3,7 @@
#ifndef SCM_STACKCHK_H
#define SCM_STACKCHK_H
/* Copyright (C) 1995,1996,1998,2000, 2003, 2006 Free Software Foundation, Inc.
/* Copyright (C) 1995,1996,1998,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
@ -60,7 +60,7 @@ SCM_API int scm_stack_checking_enabled_p;
SCM_API void scm_report_stack_overflow (void);
SCM_API long scm_stack_size (SCM_STACKITEM *start);
SCM_API void scm_stack_report (void);
SCM_API void scm_init_stackchk (void);
SCM_INTERNAL void scm_init_stackchk (void);
#endif /* SCM_STACKCHK_H */

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