diff options
-rw-r--r-- | .gitignore | 1 | ||||
-rw-r--r-- | acinclude.m4 | 19 | ||||
-rw-r--r-- | configure.in | 6 | ||||
-rw-r--r-- | libguile/Makefile.am | 26 | ||||
-rw-r--r-- | libguile/__scm.h | 12 | ||||
-rw-r--r-- | libguile/_scm.h | 3 | ||||
-rw-r--r-- | libguile/boehm-gc.h | 18 | ||||
-rw-r--r-- | libguile/guile-snarf.in | 4 | ||||
-rw-r--r-- | libguile/procs.h | 37 | ||||
-rw-r--r-- | libguile/snarf.h | 148 | ||||
-rw-r--r-- | libguile/strings.c | 17 | ||||
-rw-r--r-- | libguile/strings.h | 13 | ||||
-rw-r--r-- | libguile/tags.h | 4 | ||||
-rw-r--r-- | libguile/vectors.c | 6 | ||||
-rw-r--r-- | libguile/weaks.c | 18 |
15 files changed, 295 insertions, 37 deletions
diff --git a/.gitignore b/.gitignore index 7644deacd..43545aedb 100644 --- a/.gitignore +++ b/.gitignore @@ -74,4 +74,5 @@ libguile/stack-limit-calibration.scm cscope.out cscope.files *.log +/libguile/snarf-gsubr.h INSTALL diff --git a/acinclude.m4 b/acinclude.m4 index 345e323b3..3e1dbeb2a 100644 --- a/acinclude.m4 +++ b/acinclude.m4 @@ -1,3 +1,5 @@ +dnl -*- Autoconf -*- + dnl On the NeXT, #including <utime.h> doesn't give you a definition for dnl struct utime, unless you #define _POSIX_SOURCE. @@ -308,3 +310,20 @@ else fi 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"]) +]) diff --git a/configure.in b/configure.in index 3c54bbdcd..c278361b6 100644 --- a/configure.in +++ b/configure.in @@ -4,7 +4,7 @@ dnl define(GUILE_CONFIGURE_COPYRIGHT,[[ -Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. +Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. This file is part of GUILE @@ -1448,6 +1448,10 @@ esac AC_SUBST(GCC_CFLAGS) +# Check for GNU ld's "-z relro". +GUILE_GNU_LD_RELRO + + ## If we're creating a shared library (using libtool!), then we'll ## need to generate a list of .lo files corresponding to the .o files ## given in LIBOBJS. We'll call it LIBLOBJS. diff --git a/libguile/Makefile.am b/libguile/Makefile.am index fe06c01c6..885de72c4 100644 --- a/libguile/Makefile.am +++ b/libguile/Makefile.am @@ -1,6 +1,6 @@ ## Process this file with Automake to create Makefile.in ## -## Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2006, 2007, 2008 Free Software Foundation, Inc. +## Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. ## ## This file is part of GUILE. ## @@ -77,6 +77,21 @@ scmconfig.h: ${top_builddir}/config.h gen-scmconfig$(EXEEXT) rm -f scmconfig.h mv scmconfig.h.tmp scmconfig.h +# Generate aliases for `SCM_DEFINE_GSUBR'. Since there's a lot of +# them, it's an efficient compression method. +snarf-gsubr.h: + ( echo "/* Automatically generated, do not edit. */" ; \ + for req in `seq 0 16`; do \ + for opt in `seq 0 16`; do \ + for rst in 0 1; do \ + echo "#ifndef SCM_DEFINE_SUBR_req$${req}_opt$${opt}_rst$${rst}" ; \ + echo "# define SCM_DEFINE_SUBR_req$${req}_opt$${opt}_rst$${rst} SCM_DEFINE_GSUBR" ; \ + echo "#endif" ; \ + done ; \ + done ; \ + done ) > "$@.tmp" + mv "$@.tmp" "$@" + guile_filter_doc_snarfage_SOURCES = c-tokenize.c ## Override default rule; this should be compiled for BUILD host. @@ -166,8 +181,8 @@ DOT_DOC_FILES = alist.doc arbiters.doc async.doc backtrace.doc \ EXTRA_DOT_DOC_FILES = @EXTRA_DOT_DOC_FILES@ -BUILT_SOURCES = cpp_err_symbols.c cpp_sig_symbols.c libpath.h \ - version.h scmconfig.h \ +BUILT_SOURCES = cpp_err_symbols.c cpp_sig_symbols.c libpath.h \ + version.h scmconfig.h snarf-gsubr.h \ $(DOT_X_FILES) $(EXTRA_DOT_X_FILES) EXTRA_libguile_la_SOURCES = _scm.h \ @@ -224,7 +239,7 @@ modinclude_HEADERS = __scm.h alist.h arbiters.h async.h backtrace.h \ pthread-threads.h null-threads.h throw.h unif.h values.h \ variable.h vectors.h vports.h weaks.h -nodist_modinclude_HEADERS = version.h scmconfig.h +nodist_modinclude_HEADERS = version.h scmconfig.h snarf-gsubr.h bin_SCRIPTS = guile-snarf @@ -409,7 +424,8 @@ MOSTLYCLEANFILES = \ cpp_err_symbols_here cpp_err_symbols_diff cpp_err_symbols_new \ cpp_sig_symbols_here cpp_sig_symbols_diff cpp_sig_symbols_new \ version.h version.h.tmp \ - scmconfig.h scmconfig.h.tmp stack-limit-calibration.scm + scmconfig.h scmconfig.h.tmp snarf-gsubr.h snarf-gsubr.h.tmp \ + stack-limit-calibration.scm CLEANFILES = libpath.h *.x *.doc guile-procedures.txt guile-procedures.texi guile.texi diff --git a/libguile/__scm.h b/libguile/__scm.h index d486b69bf..b84cbb98b 100644 --- a/libguile/__scm.h +++ b/libguile/__scm.h @@ -3,7 +3,7 @@ #ifndef SCM___SCM_H #define SCM___SCM_H -/* Copyright (C) 1995,1996,1998,1999,2000,2001,2002,2003, 2006, 2007, 2008 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1998,1999,2000,2001,2002,2003, 2006, 2007, 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 @@ -106,6 +106,16 @@ # define SCM_INTERNAL extern #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 /* {Supported Options} diff --git a/libguile/_scm.h b/libguile/_scm.h index e40f29bb0..ff033ded0 100644 --- a/libguile/_scm.h +++ b/libguile/_scm.h @@ -3,7 +3,7 @@ #ifndef SCM__SCM_H #define SCM__SCM_H -/* Copyright (C) 1995,1996,2000,2001, 2002, 2006, 2008 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,2000,2001, 2002, 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 @@ -77,6 +77,7 @@ #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 diff --git a/libguile/boehm-gc.h b/libguile/boehm-gc.h index 708f17b35..ab842bc1b 100644 --- a/libguile/boehm-gc.h +++ b/libguile/boehm-gc.h @@ -1,7 +1,7 @@ #ifndef SCM_BOEHM_GC_H #define SCM_BOEHM_GC_H -/* Copyright (C) 2006, 2008 Free Software Foundation, Inc. +/* Copyright (C) 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 @@ -45,4 +45,20 @@ typedef void *GC_PTR; #endif + +/* Return true if PTR points to the heap. */ +#define SCM_I_IS_POINTER_TO_THE_HEAP(ptr) \ + (GC_base (ptr) != NULL) + +/* Register a disappearing link for the object pointed to by OBJ such that + the pointer pointed to be LINK is cleared when OBJ is reclaimed. Do so + only if OBJ actually points to the heap. See + http://thread.gmane.org/gmane.comp.programming.garbage-collection.boehmgc/2563 + for details. */ +#define SCM_I_REGISTER_DISAPPEARING_LINK(link, obj) \ + ((SCM_I_IS_POINTER_TO_THE_HEAP (obj)) \ + ? GC_GENERAL_REGISTER_DISAPPEARING_LINK ((link), (obj)) \ + : 0) + + #endif /* SCM_BOEHM_GC_H */ diff --git a/libguile/guile-snarf.in b/libguile/guile-snarf.in index 617bad822..4d79f43bf 100644 --- a/libguile/guile-snarf.in +++ b/libguile/guile-snarf.in @@ -1,7 +1,7 @@ #!/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 @@ -51,7 +51,7 @@ modern_snarf () # writes stdout ## empty file. echo "/* cpp arguments: $@ */" ; ${cpp} -DSCM_MAGIC_SNARF_INITS -DSCM_MAGIC_SNARFER "$@" > ${temp} && cpp_ok_p=true - grep "^ *\^ *\^" ${temp} | sed -e "s/^ *\^ *\^//" -e "s/\^\ *:\ *\^.*/;/" + grep "^ *\^ *\^" ${temp} | sed -e "s/ *\^ *\^//g" -e "s/\^ *: *\^/;/g" } ## main diff --git a/libguile/procs.h b/libguile/procs.h index 354d27179..1e273512a 100644 --- a/libguile/procs.h +++ b/libguile/procs.h @@ -51,6 +51,40 @@ #define SCM_CCLO_SUBR(x) (SCM_CCLO_REF ((x), 0)) #define SCM_SET_CCLO_SUBR(x, v) (SCM_CCLO_SET ((x), 0, (v))) +/* Return the subr type corresponding to the given arity. If the arity + doesn't match that of a subr (e.g., too many arguments), then -1 is + returned. This has to be in sync with `create_gsubr ()'. */ +#define SCM_SUBR_ARITY_TO_TYPE(req, opt, rest) \ + ((rest) == 0 \ + ? ((opt) == 0 \ + ? ((req) == 0 \ + ? scm_tc7_subr_0 \ + : ((req) == 1 \ + ? scm_tc7_subr_1 \ + : ((req) == 2 \ + ? scm_tc7_subr_2 \ + : ((req) == 3 \ + ? scm_tc7_subr_3 \ + : -1)))) \ + : ((opt) == 1 \ + ? ((req) == 0 \ + ? scm_tc7_subr_1o \ + : ((req) == 1 \ + ? scm_tc7_subr_2o \ + : -1)) \ + : -1)) \ + : ((rest) == 1 \ + ? ((opt) == 0 \ + ? ((req) == 0 \ + ? scm_tc7_lsubr \ + : ((req) == 2 \ + ? scm_tc7_lsubr_2 \ + : -1)) \ + : -1) \ + : -1)) + + + /* Closures */ @@ -115,6 +149,9 @@ #define SCM_PROCEDURE(obj) SCM_CELL_OBJECT_1 (obj) #define SCM_SETTER(obj) SCM_CELL_OBJECT_2 (obj) + + + SCM_API SCM scm_c_make_subr (const char *name, long type, SCM (*fcn)()); SCM_API SCM scm_c_make_subr_with_generic (const char *name, long type, SCM (*fcn)(), SCM *gf); diff --git a/libguile/snarf.h b/libguile/snarf.h index 5c2f18774..451323c1b 100644 --- a/libguile/snarf.h +++ b/libguile/snarf.h @@ -3,7 +3,7 @@ #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 @@ -35,6 +35,17 @@ #define SCM_FUNC_CAST_ARBITRARY_ARGS SCM (*)() #endif +#if (defined SCM_ALIGNED) && (SCM_DEBUG_TYPING_STRICTNESS <= 1) +/* We support static allocation of some `SCM' objects. */ +# define SCM_SUPPORT_STATIC_ALLOCATION +#endif + +/* C preprocessor token concatenation. */ +#define scm_i_paste(x, y) x ## y +#define scm_i_paste3(a, b, c) a ## b ## c + + + /* Generic macros to be used in user macro definitions. * * For example, in order to define a macro which creates ints and @@ -73,7 +84,7 @@ DOCSTRING ^^ } # endif #endif -#define SCM_DEFINE(FNAME, PRIMNAME, REQ, OPT, VAR, ARGLIST, DOCSTRING) \ +#define SCM_DEFINE_GSUBR(FNAME, PRIMNAME, REQ, OPT, VAR, ARGLIST, DOCSTRING) \ SCM_SNARF_HERE(\ static const char s_ ## FNAME [] = PRIMNAME; \ SCM FNAME ARGLIST\ @@ -84,6 +95,63 @@ scm_c_define_gsubr (s_ ## FNAME, REQ, OPT, VAR, \ )\ SCM_SNARF_DOCS(primitive, FNAME, PRIMNAME, ARGLIST, REQ, OPT, VAR, DOCSTRING) +#ifdef SCM_SUPPORT_STATIC_ALLOCATION + +/* Regular "subrs", i.e., few arguments. */ +#define SCM_DEFINE_SUBR(FNAME, PRIMNAME, REQ, OPT, VAR, ARGLIST, DOCSTRING) \ +SCM_SYMBOL (scm_i_paste (FNAME, __name), PRIMNAME); \ +SCM_SNARF_HERE( \ + static const char scm_i_paste (s_, FNAME) [] = PRIMNAME; \ + SCM_IMMUTABLE_SUBR (scm_i_paste (FNAME, __subr), \ + scm_i_paste (FNAME, __name), \ + REQ, OPT, VAR, &FNAME); \ + SCM FNAME ARGLIST \ +) \ +SCM_SNARF_INIT( \ + /* Initialize the procedure name (an interned symbol). */ \ + scm_i_paste (FNAME, __subr_meta_info)[0] = scm_i_paste (FNAME, __name); \ + \ + /* Define the subr. */ \ + scm_c_define (scm_i_paste (s_, FNAME), scm_i_paste (FNAME, __subr)); \ +) \ +SCM_SNARF_DOCS(primitive, FNAME, PRIMNAME, ARGLIST, REQ, OPT, VAR, DOCSTRING) + +/* XXX: Eventually, we could statically allocate gsubrs as well. */ + +/* These are the subrs whose arity makes it possible to define them as "raw + subrs" (as opposed to "gsubrs"). This has to be consistent with + `SCM_SUBR_ARITY_TO_TYPE ()' and `create_gsubr ()'. */ +#define SCM_DEFINE_SUBR_req0_opt0_rst0 SCM_DEFINE_SUBR +#define SCM_DEFINE_SUBR_req1_opt0_rst0 SCM_DEFINE_SUBR +#define SCM_DEFINE_SUBR_req0_opt1_rst0 SCM_DEFINE_SUBR +#define SCM_DEFINE_SUBR_req1_opt1_rst0 SCM_DEFINE_SUBR +#define SCM_DEFINE_SUBR_req2_opt0_rst0 SCM_DEFINE_SUBR +#define SCM_DEFINE_SUBR_req3_opt0_rst0 SCM_DEFINE_SUBR +#define SCM_DEFINE_SUBR_req0_opt0_rst1 SCM_DEFINE_SUBR +#define SCM_DEFINE_SUBR_req2_opt0_rst1 SCM_DEFINE_SUBR + +/* For any other combination of required/optional/rest arguments, use + `SCM_DEFINE_GSUBR (). */ +#include "libguile/snarf-gsubr.h" + +/* The generic subr definition macro. This macro dispatches to either + `SCM_DEFINE_SUBR ()' or `SCM_DEFINE_GSUBR ()' depending on the arity of + the subr being defined. */ +#define SCM_DEFINE(FNAME, PRIMNAME, REQ, OPT, VAR, ARGLIST, DOCSTRING) \ + SCM_DEFINE_SUBR_req ## REQ ## _opt ## OPT ## _rst ## VAR \ + (FNAME, PRIMNAME, \ + REQ, OPT, VAR, \ + ARGLIST, DOCSTRING) + + +#else /* !SCM_SUPPORT_STATIC_ALLOCATION */ + +/* Always use the generic subr case. */ +#define SCM_DEFINE SCM_DEFINE_GSUBR + +#endif /* !SCM_SUPPORT_STATIC_ALLOCATION */ + + #define SCM_PRIMITIVE_GENERIC(FNAME, PRIMNAME, REQ, OPT, VAR, ARGLIST, DOCSTRING) \ SCM_SNARF_HERE(\ static const char s_ ## FNAME [] = PRIMNAME; \ @@ -173,14 +241,36 @@ scm_c_define_subr_with_generic (RANAME, TYPE, \ SCM_SNARF_HERE(static const char RANAME[]=STR)\ SCM_SNARF_INIT(scm_make_synt (RANAME, TYPE, CFN)) -#define SCM_SYMBOL(c_name, scheme_name) \ -SCM_SNARF_HERE(static SCM c_name) \ +#ifdef SCM_SUPPORT_STATIC_ALLOCATION + +# define SCM_SYMBOL(c_name, scheme_name) \ +SCM_SNARF_HERE( \ + SCM_IMMUTABLE_STRING (scm_i_paste (c_name, _string), scheme_name); \ + static SCM c_name) \ +SCM_SNARF_INIT( \ + c_name = scm_string_to_symbol (scm_i_paste (c_name, _string)) \ +) + +# define SCM_GLOBAL_SYMBOL(c_name, scheme_name) \ +SCM_SNARF_HERE( \ + SCM_IMMUTABLE_STRING (scm_i_paste (c_name, _string), scheme_name); \ + SCM c_name) \ +SCM_SNARF_INIT( \ + c_name = scm_string_to_symbol (scm_i_paste (c_name, _string)) \ +) + +#else /* !SCM_SUPPORT_STATIC_ALLOCATION */ + +# define SCM_SYMBOL(c_name, scheme_name) \ +SCM_SNARF_HERE(static SCM c_name) \ SCM_SNARF_INIT(c_name = scm_permanent_object (scm_from_locale_symbol (scheme_name))) -#define SCM_GLOBAL_SYMBOL(c_name, scheme_name) \ -SCM_SNARF_HERE(SCM c_name) \ +# define SCM_GLOBAL_SYMBOL(c_name, scheme_name) \ +SCM_SNARF_HERE(SCM c_name) \ SCM_SNARF_INIT(c_name = scm_permanent_object (scm_from_locale_symbol (scheme_name))) +#endif /* !SCM_SUPPORT_STATIC_ALLOCATION */ + #define SCM_KEYWORD(c_name, scheme_name) \ SCM_SNARF_HERE(static SCM c_name) \ SCM_SNARF_INIT(c_name = scm_permanent_object (scm_from_locale_keyword (scheme_name))) @@ -269,6 +359,52 @@ SCM_SNARF_INIT(scm_set_smob_apply((tag), (c_name), (req), (opt), (rest));) 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_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), \ + (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 --git a/libguile/strings.c b/libguile/strings.c index 6e3b0a347..1839c6ac0 100644 --- a/libguile/strings.c +++ b/libguile/strings.c @@ -65,8 +65,8 @@ * stringbuf. So we have fixstrings and bigstrings... */ -#define STRINGBUF_F_SHARED 0x100 -#define STRINGBUF_F_INLINE 0x200 +#define STRINGBUF_F_SHARED SCM_I_STRINGBUF_F_SHARED +#define STRINGBUF_F_INLINE SCM_I_STRINGBUF_F_INLINE #define STRINGBUF_TAG scm_tc7_stringbuf #define STRINGBUF_SHARED(buf) (SCM_CELL_WORD_0(buf) & STRINGBUF_F_SHARED) @@ -86,8 +86,15 @@ #define STRINGBUF_MAX_INLINE_LEN (3*sizeof(scm_t_bits)) -#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 static size_t lenhist[1001]; @@ -155,7 +162,7 @@ scm_i_pthread_mutex_t stringbuf_write_mutex = SCM_I_PTHREAD_MUTEX_INITIALIZER; /* Read-only strings. */ -#define RO_STRING_TAG (scm_tc7_string + 0x200) +#define RO_STRING_TAG scm_tc7_ro_string #define IS_RO_STRING(str) (SCM_CELL_TYPE(str)==RO_STRING_TAG) /* Mutation-sharing substrings diff --git a/libguile/strings.h b/libguile/strings.h index e7053257f..2dabde1d6 100644 --- a/libguile/strings.h +++ b/libguile/strings.h @@ -3,7 +3,7 @@ #ifndef SCM_STRINGS_H #define SCM_STRINGS_H -/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2004, 2005, 2006, 2008 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2004, 2005, 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 @@ -109,6 +109,17 @@ SCM_API size_t scm_to_locale_stringbuf (SCM str, char *buf, size_t max_len); 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. */ +#define SCM_I_STRINGBUF_F_SHARED 0x100 +#define SCM_I_STRINGBUF_F_INLINE 0x200 + + /* internal accessor functions. Arguments must be valid. */ SCM_INTERNAL SCM scm_i_make_string (size_t len, char **datap); diff --git a/libguile/tags.h b/libguile/tags.h index 4e0700b52..249e1d5ba 100644 --- a/libguile/tags.h +++ b/libguile/tags.h @@ -3,7 +3,7 @@ #ifndef SCM_TAGS_H #define SCM_TAGS_H -/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002,2003,2004,2008 +/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002,2003,2004,2008,2009 * Free Software Foundation, Inc. * * This library is free software; you can redistribute it and/or @@ -106,7 +106,7 @@ typedef unsigned long scm_t_bits; /* This is the default, which provides an intermediate level of compile time * type checking while still resulting in very efficient code. */ - typedef struct scm_unused_struct * SCM; + typedef struct { char scm_unused_field; } * SCM; /* The 0?: constructions makes sure that the code is never executed, diff --git a/libguile/vectors.c b/libguile/vectors.c index c01b3e3b6..cc4c04f7b 100644 --- a/libguile/vectors.c +++ b/libguile/vectors.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1995,1996,1998,1999,2000,2001, 2006, 2008 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1998,1999,2000,2001, 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 @@ -279,7 +279,7 @@ scm_c_vector_set_x (SCM v, size_t k, SCM obj) { /* Make it a weak pointer. */ GC_PTR link = (GC_PTR) & ((SCM_I_VECTOR_WELTS (v))[k]); - GC_GENERAL_REGISTER_DISAPPEARING_LINK (link, obj); + SCM_I_REGISTER_DISAPPEARING_LINK (link, obj); } } else if (SCM_I_ARRAYP (v) && SCM_I_ARRAY_NDIM (v) == 1) @@ -297,7 +297,7 @@ scm_c_vector_set_x (SCM v, size_t k, SCM obj) { /* Make it a weak pointer. */ GC_PTR link = (GC_PTR) & ((SCM_I_VECTOR_WELTS (vv))[k]); - GC_GENERAL_REGISTER_DISAPPEARING_LINK (link, obj); + SCM_I_REGISTER_DISAPPEARING_LINK (link, obj); } } else diff --git a/libguile/weaks.c b/libguile/weaks.c index 7558e78a6..6af4d6722 100644 --- a/libguile/weaks.c +++ b/libguile/weaks.c @@ -1,4 +1,4 @@ -/* 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 @@ -64,8 +64,8 @@ scm_weak_car_pair (SCM car, SCM cdr) if (SCM_NIMP (car)) { /* Weak car cells make sense iff the car is non-immediate. */ - GC_GENERAL_REGISTER_DISAPPEARING_LINK ((GC_PTR)&cell->word_0, - (GC_PTR)SCM_UNPACK (car)); + SCM_I_REGISTER_DISAPPEARING_LINK ((GC_PTR) &cell->word_0, + (GC_PTR) SCM_UNPACK (car)); } return (SCM_PACK (cell)); @@ -85,8 +85,8 @@ scm_weak_cdr_pair (SCM car, SCM cdr) if (SCM_NIMP (cdr)) { /* Weak cdr cells make sense iff the cdr is non-immediate. */ - GC_GENERAL_REGISTER_DISAPPEARING_LINK ((GC_PTR)&cell->word_1, - (GC_PTR)SCM_UNPACK (cdr)); + SCM_I_REGISTER_DISAPPEARING_LINK ((GC_PTR) &cell->word_1, + (GC_PTR) SCM_UNPACK (cdr)); } return (SCM_PACK (cell)); @@ -104,13 +104,13 @@ scm_doubly_weak_pair (SCM car, SCM cdr) if (SCM_NIMP (car)) { - GC_GENERAL_REGISTER_DISAPPEARING_LINK ((GC_PTR)&cell->word_0, - (GC_PTR)SCM_UNPACK (car)); + SCM_I_REGISTER_DISAPPEARING_LINK ((GC_PTR) &cell->word_0, + (GC_PTR) SCM_UNPACK (car)); } if (SCM_NIMP (cdr)) { - GC_GENERAL_REGISTER_DISAPPEARING_LINK ((GC_PTR)&cell->word_1, - (GC_PTR)SCM_UNPACK (cdr)); + SCM_I_REGISTER_DISAPPEARING_LINK ((GC_PTR) &cell->word_1, + (GC_PTR) SCM_UNPACK (cdr)); } return (SCM_PACK (cell)); |