code:
## Process this file with Automake to create Makefile.in
##
##  	Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
##
##   This file is part of GUILE.
##
##   GUILE is free software; you can redistribute it and/or modify it
##   under the terms of the GNU Lesser General Public License as
##   published by the Free Software Foundation; either version 3, or
##   (at your option) any later version.
##
##   GUILE 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 GUILE; see the file COPYING.LESSER.  If not,
##   write to the Free Software Foundation, Inc., 51 Franklin Street,
##   Fifth Floor, Boston, MA 02110-1301 USA

include $(top_srcdir)/am/snarf

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'.
AM_CPPFLAGS = -DBUILDING_LIBGUILE=1 -I$(top_srcdir) -I$(top_builddir) \
	      -I$(top_srcdir)/lib -I$(top_builddir)/lib $(LIBFFI_CFLAGS)

AM_CFLAGS = $(GCC_CFLAGS) $(CFLAG_VISIBILITY)

## The Gnulib Libtool archive.
gnulib_library = $(top_builddir)/lib/libgnu.la

ETAGS_ARGS = --regex='/SCM_\(GLOBAL_\)?\(G?PROC\|G?PROC1\|SYMBOL\|VCELL\|CONST_LONG\).*\"\([^\"]\)*\"/\3/' \
   --regex='/[ \t]*SCM_[G]?DEFINE1?[ \t]*(\([^,]*\),[^,]*/\1/'

lib_LTLIBRARIES = libguile-@GUILE_EFFECTIVE_VERSION@.la
bin_PROGRAMS = guile

noinst_PROGRAMS = guile_filter_doc_snarfage gen-scmconfig

gen_scmconfig_SOURCES = gen-scmconfig.c

## Override default rule; this should be compiled for BUILD host.
## For some reason, OBJEXT does not include the dot
gen-scmconfig.$(OBJEXT): gen-scmconfig.c
	$(AM_V_GEN) \
	if [ "$(cross_compiling)" = "yes" ]; then \
		$(CC_FOR_BUILD) $(DEFS) $(DEFAULT_INCLUDES) $(AM_CPPFLAGS) -c -o $@ $<; \
	else \
		$(COMPILE) -c -o $@ $<; \
	fi

## Override default rule; this should run on BUILD host.
gen-scmconfig$(EXEEXT): $(gen_scmconfig_OBJECTS) $(gen_scmconfig_DEPENDENCIES)
	$(AM_V_GEN) \
	rm -f gen-scmconfig$(EXEEXT); \
	if [ "$(cross_compiling)" = "yes" ]; then \
		$(CCLD_FOR_BUILD) -o $@ $(gen_scmconfig_OBJECTS); \
	else \
		$(LINK) $(gen_scmconfig_OBJECTS) $(LDADD) $(LIBS); \
	fi

scmconfig.h: ${top_builddir}/config.h gen-scmconfig$(EXEEXT)
	$(AM_V_GEN)(rm -f scmconfig.h.tmp; \
	cat $(srcdir)/scmconfig.h.top > scmconfig.h.tmp; \
	./gen-scmconfig$(EXEEXT) >> scmconfig.h.tmp; \
	chmod 444 scmconfig.h.tmp; \
	rm -f scmconfig.h; \
	mv scmconfig.h.tmp scmconfig.h)

guile_filter_doc_snarfage_SOURCES = c-tokenize.c

## Override default rule; this should be compiled for BUILD host.
## For some reason, OBJEXT does not include the dot
c-tokenize.$(OBJEXT): c-tokenize.c
	$(AM_V_GEN) \
	if [ "$(cross_compiling)" = "yes" ]; then \
		$(CC_FOR_BUILD) $(DEFS) $(AM_CPPFLAGS) -c -o $@ $<; \
	else \
		$(COMPILE) -c -o $@ $<; \
	fi

## Override default rule; this should run on BUILD host.
guile_filter_doc_snarfage$(EXEEXT): $(guile_filter_doc_snarfage_OBJECTS) $(guile_filter_doc_snarfage_DEPENDENCIES)
	$(AM_V_GEN) \
	rm -f guile_filter_doc_snarfage$(EXEEXT); \
	if [ "$(cross_compiling)" = "yes" ]; then \
		$(CCLD_FOR_BUILD) -o $@ $(guile_filter_doc_snarfage_OBJECTS); \
	else \
		$(LINK) $(guile_filter_doc_snarfage_OBJECTS) $(LDADD) $(LIBS); \
	fi

guile_SOURCES = guile.c
guile_CFLAGS = $(GUILE_CFLAGS) $(AM_CFLAGS)
guile_LDADD = libguile-@GUILE_EFFECTIVE_VERSION@.la
guile_LDFLAGS = $(GUILE_CFLAGS)

libguile_@GUILE_EFFECTIVE_VERSION@_la_CFLAGS = $(GUILE_CFLAGS) $(AM_CFLAGS)

libguile_@GUILE_EFFECTIVE_VERSION@_la_SOURCES =				\
	alist.c					\
	arbiters.c				\
	array-handle.c				\
	array-map.c				\
	arrays.c				\
	async.c					\
	backtrace.c				\
	boolean.c				\
	bitvectors.c				\
	bytevectors.c				\
	chars.c					\
	control.c				\
	continuations.c				\
	debug.c					\
	deprecated.c				\
	deprecation.c				\
	dynwind.c				\
	eq.c					\
	error.c					\
	eval.c					\
	evalext.c				\
	expand.c				\
	extensions.c				\
	feature.c				\
	fluids.c				\
	foreign.c				\
	fports.c				\
	frames.c				\
	gc-malloc.c				\
	gc.c					\
	gdbint.c				\
	gettext.c				\
	generalized-arrays.c			\
	generalized-vectors.c			\
	goops.c					\
	gsubr.c					\
	guardians.c				\
	hash.c					\
	hashtab.c				\
	hooks.c					\
	i18n.c					\
	init.c					\
	inline.c				\
	instructions.c				\
	ioext.c					\
	keywords.c				\
	list.c					\
	load.c					\
	macros.c				\
	mallocs.c				\
	memoize.c				\
	modules.c				\
	null-threads.c				\
	numbers.c				\
	objcodes.c				\
	objprop.c				\
	options.c				\
	pairs.c					\
	ports.c					\
	print.c					\
	procprop.c				\
	procs.c					\
	programs.c				\
	promises.c				\
	properties.c				\
	r6rs-ports.c				\
	random.c				\
	rdelim.c				\
	read.c					\
	root.c					\
	rw.c					\
	scmsigs.c				\
	script.c				\
	simpos.c				\
	smob.c					\
	sort.c					\
	srcprop.c				\
	srfi-13.c				\
	srfi-14.c				\
	srfi-4.c				\
	stackchk.c				\
	stacks.c				\
	stime.c					\
	strings.c				\
	strorder.c				\
	strports.c				\
	struct.c				\
	symbols.c				\
	threads.c				\
	throw.c					\
	trees.c					\
	uniform.c				\
	values.c				\
	variable.c				\
	vectors.c				\
	version.c				\
	vm.c					\
	vports.c				\
	weaks.c

DOT_X_FILES =					\
	alist.x					\
	arbiters.x				\
	array-handle.x				\
	array-map.x				\
	arrays.x				\
	async.x					\
	backtrace.x				\
	boolean.x				\
	bitvectors.x				\
	bytevectors.x				\
	chars.x					\
	control.x				\
	continuations.x				\
	debug.x					\
	deprecated.x				\
	deprecation.x				\
	dynl.x					\
	dynwind.x				\
	eq.x					\
	error.x					\
	eval.x					\
	evalext.x				\
	expand.x				\
	extensions.x				\
	feature.x				\
	fluids.x				\
	foreign.x				\
	fports.x				\
	gc-malloc.x				\
	gc.x					\
	gettext.x				\
	generalized-arrays.x			\
	generalized-vectors.x			\
	goops.x					\
	gsubr.x					\
	guardians.x				\
	hash.x					\
	hashtab.x				\
	hooks.x					\
	i18n.x					\
	init.x					\
	ioext.x					\
	keywords.x				\
	list.x					\
	load.x					\
	macros.x				\
	mallocs.x				\
	memoize.x				\
	modules.x				\
	numbers.x				\
	objprop.x				\
	options.x				\
	pairs.x					\
	ports.x					\
	print.x					\
	procprop.x				\
	procs.x					\
	promises.x				\
	properties.x				\
	r6rs-ports.x				\
	random.x				\
	rdelim.x				\
	read.x					\
	root.x					\
	rw.x					\
	scmsigs.x				\
	script.x				\
	simpos.x				\
	smob.x					\
	sort.x					\
	srcprop.x				\
	srfi-13.x				\
	srfi-14.x				\
	srfi-4.x				\
	stackchk.x				\
	stacks.x				\
	stime.x					\
	strings.x				\
	strorder.x				\
	strports.x				\
	struct.x				\
	symbols.x				\
	threads.x				\
	throw.x					\
	trees.x					\
	uniform.x				\
	values.x				\
	variable.x				\
	vectors.x				\
	version.x				\
	vports.x				\
	weaks.x

# vm-related snarfs
DOT_X_FILES += frames.x instructions.x objcodes.x programs.x vm.x

EXTRA_DOT_X_FILES = @EXTRA_DOT_X_FILES@

DOT_DOC_FILES = 				\
	alist.doc				\
	arbiters.doc				\
	array-handle.doc			\
	array-map.doc				\
	arrays.doc				\
	async.doc				\
	backtrace.doc				\
	boolean.doc				\
	bitvectors.doc				\
	bytevectors.doc				\
	chars.doc				\
	control.doc				\
	continuations.doc			\
	debug.doc				\
	deprecated.doc				\
	deprecation.doc				\
	dynl.doc				\
	dynwind.doc				\
	eq.doc					\
	error.doc				\
	eval.doc				\
	evalext.doc				\
	expand.doc				\
	extensions.doc				\
	feature.doc				\
	fluids.doc				\
	foreign.doc				\
	fports.doc				\
	gc-malloc.doc				\
	gc.doc					\
	gettext.doc				\
	generalized-arrays.doc			\
	generalized-vectors.doc			\
	goops.doc				\
	gsubr.doc				\
	guardians.doc				\
	hash.doc				\
	hashtab.doc				\
	hooks.doc				\
	i18n.doc				\
	init.doc				\
	ioext.doc				\
	keywords.doc				\
	list.doc				\
	load.doc				\
	macros.doc				\
	mallocs.doc				\
	memoize.doc				\
	modules.doc				\
	numbers.doc				\
	objprop.doc				\
	options.doc				\
	pairs.doc				\
	ports.doc				\
	print.doc				\
	procprop.doc				\
	procs.doc				\
	promises.doc				\
	properties.doc				\
	r6rs-ports.doc				\
	random.doc				\
	rdelim.doc				\
	read.doc				\
	root.doc				\
	rw.doc					\
	scmsigs.doc				\
	script.doc				\
	simpos.doc				\
	smob.doc				\
	sort.doc				\
	srcprop.doc				\
	srfi-13.doc				\
	srfi-14.doc				\
	srfi-4.doc				\
	stackchk.doc				\
	stacks.doc				\
	stime.doc				\
	strings.doc				\
	strorder.doc				\
	strports.doc				\
	struct.doc				\
	symbols.doc				\
	threads.doc				\
	throw.doc				\
	trees.doc				\
	uniform.doc				\
	values.doc				\
	variable.doc				\
	vectors.doc				\
	version.doc				\
	vports.doc				\
	weaks.doc

EXTRA_DOT_DOC_FILES = @EXTRA_DOT_DOC_FILES@

DOT_I_FILES = vm-i-system.i vm-i-scheme.i vm-i-loader.i

.c.i:
	$(AM_V_GEN)$(GREP) '^VM_DEFINE' $< > $@

BUILT_SOURCES = cpp-E.c cpp-SIG.c libpath.h \
    version.h scmconfig.h \
    $(DOT_I_FILES) $(DOT_X_FILES) $(EXTRA_DOT_X_FILES)

