[bpt/guile.git] / libguile / snarf.h

/* classes: h_files */

#ifndef SCM_SNARF_H
#define SCM_SNARF_H

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

\f

/* Macros for snarfing initialization actions from C source. */

/* Casting to a function that can take any number of arguments.  */
#define SCM_FUNC_CAST_ARBITRARY_ARGS  scm_t_subr


#ifdef SCM_ALIGNED
/* 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


\f
/* Generic macros to be used in user macro definitions.
 *
 * For example, in order to define a macro which creates ints and
 * initializes them to the result of foo (), do:
 *
 *   #define SCM_FOO(NAME) \
 *     SCM_SNARF_HERE (int NAME) \
 *     SCM_SNARF_INIT (NAME = foo ())
 *
 * The SCM_SNARF_INIT text goes into the corresponding .x file
 * up through the first occurrence of SCM_SNARF_DOC_START on that
 * line, if any.
 *
 * Some debugging options can cause the preprocessor to echo #define
 * directives to its output. Keeping the snarfing markers on separate
 * lines prevents guile-snarf from inadvertently snarfing the definition
 * of SCM_SNARF_INIT if those options are in effect.
 */

#ifdef SCM_MAGIC_SNARF_INITS
# define SCM_SNARF_HERE(X)
# define SCM_SNARF_INIT_PREFIX ^^
# define SCM_SNARF_INIT(X) SCM_SNARF_INIT_PREFIX X ^:^
# define SCM_SNARF_DOCS(TYPE, CNAME, FNAME, ARGLIST, REQ, OPT, VAR, DOCSTRING)
#else
# ifdef SCM_MAGIC_SNARF_DOCS
#  define SCM_SNARF_HERE(X)
#  define SCM_SNARF_INIT(X)
#  define SCM_SNARF_DOCS(TYPE, CNAME, FNAME, ARGLIST, REQ, OPT, VAR, DOCSTRING) \
^^ { \
cname CNAME ^^ \
fname FNAME ^^ \
type TYPE ^^ \
location __FILE__ __LINE__ ^^ \
arglist ARGLIST ^^ \
argsig REQ OPT VAR ^^ \
DOCSTRING ^^ }
# else
#  define SCM_SNARF_HERE(X) X
#  define SCM_SNARF_INIT(X)
#  define SCM_SNARF_DOCS(TYPE, CNAME, FNAME, ARGLIST, REQ, OPT, VAR, DOCSTRING)
# endif
#endif

#define SCM_DEFINE_GSUBR(FNAME, PRIMNAME, REQ, OPT, VAR, ARGLIST, DOCSTRING) \
SCM_SNARF_HERE(\
SCM_UNUSED static const char s_ ## FNAME [] = PRIMNAME; \
SCM FNAME ARGLIST\
)\
SCM_SNARF_INIT(\
scm_c_define_gsubr (s_ ## FNAME, REQ, OPT, VAR, \
                    (SCM_FUNC_CAST_ARBITRARY_ARGS) FNAME); \
)\
SCM_SNARF_DOCS(primitive, FNAME, PRIMNAME, ARGLIST, REQ, OPT, VAR, DOCSTRING)

/* Always use the generic subr case.  */
#define SCM_DEFINE SCM_DEFINE_GSUBR


