123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345 |
- #ifndef SCM_SNARF_H
- #define SCM_SNARF_H
- #define SCM_FUNC_CAST_ARBITRARY_ARGS scm_t_subr
- #ifdef SCM_ALIGNED
- # define SCM_SUPPORT_STATIC_ALLOCATION
- #endif
- #define scm_i_paste(x, y) x ## y
- #define scm_i_paste3(a, b, c) a ## b ## c
- #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(\
- 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)
- #define SCM_DEFINE SCM_DEFINE_GSUBR
- #define SCM_PRIMITIVE_GENERIC(FNAME, PRIMNAME, REQ, OPT, VAR, ARGLIST, DOCSTRING) \
- SCM_SNARF_HERE(\
- 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(\
- 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(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(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(\
- static const char RANAME[]=STR;\
- static SCM GF \
- )SCM_SNARF_INIT(\
- GF = SCM_PACK (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));)
- #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 */
- #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 */
|