EXTRA_libguile_@GUILE_EFFECTIVE_VERSION@_la_SOURCES = _scm.h		\
    memmove.c strerror.c			\
    dynl.c regex-posix.c			\
    filesys.c posix.c net_db.c socket.c		\
    debug-malloc.c mkstemp.c			\
    win32-uname.c win32-dirent.c win32-socket.c	\
    locale-categories.h

## delete guile-snarf.awk from the installation bindir, in case it's
## lingering there due to an earlier guile version not having been
## wiped out.
install-exec-hook:
	rm -f $(DESTDIR)$(bindir)/guile-snarf.awk

## This is kind of nasty... there are ".c" files that we don't want to
## compile, since they are #included.  So instead we list them here.
## Perhaps we can deal with them normally once the merge seems to be
## working.
noinst_HEADERS = conv-integer.i.c conv-uinteger.i.c		\
                 ieee-754.h					\
                 srfi-14.i.c					\
                 quicksort.i.c                                  \
                 win32-uname.h win32-dirent.h win32-socket.h	\
		 private-gc.h private-options.h

# vm instructions
noinst_HEADERS += vm-engine.c vm-i-system.c vm-i-scheme.c vm-i-loader.c

libguile_@GUILE_EFFECTIVE_VERSION@_la_DEPENDENCIES = @LIBLOBJS@
libguile_@GUILE_EFFECTIVE_VERSION@_la_LIBADD =				\
  @LIBLOBJS@ $(gnulib_library) $(LTLIBGMP)	\
  $(LTLIBUNISTRING) $(LTLIBICONV) $(LTLIBINTL)
libguile_@GUILE_EFFECTIVE_VERSION@_la_LDFLAGS =											\
  @LTLIBINTL@ $(LIBFFI_LIBS) $(INET_NTOP_LIB) $(INET_PTON_LIB)						\
  $(GETADDRINFO_LIB) $(HOSTENT_LIB) $(SERVENT_LIB)							\
  -version-info @LIBGUILE_INTERFACE_CURRENT@:@LIBGUILE_INTERFACE_REVISION@:@LIBGUILE_INTERFACE_AGE@	\
  -export-dynamic -no-undefined										\
  $(GNU_LD_FLAGS)

if HAVE_LD_VERSION_SCRIPT

libguile_@GUILE_EFFECTIVE_VERSION@_la_LDFLAGS += -Wl,--version-script="$(srcdir)/libguile.map"

endif HAVE_LD_VERSION_SCRIPT

# These are headers visible as <guile/mumble.h>
pkginclude_HEADERS =

# These are headers visible as <libguile/mumble.h>.
modincludedir = $(pkgincludedir)/$(GUILE_EFFECTIVE_VERSION)/libguile
modinclude_HEADERS =				\
	__scm.h					\
	alist.h					\
	arbiters.h				\
	array-handle.h				\
	array-map.h				\
	arrays.h				\
	async.h					\
	backtrace.h				\
	bdw-gc.h				\
	boolean.h				\
	bitvectors.h				\
	bytevectors.h				\
	chars.h					\
	control.h				\
	continuations.h				\
	debug-malloc.h				\
	debug.h					\
	deprecated.h				\
	deprecation.h				\
	dynl.h					\
	dynwind.h				\
	eq.h					\
	error.h					\
	eval.h					\
	evalext.h				\
	expand.h				\
	extensions.h				\
	feature.h				\
	filesys.h				\
	fluids.h				\
	foreign.h				\
	fports.h				\
	frames.h				\
	gc.h					\
	gdb_interface.h				\
	gdbint.h				\
	gettext.h				\
	generalized-arrays.h			\
	generalized-vectors.h			\
	goops.h					\
	gsubr.h					\
	guardians.h				\
	hash.h					\
	hashtab.h				\
	hooks.h					\
	i18n.h					\
	init.h					\
	inline.h				\
	instructions.h				\
	ioext.h					\
	iselect.h				\
	keywords.h				\
	list.h					\
	load.h					\
	macros.h				\
	mallocs.h				\
	memoize.h				\
	modules.h				\
	net_db.h				\
	null-threads.h				\
	numbers.h				\
	objcodes.h				\
	objprop.h				\
	options.h				\
	pairs.h					\
	ports.h					\
	posix.h					\
	print.h					\
	procprop.h				\
	procs.h					\
	programs.h				\
	promises.h				\
	properties.h				\
	pthread-threads.h			\
	r6rs-ports.h				\
	random.h				\
	rdelim.h				\
	read.h					\
	regex-posix.h				\
	root.h					\
	rw.h					\
	scmsigs.h				\
	script.h				\
	simpos.h				\
	smob.h					\
	snarf.h					\
	socket.h				\
	sort.h					\
	srcprop.h				\
	srfi-13.h				\
	srfi-14.h				\
	srfi-4.h				\
	stackchk.h				\
	stacks.h				\
	stime.h					\
	strings.h				\
	strorder.h				\
	strports.h				\
	struct.h				\
	symbols.h				\
	tags.h					\
	threads.h				\
	throw.h					\
	trees.h					\
	validate.h				\
	uniform.h				\
	values.h				\
	variable.h				\
	vectors.h				\
	vm-engine.h				\
	vm-expand.h				\
	vm.h					\
	vports.h				\
	weaks.h

nodist_modinclude_HEADERS = version.h scmconfig.h

bin_SCRIPTS = guile-snarf

# We can re-enable install for some of these if/when they are documented
# and people feel like maintaining them.  For now, this is not the case.
noinst_SCRIPTS = guile-snarf-docs

EXTRA_DIST = ChangeLog-scm ChangeLog-threads		\
    ChangeLog-1996-1999 ChangeLog-2000 ChangeLog-2008	\
    guile-func-name-check				\
    cpp-E.syms cpp-E.c cpp-SIG.syms cpp-SIG.c			\
    c-tokenize.lex version.h.in						\
    scmconfig.h.top libgettext.h unidata_to_charset.pl libguile.map
#    $(DOT_DOC_FILES) $(EXTRA_DOT_DOC_FILES) \
#    guile-procedures.txt guile.texi

## We use @-...-@ as the substitution brackets here, instead of the
## usual @...@, so autoconf doesn't go and substitute the values
## directly into the left-hand sides of the sed substitutions.  *sigh*
version.h: version.h.in $(top_builddir)/config.status
	$(AM_V_GEN)sed < $(srcdir)/version.h.in > $@.tmp \
	  -e s:@-GUILE_MAJOR_VERSION-@:${GUILE_MAJOR_VERSION}: \
	  -e s:@-GUILE_MINOR_VERSION-@:${GUILE_MINOR_VERSION}: \
	  -e s:@-GUILE_MICRO_VERSION-@:${GUILE_MICRO_VERSION}: \
	  -e s:@-GUILE_EFFECTIVE_VERSION-@:${GUILE_EFFECTIVE_VERSION}: && mv $@.tmp $@

## FIXME: Consider using timestamp file, to avoid unnecessary rebuilds.
libpath.h: $(srcdir)/Makefile.in  $(top_builddir)/config.status
	@rm -f libpath.tmp
	@echo '/* generated by Makefile */' > libpath.tmp
	@echo '#define SCM_PKGDATA_DIR "$(pkgdatadir)"' >> libpath.tmp
	@echo '#define SCM_LIBRARY_DIR "$(pkgdatadir)/$(GUILE_EFFECTIVE_VERSION)"'>>libpath.tmp
	@echo '#define SCM_SITE_DIR "$(pkgdatadir)/site/$(GUILE_EFFECTIVE_VERSION)"' >> libpath.tmp
	@echo '#define SCM_GLOBAL_SITE_DIR "$(pkgdatadir)/site"' >> libpath.tmp
	@echo '#define SCM_LIB_DIR "$(libdir)"' >> libpath.tmp
	@echo '#define SCM_EXTENSIONS_DIR "$(pkglibdir)/$(GUILE_EFFECTIVE_VERSION)/extensions"' >> libpath.tmp
	@echo '#define SCM_CCACHE_DIR "$(pkglibdir)/$(GUILE_EFFECTIVE_VERSION)/ccache"' >> libpath.tmp
	@echo '#define SCM_EFFECTIVE_VERSION "$(GUILE_EFFECTIVE_VERSION)"' >> libpath.tmp
	@echo '#define SCM_BUILD_INFO { \' >> libpath.tmp
	@echo '	{ "srcdir", "'"`cd @srcdir@; pwd`"'" }, \' >> libpath.tmp
	@echo ' { "top_srcdir",    "@top_srcdir_absolute@" }, \' >> libpath.tmp
	@echo '	{ "prefix",	   "@prefix@" }, \' >> libpath.tmp
	@echo '	{ "exec_prefix",   "@exec_prefix@" }, \' >> libpath.tmp
	@echo '	{ "bindir",	   "@bindir@" }, \' >> libpath.tmp
	@echo '	{ "sbindir",	   "@sbindir@" }, \' >> libpath.tmp
	@echo '	{ "libexecdir",	   "@libexecdir@" }, \' >> libpath.tmp
	@echo '	{ "datadir",	   "@datadir@" }, \' >> libpath.tmp
	@echo '	{ "sysconfdir",	   "@sysconfdir@" }, \' >> libpath.tmp
	@echo '	{ "sharedstatedir", "@sharedstatedir@" }, \' >> libpath.tmp
	@echo '	{ "localstatedir", "@localstatedir@" }, \' >> libpath.tmp
	@echo '	{ "libdir",	   "@libdir@" }, \' >> libpath.tmp
	@echo '	{ "ccachedir",	   SCM_CCACHE_DIR }, \' >> libpath.tmp
	@echo '	{ "infodir",	   "@infodir@" }, \' >> libpath.tmp
	@echo '	{ "mandir",	   "@mandir@" }, \' >> libpath.tmp
	@echo '	{ "includedir",	   "@includedir@" }, \' >> libpath.tmp
	@echo '	{ "pkgdatadir",	   "$(pkgdatadir)" }, \' >> libpath.tmp
	@echo '	{ "pkglibdir",	   "$(pkglibdir)" }, \' >> libpath.tmp
	@echo '	{ "pkgincludedir", "$(pkgincludedir)" }, \' \
		>> libpath.tmp
	@echo '	{ "extensiondir", "$(pkglibdir)/$(GUILE_EFFECTIVE_VERSION)/extensions" }, \' >> libpath.tmp
	@echo '	{ "guileversion", "@GUILE_VERSION@" }, \' >> libpath.tmp
	@echo '	{ "libguileinterface", "@LIBGUILE_INTERFACE@" }, \' \
		>> libpath.tmp
	@echo '	{ "LIBS",	   "@GUILE_LIBS@" }, \' >> libpath.tmp
	@echo '	{ "CFLAGS",	   "@GUILE_CFLAGS@" }, \' >> libpath.tmp
	@echo '	{ "buildstamp",    "'`date -u +'%Y-%m-%d %T'`'" }, \' >> libpath.tmp
	@echo '}' >> libpath.tmp
	$(AM_V_GEN)mv libpath.tmp libpath.h

snarfcppopts = $(DEFS) $(AM_CPPFLAGS) $(CPPFLAGS) $(CFLAGS)

SUFFIXES = .x .doc

AM_V_FILTER = $(AM_V_FILTER_$(V))
AM_V_FILTER_ = $(AM_V_FILTER_$(AM_DEFAULT_VERBOSITY))
AM_V_FILTER_0 = @echo "  FILTER" $@;

.c.x:
	$(AM_V_SNARF)$(GUILE_SNARF) -o $@ $< $(snarfcppopts)
.c.doc:
	-$(AM_V_FILTER)$(AWK) -f $(srcdir)/guile-func-name-check $< && (./guile-snarf-docs $(snarfcppopts) $< | ./guile_filter_doc_snarfage$(EXEEXT) --filter-snarfage) > $@ || { rm $@; false; }

$(DOT_X_FILES) $(EXTRA_DOT_X_FILES): scmconfig.h snarf.h guile-snarf.in version.h

