[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] GNU Guile branch, master, updated. release_1-9-4-78-g731
|
From: |
Ludovic Courtès |
|
Subject: |
[Guile-commits] GNU Guile branch, master, updated. release_1-9-4-78-g731dd0c |
|
Date: |
Sun, 01 Nov 2009 17:35:41 +0000 |
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".
http://git.savannah.gnu.org/cgit/guile.git/commit/?id=731dd0ce191bf4f3ba8fedfe0e08c0e67a966ce4
The branch, master has been updated
via 731dd0ce191bf4f3ba8fedfe0e08c0e67a966ce4 (commit)
via 5f236208d0d864546e59afa0f5a11c9b3ba14b10 (commit)
via f0eb5ae6c173aed35965b0561897fda1d8ff0db1 (commit)
via a4167c920a88ceb02ce201a6cd03b60204657ddd (commit)
via bb2e15a5f4129d0ed9dedb2ac39f3205480c849e (commit)
via 4cc889000192b284913b92417afd0f39f7f6f134 (commit)
via 4f6e6e4fb73e0f0a4c086500e065fdcc3426e6c7 (commit)
via 475461b7a02a5350af7cfb972826e155f3aab3c4 (commit)
via 9b41542f4d03c3b59ff458f3569688fbd8fb8bc1 (commit)
via 46f9baf49a8ea4461e8494c75a88b87d0f5c5195 (commit)
via 6eca5d2b9b06deaeacf8b133604e16f4b108adab (commit)
via b68095f091bf0e46df90f5b20a64fcd30aa25546 (commit)
via dbe4d258f6a8f3e12ae42cf0f485d46969648c9e (commit)
via 2ee5aa25dbd679b175707762f5961585027e1397 (commit)
via 499b5dfa3eff74f525ba07b6c865a970c056a6cb (commit)
via a62fad3a22fd2d5bc0d808c60458df6088a0f1f5 (commit)
via 5bec288a6727d9a3fff4e016b8f9c7788db42808 (commit)
via c6054feaf03f8bde236f5e45a946f38827074923 (commit)
via 35920c00a8f9c3140005e612a393977a0d5d138d (commit)
from b4246e5b2235bd01a24a5069ed683fc3c0f6f18c (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit 731dd0ce191bf4f3ba8fedfe0e08c0e67a966ce4
Merge: b4246e5b2235bd01a24a5069ed683fc3c0f6f18c
5f236208d0d864546e59afa0f5a11c9b3ba14b10
Author: Ludovic Courtès <address@hidden>
Date: Sun Nov 1 18:17:31 2009 +0100
Merge branch 'bdw-gc-static-alloc'
Conflicts:
acinclude.m4
libguile/__scm.h
libguile/bdw-gc.h
libguile/eval.c
-----------------------------------------------------------------------
Summary of changes:
libguile/__scm.h | 10 ++++
libguile/_scm.h | 1 +
libguile/bdw-gc.h | 16 ++++++
libguile/eval.c | 47 ++++++++---------
libguile/guile-snarf.in | 4 +-
libguile/procs.h | 43 ++++++++++++++++
libguile/snarf.h | 128 ++++++++++++++++++++++++++++++++++++++++++++--
libguile/strings.c | 19 ++++---
libguile/strings.h | 11 ++++
libguile/tags.h | 2 +-
libguile/vectors.c | 4 +-
libguile/weaks.c | 18 +++---
12 files changed, 252 insertions(+), 51 deletions(-)
diff --git a/libguile/__scm.h b/libguile/__scm.h
index 55f9f49..8bb1b1a 100644
--- a/libguile/__scm.h
+++ b/libguile/__scm.h
@@ -115,6 +115,16 @@
# 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
/* {Supported Options}
diff --git a/libguile/_scm.h b/libguile/_scm.h
index 33cb375..6cb7ce8 100644
--- a/libguile/_scm.h
+++ b/libguile/_scm.h
@@ -79,6 +79,7 @@
#include "libguile/variable.h"
#include "libguile/modules.h"
#include "libguile/inline.h"
+#include "libguile/strings.h"
#ifndef SCM_SYSCALL
#ifdef vms
diff --git a/libguile/bdw-gc.h b/libguile/bdw-gc.h
index a54785e..3adf99e 100644
--- a/libguile/bdw-gc.h
+++ b/libguile/bdw-gc.h
@@ -46,4 +46,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_BDW_GC_H */
diff --git a/libguile/eval.c b/libguile/eval.c
index 3c96251..cdb9042 100644
--- a/libguile/eval.c
+++ b/libguile/eval.c
@@ -923,7 +923,7 @@ m_expand_body (const SCM forms, const SCM env)
}
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");
static SCM
scm_m_and (SCM expr, SCM env SCM_UNUSED)
@@ -953,7 +953,7 @@ unmemoize_and (const SCM expr, const SCM env)
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");
static SCM
scm_m_begin (SCM expr, SCM env SCM_UNUSED)
@@ -976,7 +976,7 @@ unmemoize_begin (const SCM expr, const SCM env)
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");
static SCM
@@ -1072,7 +1072,7 @@ unmemoize_case (const SCM expr, const SCM env)
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, "=>");
static SCM
@@ -1175,7 +1175,7 @@ unmemoize_cond (const SCM expr, const SCM env)
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
@@ -1286,7 +1286,7 @@ memoize_as_thunk_prototype (const SCM expr, const SCM env
SCM_UNUSED)
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 (address@hidden '() <expression>),
where
@@ -1315,7 +1315,7 @@ unmemoize_delay (const SCM expr, const SCM env)
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
@@ -1431,7 +1431,7 @@ unmemoize_do (const SCM expr, const SCM env)
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");
static SCM
scm_m_if (SCM expr, SCM env SCM_UNUSED)
@@ -1465,7 +1465,7 @@ unmemoize_if (const SCM expr, const SCM env)
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
@@ -1613,7 +1613,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
@@ -1725,7 +1725,7 @@ unmemoize_let (const SCM expr, const SCM env)
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");
static SCM
scm_m_letrec (SCM expr, SCM env)
@@ -1774,7 +1774,7 @@ unmemoize_letrec (const SCM expr, const SCM env)
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 (address@hidden (v1 i1 v2 i2 ...)
body). */
@@ -1849,7 +1849,7 @@ unmemoize_letstar (const SCM expr, const SCM env)
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");
static SCM
scm_m_or (SCM expr, SCM env SCM_UNUSED)
@@ -1879,7 +1879,7 @@ unmemoize_or (const SCM expr, const SCM env)
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");
@@ -1946,7 +1946,7 @@ 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");
static SCM
scm_m_quote (SCM expr, SCM env SCM_UNUSED)
@@ -1974,8 +1974,7 @@ unmemoize_quote (const SCM expr, const SCM env SCM_UNUSED)
/* 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!");
static SCM
scm_m_set_x (SCM expr, SCM env SCM_UNUSED)
@@ -2012,7 +2011,7 @@ unmemoize_set_x (const SCM expr, const SCM env)
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)
@@ -2033,7 +2032,7 @@ scm_m_at (SCM expr, SCM env SCM_UNUSED)
}
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)
@@ -2054,8 +2053,8 @@ scm_m_atat (SCM expr, SCM env SCM_UNUSED)
}
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");
static SCM
scm_m_apply (SCM expr, SCM env SCM_UNUSED)
@@ -2131,7 +2130,7 @@ 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");
static SCM
scm_m_cont (SCM expr, SCM env SCM_UNUSED)
@@ -2152,7 +2151,7 @@ unmemoize_atcall_cc (const SCM expr, const SCM env)
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");
static SCM
scm_m_at_call_with_values (SCM expr, SCM env SCM_UNUSED)
@@ -2173,7 +2172,7 @@ unmemoize_at_call_with_values (const SCM expr, const SCM
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");
diff --git a/libguile/guile-snarf.in b/libguile/guile-snarf.in
index 6a72dd5..043b3ed 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 Lesser General Public License as
@@ -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 469b735..7e445ad 100644
--- a/libguile/procs.h
+++ b/libguile/procs.h
@@ -40,6 +40,46 @@
#define SCM_SET_SUBR_GENERIC(x, g) (*((SCM *) SCM_CELL_WORD_2 (x)) = (g))
#define SCM_SET_SUBR_GENERIC_LOC(x, g) (SCM_SET_CELL_WORD_2 (x, (scm_t_bits)
g))
+/* Return the most suitable subr type for a subr with REQ required arguments,
+ OPT optional arguments, and REST (0 or 1) arguments. 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 \
+ : scm_tc7_gsubr \
+ | (SCM_GSUBR_MAKTYPE (req, opt, rest) << 8U))))) \
+ : ((opt) == 1 \
+ ? ((req) == 0 \
+ ? scm_tc7_subr_1o \
+ : ((req) == 1 \
+ ? scm_tc7_subr_2o \
+ : scm_tc7_gsubr | \
+ (SCM_GSUBR_MAKTYPE (req, opt, rest) << 8U))) \
+ : scm_tc7_gsubr | \
+ (SCM_GSUBR_MAKTYPE (req, opt, rest) << 8U))) \
+ : ((rest) == 1 \
+ ? ((opt) == 0 \
+ ? ((req) == 0 \
+ ? scm_tc7_lsubr \
+ : ((req) == 2 \
+ ? scm_tc7_lsubr_2 \
+ : scm_tc7_gsubr \
+ | (SCM_GSUBR_MAKTYPE (req, opt, rest) << 8U))) \
+ : scm_tc7_gsubr \
+ | (SCM_GSUBR_MAKTYPE (req, opt, rest) << 8U)) \
+ : scm_tc7_gsubr \
+ | (SCM_GSUBR_MAKTYPE (req, opt, rest) << 8U)))
+
+
+
/* Closures
*/
@@ -104,6 +144,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 03a3edd..9eaccf6 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 License
@@ -36,6 +36,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
@@ -74,7 +85,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\
@@ -85,6 +96,35 @@ 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
+
+/* Static subr allocation. */
+#define SCM_DEFINE(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)
+
+#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; \
@@ -174,14 +214,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)))
@@ -270,6 +332,60 @@ 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) \
+ 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 */
+
+
+/* Documentation. */
#ifdef SCM_MAGIC_SNARF_DOCS
#undef SCM_ASSERT
diff --git a/libguile/strings.c b/libguile/strings.c
index c7f09db..21295ad 100644
--- a/libguile/strings.c
+++ b/libguile/strings.c
@@ -72,10 +72,8 @@
#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_WIDE SCM_I_STRINGBUF_F_WIDE
#define STRINGBUF_TAG scm_tc7_stringbuf
#define STRINGBUF_SHARED(buf) (SCM_CELL_WORD_0(buf) & STRINGBUF_F_SHARED)
@@ -88,8 +86,15 @@
#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_STRING_LENGTH_HISTOGRAM
static size_t lenhist[1001];
@@ -235,7 +240,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 e68bbe9..4e5f700 100644
--- a/libguile/strings.h
+++ b/libguile/strings.h
@@ -142,6 +142,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 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);
diff --git a/libguile/tags.h b/libguile/tags.h
index f745732..4a68f9c 100644
--- a/libguile/tags.h
+++ b/libguile/tags.h
@@ -107,7 +107,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 4198c54..b1b5890 100644
--- a/libguile/vectors.c
+++ b/libguile/vectors.c
@@ -283,7 +283,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)
@@ -301,7 +301,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 abe9292..913166f 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 License
@@ -65,8 +65,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));
@@ -86,8 +86,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));
@@ -105,13 +105,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));
hooks/post-receive
--
GNU Guile
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Guile-commits] GNU Guile branch, master, updated. release_1-9-4-78-g731dd0c,
Ludovic Courtès <=