#define SCM_PRIMITIVE_GENERIC(FNAME, PRIMNAME, REQ, OPT, VAR, ARGLIST, DOCSTRING) \
SCM_SNARF_HERE(\
SCM_UNUSED static const char s_ ## FNAME [] = PRIMNAME; \
static SCM g_ ## FNAME; \
SCM FNAME ARGLIST\
)\
SCM_SNARF_INIT(\
g_ ## FNAME = SCM_PACK (0); \
scm_c_define_gsubr_with_generic (s_ ## FNAME, REQ, OPT, VAR, \
                    		 (SCM_FUNC_CAST_ARBITRARY_ARGS) FNAME, \
				 &g_ ## FNAME); \
)\
SCM_SNARF_DOCS(primitive, FNAME, PRIMNAME, ARGLIST, REQ, OPT, VAR, DOCSTRING)

#define SCM_DEFINE_PUBLIC(FNAME, PRIMNAME, REQ, OPT, VAR, ARGLIST, DOCSTRING) \
SCM_SNARF_HERE(\
SCM_UNUSED static const char s_ ## FNAME [] = PRIMNAME; \
SCM FNAME ARGLIST\
)\
SCM_SNARF_INIT(\
scm_c_define_gsubr (s_ ## FNAME, REQ, OPT, VAR, \
                    (SCM_FUNC_CAST_ARBITRARY_ARGS) FNAME); \
scm_c_export (s_ ## FNAME, NULL); \
)\
SCM_SNARF_DOCS(primitive, FNAME, PRIMNAME, ARGLIST, REQ, OPT, VAR, DOCSTRING)

#define SCM_PROC(RANAME, STR, REQ, OPT, VAR, CFN)  \
SCM_SNARF_HERE(SCM_UNUSED static const char RANAME[]=STR) \
SCM_SNARF_INIT(scm_c_define_gsubr (RANAME, REQ, OPT, VAR, \
                                   (SCM_FUNC_CAST_ARBITRARY_ARGS) CFN))

#define SCM_REGISTER_PROC(RANAME, STR, REQ, OPT, VAR, CFN)  \
SCM_SNARF_HERE(SCM_UNUSED static const char RANAME[]=STR) \
SCM_SNARF_INIT(scm_c_define_gsubr (RANAME, REQ, OPT, VAR, \
                                   (SCM_FUNC_CAST_ARBITRARY_ARGS) CFN);) \
SCM_SNARF_DOCS(register, CFN, STR, (), REQ, OPT, VAR, \
               "implemented by the C function \"" #CFN "\"")

#define SCM_GPROC(RANAME, STR, REQ, OPT, VAR, CFN, GF)  \
SCM_SNARF_HERE(\
SCM_UNUSED static const char RANAME[]=STR;\
static SCM GF \
)SCM_SNARF_INIT(\
GF = SCM_PACK (0);  /* Dirk:FIXME:: Can we safely use #f instead of 0? */ \
scm_c_define_gsubr_with_generic (RANAME, REQ, OPT, VAR, \
                                 (SCM_FUNC_CAST_ARBITRARY_ARGS) CFN, &GF) \
)

#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_from_utf8_symbol (scheme_name))

# define SCM_GLOBAL_SYMBOL(c_name, scheme_name)				\
SCM_SNARF_HERE(SCM c_name)						\
SCM_SNARF_INIT(c_name = scm_from_utf8_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_from_locale_keyword (scheme_name))

#define SCM_GLOBAL_KEYWORD(c_name, scheme_name) \
SCM_SNARF_HERE(SCM c_name) \
SCM_SNARF_INIT(c_name = scm_from_locale_keyword (scheme_name))

#define SCM_VARIABLE(c_name, scheme_name) \
SCM_SNARF_HERE(static SCM c_name) \
SCM_SNARF_INIT(c_name = scm_c_define (scheme_name, SCM_BOOL_F);)

#define SCM_GLOBAL_VARIABLE(c_name, scheme_name) \
SCM_SNARF_HERE(SCM c_name) \
SCM_SNARF_INIT(c_name = scm_c_define (scheme_name, SCM_BOOL_F);)

#define SCM_VARIABLE_INIT(c_name, scheme_name, init_val) \
SCM_SNARF_HERE(static SCM c_name) \
SCM_SNARF_INIT(c_name = scm_c_define (scheme_name, init_val);)

#define SCM_GLOBAL_VARIABLE_INIT(c_name, scheme_name, init_val) \
SCM_SNARF_HERE(SCM c_name) \
SCM_SNARF_INIT(c_name = scm_c_define (scheme_name, init_val);)

#define SCM_MUTEX(c_name) \
SCM_SNARF_HERE(static scm_t_mutex c_name) \
SCM_SNARF_INIT(scm_i_plugin_mutex_init (&c_name, &scm_i_plugin_mutex))

#define SCM_GLOBAL_MUTEX(c_name) \
SCM_SNARF_HERE(scm_t_mutex c_name) \
SCM_SNARF_INIT(scm_i_plugin_mutex_init (&c_name, &scm_i_plugin_mutex))

#define SCM_REC_MUTEX(c_name) \
SCM_SNARF_HERE(static scm_t_rec_mutex c_name) \
SCM_SNARF_INIT(scm_i_plugin_rec_mutex_init (&c_name, &scm_i_plugin_rec_mutex))

#define SCM_GLOBAL_REC_MUTEX(c_name) \
SCM_SNARF_HERE(scm_t_rec_mutex c_name) \
SCM_SNARF_INIT(scm_i_plugin_rec_mutex_init (&c_name, &scm_i_plugin_rec_mutex))

#define SCM_SMOB(tag, scheme_name, size) \
SCM_SNARF_HERE(static scm_t_bits tag) \
SCM_SNARF_INIT((tag)=scm_make_smob_type((scheme_name), (size));)

#define SCM_GLOBAL_SMOB(tag, scheme_name, size) \
SCM_SNARF_HERE(scm_t_bits tag) \
SCM_SNARF_INIT((tag)=scm_make_smob_type((scheme_name), (size));)

#define SCM_SMOB_MARK(tag, c_name, arg) \
SCM_SNARF_HERE(static SCM c_name(SCM arg)) \
SCM_SNARF_INIT(scm_set_smob_mark((tag), (c_name));)

#define SCM_GLOBAL_SMOB_MARK(tag, c_name, arg) \
SCM_SNARF_HERE(SCM c_name(SCM arg)) \
SCM_SNARF_INIT(scm_set_smob_mark((tag), (c_name));)

#define SCM_SMOB_FREE(tag, c_name, arg) \
SCM_SNARF_HERE(static size_t c_name(SCM arg)) \
SCM_SNARF_INIT(scm_set_smob_free((tag), (c_name));)

#define SCM_GLOBAL_SMOB_FREE(tag, c_name, arg) \
SCM_SNARF_HERE(size_t c_name(SCM arg)) \
SCM_SNARF_INIT(scm_set_smob_free((tag), (c_name));)

#define SCM_SMOB_PRINT(tag, c_name, obj, port, pstate) \
SCM_SNARF_HERE(static int c_name(SCM obj, SCM port, scm_print_state* pstate)) \
SCM_SNARF_INIT(scm_set_smob_print((tag), (c_name));)

#define SCM_GLOBAL_SMOB_PRINT(tag, c_name, obj, port, pstate) \
SCM_SNARF_HERE(int c_name(SCM obj, SCM port, scm_print_state* pstate)) \
SCM_SNARF_INIT(scm_set_smob_print((tag), (c_name));)

#define SCM_SMOB_EQUALP(tag, c_name, obj1, obj2) \
SCM_SNARF_HERE(static SCM c_name(SCM obj1, SCM obj2)) \
SCM_SNARF_INIT(scm_set_smob_equalp((tag), (c_name));)

#define SCM_GLOBAL_SMOB_EQUALP(tag, c_name, obj1, obj2) \
SCM_SNARF_HERE(SCM c_name(SCM obj1, SCM obj2)) \
SCM_SNARF_INIT(scm_set_smob_equalp((tag), (c_name));)

#define SCM_SMOB_APPLY(tag, c_name, req, opt, rest, arglist) \
SCM_SNARF_HERE(static SCM c_name arglist) \
SCM_SNARF_INIT(scm_set_smob_apply((tag), (c_name), (req), (opt), (rest));)

#define SCM_GLOBAL_SMOB_APPLY(tag, c_name, req, opt, rest, arglist) \
SCM_SNARF_HERE(SCM c_name arglist) \
SCM_SNARF_INIT(scm_set_smob_apply((tag), (c_name), (req), (opt), (rest));)

\f
/* Low-level snarfing for static memory allocation.  */

#ifdef SCM_SUPPORT_STATIC_ALLOCATION

#define SCM_IMMUTABLE_CELL(c_name, car, cdr)		\
  static SCM_ALIGNED (8) SCM_UNUSED const scm_t_cell			\
       c_name ## _raw_scell =						\
  {                                                                     \
    SCM_PACK (car),                                                     \
    SCM_PACK (cdr)                                                      \
  };                                                                    \
  static SCM_UNUSED const SCM c_name = SCM_PACK (& c_name ## _raw_scell)

#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_STATIC_DOUBLE_CELL(c_name, car, cbr, ccr, cdr)		\
  static SCM_ALIGNED (8) SCM_UNUSED scm_t_cell                          \
  c_name ## _raw_cell [2] =						\
    {									\
      { SCM_PACK (car), SCM_PACK (cbr) },				\
      { SCM_PACK (ccr), SCM_PACK (cdr) }				\
    };									\
  static SCM_UNUSED 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_POINTER(c_name, ptr)		\
  SCM_IMMUTABLE_CELL (c_name, scm_tc7_pointer, ptr)

#endif /* SCM_SUPPORT_STATIC_ALLOCATION */

\f
/* Documentation.  */

#ifdef SCM_MAGIC_SNARF_DOCS
#undef SCM_ASSERT
#define SCM_ASSERT(_cond, _arg, _pos, _subr) ^^ argpos _arg _pos __LINE__ ^^
#endif /* SCM_MAGIC_SNARF_DOCS */

#endif  /* SCM_SNARF_H */

/*
  Local Variables:
  c-file-style: "gnu"
  End:
*/
Commit	Line	Data
5b4215a8 JB	1	/* classes: h_files */
5b4215a8 JB	2
b29058ff DH	3	#ifndef SCM_SNARF_H
b29058ff DH	4	#define SCM_SNARF_H
5b4215a8	5
be90d0b6	6	/* Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
475772ea	7	* 2004, 2006, 2009, 2010, 2011, 2013, 2014 Free Software Foundation, Inc.
b29058ff	8	*
73be1d9e	9	* This library is free software; you can redistribute it and/or
53befeb7 NJ	10	* modify it under the terms of the GNU Lesser General Public License
	11	* as published by the Free Software Foundation; either version 3 of
	12	* the License, or (at your option) any later version.
b29058ff	13	*
53befeb7 NJ	14	* This library is distributed in the hope that it will be useful, but
53befeb7 NJ	15	* WITHOUT ANY WARRANTY; without even the implied warranty of
73be1d9e MV	16	* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
73be1d9e MV	17	* Lesser General Public License for more details.
b29058ff	18	*
73be1d9e MV	19	* You should have received a copy of the GNU Lesser General Public
73be1d9e MV	20	* License along with this library; if not, write to the Free Software
53befeb7 NJ	21	* Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
53befeb7 NJ	22	* 02110-1301 USA
73be1d9e	23	*/
1bbd0b84	24
5b4215a8 JB	25	\f
5b4215a8 JB	26
b29058ff DH	27	/* Macros for snarfing initialization actions from C source. */
b29058ff DH	28
be90d0b6 LC	29	/* Casting to a function that can take any number of arguments. */
be90d0b6 LC	30	#define SCM_FUNC_CAST_ARBITRARY_ARGS scm_t_subr
e1fbffa9	31
bfe19b46	32
544a29de	33	#ifdef SCM_ALIGNED
c6054fea LC	34	/* We support static allocation of some `SCM' objects. */
	35	# define SCM_SUPPORT_STATIC_ALLOCATION
	36	#endif
	37
b68095f0 LC	38	/* C preprocessor token concatenation. */
	39	#define scm_i_paste(x, y) x ## y
	40	#define scm_i_paste3(a, b, c) a ## b ## c
	41
c6054fea LC	42
c6054fea LC	43	\f
73d8385e MD	44	/* Generic macros to be used in user macro definitions.
	45	*
	46	* For example, in order to define a macro which creates ints and
	47	* initializes them to the result of foo (), do:
	48	*
	49	* #define SCM_FOO(NAME) \
94a70859 MD	50	* SCM_SNARF_HERE (int NAME) \
94a70859 MD	51	* SCM_SNARF_INIT (NAME = foo ())
1e76143f	52	*
94a70859	53	* The SCM_SNARF_INIT text goes into the corresponding .x file
3c6d9d71 DH	54	* up through the first occurrence of SCM_SNARF_DOC_START on that
3c6d9d71 DH	55	* line, if any.
95c1cfb5 BT	56	*
	57	* Some debugging options can cause the preprocessor to echo #define
	58	* directives to its output. Keeping the snarfing markers on separate
	59	* lines prevents guile-snarf from inadvertently snarfing the definition
	60	* of SCM_SNARF_INIT if those options are in effect.
73d8385e MD	61	*/
73d8385e MD	62
c99f9605 ML	63	#ifdef SCM_MAGIC_SNARF_INITS
c99f9605 ML	64	# define SCM_SNARF_HERE(X)
95c1cfb5 BT	65	# define SCM_SNARF_INIT_PREFIX ^^
95c1cfb5 BT	66	# define SCM_SNARF_INIT(X) SCM_SNARF_INIT_PREFIX X ^:^
cecb4a5e	67	# define SCM_SNARF_DOCS(TYPE, CNAME, FNAME, ARGLIST, REQ, OPT, VAR, DOCSTRING)
1e76143f	68	#else
c99f9605	69	# ifdef SCM_MAGIC_SNARF_DOCS
94a70859	70	# define SCM_SNARF_HERE(X)
c99f9605	71	# define SCM_SNARF_INIT(X)
cecb4a5e	72	# define SCM_SNARF_DOCS(TYPE, CNAME, FNAME, ARGLIST, REQ, OPT, VAR, DOCSTRING) \
ac13d9d2	73	^^ { \
cecb4a5e	74	cname CNAME ^^ \
ac13d9d2 ML	75	fname FNAME ^^ \
	76	type TYPE ^^ \
	77	location __FILE__ __LINE__ ^^ \
	78	arglist ARGLIST ^^ \
	79	argsig REQ OPT VAR ^^ \
	80	DOCSTRING ^^ }
c99f9605 ML	81	# else
	82	# define SCM_SNARF_HERE(X) X
	83	# define SCM_SNARF_INIT(X)
cecb4a5e	84	# define SCM_SNARF_DOCS(TYPE, CNAME, FNAME, ARGLIST, REQ, OPT, VAR, DOCSTRING)
c99f9605	85	# endif
1e76143f	86	#endif
73d8385e	87
46f9baf4	88	#define SCM_DEFINE_GSUBR(FNAME, PRIMNAME, REQ, OPT, VAR, ARGLIST, DOCSTRING) \
94a70859	89	SCM_SNARF_HERE(\
b8d7aacd	90	SCM_UNUSED static const char s_ ## FNAME [] = PRIMNAME; \
4b4d0898 GB	91	SCM FNAME ARGLIST\
4b4d0898 GB	92	)\
94a70859	93	SCM_SNARF_INIT(\
9a441ddb MV	94	scm_c_define_gsubr (s_ ## FNAME, REQ, OPT, VAR, \
9a441ddb MV	95	(SCM_FUNC_CAST_ARBITRARY_ARGS) FNAME); \
2fdcf8bd	96	)\
cecb4a5e	97	SCM_SNARF_DOCS(primitive, FNAME, PRIMNAME, ARGLIST, REQ, OPT, VAR, DOCSTRING)
1bbd0b84	98
46f9baf4 LC	99	/* Always use the generic subr case. */
	100	#define SCM_DEFINE SCM_DEFINE_GSUBR
	101
46f9baf4	102
a48d60b1 MD	103	#define SCM_PRIMITIVE_GENERIC(FNAME, PRIMNAME, REQ, OPT, VAR, ARGLIST, DOCSTRING) \
a48d60b1 MD	104	SCM_SNARF_HERE(\
b8d7aacd	105	SCM_UNUSED static const char s_ ## FNAME [] = PRIMNAME; \
a48d60b1 MD	106	static SCM g_ ## FNAME; \
	107	SCM FNAME ARGLIST\
	108	)\
	109	SCM_SNARF_INIT(\
	110	g_ ## FNAME = SCM_PACK (0); \
	111	scm_c_define_gsubr_with_generic (s_ ## FNAME, REQ, OPT, VAR, \
	112	(SCM_FUNC_CAST_ARBITRARY_ARGS) FNAME, \
	113	&g_ ## FNAME); \
	114	)\
	115	SCM_SNARF_DOCS(primitive, FNAME, PRIMNAME, ARGLIST, REQ, OPT, VAR, DOCSTRING)
	116
5527702a MV	117	#define SCM_DEFINE_PUBLIC(FNAME, PRIMNAME, REQ, OPT, VAR, ARGLIST, DOCSTRING) \
5527702a MV	118	SCM_SNARF_HERE(\
b8d7aacd	119	SCM_UNUSED static const char s_ ## FNAME [] = PRIMNAME; \
5527702a MV	120	SCM FNAME ARGLIST\
	121	)\
	122	SCM_SNARF_INIT(\
	123	scm_c_define_gsubr (s_ ## FNAME, REQ, OPT, VAR, \
	124	(SCM_FUNC_CAST_ARBITRARY_ARGS) FNAME); \
	125	scm_c_export (s_ ## FNAME, NULL); \
	126	)\
	127	SCM_SNARF_DOCS(primitive, FNAME, PRIMNAME, ARGLIST, REQ, OPT, VAR, DOCSTRING)
	128
9b1594fd	129	#define SCM_PROC(RANAME, STR, REQ, OPT, VAR, CFN) \
b8d7aacd	130	SCM_SNARF_HERE(SCM_UNUSED static const char RANAME[]=STR) \
9a441ddb MV	131	SCM_SNARF_INIT(scm_c_define_gsubr (RANAME, REQ, OPT, VAR, \
9a441ddb MV	132	(SCM_FUNC_CAST_ARBITRARY_ARGS) CFN))
9b1594fd	133
1bbd0b84	134	#define SCM_REGISTER_PROC(RANAME, STR, REQ, OPT, VAR, CFN) \
b8d7aacd	135	SCM_SNARF_HERE(SCM_UNUSED static const char RANAME[]=STR) \
9a441ddb MV	136	SCM_SNARF_INIT(scm_c_define_gsubr (RANAME, REQ, OPT, VAR, \
9a441ddb MV	137	(SCM_FUNC_CAST_ARBITRARY_ARGS) CFN);) \
cecb4a5e	138	SCM_SNARF_DOCS(register, CFN, STR, (), REQ, OPT, VAR, \
c99f9605	139	"implemented by the C function \"" #CFN "\"")
3dc81fba	140
9de33deb	141	#define SCM_GPROC(RANAME, STR, REQ, OPT, VAR, CFN, GF) \
94a70859	142	SCM_SNARF_HERE(\
b8d7aacd	143	SCM_UNUSED static const char RANAME[]=STR;\
54778cd3	144	static SCM GF \
94a70859	145	)SCM_SNARF_INIT(\
54778cd3	146	GF = SCM_PACK (0); /* Dirk:FIXME:: Can we safely use #f instead of 0? */ \
9a441ddb MV	147	scm_c_define_gsubr_with_generic (RANAME, REQ, OPT, VAR, \
9a441ddb MV	148	(SCM_FUNC_CAST_ARBITRARY_ARGS) CFN, &GF) \
4b4d0898	149	)
3dc81fba	150
c6054fea LC	151	#ifdef SCM_SUPPORT_STATIC_ALLOCATION
	152
	153	# define SCM_SYMBOL(c_name, scheme_name) \
	154	SCM_SNARF_HERE( \
b68095f0	155	SCM_IMMUTABLE_STRING (scm_i_paste (c_name, _string), scheme_name); \
c6054fea	156	static SCM c_name) \
b68095f0 LC	157	SCM_SNARF_INIT( \
	158	c_name = scm_string_to_symbol (scm_i_paste (c_name, _string)) \
	159	)
c6054fea LC	160
	161	# define SCM_GLOBAL_SYMBOL(c_name, scheme_name) \
	162	SCM_SNARF_HERE( \
b68095f0	163	SCM_IMMUTABLE_STRING (scm_i_paste (c_name, _string), scheme_name); \
c6054fea	164	SCM c_name) \
b68095f0 LC	165	SCM_SNARF_INIT( \
	166	c_name = scm_string_to_symbol (scm_i_paste (c_name, _string)) \
	167	)
c6054fea LC	168
	169	#else /* !SCM_SUPPORT_STATIC_ALLOCATION */
	170
	171	# define SCM_SYMBOL(c_name, scheme_name) \
	172	SCM_SNARF_HERE(static SCM c_name) \
25d50a05	173	SCM_SNARF_INIT(c_name = scm_from_utf8_symbol (scheme_name))
5b4215a8	174
c6054fea LC	175	# define SCM_GLOBAL_SYMBOL(c_name, scheme_name) \
c6054fea LC	176	SCM_SNARF_HERE(SCM c_name) \
25d50a05	177	SCM_SNARF_INIT(c_name = scm_from_utf8_symbol (scheme_name))
78f9f47b	178
c6054fea LC	179	#endif /* !SCM_SUPPORT_STATIC_ALLOCATION */
c6054fea LC	180
37b83f68	181	#define SCM_KEYWORD(c_name, scheme_name) \
94a70859	182	SCM_SNARF_HERE(static SCM c_name) \
e7efe8e7	183	SCM_SNARF_INIT(c_name = scm_from_locale_keyword (scheme_name))
37b83f68	184
37b83f68	185	#define SCM_GLOBAL_KEYWORD(c_name, scheme_name) \
94a70859	186	SCM_SNARF_HERE(SCM c_name) \
e7efe8e7	187	SCM_SNARF_INIT(c_name = scm_from_locale_keyword (scheme_name))
5b4215a8	188
86d31dfe MV	189	#define SCM_VARIABLE(c_name, scheme_name) \
86d31dfe MV	190	SCM_SNARF_HERE(static SCM c_name) \
e7efe8e7	191	SCM_SNARF_INIT(c_name = scm_c_define (scheme_name, SCM_BOOL_F);)
86d31dfe MV	192
	193	#define SCM_GLOBAL_VARIABLE(c_name, scheme_name) \
	194	SCM_SNARF_HERE(SCM c_name) \
e7efe8e7	195	SCM_SNARF_INIT(c_name = scm_c_define (scheme_name, SCM_BOOL_F);)
86d31dfe MV	196
	197	#define SCM_VARIABLE_INIT(c_name, scheme_name, init_val) \
	198	SCM_SNARF_HERE(static SCM c_name) \
e7efe8e7	199	SCM_SNARF_INIT(c_name = scm_c_define (scheme_name, init_val);)
86d31dfe MV	200
	201	#define SCM_GLOBAL_VARIABLE_INIT(c_name, scheme_name, init_val) \
	202	SCM_SNARF_HERE(SCM c_name) \
e7efe8e7	203	SCM_SNARF_INIT(c_name = scm_c_define (scheme_name, init_val);)
86d31dfe	204
28d52ebb MD	205	#define SCM_MUTEX(c_name) \
	206	SCM_SNARF_HERE(static scm_t_mutex c_name) \
	207	SCM_SNARF_INIT(scm_i_plugin_mutex_init (&c_name, &scm_i_plugin_mutex))
9bc4701c	208
28d52ebb MD	209	#define SCM_GLOBAL_MUTEX(c_name) \
	210	SCM_SNARF_HERE(scm_t_mutex c_name) \
	211	SCM_SNARF_INIT(scm_i_plugin_mutex_init (&c_name, &scm_i_plugin_mutex))
9bc4701c	212
28d52ebb MD	213	#define SCM_REC_MUTEX(c_name) \
	214	SCM_SNARF_HERE(static scm_t_rec_mutex c_name) \
	215	SCM_SNARF_INIT(scm_i_plugin_rec_mutex_init (&c_name, &scm_i_plugin_rec_mutex))
9bc4701c	216
28d52ebb MD	217	#define SCM_GLOBAL_REC_MUTEX(c_name) \
28d52ebb MD	218	SCM_SNARF_HERE(scm_t_rec_mutex c_name) \
0b6843b1	219	SCM_SNARF_INIT(scm_i_plugin_rec_mutex_init (&c_name, &scm_i_plugin_rec_mutex))
9bc4701c	220
94e38a65 MV	221	#define SCM_SMOB(tag, scheme_name, size) \
	222	SCM_SNARF_HERE(static scm_t_bits tag) \
	223	SCM_SNARF_INIT((tag)=scm_make_smob_type((scheme_name), (size));)
	224
	225	#define SCM_GLOBAL_SMOB(tag, scheme_name, size) \
	226	SCM_SNARF_HERE(scm_t_bits tag) \
	227	SCM_SNARF_INIT((tag)=scm_make_smob_type((scheme_name), (size));)
	228
	229	#define SCM_SMOB_MARK(tag, c_name, arg) \
	230	SCM_SNARF_HERE(static SCM c_name(SCM arg)) \
	231	SCM_SNARF_INIT(scm_set_smob_mark((tag), (c_name));)
	232
	233	#define SCM_GLOBAL_SMOB_MARK(tag, c_name, arg) \
	234	SCM_SNARF_HERE(SCM c_name(SCM arg)) \
	235	SCM_SNARF_INIT(scm_set_smob_mark((tag), (c_name));)
	236
	237	#define SCM_SMOB_FREE(tag, c_name, arg) \
	238	SCM_SNARF_HERE(static size_t c_name(SCM arg)) \
	239	SCM_SNARF_INIT(scm_set_smob_free((tag), (c_name));)
	240
	241	#define SCM_GLOBAL_SMOB_FREE(tag, c_name, arg) \
	242	SCM_SNARF_HERE(size_t c_name(SCM arg)) \
	243	SCM_SNARF_INIT(scm_set_smob_free((tag), (c_name));)
	244
	245	#define SCM_SMOB_PRINT(tag, c_name, obj, port, pstate) \
	246	SCM_SNARF_HERE(static int c_name(SCM obj, SCM port, scm_print_state* pstate)) \
	247	SCM_SNARF_INIT(scm_set_smob_print((tag), (c_name));)
	248
	249	#define SCM_GLOBAL_SMOB_PRINT(tag, c_name, obj, port, pstate) \
	250	SCM_SNARF_HERE(int c_name(SCM obj, SCM port, scm_print_state* pstate)) \
	251	SCM_SNARF_INIT(scm_set_smob_print((tag), (c_name));)
	252
	253	#define SCM_SMOB_EQUALP(tag, c_name, obj1, obj2) \
	254	SCM_SNARF_HERE(static SCM c_name(SCM obj1, SCM obj2)) \
	255	SCM_SNARF_INIT(scm_set_smob_equalp((tag), (c_name));)
	256
	257	#define SCM_GLOBAL_SMOB_EQUALP(tag, c_name, obj1, obj2) \
	258	SCM_SNARF_HERE(SCM c_name(SCM obj1, SCM obj2)) \
	259	SCM_SNARF_INIT(scm_set_smob_equalp((tag), (c_name));)
	260
	261	#define SCM_SMOB_APPLY(tag, c_name, req, opt, rest, arglist) \
	262	SCM_SNARF_HERE(static SCM c_name arglist) \
	263	SCM_SNARF_INIT(scm_set_smob_apply((tag), (c_name), (req), (opt), (rest));)
	264
	265	#define SCM_GLOBAL_SMOB_APPLY(tag, c_name, req, opt, rest, arglist) \
	266	SCM_SNARF_HERE(SCM c_name arglist) \
	267	SCM_SNARF_INIT(scm_set_smob_apply((tag), (c_name), (req), (opt), (rest));)
	268
c6054fea LC	269	\f
	270	/* Low-level snarfing for static memory allocation. */
	271
	272	#ifdef SCM_SUPPORT_STATIC_ALLOCATION
	273
fd12a19a AW	274	#define SCM_IMMUTABLE_CELL(c_name, car, cdr) \
	275	static SCM_ALIGNED (8) SCM_UNUSED const scm_t_cell \
	276	c_name ## _raw_scell = \
	277	{ \
	278	SCM_PACK (car), \
	279	SCM_PACK (cdr) \
	280	}; \
	281	static SCM_UNUSED const SCM c_name = SCM_PACK (& c_name ## _raw_scell)
	282
c6054fea LC	283	#define SCM_IMMUTABLE_DOUBLE_CELL(c_name, car, cbr, ccr, cdr) \
	284	static SCM_ALIGNED (8) SCM_UNUSED const scm_t_cell \
	285	c_name ## _raw_cell [2] = \
	286	{ \
	287	{ SCM_PACK (car), SCM_PACK (cbr) }, \
	288	{ SCM_PACK (ccr), SCM_PACK (cdr) } \
	289	}; \
	290	static SCM_UNUSED const SCM c_name = SCM_PACK (& c_name ## _raw_cell)
	291
fd12a19a AW	292	#define SCM_STATIC_DOUBLE_CELL(c_name, car, cbr, ccr, cdr) \
	293	static SCM_ALIGNED (8) SCM_UNUSED scm_t_cell \
	294	c_name ## _raw_cell [2] = \
	295	{ \
	296	{ SCM_PACK (car), SCM_PACK (cbr) }, \
	297	{ SCM_PACK (ccr), SCM_PACK (cdr) } \
	298	}; \
	299	static SCM_UNUSED SCM c_name = SCM_PACK (& c_name ## _raw_cell)
	300
5f236208 LC	301	#define SCM_IMMUTABLE_STRINGBUF(c_name, contents) \
	302	static SCM_UNUSED const \
	303	struct \
	304	{ \
	305	scm_t_bits word_0; \
	306	scm_t_bits word_1; \
	307	const char buffer[sizeof (contents)]; \
	308	} \
	309	c_name = \
	310	{ \
	311	scm_tc7_stringbuf \| SCM_I_STRINGBUF_F_SHARED, \
	312	sizeof (contents) - 1, \
	313	contents \
	314	}
c6054fea LC	315
c6054fea LC	316	#define SCM_IMMUTABLE_STRING(c_name, contents) \
b68095f0	317	SCM_IMMUTABLE_STRINGBUF (scm_i_paste (c_name, _stringbuf), contents); \
c6054fea LC	318	SCM_IMMUTABLE_DOUBLE_CELL (c_name, \
c6054fea LC	319	scm_tc7_ro_string, \
b68095f0	320	(scm_t_bits) &scm_i_paste (c_name, \
5f236208	321	_stringbuf), \
c6054fea	322	(scm_t_bits) 0, \
544a29de	323	(scm_t_bits) (sizeof (contents) - 1))
c6054fea	324
5b46a8c2 LC	325	#define SCM_IMMUTABLE_POINTER(c_name, ptr) \
5b46a8c2 LC	326	SCM_IMMUTABLE_CELL (c_name, scm_tc7_pointer, ptr)
fd12a19a	327
c6054fea LC	328	#endif /* SCM_SUPPORT_STATIC_ALLOCATION */
	329
	330	\f
	331	/* Documentation. */
94e38a65	332
c99f9605	333	#ifdef SCM_MAGIC_SNARF_DOCS
4b4d0898	334	#undef SCM_ASSERT
ac13d9d2	335	#define SCM_ASSERT(_cond, _arg, _pos, _subr) ^^ argpos _arg _pos __LINE__ ^^
c99f9605	336	#endif /* SCM_MAGIC_SNARF_DOCS */
2e07d033	337
b29058ff	338	#endif /* SCM_SNARF_H */
89e00824 ML	339
	340	/*
	341	Local Variables:
	342	c-file-style: "gnu"
	343	End:
	344	*/