$(DOT_DOC_FILES) $(EXTRA_DOT_DOC_FILES): scmconfig.h snarf.h guile-snarf-docs.in guile_filter_doc_snarfage$(EXEEXT)

error.x: cpp-E.c
posix.x: cpp-SIG.c
load.x: libpath.h

alldotdocfiles    = $(DOT_DOC_FILES) $(EXTRA_DOT_DOC_FILES)
snarf2checkedtexi = GUILE_AUTO_COMPILE=0 $(top_builddir)/meta/uninstalled-env guile-tools snarf-check-and-output-texi
dotdoc2texi       = cat $(alldotdocfiles) | $(snarf2checkedtexi)

guile.texi: $(alldotdocfiles) guile$(EXEEXT)
	$(dotdoc2texi) --manual > $@ || { rm $@; false; }

guile-procedures.texi: $(alldotdocfiles) guile$(EXEEXT)
	$(AM_V_GEN)$(dotdoc2texi)          > $@ || { rm $@; false; }

if HAVE_MAKEINFO

guile-procedures.txt: guile-procedures.texi
	rm -f $@
	makeinfo --force -o $@ guile-procedures.texi || test -f $@

else

guile-procedures.txt: guile-procedures.texi
	cp guile-procedures.texi $@

endif

c-tokenize.c: c-tokenize.lex
	flex -t $(srcdir)/c-tokenize.lex > $@ || { rm $@; false; }

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) $(AM_CPPFLAGS) $(CPPFLAGS) $(CFLAGS)

# This page is for maintenance of the lists of CPP symbols that are eventually
# included in error.c (‘errno’ values: E*) and posix.c (signal names: SIG*),
# in the funcs scm_init_{error,posix}, respectively.
#
# The lists (files cpp-{E,SIG}.syms) are not included verbatim, but processed
# (via pattern rule ‘.syms.c’ below) so that each CPP symbol is transformed to
# fragment of #ifdef'd C code that defines a Scheme variable of the same name.
# The resulting files, cpp-{E,SIG}.c, are the ones #include:d.
#
# To maintain the (source) lists of symbols, we use a GCC-specific feature
# to list all symbols #define:d when expanding <{errno,signal}.h>, grep
# the output for {E,SIG}*, massage the result into a usable form, and
# construct a union of the current and new symbols.  This is written to
# files cpp-{E,SIG}.syms.NEW for review.  If things look ok, you can then
# "mv foo.NEW foo" and commit.  Generating the foo.NEW files and showing
# an informative message is the job of targets chknew-{E,SIG}.

# For each line in foo.syms, transform:
#	SYMBOL
# to:
#	#ifdef SYMBOL
#	scm_c_define ("SYMBOL", scm_from_int (SYMBOL));
#	#endif
# writing output to foo.c.
.syms.c:
	sed 's/.*/#ifdef &\nscm_c_define ("&", scm_from_int (&));\n#endif/' \
	  $< > $@T
	mv $@T $@

# Write $(srcdir)/cpp-{E,SIG}.syms.NEW if there are any not-yet-seen
# ("new" to us) E* or SIG* symbols in <errno.h> or <signal.h>, respectively.
chknew-E chknew-SIG:
	@bit=`echo $@ | sed s/^chknew-//` ;			\
	old="$(srcdir)/cpp-$$bit.syms" ;			\
	echo "#include <$${bit}.h>"				\
	 | sed 's/E/errno/;s/SIG/signal/'			\
	 | gcc -undef -dM -E -					\
	 | sed 's/^#define //;/^'$$bit'[A-Z][A-Z]*/!d;s/ .*//'	\
	 | sort | diff -u $$old - | sed '1,2d;/^+/!d;s/^.//'	\
	 > TMP ;						\
	if [ -s TMP ] ; then new="$$old.NEW" ;			\
	  cat $$old TMP | sort > $$new ;			\
	  echo "$$new: `sed -n '$$=' TMP` new symbol(s)." ;	\
	  sed 's/^/  /' TMP ;					\
	else echo "No new symbols found." ;			\
	fi ; rm TMP

MOSTLYCLEANFILES = \
	version.h version.h.tmp \
	scmconfig.h scmconfig.h.tmp

CLEANFILES = libpath.h *.x *.doc guile-procedures.txt guile-procedures.texi guile.texi \
	vm-i-*.i

MAINTAINERCLEANFILES = c-tokenize.c


code:
/* classes: h_files */

#ifndef SCM___SCM_H
#define SCM___SCM_H

/* Copyright (C) 1995,1996,1998,1999,2000,2001,2002,2003, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
 *
 * This library is free software; you can redistribute it and/or
 * modify it under the terms of the GNU Lesser General Public License
 * as published by the Free Software Foundation; either version 3 of
 * 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
 */

/**********************************************************************
 This file is Guile's central public header.

 When included by other files, this file should preceed any include
 other than __scm.h.

 Under *NO* circumstances should new items be added to the global
 namespace (via adding #define, typedef, or similar to this file) with
 generic names.  This usually means that any new names should be
 prefixed by either SCM_ or GUILE_.  i.e. do *not* #define HAVE_FOO or
 SIZEOF_BAR.  See configure.in, gen-scmconfig.h.in, and
 gen-scmconfig.c for examples of how to properly handle this issue.
 The main documentation is in gen-scmconfig.c.

 "What's the difference between _scm.h and __scm.h?"

   _scm.h is not installed; it's only visible to the libguile sources
   themselves, and it includes config.h, the private config header.

   __scm.h is installed, and is #included by <libguile.h>.  If both
   the client and libguile need some piece of information, and it
   doesn't fit well into the header file for any particular module, it
   should go in __scm.h.  __scm.h includes scmconfig.h, the public
   config header.
 **********************************************************************/

/* What did the configure script discover about the outside world?  */
#include "libguile/scmconfig.h"

/* {Compiler hints}
 *
 * The following macros are used to provide additional information for the
 * compiler, which may help to do better error checking and code
 * optimization.  A second benefit of these macros is, that they also provide
 * additional information to the developers.
 */

/* The macro SCM_NORETURN indicates that a function will never return.
 * Examples:
 *   1) int foo (char arg) SCM_NORETURN;
 */
#ifdef __GNUC__
#define SCM_NORETURN __attribute__ ((noreturn))
#else
#define SCM_NORETURN
#endif

/* The macro SCM_UNUSED indicates that a function, function argument or
 * variable may potentially be unused.
 * Examples:
 *   1) static int unused_function (char arg) SCM_UNUSED;
 *   2) int foo (char unused_argument SCM_UNUSED);
 *   3) int unused_variable SCM_UNUSED;
 */
#ifdef __GNUC__
#define SCM_UNUSED __attribute__ ((unused))
#else
#define SCM_UNUSED
#endif

/* The SCM_EXPECT macros provide branch prediction hints to the compiler.  To
 * use only in places where the result of the expression under "normal"
 * circumstances is known.  */
#if defined(__GNUC__) && (__GNUC__ >= 3)
# define SCM_EXPECT    __builtin_expect
#else
# define SCM_EXPECT(_expr, _value) (_expr)
#endif

#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.  However our current tack on this problem is
 * to use GCC 4's -fvisibility=hidden, making functions internal by default,
 * and then SCM_API marks them for export. */
#define SCM_INTERNAL  extern

/* The SCM_DEPRECATED macro is used in declarations of deprecated functions
 * or variables.  Defining `SCM_BUILDING_DEPRECATED_CODE' allows deprecated
 * functions to be implemented in terms of deprecated functions, and allows
 * deprecated functions to be referred to by `scm_c_define_gsubr ()'.  */
#if !defined (SCM_BUILDING_DEPRECATED_CODE)	\
    && defined (__GNUC__) && (__GNUC__ >= 3)
# define SCM_DEPRECATED  SCM_API __attribute__ ((__deprecated__))
#else
# define SCM_DEPRECATED  SCM_API
#endif

/* The SCM_ALIGNED macro, when defined, can be used to instruct the compiler
 * to honor the given alignment constraint.  */
#if defined __GNUC__
# define SCM_ALIGNED(x)  __attribute__ ((aligned (x)))
#elif defined __INTEL_COMPILER
# define SCM_ALIGNED(x)  __declspec (align (x))
#else
/* Don't know how to align things.  */
# undef SCM_ALIGNED
#endif

/* The SCM_MALLOC macro can be used in function declarations to tell the
 * compiler that a function may be treated as if any non-NULL pointer it returns
 * cannot alias any other pointer valid when the function returns.  */
#if defined (__GNUC__) && (__GNUC__ >= 3)
# define SCM_MALLOC  __attribute__ ((__malloc__))
#else
# define SCM_MALLOC
#endif

/* {Supported Options}
 *
 * These may be defined or undefined.
 */

/* #define GUILE_DEBUG_FREELIST */

/* Use engineering notation when converting numbers strings?
 */
#undef ENGNOT

/* {Unsupported Options}
 *
 * These must be defined as given here.
 */

/* Guile Scheme supports the #f/() distinction; Guile Lisp won't.  We
   have horrible plans for their unification.  */
#undef SICP

/* Random options (not yet supported or in final form). */

#define STACK_CHECKING
#undef NO_CEVAL_STACK_CHECKING

/* SCM_API is a macro prepended to all function and data definitions
   which should be exported from libguile. */

#if defined BUILDING_LIBGUILE && defined HAVE_VISIBILITY
# define SCM_API extern __attribute__((__visibility__("default")))
#elif defined BUILDING_LIBGUILE && defined _MSC_VER
# define SCM_API __declspec(dllexport) extern
#elif defined _MSC_VER
# define SCM_API __declspec(dllimport) extern
#else
# define SCM_API extern
#endif

/* {Debugging Options}
 *
 * These compile time options determine whether to include code that is only
 * useful for debugging guile itself or C level extensions to guile.  The
 * common prefix for all option macros of this kind is "SCM_DEBUG_".  It is
 * guaranteed that a macro named SCM_DEBUG_XXX is always defined (typically to
 * either 0 or 1), i. e. there is no need to test for the undefined case.
 * This allows to use these definitions comfortably within code, as in the
 * following example:
 *   #define FOO do { if (SCM_DEBUG_XXX) bar(); else baz(); } while (0)
 * Any sane compiler will remove the unused branch without any performance
 * penalty for the resulting code.
 *
 * Note:  Some SCM_DEBUG_XXX options are not settable at configure time.
 * To change the value of such options you will have to edit this header
 * file or give suitable options to make, like:
 *   make all CFLAGS="-DSCM_DEBUG_XXX=1 ..."
 */

/* The value of SCM_DEBUG determines the default for most of the not yet
 * defined debugging options.  This allows, for example, to enable most of the
 * debugging options by simply defining SCM_DEBUG as 1.
 */
#ifndef SCM_DEBUG
#define SCM_DEBUG 0
#endif

/* For debugging purposes: define this is to ensure nobody is using
 * the mark bits outside of the marking phase.  This is meant for
 * debugging purposes only.
 */
#ifndef SCM_DEBUG_MARKING_API
#define SCM_DEBUG_MARKING_API 0
#endif

/* If SCM_DEBUG_CELL_ACCESSES is set to 1, cell accesses will perform
 * exhaustive parameter checking:  It will be verified that cell parameters
 * actually point to a valid heap cell.  Note:  If this option is enabled,
 * guile will run about ten times slower than normally.
 */
#ifndef SCM_DEBUG_CELL_ACCESSES
#define SCM_DEBUG_CELL_ACCESSES SCM_DEBUG
#endif

/* If SCM_DEBUG_INTERRUPTS is set to 1, with every deferring and allowing of
 * interrupts a consistency check will be performed.
 */
#ifndef SCM_DEBUG_INTERRUPTS
#define SCM_DEBUG_INTERRUPTS SCM_DEBUG
#endif

/* If SCM_DEBUG_PAIR_ACCESSES is set to 1, accesses to cons cells will be
 * exhaustively checked.  Note:  If this option is enabled, guile will run
 * slower than normally.
 */
#ifndef SCM_DEBUG_PAIR_ACCESSES
#define SCM_DEBUG_PAIR_ACCESSES SCM_DEBUG
#endif

