AC_LANG_RESTORE
])dnl ACX_PTHREAD
-
+dnl Check whether GNU ld's read-only relocations (the `PT_GNU_RELRO'
+dnl ELF segment header) are supported. This allows things like
+dnl statically allocated cells (1) to eventually be remapped read-only
+dnl by the loader, and (2) to be identified as pointerless by the
+dnl garbage collector.
+AC_DEFUN([GUILE_GNU_LD_RELRO], [
+ AC_MSG_CHECKING([whether the linker understands `-z relro'])
+
+ save_LDFLAGS="$LDFLAGS"
+ LDFLAGS="$LDFLAGS -Wl,-z -Wl,relro"
+ AC_LINK_IFELSE([AC_LANG_PROGRAM([], [])],
+ [AC_MSG_RESULT([yes])],
+ [AC_MSG_RESULT([no])
+ LDFLAGS="$save_LDFLAGS"])
+])
++
+ dnl GUILE_READLINE
+ dnl
+ dnl Check all the things needed by `guile-readline', the Readline
+ dnl bindings.
+ AC_DEFUN([GUILE_READLINE], [
+ for termlib in ncurses curses termcap terminfo termlib ; do
+ AC_CHECK_LIB(${termlib}, [tgoto],
+ [READLINE_LIBS="-l${termlib} $READLINE_LIBS"; break])
+ done
+
+ AC_LIB_LINKFLAGS([readline])
+
+ if test "x$LTLIBREADLINE" = "x"; then
+ AC_MSG_WARN([GNU Readline was not found on your system.])
+ else
+ rl_save_LIBS="$LIBS"
+ LIBS="$LIBREADLINE $READLINE_LIBS $LIBS"
+
+ AC_CHECK_FUNCS([siginterrupt rl_clear_signals rl_cleanup_after_signal])
+
+ dnl Check for modern readline naming
+ AC_CHECK_FUNCS([rl_filename_completion_function])
+
+ dnl Check for rl_get_keymap. We only use this for deciding whether to
+ dnl install paren matching on the Guile command line (when using
+ dnl readline for input), so it's completely optional.
+ AC_CHECK_FUNCS([rl_get_keymap])
+
+ AC_CACHE_CHECK([for rl_getc_function pointer in readline],
+ ac_cv_var_rl_getc_function,
+ [AC_TRY_LINK([
+ #include <stdio.h>
+ #include <readline/readline.h>],
+ [printf ("%ld", (long) rl_getc_function)],
+ [ac_cv_var_rl_getc_function=yes],
+ [ac_cv_var_rl_getc_function=no])])
+ if test "${ac_cv_var_rl_getc_function}" = "yes"; then
+ AC_DEFINE([HAVE_RL_GETC_FUNCTION], 1,
+ [Define if your readline library has the rl_getc_function variable.])
+ fi
+
+ if test $ac_cv_var_rl_getc_function = no; then
+ AC_MSG_WARN([*** GNU Readline is too old on your system.])
+ AC_MSG_WARN([*** You need readline version 2.1 or later.])
+ LTLIBREADLINE=""
+ LIBREADLINE=""
+ fi
+
+ LIBS="$rl_save_LIBS"
+
+ READLINE_LIBS="$LTLIBREADLINE $READLINE_LIBS"
+ fi
+
+ AM_CONDITIONAL([HAVE_READLINE], [test "x$LTLIBREADLINE" != "x"])
+
+ AC_CHECK_FUNCS([strdup])
+
+ AC_SUBST([READLINE_LIBS])
+
+ . $srcdir/guile-readline/LIBGUILEREADLINE-VERSION
+ AC_SUBST(LIBGUILEREADLINE_MAJOR)
+ AC_SUBST(LIBGUILEREADLINE_INTERFACE_CURRENT)
+ AC_SUBST(LIBGUILEREADLINE_INTERFACE_REVISION)
+ AC_SUBST(LIBGUILEREADLINE_INTERFACE_AGE)
+ AC_SUBST(LIBGUILEREADLINE_INTERFACE)
+ ])
#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
+ * 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_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
\f
/* {Supported Options}
#include "libguile/variable.h"
#include "libguile/modules.h"
#include "libguile/inline.h"
+#include "libguile/strings.h"
- /* SCM_SYSCALL retries system calls that have been interrupted (EINTR).
- However this can be avoided if the operating system can restart
- system calls automatically. We assume this is the case if
- sigaction is available and SA_RESTART is defined; they will be used
- when installing signal handlers.
- */
-
- #ifdef HAVE_RESTARTABLE_SYSCALLS
- #if ! SCM_USE_PTHREAD_THREADS /* However, don't assume SA_RESTART
- works with pthreads... */
- #define SCM_SYSCALL(line) line
- #endif
- #endif
-
#ifndef SCM_SYSCALL
#ifdef vms
# ifndef __GNUC__
}
}
- static SCM
- macroexp (SCM x, SCM env)
- {
- SCM res, proc, orig_sym;
-
- /* Don't bother to produce error messages here. We get them when we
- eventually execute the code for real. */
-
- macro_tail:
- orig_sym = SCM_CAR (x);
- if (!scm_is_symbol (orig_sym))
- return x;
-
- {
- SCM *proc_ptr = scm_lookupcar1 (x, env, 0);
- if (proc_ptr == NULL)
- {
- /* We have lost the race. */
- goto macro_tail;
- }
- proc = *proc_ptr;
- }
-
- /* Only handle memoizing macros. `Acros' and `macros' are really
- special forms and should not be evaluated here. */
-
- if (!SCM_MACROP (proc)
- || (SCM_MACRO_TYPE (proc) != 2 && !SCM_BUILTIN_MACRO_P (proc)))
- return x;
-
- SCM_SETCAR (x, orig_sym); /* Undo memoizing effect of lookupcar */
- res = scm_call_2 (SCM_MACRO_CODE (proc), x, env);
-
- if (scm_ilength (res) <= 0)
- /* Result of expansion is not a list. */
- return (scm_list_2 (SCM_IM_BEGIN, res));
- else
- {
- /* njrev: Several queries here: (1) I don't see how it can be
- correct that the SCM_SETCAR 2 lines below this comment needs
- protection, but the SCM_SETCAR 6 lines above does not, so
- something here is probably wrong. (2) macroexp() is now only
- used in one place - scm_m_generalized_set_x - whereas all other
- macro expansion happens through expand_user_macros. Therefore
- (2.1) perhaps macroexp() could be eliminated completely now?
- (2.2) Does expand_user_macros need any critical section
- protection? */
-
- SCM_CRITICAL_SECTION_START;
- SCM_SETCAR (x, SCM_CAR (res));
- SCM_SETCDR (x, SCM_CDR (res));
- SCM_CRITICAL_SECTION_END;
-
- goto macro_tail;
- }
- }
-
- /* Start of the memoizers for the standard R5RS builtin macros. */
-
-
SCM_SYNTAX (s_and, "and", scm_i_makbimacro, scm_m_and);
--SCM_GLOBAL_SYMBOL (scm_sym_and, s_and);
++SCM_GLOBAL_SYMBOL (scm_sym_and, "and");
- SCM
+ static SCM
scm_m_and (SCM expr, SCM env SCM_UNUSED)
{
const SCM cdr_expr = SCM_CDR (expr);
SCM_SYNTAX (s_begin, "begin", scm_i_makbimacro, scm_m_begin);
--SCM_GLOBAL_SYMBOL (scm_sym_begin, s_begin);
++SCM_GLOBAL_SYMBOL (scm_sym_begin, "begin");
- SCM
+ static SCM
scm_m_begin (SCM expr, SCM env SCM_UNUSED)
{
const SCM cdr_expr = SCM_CDR (expr);
SCM_SYNTAX (s_case, "case", scm_i_makbimacro, scm_m_case);
--SCM_GLOBAL_SYMBOL (scm_sym_case, s_case);
++SCM_GLOBAL_SYMBOL (scm_sym_case, "case");
SCM_GLOBAL_SYMBOL (scm_sym_else, "else");
- SCM
+ static SCM
scm_m_case (SCM expr, SCM env)
{
SCM clauses;
SCM_SYNTAX (s_cond, "cond", scm_i_makbimacro, scm_m_cond);
--SCM_GLOBAL_SYMBOL (scm_sym_cond, s_cond);
++SCM_GLOBAL_SYMBOL (scm_sym_cond, "cond");
SCM_GLOBAL_SYMBOL (scm_sym_arrow, "=>");
- SCM
+ static SCM
scm_m_cond (SCM expr, SCM env)
{
/* Check, whether 'else or '=> is a literal, i. e. not bound to a value. */
SCM_SYNTAX (s_define, "define", scm_i_makbimacro, scm_m_define);
--SCM_GLOBAL_SYMBOL (scm_sym_define, s_define);
++SCM_GLOBAL_SYMBOL (scm_sym_define, "define");
/* Guile provides an extension to R5RS' define syntax to represent function
* currying in a compact way. With this extension, it is allowed to write
SCM_SYNTAX (s_delay, "delay", scm_i_makbimacro, scm_m_delay);
--SCM_GLOBAL_SYMBOL (scm_sym_delay, s_delay);
++SCM_GLOBAL_SYMBOL (scm_sym_delay, "delay");
/* Promises are implemented as closures with an empty parameter list. Thus,
* (delay <expression>) is transformed into (#@delay '() <expression>), where
SCM_SYNTAX(s_do, "do", scm_i_makbimacro, scm_m_do);
--SCM_GLOBAL_SYMBOL(scm_sym_do, s_do);
++SCM_GLOBAL_SYMBOL(scm_sym_do, "do");
/* DO gets the most radically altered syntax. The order of the vars is
* reversed here. During the evaluation this allows for simple consing of the
SCM_SYNTAX (s_if, "if", scm_i_makbimacro, scm_m_if);
--SCM_GLOBAL_SYMBOL (scm_sym_if, s_if);
++SCM_GLOBAL_SYMBOL (scm_sym_if, "if");
- SCM
+ static SCM
scm_m_if (SCM expr, SCM env SCM_UNUSED)
{
const SCM cdr_expr = SCM_CDR (expr);
SCM_SYNTAX (s_lambda, "lambda", scm_i_makbimacro, scm_m_lambda);
--SCM_GLOBAL_SYMBOL (scm_sym_lambda, s_lambda);
++SCM_GLOBAL_SYMBOL (scm_sym_lambda, "lambda");
/* A helper function for memoize_lambda to support checking for duplicate
* formal arguments: Return true if OBJ is `eq?' to one of the elements of
SCM_SYNTAX(s_let, "let", scm_i_makbimacro, scm_m_let);
--SCM_GLOBAL_SYMBOL(scm_sym_let, s_let);
++SCM_GLOBAL_SYMBOL(scm_sym_let, "let");
/* This function is a helper function for memoize_let. It transforms
* (let name ((var init) ...) body ...) into
SCM_SYNTAX(s_letrec, "letrec", scm_i_makbimacro, scm_m_letrec);
--SCM_GLOBAL_SYMBOL(scm_sym_letrec, s_letrec);
++SCM_GLOBAL_SYMBOL(scm_sym_letrec, "letrec");
- SCM
+ static SCM
scm_m_letrec (SCM expr, SCM env)
{
SCM bindings;
SCM_SYNTAX (s_letstar, "let*", scm_i_makbimacro, scm_m_letstar);
--SCM_GLOBAL_SYMBOL (scm_sym_letstar, s_letstar);
++SCM_GLOBAL_SYMBOL (scm_sym_letstar, "let*");
/* (let* ((v1 i1) (v2 i2) ...) body) with variables v1 .. vn and initializers
* i1 .. in is transformed into the form (#@let* (v1 i1 v2 i2 ...) body). */
SCM_SYNTAX (s_or, "or", scm_i_makbimacro, scm_m_or);
--SCM_GLOBAL_SYMBOL (scm_sym_or, s_or);
++SCM_GLOBAL_SYMBOL (scm_sym_or, "or");
- SCM
+ static SCM
scm_m_or (SCM expr, SCM env SCM_UNUSED)
{
const SCM cdr_expr = SCM_CDR (expr);
SCM_SYNTAX (s_quasiquote, "quasiquote", scm_makacro, scm_m_quasiquote);
--SCM_GLOBAL_SYMBOL (scm_sym_quasiquote, s_quasiquote);
++SCM_GLOBAL_SYMBOL (scm_sym_quasiquote, "quasiquote");
SCM_GLOBAL_SYMBOL (scm_sym_unquote, "unquote");
SCM_GLOBAL_SYMBOL (scm_sym_uq_splicing, "unquote-splicing");
SCM_SYNTAX (s_quote, "quote", scm_i_makbimacro, scm_m_quote);
--SCM_GLOBAL_SYMBOL (scm_sym_quote, s_quote);
++SCM_GLOBAL_SYMBOL (scm_sym_quote, "quote");
- SCM
+ static SCM
scm_m_quote (SCM expr, SCM env SCM_UNUSED)
{
SCM quotee;
/* Will go into the RnRS module when Guile is factorized.
SCM_SYNTAX (s_set_x, "set!", scm_i_makbimacro, scm_m_set_x); */
--static const char s_set_x[] = "set!";
--SCM_GLOBAL_SYMBOL (scm_sym_set_x, s_set_x);
++SCM_GLOBAL_SYMBOL (scm_sym_set_x, "set!");
- SCM
+ static SCM
scm_m_set_x (SCM expr, SCM env SCM_UNUSED)
{
SCM variable;
/* Start of the memoizers for non-R5RS builtin macros. */
-SCM_GLOBAL_SYMBOL (scm_sym_at, s_at);
+ SCM_SYNTAX (s_at, "@", scm_makmmacro, scm_m_at);
-SCM_GLOBAL_SYMBOL (scm_sym_atat, s_atat);
++SCM_GLOBAL_SYMBOL (scm_sym_at, "@");
+
+ static SCM
+ scm_m_at (SCM expr, SCM env SCM_UNUSED)
+ {
+ SCM mod, var;
+ ASSERT_SYNTAX (scm_ilength (expr) == 3, s_bad_expression, expr);
+ ASSERT_SYNTAX (scm_ilength (scm_cadr (expr)) > 0, s_bad_expression, expr);
+ ASSERT_SYNTAX (scm_is_symbol (scm_caddr (expr)), s_bad_expression, expr);
+
+ mod = scm_resolve_module (scm_cadr (expr));
+ if (scm_is_false (mod))
+ error_unbound_variable (expr);
+ var = scm_module_variable (scm_module_public_interface (mod), scm_caddr (expr));
+ if (scm_is_false (var))
+ error_unbound_variable (expr);
+
+ return var;
+ }
+
+ SCM_SYNTAX (s_atat, "@@", scm_makmmacro, scm_m_atat);
++SCM_GLOBAL_SYMBOL (scm_sym_atat, "@@");
+
+ static SCM
+ scm_m_atat (SCM expr, SCM env SCM_UNUSED)
+ {
+ SCM mod, var;
+ ASSERT_SYNTAX (scm_ilength (expr) == 3, s_bad_expression, expr);
+ ASSERT_SYNTAX (scm_ilength (scm_cadr (expr)) > 0, s_bad_expression, expr);
+ ASSERT_SYNTAX (scm_is_symbol (scm_caddr (expr)), s_bad_expression, expr);
+
+ mod = scm_resolve_module (scm_cadr (expr));
+ if (scm_is_false (mod))
+ error_unbound_variable (expr);
+ var = scm_module_variable (mod, scm_caddr (expr));
+ if (scm_is_false (var))
+ error_unbound_variable (expr);
+
+ return var;
+ }
+
SCM_SYNTAX (s_atapply, "@apply", scm_i_makbimacro, scm_m_apply);
--SCM_GLOBAL_SYMBOL (scm_sym_atapply, s_atapply);
--SCM_GLOBAL_SYMBOL (scm_sym_apply, s_atapply + 1);
++SCM_GLOBAL_SYMBOL (scm_sym_atapply, "@apply");
++SCM_GLOBAL_SYMBOL (scm_sym_apply, "apply");
- SCM
+ static SCM
scm_m_apply (SCM expr, SCM env SCM_UNUSED)
{
const SCM cdr_expr = SCM_CDR (expr);
SCM_SYNTAX(s_atcall_cc, "@call-with-current-continuation", scm_i_makbimacro, scm_m_cont);
--SCM_GLOBAL_SYMBOL(scm_sym_atcall_cc, s_atcall_cc);
++SCM_GLOBAL_SYMBOL(scm_sym_atcall_cc, "@call-with-current-continuation");
- SCM
+ static SCM
scm_m_cont (SCM expr, SCM env SCM_UNUSED)
{
const SCM cdr_expr = SCM_CDR (expr);
SCM_SYNTAX (s_at_call_with_values, "@call-with-values", scm_i_makbimacro, scm_m_at_call_with_values);
--SCM_GLOBAL_SYMBOL(scm_sym_at_call_with_values, s_at_call_with_values);
++SCM_GLOBAL_SYMBOL(scm_sym_at_call_with_values, "@call-with-values");
- SCM
+ static SCM
scm_m_at_call_with_values (SCM expr, SCM env SCM_UNUSED)
{
const SCM cdr_expr = SCM_CDR (expr);
unmemoize_exprs (SCM_CDR (expr), env));
}
-SCM_GLOBAL_SYMBOL (scm_sym_eval_when, s_eval_when);
+ SCM_SYNTAX (s_eval_when, "eval-when", scm_makmmacro, scm_m_eval_when);
++SCM_GLOBAL_SYMBOL (scm_sym_eval_when, "eval-when");
+ SCM_SYMBOL (sym_eval, "eval");
+ SCM_SYMBOL (sym_load, "load");
+
+
+ static SCM
+ scm_m_eval_when (SCM expr, SCM env SCM_UNUSED)
+ {
+ ASSERT_SYNTAX (scm_ilength (expr) >= 3, s_bad_expression, expr);
+ ASSERT_SYNTAX (scm_ilength (scm_cadr (expr)) > 0, s_bad_expression, expr);
+
+ if (scm_is_true (scm_memq (sym_eval, scm_cadr (expr)))
+ || scm_is_true (scm_memq (sym_load, scm_cadr (expr))))
+ return scm_cons (SCM_IM_BEGIN, scm_cddr (expr));
+
+ return scm_list_1 (SCM_IM_BEGIN);
+ }
+
#if 0
/* See futures.h for a comment why futures are not enabled.
*/
SCM_SYNTAX (s_future, "future", scm_i_makbimacro, scm_m_future);
--SCM_GLOBAL_SYMBOL (scm_sym_future, s_future);
++SCM_GLOBAL_SYMBOL (scm_sym_future, "future");
/* Like promises, futures are implemented as closures with an empty
* parameter list. Thus, (future <expression>) is transformed into
#!/bin/sh
# Extract the initialization actions from source files.
#
-# Copyright (C) 1996, 97, 98, 99, 2000, 2001, 2002, 2004, 2006, 2008 Free Software Foundation, Inc.
+# Copyright (C) 1996, 97, 98, 99, 2000, 2001, 2002, 2004, 2006, 2008, 2009 Free Software Foundation, Inc.
#
# This program is free software; you can redistribute it and/or modify
- # it under the terms of the GNU General Public License as published by
- # the Free Software Foundation; either version 2, or (at your option)
- # any later version.
- #
- # This program is distributed in the hope that it will be useful,
- # but WITHOUT ANY WARRANTY; without even the implied warranty of
- # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- # GNU General Public License for more details.
- #
- # You should have received a copy of the GNU General Public License
- # along with this software; see the file COPYING. If not, write to
- # the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
- # Boston, MA 02110-1301 USA
+ # 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.
+ #
+ # This program is distributed in the hope that it will be useful, but
+ # WITHOUT ANY WARRANTY; without even the implied warranty of
+ # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ # Lesser General Public License for more details.
+ #
+ # You should have received a copy of the GNU Lesser General Public
+ # License along with this software; see the file COPYING.LESSER. If
+ # not, write to the Free Software Foundation, Inc., 51 Franklin
+ # Street, Fifth Floor, Boston, MA 02110-1301 USA
# Commentary:
#ifndef SCM_SNARF_H
#define SCM_SNARF_H
-/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2004, 2006 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2004, 2006, 2009 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * 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
+ * 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.
*
SCM_SNARF_HERE(SCM c_name arglist) \
SCM_SNARF_INIT(scm_set_smob_apply((tag), (c_name), (req), (opt), (rest));)
- #define SCM_IMMUTABLE_STRINGBUF(c_name, contents) \
- SCM_IMMUTABLE_DOUBLE_CELL (c_name, \
- scm_tc7_stringbuf | SCM_I_STRINGBUF_F_SHARED, \
- (scm_t_bits) (contents), \
- (scm_t_bits) sizeof (contents) - 1, \
- (scm_t_bits) 0)
+\f
+/* Low-level snarfing for static memory allocation. */
+
+#ifdef SCM_SUPPORT_STATIC_ALLOCATION
+
+#define SCM_IMMUTABLE_DOUBLE_CELL(c_name, car, cbr, ccr, cdr) \
+ static SCM_ALIGNED (8) SCM_UNUSED const scm_t_cell \
+ c_name ## _raw_cell [2] = \
+ { \
+ { SCM_PACK (car), SCM_PACK (cbr) }, \
+ { SCM_PACK (ccr), SCM_PACK (cdr) } \
+ }; \
+ static SCM_UNUSED const SCM c_name = SCM_PACK (& c_name ## _raw_cell)
+
- _stringbuf_raw_cell), \
++#define SCM_IMMUTABLE_STRINGBUF(c_name, contents) \
++ static SCM_UNUSED const \
++ struct \
++ { \
++ scm_t_bits word_0; \
++ scm_t_bits word_1; \
++ const char buffer[sizeof (contents)]; \
++ } \
++ c_name = \
++ { \
++ scm_tc7_stringbuf | SCM_I_STRINGBUF_F_SHARED, \
++ sizeof (contents) - 1, \
++ contents \
++ }
+
+#define SCM_IMMUTABLE_STRING(c_name, contents) \
+ SCM_IMMUTABLE_STRINGBUF (scm_i_paste (c_name, _stringbuf), contents); \
+ SCM_IMMUTABLE_DOUBLE_CELL (c_name, \
+ scm_tc7_ro_string, \
+ (scm_t_bits) &scm_i_paste (c_name, \
++ _stringbuf), \
+ (scm_t_bits) 0, \
+ (scm_t_bits) sizeof (contents) - 1)
+
+#define SCM_IMMUTABLE_SUBR(c_name, name, req, opt, rest, fcn) \
+ static SCM_UNUSED SCM scm_i_paste (c_name, _meta_info)[2] = \
+ { \
+ SCM_BOOL_F, /* The name, initialized at run-time. */ \
+ SCM_EOL /* The procedure properties. */ \
+ }; \
+ SCM_IMMUTABLE_DOUBLE_CELL (c_name, \
+ SCM_SUBR_ARITY_TO_TYPE (req, opt, rest), \
+ (scm_t_bits) fcn, \
+ (scm_t_bits) 0 /* no generic */, \
+ (scm_t_bits) & scm_i_paste (c_name, _meta_info));
+
+#endif /* SCM_SUPPORT_STATIC_ALLOCATION */
+
+\f
+/* Documentation. */
#ifdef SCM_MAGIC_SNARF_DOCS
#undef SCM_ASSERT
* cow-strings, but it failed randomly with more than 10 threads, say.
* I couldn't figure out what went wrong, so I used the conservative
* approach implemented below.
- *
- * A stringbuf needs to know its length, but only so that it can be
- * reported when the stringbuf is freed.
*
- * Stringbufs (and strings) are not stored very compactly: a stringbuf
- * has room for about 2*sizeof(scm_t_bits)-1 bytes additional
- * information. As a compensation, the code below is made more
- * complicated by storing small strings inline in the double cell of a
- * stringbuf. So we have fixstrings and bigstrings...
+ * There are 2 storage strategies for stringbufs: 8-bit and wide. 8-bit
+ * strings are ISO-8859-1-encoded strings; wide strings are 32-bit (UCS-4)
+ * strings.
*/
-#define STRINGBUF_F_SHARED 0x100
-#define STRINGBUF_F_WIDE 0x400 /* If true, strings have UCS-4
- encoding. Otherwise, strings
- are Latin-1. */
+ /* The size in words of the stringbuf header (type tag + size). */
+ #define STRINGBUF_HEADER_SIZE 2U
+
+ #define STRINGBUF_HEADER_BYTES (STRINGBUF_HEADER_SIZE * sizeof (SCM))
+
- #define STRINGBUF_F_INLINE SCM_I_STRINGBUF_F_INLINE
+#define STRINGBUF_F_SHARED SCM_I_STRINGBUF_F_SHARED
++#define STRINGBUF_F_WIDE SCM_I_STRINGBUF_F_WIDE
#define STRINGBUF_TAG scm_tc7_stringbuf
#define STRINGBUF_SHARED(buf) (SCM_CELL_WORD_0(buf) & STRINGBUF_F_SHARED)
- #define STRINGBUF_INLINE(buf) (SCM_CELL_WORD_0(buf) & STRINGBUF_F_INLINE)
-
- #define STRINGBUF_OUTLINE_CHARS(buf) ((char *)SCM_CELL_WORD_1(buf))
- #define STRINGBUF_OUTLINE_LENGTH(buf) (SCM_CELL_WORD_2(buf))
- #define STRINGBUF_INLINE_CHARS(buf) ((char *)SCM_CELL_OBJECT_LOC(buf,1))
- #define STRINGBUF_INLINE_LENGTH(buf) (((size_t)SCM_CELL_WORD_0(buf))>>16)
+ #define STRINGBUF_WIDE(buf) (SCM_CELL_WORD_0(buf) & STRINGBUF_F_WIDE)
- #define STRINGBUF_CHARS(buf) (STRINGBUF_INLINE (buf) \
- ? STRINGBUF_INLINE_CHARS (buf) \
- : STRINGBUF_OUTLINE_CHARS (buf))
- #define STRINGBUF_LENGTH(buf) (STRINGBUF_INLINE (buf) \
- ? STRINGBUF_INLINE_LENGTH (buf) \
- : STRINGBUF_OUTLINE_LENGTH (buf))
+ #define STRINGBUF_CHARS(buf) ((unsigned char *) \
+ SCM_CELL_OBJECT_LOC (buf, \
+ STRINGBUF_HEADER_SIZE))
+ #define STRINGBUF_LENGTH(buf) (SCM_CELL_WORD_1 (buf))
- #define STRINGBUF_MAX_INLINE_LEN (3*sizeof(scm_t_bits))
+ #define STRINGBUF_WIDE_CHARS(buf) ((scm_t_wchar *) STRINGBUF_CHARS (buf))
-#define SET_STRINGBUF_SHARED(buf) \
- (SCM_SET_CELL_WORD_0 ((buf), SCM_CELL_WORD_0 (buf) | STRINGBUF_F_SHARED))
+#define SET_STRINGBUF_SHARED(buf) \
+ do \
+ { \
+ /* Don't modify BUF if it's already marked as shared since it might be \
+ a read-only, statically allocated stringbuf. */ \
+ if (SCM_LIKELY (!STRINGBUF_SHARED (buf))) \
+ SCM_SET_CELL_WORD_0 ((buf), SCM_CELL_WORD_0 (buf) | STRINGBUF_F_SHARED); \
+ } \
+ while (0)
- #if SCM_DEBUG
+ #if SCM_STRING_LENGTH_HISTOGRAM
static size_t lenhist[1001];
#endif
SCM_API SCM scm_makfromstrs (int argc, char **argv);
- /* Flags for shared and inline strings. */
+\f
+/* internal constants */
+
+/* Type tag for read-only strings. */
+#define scm_tc7_ro_string (scm_tc7_string + 0x200)
+
- #define SCM_I_STRINGBUF_F_INLINE 0x200
++/* Flags for shared and wide strings. */
+#define SCM_I_STRINGBUF_F_SHARED 0x100
++#define SCM_I_STRINGBUF_F_WIDE 0x400
+
+
/* internal accessor functions. Arguments must be valid. */
SCM_INTERNAL SCM scm_i_make_string (size_t len, char **datap);
-/* Copyright (C) 1995,1996,1998,2000,2001, 2003, 2006, 2008 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1998,2000,2001, 2003, 2006, 2008, 2009 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * 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
+ * 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.
*
HCoop / bpt / guile.git / commitdiff