From: Ludovic Courtès Date: Tue, 1 Sep 2009 22:07:27 +0000 (+0200) Subject: Merge branch 'boehm-demers-weiser-gc' into bdw-gc-static-alloc X-Git-Url: http://git.hcoop.net/bpt/guile.git/commitdiff_plain/5f236208d0d864546e59afa0f5a11c9b3ba14b10 Merge branch 'boehm-demers-weiser-gc' into bdw-gc-static-alloc Conflicts: acinclude.m4 libguile/strings.c --- 5f236208d0d864546e59afa0f5a11c9b3ba14b10 diff --cc acinclude.m4 index 3e1dbeb2a,5629263b7..680003309 --- a/acinclude.m4 +++ b/acinclude.m4 @@@ -311,19 -311,69 +311,85 @@@ f 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 + #include ], + [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) + ]) diff --cc libguile/__scm.h index a9f05ba46,791150d46..32b52df51 --- a/libguile/__scm.h +++ b/libguile/__scm.h @@@ -98,24 -99,11 +99,21 @@@ #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 /* {Supported Options} diff --cc libguile/_scm.h index ff033ded0,8a9a21161..9907adf24 --- a/libguile/_scm.h +++ b/libguile/_scm.h @@@ -77,22 -79,7 +79,8 @@@ #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__ diff --cc libguile/eval.c index 18cd3b11f,59db42976..e58c05410 --- a/libguile/eval.c +++ b/libguile/eval.c @@@ -826,70 -927,10 +927,10 @@@ m_expand_body (const SCM forms, const S } } - 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); @@@ -917,9 -958,9 +958,9 @@@ unmemoize_and (const SCM expr, const SC 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); @@@ -940,10 -981,10 +981,10 @@@ unmemoize_begin (const SCM expr, const 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; @@@ -1036,10 -1077,10 +1077,10 @@@ unmemoize_case (const SCM expr, const S 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. */ @@@ -1139,7 -1180,7 +1180,7 @@@ unmemoize_cond (const SCM expr, const S 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 @@@ -1250,7 -1291,7 +1291,7 @@@ memoize_as_thunk_prototype (const SCM e 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 ) is transformed into (#@delay '() ), where @@@ -1279,7 -1320,7 +1320,7 @@@ unmemoize_delay (const SCM expr, const 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 @@@ -1395,9 -1436,9 +1436,9 @@@ unmemoize_do (const SCM expr, const SC 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); @@@ -1429,7 -1470,7 +1470,7 @@@ unmemoize_if (const SCM expr, const SC 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 @@@ -1577,7 -1618,7 +1618,7 @@@ transform_bindings 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 @@@ -1689,9 -1730,9 +1730,9 @@@ unmemoize_let (const SCM expr, const SC 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; @@@ -1738,7 -1779,7 +1779,7 @@@ unmemoize_letrec (const SCM expr, cons 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). */ @@@ -1813,9 -1854,9 +1854,9 @@@ unmemoize_letstar (const SCM expr, cons 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); @@@ -1843,7 -1884,7 +1884,7 @@@ unmemoize_or (const SCM expr, const SC 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"); @@@ -1910,9 -1951,9 +1951,9 @@@ scm_m_quasiquote (SCM expr, SCM env 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; @@@ -1938,10 -1979,10 +1979,9 @@@ unmemoize_quote (const SCM expr, const /* 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; @@@ -1974,11 -2016,53 +2015,53 @@@ unmemoize_set_x (const SCM expr, const /* Start of the memoizers for non-R5RS builtin macros. */ + SCM_SYNTAX (s_at, "@", scm_makmmacro, scm_m_at); -SCM_GLOBAL_SYMBOL (scm_sym_at, s_at); ++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, s_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); @@@ -2052,9 -2136,9 +2135,9 @@@ scm_m_atbind (SCM expr, SCM env 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); @@@ -2073,9 -2157,9 +2156,9 @@@ unmemoize_atcall_cc (const SCM expr, co 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); @@@ -2093,13 -2177,32 +2176,32 @@@ unmemoize_at_call_with_values (const SC unmemoize_exprs (SCM_CDR (expr), env)); } + SCM_SYNTAX (s_eval_when, "eval-when", scm_makmmacro, scm_m_eval_when); -SCM_GLOBAL_SYMBOL (scm_sym_eval_when, s_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 ) is transformed into diff --cc libguile/guile-snarf.in index 4d79f43bf,6a72dd5d5..043b3ed0d --- a/libguile/guile-snarf.in +++ b/libguile/guile-snarf.in @@@ -1,22 -1,22 +1,22 @@@ #!/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: diff --cc libguile/snarf.h index c3113e1a7,03a3edd47..9eaccf60c --- a/libguile/snarf.h +++ b/libguile/snarf.h @@@ -3,15 -3,15 +3,15 @@@ #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. * @@@ -331,52 -270,6 +332,60 @@@ SCM_SNARF_INIT(scm_set_smob_apply((tag) SCM_SNARF_HERE(SCM c_name arglist) \ SCM_SNARF_INIT(scm_set_smob_apply((tag), (c_name), (req), (opt), (rest));) + +/* 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) + - #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) ++#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_raw_cell), \ ++ _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 */ + + +/* Documentation. */ #ifdef SCM_MAGIC_SNARF_DOCS #undef SCM_ASSERT diff --cc libguile/strings.c index 1839c6ac0,519998167..03ead8138 --- a/libguile/strings.c +++ b/libguile/strings.c @@@ -54,49 -61,37 +61,42 @@@ * 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. */ + /* 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_SHARED 0x100 -#define STRINGBUF_F_WIDE 0x400 /* If true, strings have UCS-4 - encoding. Otherwise, strings - are Latin-1. */ +#define STRINGBUF_F_SHARED SCM_I_STRINGBUF_F_SHARED - #define STRINGBUF_F_INLINE SCM_I_STRINGBUF_F_INLINE ++#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 diff --cc libguile/strings.h index 2dabde1d6,fff7c97bd..910d51ee6 --- a/libguile/strings.h +++ b/libguile/strings.h @@@ -109,17 -138,6 +138,17 @@@ SCM_API size_t scm_to_locale_stringbuf SCM_API SCM scm_makfromstrs (int argc, char **argv); + +/* internal constants */ + +/* Type tag for read-only strings. */ +#define scm_tc7_ro_string (scm_tc7_string + 0x200) + - /* Flags for shared and inline strings. */ ++/* Flags for shared and wide strings. */ +#define SCM_I_STRINGBUF_F_SHARED 0x100 - #define SCM_I_STRINGBUF_F_INLINE 0x200 ++#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); diff --cc libguile/weaks.c index 6af4d6722,92fb305cc..4719980a7 --- a/libguile/weaks.c +++ b/libguile/weaks.c @@@ -1,12 -1,12 +1,12 @@@ -/* 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. *