/* If SCM_DEBUG_REST_ARGUMENT is set to 1, functions that take rest arguments
 * will check whether the rest arguments are actually passed as a proper list.
 * Otherwise, if SCM_DEBUG_REST_ARGUMENT is 0, functions that take rest
 * arguments will take it for granted that these are passed as a proper list.
 */
#ifndef SCM_DEBUG_REST_ARGUMENT
#define SCM_DEBUG_REST_ARGUMENT SCM_DEBUG
#endif

/* The macro SCM_DEBUG_TYPING_STRICTNESS indicates what level of type checking
 * shall be performed with respect to the use of the SCM datatype.  The macro
 * may be defined to one of the values 0, 1 and 2.
 *
 * A value of 0 means that there will be no compile time type checking, since
 * the SCM datatype will be declared as an integral type.  This setting should
 * only be used on systems, where casting from integral types to pointers may
 * lead to loss of bit information.
 *
 * A value of 1 means that there will an intermediate level of compile time
 * type checking, since the SCM datatype will be declared as a pointer to an
 * undefined struct.  This setting is the default, since it does not cost
 * anything in terms of performance or code size.
 *
 * A value of 2 provides a maximum level of compile time type checking since
 * the SCM datatype will be declared as a struct.  This setting should be used
 * for _compile time_ type checking only, since the compiled result is likely
 * to be quite inefficient.  The right way to make use of this option is to do
 * a 'make clean; make CFLAGS=-DSCM_DEBUG_TYPING_STRICTNESS=2', fix your
 * errors, and then do 'make clean; make'.
 */
#ifndef SCM_DEBUG_TYPING_STRICTNESS
#define SCM_DEBUG_TYPING_STRICTNESS 1
#endif

/* If SCM_DEBUG_DEBUGGING_SUPPORT is set to 1, guile will provide a set of
 * special functions that support debugging with a debugger like gdb or
 * debugging of guile internals on the scheme level.  The behaviour of guile
 * is not changed by this macro, only the set of functions that are available
 * will differ.  All functions that are introduced this way have the prefix
 * 'scm_dbg_' on the C level and the prefix 'dbg-' on the scheme level.  This
 * allows to easily determine the set of support functions, given that your
 * debugger or repl provide automatic name completion.  Note that these
 * functions are intended to be used during interactive debugging sessions
 * only.  They are not considered part of guile's official API.  They may
 * change or disappear without notice or deprecation phase.
 */
#ifndef SCM_DEBUG_DEBUGGING_SUPPORT
#define SCM_DEBUG_DEBUGGING_SUPPORT SCM_DEBUG
#endif

/* {Feature Options}
 *
 * These compile time options determine whether code for certain features
 * should be compiled into guile.  The common prefix for all option macros
 * of this kind is "SCM_ENABLE_".  It is guaranteed that a macro named
 * SCM_ENABLE_XXX is defined to be either 0 or 1, i. e. there is no need to
 * test for the undefined case.  This allows to use these definitions
 * comfortably within code, as in the following example:
 *   #define FOO do { if (SCM_ENABLE_XXX) bar(); else baz(); } while (0)
 * Any sane compiler will remove the unused branch without any performance
 * penalty for the resulting code.
 *
 * Note:  Some SCM_ENABLE_XXX options are not settable at configure time.
 * To change the value of such options you will have to edit this header
 * file or give suitable options to make, like:
 *   make all CFLAGS="-DSCM_ENABLE_XXX=1 ..."
 */

/* If SCM_ENABLE_DEPRECATED is set to 1, deprecated code will be included in
 * guile, as well as some functions to issue run-time warnings about uses of
 * deprecated functions.
 */
#ifndef SCM_ENABLE_DEPRECATED
#define SCM_ENABLE_DEPRECATED 0
#endif

/* {Architecture and compiler properties}
 *
 * Guile as of today can only work on systems which fulfill at least the
 * following requirements:
 *
 * - scm_t_bits and SCM variables have at least 32 bits.
 *   Guile's type system is based on this assumption.
 *
 * - sizeof (scm_t_bits) >= sizeof (void*) and sizeof (SCM) >= sizeof (void*)
 *   Guile's type system is based on this assumption, since it must be
 *   possible to store pointers to cells on the heap in scm_t_bits and SCM
 *   variables.
 *
 * - sizeof (scm_t_bits) >= 4 and sizeof (scm_t_bits) is a power of 2.
 *   Guile's type system is based on this assumption.  In particular, it is
 *   assumed that cells, i. e. pairs of scm_t_bits variables, are eight
 *   character aligned.  This is because three bits of a scm_t_bits variable
 *   that is holding a pointer to a cell on the heap must be available for
 *   storing type data.
 *
 * - sizeof (scm_t_bits) <= sizeof (void*) and sizeof (SCM) <= sizeof (void*)
 *   In some parts of guile, scm_t_bits and SCM variables are passed to
 *   functions as void* arguments.  Together with the requirement above, this
 *   requires a one-to-one correspondence between the size of a void* and the
 *   sizes of scm_t_bits and SCM variables.
 *
 * - numbers are encoded using two's complement.
 *   The implementation of the bitwise scheme level operations is based on
 *   this assumption.
 *
 * - ... add more
 */

#ifdef CHAR_BIT
# define SCM_CHAR_BIT CHAR_BIT
#else
# define SCM_CHAR_BIT 8
#endif

#ifdef LONG_BIT
# define SCM_LONG_BIT LONG_BIT
#else
# define SCM_LONG_BIT (SCM_CHAR_BIT * sizeof (long) / sizeof (char))
#endif

#ifdef UCHAR_MAX
# define SCM_CHAR_CODE_LIMIT (UCHAR_MAX + 1L)
#else
# define SCM_CHAR_CODE_LIMIT 256L
#endif

#define SCM_I_UTYPE_MAX(type)      ((type)-1)
#define SCM_I_TYPE_MAX(type,umax)  ((type)((umax)/2))
#define SCM_I_TYPE_MIN(type,umax)  (-((type)((umax)/2))-1)

#define SCM_T_UINT8_MAX   SCM_I_UTYPE_MAX(scm_t_uint8)
#define SCM_T_INT8_MIN    SCM_I_TYPE_MIN(scm_t_int8,SCM_T_UINT8_MAX)
#define SCM_T_INT8_MAX    SCM_I_TYPE_MAX(scm_t_int8,SCM_T_UINT8_MAX)

#define SCM_T_UINT16_MAX  SCM_I_UTYPE_MAX(scm_t_uint16)
#define SCM_T_INT16_MIN   SCM_I_TYPE_MIN(scm_t_int16,SCM_T_UINT16_MAX)
#define SCM_T_INT16_MAX   SCM_I_TYPE_MAX(scm_t_int16,SCM_T_UINT16_MAX)

#define SCM_T_UINT32_MAX  SCM_I_UTYPE_MAX(scm_t_uint32)
#define SCM_T_INT32_MIN   SCM_I_TYPE_MIN(scm_t_int32,SCM_T_UINT32_MAX)
#define SCM_T_INT32_MAX   SCM_I_TYPE_MAX(scm_t_int32,SCM_T_UINT32_MAX)

#define SCM_T_UINT64_MAX  SCM_I_UTYPE_MAX(scm_t_uint64)
#define SCM_T_INT64_MIN   SCM_I_TYPE_MIN(scm_t_int64,SCM_T_UINT64_MAX)
#define SCM_T_INT64_MAX   SCM_I_TYPE_MAX(scm_t_int64,SCM_T_UINT64_MAX)

#if SCM_SIZEOF_LONG_LONG
#define SCM_I_ULLONG_MAX  SCM_I_UTYPE_MAX(unsigned long long)
#define SCM_I_LLONG_MIN   SCM_I_TYPE_MIN(long long,SCM_I_ULLONG_MAX)
#define SCM_I_LLONG_MAX   SCM_I_TYPE_MAX(long long,SCM_I_ULLONG_MAX)
#endif

#define SCM_T_UINTMAX_MAX SCM_I_UTYPE_MAX(scm_t_uintmax)
#define SCM_T_INTMAX_MIN  SCM_I_TYPE_MIN(scm_t_intmax,SCM_T_UINTMAX_MAX)
#define SCM_T_INTMAX_MAX  SCM_I_TYPE_MAX(scm_t_intmax,SCM_T_UINTMAX_MAX)

#define SCM_T_UINTPTR_MAX SCM_I_UTYPE_MAX(scm_t_uintptr)
#define SCM_T_INTPTR_MIN  SCM_I_TYPE_MIN(scm_t_intptr,SCM_T_UINTPTR_MAX)
#define SCM_T_INTPTR_MAX  SCM_I_TYPE_MAX(scm_t_intptr,SCM_T_UINTPTR_MAX)

#define SCM_I_SIZE_MAX    SCM_I_UTYPE_MAX(size_t)
#define SCM_I_SSIZE_MIN   SCM_I_TYPE_MIN(ssize_t,SCM_I_SIZE_MAX)
#define SCM_I_SSIZE_MAX   SCM_I_TYPE_MAX(ssize_t,SCM_I_SIZE_MAX)

#include "libguile/tags.h"

#ifdef vms
# ifndef CHEAP_CONTINUATIONS
   typedef int jmp_buf[17];
   extern int setjump(jmp_buf env);
   extern int longjump(jmp_buf env, int ret);
#  define setjmp setjump
#  define longjmp longjump
# else
#  include <setjmp.h>
# endif
#else				/* ndef vms */
# ifdef _CRAY1
    typedef int jmp_buf[112];
    extern int setjump(jmp_buf env);
    extern int longjump(jmp_buf env, int ret);
#  define setjmp setjump
#  define longjmp longjump
# else				/* ndef _CRAY1 */
#  if defined (__ia64__)
/* For IA64, emulate the setjmp API using getcontext. */
#   include <signal.h>
#   include <ucontext.h>
    typedef struct {
      ucontext_t ctx;
      int fresh;
    } scm_i_jmp_buf;
#   define SCM_I_SETJMP(JB)			        \
      ( (JB).fresh = 1,				        \
        getcontext (&((JB).ctx)),			\
        ((JB).fresh ? ((JB).fresh = 0, 0) : 1) )
#   define SCM_I_LONGJMP(JB,VAL) scm_ia64_longjmp (&(JB), VAL)
    void scm_ia64_longjmp (scm_i_jmp_buf *, int);
#  else                 	/* ndef __ia64__ */
#   include <setjmp.h>
#  endif			/* ndef __ia64__ */
# endif				/* ndef _CRAY1 */
#endif				/* ndef vms */

/* For any platform where SCM_I_SETJMP hasn't been defined in some
   special way above, map SCM_I_SETJMP, SCM_I_LONGJMP and
   scm_i_jmp_buf to setjmp, longjmp and jmp_buf. */
#ifndef SCM_I_SETJMP
#define scm_i_jmp_buf jmp_buf
#define SCM_I_SETJMP setjmp
#define SCM_I_LONGJMP longjmp
#endif

/* James Clark came up with this neat one instruction fix for
 * continuations on the SPARC.  It flushes the register windows so
 * that all the state of the process is contained in the stack.
 */

#if defined (sparc) || defined (__sparc__) || defined (__sparc)
# define SCM_FLUSH_REGISTER_WINDOWS asm("ta 3")
#else
# define SCM_FLUSH_REGISTER_WINDOWS /* empty */
#endif

/* If stack is not longword aligned then
 */

/* #define SHORT_ALIGN */
#ifdef THINK_C
# define SHORT_ALIGN
#endif
#ifdef MSDOS
# define SHORT_ALIGN
#endif
#ifdef atarist
# define SHORT_ALIGN
#endif

#ifdef SHORT_ALIGN
typedef short SCM_STACKITEM;
#else
typedef long SCM_STACKITEM;
#endif

/* Cast pointer through (void *) in order to avoid compiler warnings
   when strict aliasing is enabled */
#define SCM_STACK_PTR(ptr) ((SCM_STACKITEM *) (void *) (ptr))

SCM_API void scm_async_tick (void);

#ifdef BUILDING_LIBGUILE

/* FIXME: should change names */
# define SCM_ASYNC_TICK                                                 \
    do                                                                  \
      {                                                                 \
	if (SCM_UNLIKELY (SCM_I_CURRENT_THREAD->pending_asyncs))	\
	  scm_async_click ();                                           \
      }                                                                 \
    while (0)

/* SCM_ASYNC_TICK_WITH_CODE is only available to Guile itself */
# define SCM_ASYNC_TICK_WITH_CODE(stmt)                                 \
    do                                                                  \
      {                                                                 \
	if (SCM_UNLIKELY (SCM_I_CURRENT_THREAD->pending_asyncs))	\
	  {                                                             \
            stmt;                                                       \
            scm_async_click ();                                         \
          }                                                             \
      }                                                                 \
    while (0)

#else /* !BUILDING_LIBGUILE */

# define SCM_ASYNC_TICK  (scm_async_tick ())

#endif /* !BUILDING_LIBGUILE */

/* Anthony Green writes:
   When the compiler sees...
	   DEFER_INTS;
	   [critical code here]
	   ALLOW_INTS;
   ...it doesn't actually promise to keep the critical code within the
   boundries of the DEFER/ALLOW_INTS instructions. It may very well
   schedule it outside of the magic defined in those macros.

   However, GCC's volatile asm feature forms a barrier over which code is
   never moved. So if you add...
	   asm ("");
   ...to each of the DEFER_INTS and ALLOW_INTS macros, the critical
   code will always remain in place.  asm's without inputs or outputs
   are implicitly volatile. */
#ifdef __GNUC__
#define SCM_FENCE asm /* volatile */ ("")
#elif defined (__INTEL_COMPILER) && defined (__ia64)
#define SCM_FENCE __memory_barrier()
#else
#define SCM_FENCE
#endif

#define SCM_TICK \
do { \
  SCM_ASYNC_TICK; \
  SCM_THREAD_SWITCHING_CODE; \
} while (0)

/** SCM_ASSERT
 **
 **/

#ifdef SCM_RECKLESS
#define SCM_ASSERT(_cond, _arg, _pos, _subr)
#define SCM_ASSERT_TYPE(_cond, _arg, _pos, _subr, _msg)
#define SCM_ASRTGO(_cond, _label)
#else
#define SCM_ASSERT(_cond, _arg, _pos, _subr)			\
        do { if (SCM_UNLIKELY (!(_cond)))			\
          scm_wrong_type_arg (_subr, _pos, _arg); } while (0)
#define SCM_ASSERT_TYPE(_cond, _arg, _pos, _subr, _msg)			\
        do { if (SCM_UNLIKELY (!(_cond)))				\
          scm_wrong_type_arg_msg(_subr, _pos, _arg, _msg);  } while (0)
#define SCM_ASRTGO(_cond, _label)		\
        do {  if (SCM_UNLIKELY (!(_cond)))	\
          goto _label; } while (0)
#endif

/*
 * SCM_WTA_DISPATCH
 */

/* Dirk:FIXME:: In all of the SCM_WTA_DISPATCH_* macros it is assumed that
 * 'gf' is zero if uninitialized.  It would be cleaner if some valid SCM value
 * like SCM_BOOL_F or SCM_UNDEFINED was chosen.
 */

SCM_API SCM scm_call_generic_0 (SCM gf);

#define SCM_WTA_DISPATCH_0(gf, subr)			        \
  return (SCM_UNPACK (gf)					\
	  ? scm_call_generic_0 ((gf))				\
	  : (scm_error_num_args_subr ((subr)), SCM_UNSPECIFIED))
#define SCM_GASSERT0(cond, gf, subr)		\
  if (SCM_UNLIKELY(!(cond)))		\
    SCM_WTA_DISPATCH_0((gf), (subr))

SCM_API SCM scm_call_generic_1 (SCM gf, SCM a1);

#define SCM_WTA_DISPATCH_1(gf, a1, pos, subr)			\
  return (SCM_UNPACK (gf)					\
	  ? scm_call_generic_1 ((gf), (a1))			\
	  : (scm_wrong_type_arg ((subr), (pos), (a1)), SCM_UNSPECIFIED))

/* This form is for dispatching a subroutine.  */
#define SCM_WTA_DISPATCH_1_SUBR(subr, a1, pos)				\
  return (SCM_UNPACK ((*SCM_SUBR_GENERIC (subr)))			\
	  ? scm_call_generic_1 ((*SCM_SUBR_GENERIC (subr)), (a1))	\
	  : (scm_i_wrong_type_arg_symbol (SCM_SUBR_NAME (subr), (pos), (a1)), SCM_UNSPECIFIED))

#define SCM_GASSERT1(cond, gf, a1, pos, subr)		\
  if (SCM_UNLIKELY (!(cond)))			\
    SCM_WTA_DISPATCH_1((gf), (a1), (pos), (subr))

SCM_API SCM scm_call_generic_2 (SCM gf, SCM a1, SCM a2);

#define SCM_WTA_DISPATCH_2(gf, a1, a2, pos, subr)			\
  return (SCM_UNPACK (gf)						\
	  ? scm_call_generic_2 ((gf), (a1), (a2))			\
	  : (scm_wrong_type_arg ((subr), (pos),				\
				 (pos) == SCM_ARG1 ? (a1) : (a2)),	\
	     SCM_UNSPECIFIED))
#define SCM_GASSERT2(cond, gf, a1, a2, pos, subr)	\
  if (SCM_UNLIKELY (!(cond)))			\
    SCM_WTA_DISPATCH_2((gf), (a1), (a2), (pos), (subr))

SCM_API SCM scm_apply_generic (SCM gf, SCM args);

#define SCM_WTA_DISPATCH_n(gf, args, pos, subr)				  \
  return (SCM_UNPACK (gf)						  \
	  ? scm_apply_generic ((gf), (args))				  \
	  : (scm_wrong_type_arg ((subr), (pos),				  \
				 scm_list_ref ((args),			  \
					       scm_from_int ((pos) - 1))), \
	     SCM_UNSPECIFIED))
#define SCM_GASSERTn(cond, gf, args, pos, subr)		\
  if (SCM_UNLIKELY (!(cond)))			\
    SCM_WTA_DISPATCH_n((gf), (args), (pos), (subr))

#ifndef SCM_MAGIC_SNARFER
/* Let these macros pass through if
   we are snarfing;  thus we can tell the
   difference between the use of an actual
   number vs. the use of one of these macros --
   actual numbers in SCM_VALIDATE_* and SCM_ASSERT
   constructs must match the formal argument name,
   but using SCM_ARG* avoids the test */

#define SCM_ARGn 		0
#define SCM_ARG1 		1
#define SCM_ARG2 		2
#define SCM_ARG3 		3
#define SCM_ARG4 		4
#define SCM_ARG5 		5
#define SCM_ARG6 		6
#define SCM_ARG7 		7

#endif /* SCM_MAGIC_SNARFER */

/* SCM_EXIT_SUCCESS is the default code to return from SCM if no errors
 * were encountered.  SCM_EXIT_FAILURE is the default code to return from
 * SCM if errors were encountered.  The return code can be explicitly
 * specified in a SCM program with (scm_quit <n>).
 */

#ifndef SCM_EXIT_SUCCESS
#ifdef vms
#define SCM_EXIT_SUCCESS 1
#else
#define SCM_EXIT_SUCCESS 0
#endif /* def vms */
#endif /* ndef SCM_EXIT_SUCCESS */
#ifndef SCM_EXIT_FAILURE
#ifdef vms
#define SCM_EXIT_FAILURE 2
#else
#define SCM_EXIT_FAILURE 1
#endif /* def vms */
#endif /* ndef SCM_EXIT_FAILURE */

/* Define SCM_C_INLINE_KEYWORD so that it can be used as a replacement
   for the "inline" keyword, expanding to nothing when "inline" is not
   available.
*/

#ifdef SCM_C_INLINE
#define SCM_C_INLINE_KEYWORD SCM_C_INLINE
#else
#define SCM_C_INLINE_KEYWORD
#endif

/* Handling thread-local storage (TLS).  */

#ifdef SCM_HAVE_THREAD_STORAGE_CLASS
# define SCM_THREAD_LOCAL __thread
#else
# define SCM_THREAD_LOCAL
#endif

#endif  /* SCM___SCM_H */

/*
  Local Variables:
  c-file-style: "gnu"
  End:
*/

license: mit


code:
/* classes: h_files */

#ifndef SCM__SCM_H
#define SCM__SCM_H

/* Copyright (C) 1995,1996,2000,2001, 2002, 2006, 2008, 2009, 2010 Free Software Foundation, Inc.
 *
 * This library is free software; you can redistribute it and/or
 * modify it under the terms of the GNU Lesser General Public License
 * as published by the Free Software Foundation; either version 3 of
 * 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
 */

/**********************************************************************
 This file is Guile's central private header.

 When included by other files, this file should preceed any include
 other than __scm.h.  See __scm.h for details regarding the purpose of
 and differences between _scm.h and __scm.h.
 **********************************************************************/

#if defined(__ia64) && !defined(__ia64__)
# define __ia64__
#endif

#if HAVE_CONFIG_H
#  include <config.h>
#endif

/* The size of `scm_t_bits'.  */
#define SIZEOF_SCM_T_BITS SIZEOF_VOID_P

/* Undefine HAVE_STRUCT_TIMESPEC, because the libguile C code doesn't
   need it anymore, and because on MinGW:

   - the definition of struct timespec is provided (if at all) by
     pthread.h

   - pthread.h will _not_ define struct timespec if
     HAVE_STRUCT_TIMESPEC is 1, because then it thinks that it doesn't
     need to.

   The libguile C code doesn't need HAVE_STRUCT_TIMESPEC anymore,
   because the value of HAVE_STRUCT_TIMESPEC has already been
   incorporated in how scm_t_timespec is defined (in scmconfig.h), and
   the rest of the libguile C code now just uses scm_t_timespec.
 */
#ifdef HAVE_STRUCT_TIMESPEC
#undef HAVE_STRUCT_TIMESPEC
#endif

#include <errno.h>
#include <verify.h>
#include <alignof.h>
#include "libguile/__scm.h"

/* Include headers for those files central to the implementation.  The
   rest should be explicitly #included in the C files themselves.  */
#include "libguile/error.h"	/* Everyone signals errors.  */
#include "libguile/print.h"	/* Everyone needs to print.  */
#include "libguile/pairs.h"	/* Everyone conses.  */
#include "libguile/list.h"	/* Everyone makes lists.  */
#include "libguile/gc.h"	/* Everyone allocates.  */
#include "libguile/gsubr.h"	/* Everyone defines global functions.  */
#include "libguile/procs.h"	/* Same.  */
#include "libguile/numbers.h"	/* Everyone deals with fixnums.  */
#include "libguile/symbols.h"	/* For length, chars, values, miscellany.  */
#include "libguile/boolean.h"	/* Everyone wonders about the truth.  */
#include "libguile/threads.h"	/* You are not alone. */
#include "libguile/snarf.h"	/* Everyone snarfs. */
#include "libguile/foreign.h"	/* Snarfing needs the foreign data structures. */
#include "libguile/programs.h"	/* ... and program.h. */
#include "libguile/variable.h"
#include "libguile/modules.h"
#include "libguile/inline.h"
#include "libguile/strings.h"

#ifndef SCM_SYSCALL
#ifdef vms
# ifndef __GNUC__
#  include <ssdef.h>
#  define SCM_SYSCALL(line) do{errno = 0;line;} \
	while(EVMSERR==errno && (vaxc$errno>>3)==(SS$_CONTROLC>>3))
# endif /* ndef __GNUC__ */
#endif /* def vms */
#endif /* ndef SCM_SYSCALL  */

#ifndef SCM_SYSCALL
# ifdef EINTR
#  if (EINTR > 0)
#   define SCM_SYSCALL(line) do{errno = 0;line;}while(EINTR==errno)
#  endif /*  (EINTR > 0) */
# endif /* def EINTR */
#endif /* ndef SCM_SYSCALL */

#ifndef SCM_SYSCALL
# define SCM_SYSCALL(line) line;
#endif /* ndef SCM_SYSCALL */

#ifndef min
#define min(A, B) ((A) <= (B) ? (A) : (B))
#endif
#ifndef max
#define max(A, B) ((A) >= (B) ? (A) : (B))
#endif

/* Return the first integer greater than or equal to LEN such that
   LEN % ALIGN == 0.  Return LEN if ALIGN is zero.  */
#define ROUND_UP(len, align)					\
  ((align) ? (((len) - 1UL) | ((align) - 1UL)) + 1UL : (len))

#if GUILE_USE_64_CALLS && defined(HAVE_STAT64)
#define CHOOSE_LARGEFILE(foo,foo64)     foo64
#else
#define CHOOSE_LARGEFILE(foo,foo64)     foo
#endif

/* These names are a bit long, but they make it clear what they represent. */
#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)
#define lstat_or_lstat64                CHOOSE_LARGEFILE(lstat,lstat64)
#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)
#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)
#define scm_from_ino_t_or_ino64_t       CHOOSE_LARGEFILE(scm_from_ulong,scm_from_uint64)
#define scm_from_blkcnt_t_or_blkcnt64_t CHOOSE_LARGEFILE(scm_from_ulong,scm_from_uint64)
#define scm_to_off_t_or_off64_t         CHOOSE_LARGEFILE(scm_to_off_t,scm_to_int64)

#if SIZEOF_OFF_T == 4
#  define scm_to_off_t    scm_to_int32
#  define scm_from_off_t  scm_from_int32
#elif SIZEOF_OFF_T == 8
#  define scm_to_off_t    scm_to_int64
#  define scm_from_off_t  scm_from_int64
#else
#  error sizeof(off_t) is not 4 or 8.
#endif
#define scm_to_off64_t    scm_to_int64
#define scm_from_off64_t  scm_from_int64

/* The endianness marker in objcode.  */
#ifdef WORDS_BIGENDIAN
# define SCM_OBJCODE_ENDIANNESS "BE"
#else
# define SCM_OBJCODE_ENDIANNESS "LE"
#endif

#define _SCM_CPP_STRINGIFY(x)  # x
#define SCM_CPP_STRINGIFY(x)   _SCM_CPP_STRINGIFY (x)

/* The word size marker in objcode.  */
#define SCM_OBJCODE_WORD_SIZE  SCM_CPP_STRINGIFY (SIZEOF_VOID_P)

/* Major and minor versions must be single characters. */
#define SCM_OBJCODE_MAJOR_VERSION 0
#define SCM_OBJCODE_MINOR_VERSION R
#define SCM_OBJCODE_MAJOR_VERSION_STRING        \
  SCM_CPP_STRINGIFY(SCM_OBJCODE_MAJOR_VERSION)
#define SCM_OBJCODE_MINOR_VERSION_STRING        \
  SCM_CPP_STRINGIFY(SCM_OBJCODE_MINOR_VERSION)
#define SCM_OBJCODE_VERSION_STRING                                      \
  SCM_OBJCODE_MAJOR_VERSION_STRING "." SCM_OBJCODE_MINOR_VERSION_STRING
#define SCM_OBJCODE_MACHINE_VERSION_STRING                              \
  SCM_OBJCODE_VERSION_STRING "-" SCM_OBJCODE_ENDIANNESS "-" SCM_OBJCODE_WORD_SIZE

/* The objcode magic header.  */
#define SCM_OBJCODE_COOKIE                              \
  "GOOF-" SCM_OBJCODE_MACHINE_VERSION_STRING "---"

/* Cells have to be 8-byte aligned.  Use `scm_t_aligned_cell' when not
   allocating on the heap to have this guarantee.  This is similar to the
   `SCM_ALIGNED' macro but provides an option likely to work with compilers
   other than GCC.  */

#ifdef __GNUC__

struct scm_aligned_cell
{
  scm_t_cell cell __attribute__ ((__aligned__ (8)));
};

typedef struct scm_aligned_cell scm_t_aligned_cell;

#else /* !__GNUC__ */

union scm_aligned_cell
{
  double alignment;
  scm_t_cell cell;
};

typedef union scm_aligned_cell scm_t_aligned_cell;

#endif /* !__GNUC__ */

/* Make sure we get the right alignment.  */
verify (alignof (scm_t_aligned_cell) >= 8);

#endif  /* SCM__SCM_H */

/*
  Local Variables:
  c-file-style: "gnu"
  End:
*/


code:
/* Copyright (C) 1995, 96, 97, 98, 99, 2000, 2001, 2004, 2006, 2008, 2010 Free Software Foundation, Inc.
 *
 * This library is free software; you can redistribute it and/or
 * modify it under the terms of the GNU Lesser General Public License
 * as published by the Free Software Foundation; either version 3 of
 * 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
 */

#ifdef HAVE_CONFIG_H
# include <config.h>
#endif

#include "libguile/_scm.h"
#include "libguile/eq.h"
#include "libguile/list.h"

#include "libguile/validate.h"
#include "libguile/pairs.h"
#include "libguile/alist.h"

SCM_DEFINE (scm_acons, "acons", 3, 0, 0,
           (SCM key, SCM value, SCM alist),
	    "Add a new key-value pair to @var{alist}.  A new pair is\n"
	    "created whose car is @var{key} and whose cdr is @var{value}, and the\n"
	    "pair is consed onto @var{alist}, and the new list is returned.  This\n"
	    "function is @emph{not} destructive; @var{alist} is not modified.")
#define FUNC_NAME s_scm_acons
{
  return scm_cell (SCM_UNPACK (scm_cell (SCM_UNPACK (key),
					 SCM_UNPACK (value))),
		   SCM_UNPACK (alist));
}
#undef FUNC_NAME

SCM_DEFINE (scm_sloppy_assq, "sloppy-assq", 2, 0, 0,
            (SCM key, SCM alist),
	    "Behaves like @code{assq} but does not do any error checking.\n"
	    "Recommended only for use in Guile internals.")
#define FUNC_NAME s_scm_sloppy_assq
{
  for (; scm_is_pair (alist); alist = SCM_CDR (alist))
    {
      SCM tmp = SCM_CAR (alist);
      if (scm_is_pair (tmp) && scm_is_eq (SCM_CAR (tmp), key))
	return tmp;
    }
  return SCM_BOOL_F;
}
#undef FUNC_NAME

SCM_DEFINE (scm_sloppy_assv, "sloppy-assv", 2, 0, 0,
            (SCM key, SCM alist),
	    "Behaves like @code{assv} but does not do any error checking.\n"
	    "Recommended only for use in Guile internals.")
#define FUNC_NAME s_scm_sloppy_assv
{
  for (; scm_is_pair (alist); alist = SCM_CDR (alist))
    {
      SCM tmp = SCM_CAR (alist);
      if (scm_is_pair (tmp)
	  && scm_is_true (scm_eqv_p (SCM_CAR (tmp), key)))
	return tmp;
    }
  return SCM_BOOL_F;
}
#undef FUNC_NAME

SCM_DEFINE (scm_sloppy_assoc, "sloppy-assoc", 2, 0, 0,
            (SCM key, SCM alist),
	    "Behaves like @code{assoc} but does not do any error checking.\n"
	    "Recommended only for use in Guile internals.")
#define FUNC_NAME s_scm_sloppy_assoc
{
  for (; scm_is_pair (alist); alist = SCM_CDR (alist))
    {
      SCM tmp = SCM_CAR (alist);
      if (scm_is_pair (tmp)
	  && scm_is_true (scm_equal_p (SCM_CAR (tmp), key)))
	return tmp;
    }
  return SCM_BOOL_F;
}
#undef FUNC_NAME

SCM_DEFINE (scm_assq, "assq", 2, 0, 0,
           (SCM key, SCM alist),
	    "@deffnx {Scheme Procedure} assv key alist\n"
	    "@deffnx {Scheme Procedure} assoc key alist\n"
	    "Fetch the entry in @var{alist} that is associated with @var{key}.  To\n"
	    "decide whether the argument @var{key} matches a particular entry in\n"
	    "@var{alist}, @code{assq} compares keys with @code{eq?}, @code{assv}\n"
	    "uses @code{eqv?} and @code{assoc} uses @code{equal?}.  If @var{key}\n"
	    "cannot be found in @var{alist} (according to whichever equality\n"
	    "predicate is in use), then return @code{#f}.  These functions\n"
	    "return the entire alist entry found (i.e. both the key and the value).")
#define FUNC_NAME s_scm_assq
{
  SCM ls = alist;
  for(; scm_is_pair (ls); ls = SCM_CDR (ls))
    {
      SCM tmp = SCM_CAR (ls);
      SCM_ASSERT_TYPE (scm_is_pair (tmp), alist, SCM_ARG2, FUNC_NAME,
		       "association list");
      if (scm_is_eq (SCM_CAR (tmp), key))
	return tmp;
    }
  SCM_ASSERT_TYPE (SCM_NULL_OR_NIL_P (ls), alist, SCM_ARG2, FUNC_NAME,
		   "association list");
  return SCM_BOOL_F;
}
#undef FUNC_NAME

SCM_DEFINE (scm_assv, "assv", 2, 0, 0,
           (SCM key, SCM alist),
	    "Behaves like @code{assq} but uses @code{eqv?} for key comparison.")
#define FUNC_NAME s_scm_assv
{
  SCM ls = alist;
  for(; scm_is_pair (ls); ls = SCM_CDR (ls))
    {
      SCM tmp = SCM_CAR (ls);
      SCM_ASSERT_TYPE (scm_is_pair (tmp), alist, SCM_ARG2, FUNC_NAME,
		       "association list");
      if (scm_is_true (scm_eqv_p (SCM_CAR (tmp), key)))
	return tmp;
    }
  SCM_ASSERT_TYPE (SCM_NULL_OR_NIL_P (ls), alist, SCM_ARG2, FUNC_NAME,
		   "association list");
  return SCM_BOOL_F;
}
#undef FUNC_NAME

SCM_DEFINE (scm_assoc, "assoc", 2, 0, 0,
           (SCM key, SCM alist),
	    "Behaves like @code{assq} but uses @code{equal?} for key comparison.")
#define FUNC_NAME s_scm_assoc
{
  SCM ls = alist;
  for(; scm_is_pair (ls); ls = SCM_CDR (ls))
    {
      SCM tmp = SCM_CAR (ls);
      SCM_ASSERT_TYPE (scm_is_pair (tmp), alist, SCM_ARG2, FUNC_NAME,
		       "association list");
      if (scm_is_true (scm_equal_p (SCM_CAR (tmp), key)))
	return tmp;
    }
  SCM_ASSERT_TYPE (SCM_NULL_OR_NIL_P (ls), alist, SCM_ARG2, FUNC_NAME,
		   "association list");
  return SCM_BOOL_F;
}
#undef FUNC_NAME

/* Dirk:API2.0:: We should not return #f if the key was not found.  In the
 * current solution we can not distinguish between finding a (key . #f) pair
 * and not finding the key at all.
 *
 * Possible alternative solutions:
 * 1) Remove assq-ref from the API:  assq is sufficient.
 * 2) Signal an error (what error type?) if the key is not found.
 * 3) provide an additional 'default' parameter.
 * 3.1) The default parameter is mandatory.
 * 3.2) The default parameter is optional, but if no default is given and
 *      the key is not found, signal an error (what error type?).
 */
SCM_DEFINE (scm_assq_ref, "assq-ref", 2, 0, 0,
            (SCM alist, SCM key),
	    "@deffnx {Scheme Procedure} assv-ref alist key\n"
	    "@deffnx {Scheme Procedure} assoc-ref alist key\n"
	    "Like @code{assq}, @code{assv} and @code{assoc}, except that only the\n"
	    "value associated with @var{key} in @var{alist} is returned.  These\n"
	    "functions are equivalent to\n\n"
	    "@lisp\n"
	    "(let ((ent (@var{associator} @var{key} @var{alist})))\n"
	    "  (and ent (cdr ent)))\n"
	    "@end lisp\n\n"
	    "where @var{associator} is one of @code{assq}, @code{assv} or @code{assoc}.")
#define FUNC_NAME s_scm_assq_ref
{
  SCM handle;

  handle = scm_sloppy_assq (key, alist);
  if (scm_is_pair (handle))
    {
      return SCM_CDR (handle);
    }
  return SCM_BOOL_F;
}
#undef FUNC_NAME

SCM_DEFINE (scm_assv_ref, "assv-ref", 2, 0, 0,
            (SCM alist, SCM key),
	    "Behaves like @code{assq-ref} but uses @code{eqv?} for key comparison.")
#define FUNC_NAME s_scm_assv_ref
{
  SCM handle;

  handle = scm_sloppy_assv (key, alist);
  if (scm_is_pair (handle))
    {
      return SCM_CDR (handle);
    }
  return SCM_BOOL_F;
}
#undef FUNC_NAME

SCM_DEFINE (scm_assoc_ref, "assoc-ref", 2, 0, 0,
            (SCM alist, SCM key),
	    "Behaves like @code{assq-ref} but uses @code{equal?} for key comparison.")
#define FUNC_NAME s_scm_assoc_ref
{
  SCM handle;

  handle = scm_sloppy_assoc (key, alist);
  if (scm_is_pair (handle))
    {
      return SCM_CDR (handle);
    }
  return SCM_BOOL_F;
}
#undef FUNC_NAME

SCM_DEFINE (scm_assq_set_x, "assq-set!", 3, 0, 0,
            (SCM alist, SCM key, SCM val),
	    "@deffnx {Scheme Procedure} assv-set! alist key value\n"
	    "@deffnx {Scheme Procedure} assoc-set! alist key value\n"
	    "Reassociate @var{key} in @var{alist} with @var{value}: find any existing\n"
	    "@var{alist} entry for @var{key} and associate it with the new\n"
	    "@var{value}.  If @var{alist} does not contain an entry for @var{key},\n"
	    "add a new one.  Return the (possibly new) alist.\n\n"
	    "These functions do not attempt to verify the structure of @var{alist},\n"
	    "and so may cause unusual results if passed an object that is not an\n"
	    "association list.")
#define FUNC_NAME s_scm_assq_set_x
{
  SCM handle;

  handle = scm_sloppy_assq (key, alist);
  if (scm_is_pair (handle))
    {
      SCM_SETCDR (handle, val);
      return alist;
    }
  else
    return scm_acons (key, val, alist);
}
#undef FUNC_NAME

SCM_DEFINE (scm_assv_set_x, "assv-set!", 3, 0, 0,
            (SCM alist, SCM key, SCM val),
	    "Behaves like @code{assq-set!} but uses @code{eqv?} for key comparison.")
#define FUNC_NAME s_scm_assv_set_x
{
  SCM handle;

  handle = scm_sloppy_assv (key, alist);
  if (scm_is_pair (handle))
    {
      SCM_SETCDR (handle, val);
      return alist;
    }
  else
    return scm_acons (key, val, alist);
}
#undef FUNC_NAME

SCM_DEFINE (scm_assoc_set_x, "assoc-set!", 3, 0, 0,
            (SCM alist, SCM key, SCM val),
	    "Behaves like @code{assq-set!} but uses @code{equal?} for key comparison.")
#define FUNC_NAME s_scm_assoc_set_x
{
  SCM handle;

  handle = scm_sloppy_assoc (key, alist);
  if (scm_is_pair (handle))
    {
      SCM_SETCDR (handle, val);
      return alist;
    }
  else
    return scm_acons (key, val, alist);
}
#undef FUNC_NAME

SCM_DEFINE (scm_assq_remove_x, "assq-remove!", 2, 0, 0,
            (SCM alist, SCM key),
	    "@deffnx {Scheme Procedure} assv-remove! alist key\n"
	    "@deffnx {Scheme Procedure} assoc-remove! alist key\n"
	    "Delete the first entry in @var{alist} associated with @var{key}, and return\n"
	    "the resulting alist.")
#define FUNC_NAME s_scm_assq_remove_x
{
  SCM handle;

  handle = scm_sloppy_assq (key, alist);
  if (scm_is_pair (handle))
    alist = scm_delq1_x (handle, alist);

  return alist;
}
#undef FUNC_NAME

SCM_DEFINE (scm_assv_remove_x, "assv-remove!", 2, 0, 0,
            (SCM alist, SCM key),
	    "Behaves like @code{assq-remove!} but uses @code{eqv?} for key comparison.")
#define FUNC_NAME s_scm_assv_remove_x
{
  SCM handle;

  handle = scm_sloppy_assv (key, alist);
  if (scm_is_pair (handle))
    alist = scm_delq1_x (handle, alist);

  return alist;
}
#undef FUNC_NAME

SCM_DEFINE (scm_assoc_remove_x, "assoc-remove!", 2, 0, 0,
            (SCM alist, SCM key),
	    "Behaves like @code{assq-remove!} but uses @code{equal?} for key comparison.")
#define FUNC_NAME s_scm_assoc_remove_x
{
  SCM handle;

  handle = scm_sloppy_assoc (key, alist);
  if (scm_is_pair (handle))
    alist = scm_delq1_x (handle, alist);

  return alist;
}
#undef FUNC_NAME

void
scm_init_alist ()
{
#include "libguile/alist.x"
}

/*
  Local Variables:
  c-file-style: "gnu"
  End:
*/


code:
/* classes: h_files */

#ifndef SCM_ALIST_H
#define SCM_ALIST_H

/* 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 License
 * as published by the Free Software Foundation; either version 3 of
 * the License, or (at your option) any later version.
 *
 * This library is distributed in the hope that it will be useful, but
 * WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 * Lesser General Public License for more details.
 *
 * You should have received a copy of the GNU Lesser General Public
 * License along with this library; if not, write to the Free Software
 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
 * 02110-1301 USA
 */

#include "libguile/__scm.h"

SCM_API SCM scm_acons (SCM w, SCM x, SCM y);
SCM_API SCM scm_sloppy_assq (SCM x, SCM alist);
SCM_API SCM scm_sloppy_assv (SCM x, SCM alist);
SCM_API SCM scm_sloppy_assoc (SCM x, SCM alist);
SCM_API SCM scm_assq (SCM x, SCM alist);
SCM_API SCM scm_assv (SCM x, SCM alist);
SCM_API SCM scm_assoc (SCM x, SCM alist);
SCM_API SCM scm_assq_ref (SCM alist, SCM key);
SCM_API SCM scm_assv_ref (SCM alist, SCM key);
SCM_API SCM scm_assoc_ref (SCM alist, SCM key);
SCM_API SCM scm_assq_set_x (SCM alist, SCM key, SCM val);
SCM_API SCM scm_assv_set_x (SCM alist, SCM key, SCM val);
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_INTERNAL void scm_init_alist (void);

#endif  /* SCM_ALIST_H */

/*
  Local Variables:
  c-file-style: "gnu"
  End:
*/


code:
/*	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 License
 * as published by the Free Software Foundation; either version 3 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
 */

#ifdef HAVE_CONFIG_H
# include <config.h>
#endif

#include "libguile/_scm.h"
#include "libguile/ports.h"
#include "libguile/smob.h"

#include "libguile/validate.h"
#include "libguile/arbiters.h"

/* FETCH_STORE sets "fet" to the value fetched from "mem" and then stores
   "sto" there.  The fetch and store are done atomically, so once the fetch
   has been done no other thread or processor can fetch from there before
   the store is done.

   The operands are scm_t_bits, fet and sto are plain variables, mem is a
   memory location (ie. an lvalue).

   ENHANCE-ME: Add more cpu-specifics.  glibc atomicity.h has some of the
   sort of thing required.  FETCH_STORE could become some sort of
   compare-and-store if that better suited what various cpus do.  */

#if defined (__GNUC__) && defined (i386) && SIZEOF_SCM_T_BITS == 4
/* This is for i386 with the normal 32-bit scm_t_bits.  The xchg instruction
   is atomic on a single processor, and it automatically asserts the "lock"
   bus signal so it's atomic on a multi-processor (no need for the lock
   prefix on the instruction).

   The mem operand is read-write but "+" is not used since old gcc
   (eg. 2.7.2) doesn't support that.  "1" for the mem input doesn't work
   (eg. gcc 3.3) when mem is a pointer dereference like current usage below.
   Having mem as a plain input should be ok though.  It tells gcc the value
   is live, but as an "m" gcc won't fetch it itself (though that would be
   harmless).  */

#define FETCH_STORE(fet,mem,sto)                \
  do {                                          \
    asm ("xchg %0, %1"                          \
         : "=r" (fet), "=m" (mem)               \
         : "0"  (sto), "m"  (mem));             \
  } while (0)
#endif

#ifndef FETCH_STORE
/* This is a generic version, with a mutex to ensure the operation is
   atomic.  Unfortunately this approach probably makes arbiters no faster
   than mutexes (though still using less memory of course), so some
   CPU-specifics are highly desirable.  */
#define FETCH_STORE(fet,mem,sto)                        \
  do {                                                  \
    scm_i_scm_pthread_mutex_lock (&scm_i_misc_mutex);   \
    (fet) = (mem);                                      \
    (mem) = (sto);                                      \
    scm_i_pthread_mutex_unlock (&scm_i_misc_mutex);     \
  } while (0)
#endif

static scm_t_bits scm_tc16_arbiter;

#define SCM_LOCK_VAL         (scm_tc16_arbiter | (1L << 16))
#define SCM_UNLOCK_VAL       scm_tc16_arbiter
#define SCM_ARB_LOCKED(arb)  ((SCM_CELL_WORD_0 (arb)) & (1L << 16))

static int
arbiter_print (SCM exp, SCM port, scm_print_state *pstate)
{
  scm_puts ("#<arbiter ", port);
  if (SCM_ARB_LOCKED (exp))
    scm_puts ("locked ", port);
  scm_iprin1 (SCM_PACK (SCM_SMOB_DATA (exp)), port, pstate);
  scm_putc ('>', port);
  return !0;
}

SCM_DEFINE (scm_make_arbiter, "make-arbiter", 1, 0, 0,
	    (SCM name),
	    "Return an arbiter object, initially unlocked.  Currently\n"
	    "@var{name} is only used for diagnostic output.")
#define FUNC_NAME s_scm_make_arbiter
{
  SCM_RETURN_NEWSMOB (scm_tc16_arbiter, SCM_UNPACK (name));
}
#undef FUNC_NAME

/* The atomic FETCH_STORE here is so two threads can't both see the arbiter
   unlocked and return #t.  The arbiter itself wouldn't be corrupted by
   this, but two threads both getting #t would be contrary to the intended
   semantics.  */

SCM_DEFINE (scm_try_arbiter, "try-arbiter", 1, 0, 0,
	    (SCM arb),
	    "If @var{arb} is unlocked, then lock it and return @code{#t}.\n"
	    "If @var{arb} is already locked, then do nothing and return\n"
	    "@code{#f}.")
#define FUNC_NAME s_scm_try_arbiter
{
  scm_t_bits old;
  scm_t_bits *loc;
  SCM_VALIDATE_SMOB (1, arb, arbiter);
  loc = (scm_t_bits*)SCM_SMOB_OBJECT_N_LOC (arb, 0);
  FETCH_STORE (old, *loc, SCM_LOCK_VAL);
  return scm_from_bool (old == SCM_UNLOCK_VAL);
}
#undef FUNC_NAME

/* The atomic FETCH_STORE here is so two threads can't both see the arbiter
   locked and return #t.  The arbiter itself wouldn't be corrupted by this,
   but we don't want two threads both thinking they were the unlocker.  The
   intended usage is for the code which locked to be responsible for
   unlocking, but we guarantee the return value even if multiple threads
   compete.  */

SCM_DEFINE (scm_release_arbiter, "release-arbiter", 1, 0, 0,
	    (SCM arb),
	    "If @var{arb} is locked, then unlock it and return @code{#t}.\n"
	    "If @var{arb} is already unlocked, then do nothing and return\n"
	    "@code{#f}.\n"
	    "\n"
	    "Typical usage is for the thread which locked an arbiter to\n"
	    "later release it, but that's not required, any thread can\n"
	    "release it.")
#define FUNC_NAME s_scm_release_arbiter
{
  scm_t_bits old;
  scm_t_bits *loc;
  SCM_VALIDATE_SMOB (1, arb, arbiter);
  loc = (scm_t_bits*)SCM_SMOB_OBJECT_N_LOC (arb, 0);
  FETCH_STORE (old, *loc, SCM_UNLOCK_VAL);
  return scm_from_bool (old == SCM_LOCK_VAL);
}
#undef FUNC_NAME

void
scm_init_arbiters ()
{
  scm_tc16_arbiter = scm_make_smob_type ("arbiter", 0);
  scm_set_smob_print (scm_tc16_arbiter, arbiter_print);
#include "libguile/arbiters.x"
}

/*
  Local Variables:
  c-file-style: "gnu"
  End:
*/


code:
/* classes: h_files */

#ifndef SCM_ARBITERS_H
#define SCM_ARBITERS_H

/* 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 License
 * as published by the Free Software Foundation; either version 3 of
 * the License, or (at your option) any later version.
 *
 * This library is distributed in the hope that it will be useful, but
 * WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 * Lesser General Public License for more details.
 *
 * You should have received a copy of the GNU Lesser General Public
 * License along with this library; if not, write to the Free Software
 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
 * 02110-1301 USA
 */

#include "libguile/__scm.h"

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_INTERNAL void scm_init_arbiters (void);

#endif  /* SCM_ARBITERS_H */

/*
  Local Variables:
  c-file-style: "gnu"
  End:
*/


code:
/* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003,2004, 2005, 2006, 2009 Free Software Foundation, Inc.
 *
 * This library is free software; you can redistribute it and/or
 * modify it under the terms of the GNU Lesser General Public License
 * as published by the Free Software Foundation; either version 3 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
 */

#ifdef HAVE_CONFIG_H
#  include <config.h>
#endif

#include "libguile/_scm.h"
#include "libguile/__scm.h"

#include "libguile/array-handle.h"

SCM scm_i_array_element_types[SCM_ARRAY_ELEMENT_TYPE_LAST + 1];

#define ARRAY_IMPLS_N_STATIC_ALLOC 7
static scm_t_array_implementation array_impls[ARRAY_IMPLS_N_STATIC_ALLOC];
static int num_array_impls_registered = 0;

void
scm_i_register_array_implementation (scm_t_array_implementation *impl)
{
  if (num_array_impls_registered >= ARRAY_IMPLS_N_STATIC_ALLOC)
    /* need to increase ARRAY_IMPLS_N_STATIC_ALLOC, buster */
    abort ();
  else
    array_impls[num_array_impls_registered++] = *impl;
}

scm_t_array_implementation*
scm_i_array_implementation_for_obj (SCM obj)
{
  int i;
  for (i = 0; i < num_array_impls_registered; i++)
    if (SCM_NIMP (obj)
        && (SCM_CELL_TYPE (obj) & array_impls[i].mask) == array_impls[i].tag)
      return &array_impls[i];
  return NULL;
}

void
scm_array_get_handle (SCM array, scm_t_array_handle *h)
{
  scm_t_array_implementation *impl = scm_i_array_implementation_for_obj (array);
  if (!impl)
    scm_wrong_type_arg_msg (NULL, 0, array, "array");
  h->array = array;
  h->impl = impl;
  h->base = 0;
  h->ndims = 0;
  h->dims = NULL;
  h->element_type = SCM_ARRAY_ELEMENT_TYPE_SCM; /* have to default to
                                                   something... */
  h->elements = NULL;
  h->writable_elements = NULL;
  h->impl->get_handle (array, h);
}

ssize_t
scm_array_handle_pos (scm_t_array_handle *h, SCM indices)
{
  scm_t_array_dim *s = scm_array_handle_dims (h);
  ssize_t pos = 0, i;
  size_t k = scm_array_handle_rank (h);

  while (k > 0 && scm_is_pair (indices))
    {
      i = scm_to_signed_integer (SCM_CAR (indices), s->lbnd, s->ubnd);
      pos += (i - s->lbnd) * s->inc;
      k--;
      s++;
      indices = SCM_CDR (indices);
    }
  if (k > 0 || !scm_is_null (indices))
    scm_misc_error (NULL, "wrong number of indices, expecting ~a",
		    scm_list_1 (scm_from_size_t (scm_array_handle_rank (h))));
  return pos;
}

SCM
scm_array_handle_element_type (scm_t_array_handle *h)
{
  if (h->element_type < 0 || h->element_type > SCM_ARRAY_ELEMENT_TYPE_LAST)
    abort (); /* guile programming error */
  return scm_i_array_element_types[h->element_type];
}

void
scm_array_handle_release (scm_t_array_handle *h)
{
  /* Nothing to do here until arrays need to be reserved for real.
   */
}

const SCM *
scm_array_handle_elements (scm_t_array_handle *h)
{
  if (h->element_type != SCM_ARRAY_ELEMENT_TYPE_SCM)
    scm_wrong_type_arg_msg (NULL, 0, h->array, "non-uniform array");
  return ((const SCM*)h->elements) + h->base;
}

SCM *
scm_array_handle_writable_elements (scm_t_array_handle *h)
{
  if (h->element_type != SCM_ARRAY_ELEMENT_TYPE_SCM)
    scm_wrong_type_arg_msg (NULL, 0, h->array, "non-uniform array");
  return ((SCM*)h->elements) + h->base;
}

void
scm_init_array_handle (void)
{
#define DEFINE_ARRAY_TYPE(tag, TAG)                             \
  scm_i_array_element_types[SCM_ARRAY_ELEMENT_TYPE_##TAG] = scm_from_locale_symbol (#tag)

  scm_i_array_element_types[SCM_ARRAY_ELEMENT_TYPE_SCM] = SCM_BOOL_T;
  DEFINE_ARRAY_TYPE (a, CHAR);
  DEFINE_ARRAY_TYPE (b, BIT);
  DEFINE_ARRAY_TYPE (vu8, VU8);
  DEFINE_ARRAY_TYPE (u8, U8);
  DEFINE_ARRAY_TYPE (s8, S8);
  DEFINE_ARRAY_TYPE (u16, U16);
  DEFINE_ARRAY_TYPE (s16, S16);
  DEFINE_ARRAY_TYPE (u32, U32);
  DEFINE_ARRAY_TYPE (s32, S32);
  DEFINE_ARRAY_TYPE (u64, U64);
  DEFINE_ARRAY_TYPE (s64, S64);
  DEFINE_ARRAY_TYPE (f32, F32);
  DEFINE_ARRAY_TYPE (f64, F64);
  DEFINE_ARRAY_TYPE (c32, C32);
  DEFINE_ARRAY_TYPE (c64, C64);

#include "libguile/array-handle.x"
}

/*
  Local Variables:
  c-file-style: "gnu"
  End:
*/


code:
/* classes: h_files */

#ifndef SCM_ARRAY_HANDLE_H
#define SCM_ARRAY_HANDLE_H

/* Copyright (C) 1995,1996,1997,1999,2000,2001, 2004, 2006, 2008, 2009 Free Software Foundation, Inc.
 *
 * This library is free software; you can redistribute it and/or
 * modify it under the terms of the GNU Lesser General Public License
 * as published by the Free Software Foundation; either version 3 of
 * the License, or (at your option) any later version.
 *
 * This library is distributed in the hope that it will be useful, but
 * WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 * Lesser General Public License for more details.
 *
 * You should have received a copy of the GNU Lesser General Public
 * License along with this library; if not, write to the Free Software
 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
 * 02110-1301 USA
 */

#include "libguile/__scm.h"

struct scm_t_array_handle;

typedef SCM (*scm_i_t_array_ref) (struct scm_t_array_handle *, size_t);
typedef void (*scm_i_t_array_set) (struct scm_t_array_handle *, size_t, SCM);

typedef struct
{
  scm_t_bits tag;
  scm_t_bits mask;
  scm_i_t_array_ref vref;
  scm_i_t_array_set vset;
  void (*get_handle)(SCM, struct scm_t_array_handle*);
} scm_t_array_implementation;

#define SCM_ARRAY_IMPLEMENTATION(tag_,mask_,vref_,vset_,handle_) \
  SCM_SNARF_INIT ({                                                     \
      scm_t_array_implementation impl;                                  \
      impl.tag = tag_; impl.mask = mask_;                               \
      impl.vref = vref_; impl.vset = vset_;                             \
      impl.get_handle = handle_;                                        \
      scm_i_register_array_implementation (&impl);                      \
  })

SCM_INTERNAL void scm_i_register_array_implementation (scm_t_array_implementation *impl);
SCM_INTERNAL scm_t_array_implementation* scm_i_array_implementation_for_obj (SCM obj);

typedef struct scm_t_array_dim
{
  ssize_t lbnd;
  ssize_t ubnd;
  ssize_t inc;
} scm_t_array_dim;

typedef enum {
  SCM_ARRAY_ELEMENT_TYPE_SCM = 0, /* SCM values */
  SCM_ARRAY_ELEMENT_TYPE_CHAR = 1, /* characters */
  SCM_ARRAY_ELEMENT_TYPE_BIT = 2, /* packed numeric values */
  SCM_ARRAY_ELEMENT_TYPE_VU8 = 3,
  SCM_ARRAY_ELEMENT_TYPE_U8 = 4,
  SCM_ARRAY_ELEMENT_TYPE_S8 = 5,
  SCM_ARRAY_ELEMENT_TYPE_U16 = 6,
  SCM_ARRAY_ELEMENT_TYPE_S16 = 7,
  SCM_ARRAY_ELEMENT_TYPE_U32 = 8,
  SCM_ARRAY_ELEMENT_TYPE_S32 = 9,
  SCM_ARRAY_ELEMENT_TYPE_U64 = 10,
  SCM_ARRAY_ELEMENT_TYPE_S64 = 11,
  SCM_ARRAY_ELEMENT_TYPE_F32 = 12,
  SCM_ARRAY_ELEMENT_TYPE_F64 = 13,
  SCM_ARRAY_ELEMENT_TYPE_C32 = 14,
  SCM_ARRAY_ELEMENT_TYPE_C64 = 15,
  SCM_ARRAY_ELEMENT_TYPE_LAST = 15,
} scm_t_array_element_type;

SCM_INTERNAL SCM scm_i_array_element_types[];

typedef struct scm_t_array_handle {
  SCM array;
  scm_t_array_implementation *impl;
  /* `Base' is an offset into elements or writable_elements, corresponding to
     the first element in the array. It would be nicer just to adjust the
     elements/writable_elements pointer, but we can't because that element might
     not even be byte-addressable, as is the case with bitvectors. A nicer
     solution would be, well, nice.
   */
  size_t base;
  size_t ndims; /* ndims == the rank of the array */
  scm_t_array_dim *dims;
  scm_t_array_dim dim0;
  scm_t_array_element_type element_type;
  const void *elements;
  void *writable_elements;
} scm_t_array_handle;

#define scm_array_handle_rank(h) ((h)->ndims)
#define scm_array_handle_dims(h) ((h)->dims)

SCM_API void scm_array_get_handle (SCM array, scm_t_array_handle *h);
SCM_API ssize_t scm_array_handle_pos (scm_t_array_handle *h, SCM indices);
SCM_API SCM scm_array_handle_element_type (scm_t_array_handle *h);
SCM_API void scm_array_handle_release (scm_t_array_handle *h);
SCM_API const SCM* scm_array_handle_elements (scm_t_array_handle *h);
SCM_API SCM* scm_array_handle_writable_elements (scm_t_array_handle *h);

/* See inline.h for scm_array_handle_ref and scm_array_handle_set */

SCM_INTERNAL void scm_init_array_handle (void);

#endif  /* SCM_ARRAY_HANDLE_H */

/*
  Local Variables:
  c-file-style: "gnu"
  End:
*/