X-Git-Url: http://git.hcoop.net/bpt/guile.git/blobdiff_plain/e6bd58af8fd847dc1e7af2c8d658905ea889edca..8cb0d6d7fa9aaac316c29a64c541336b51b6f93d:/libguile/snarf.h diff --git a/libguile/snarf.h b/libguile/snarf.h index 360cb9483..1655e2c8d 100644 --- a/libguile/snarf.h +++ b/libguile/snarf.h @@ -3,7 +3,8 @@ #ifndef SCM_SNARF_H #define SCM_SNARF_H -/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2004, 2006, 2009, 2010 Free Software Foundation, Inc. +/* Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, + * 2004, 2006, 2009, 2010, 2011, 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 @@ -25,18 +26,11 @@ /* Macros for snarfing initialization actions from C source. */ -#if defined(__cplusplus) || defined(GUILE_CPLUSPLUS_SNARF) +/* Casting to a function that can take any number of arguments. */ +#define SCM_FUNC_CAST_ARBITRARY_ARGS scm_t_subr -/* This used to be "SCM (*)(...)" but GCC on RedHat 7.1 doesn't seem - to like it. - */ -#define SCM_FUNC_CAST_ARBITRARY_ARGS SCM (*)() - -#else -#define SCM_FUNC_CAST_ARBITRARY_ARGS SCM (*)() -#endif -#if (defined SCM_ALIGNED) && (SCM_DEBUG_TYPING_STRICTNESS <= 1) +#ifdef SCM_ALIGNED /* We support static allocation of some `SCM' objects. */ # define SCM_SUPPORT_STATIC_ALLOCATION #endif @@ -59,11 +53,17 @@ * 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(X) ^^ 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 @@ -87,7 +87,7 @@ DOCSTRING ^^ } #define SCM_DEFINE_GSUBR(FNAME, PRIMNAME, REQ, OPT, VAR, ARGLIST, DOCSTRING) \ SCM_SNARF_HERE(\ -static const char s_ ## FNAME [] = PRIMNAME; \ +SCM_UNUSED static const char s_ ## FNAME [] = PRIMNAME; \ SCM FNAME ARGLIST\ )\ SCM_SNARF_INIT(\ @@ -103,9 +103,9 @@ SCM_SNARF_DOCS(primitive, FNAME, PRIMNAME, ARGLIST, REQ, OPT, VAR, DOCSTRING) #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_UNUSED static const char scm_i_paste (s_, FNAME) [] = PRIMNAME; \ SCM_API SCM FNAME ARGLIST; \ - SCM_IMMUTABLE_FOREIGN (scm_i_paste (FNAME, __subr_foreign), \ + SCM_IMMUTABLE_POINTER (scm_i_paste (FNAME, __subr_foreign), \ (scm_t_bits) &FNAME); /* the subr */ \ SCM_STATIC_SUBR_OBJVECT (scm_i_paste (FNAME, __raw_objtable), \ /* FIXME: directly be the foreign */ \ @@ -141,7 +141,7 @@ SCM_SNARF_DOCS(primitive, FNAME, PRIMNAME, ARGLIST, REQ, OPT, VAR, DOCSTRING) #define SCM_PRIMITIVE_GENERIC(FNAME, PRIMNAME, REQ, OPT, VAR, ARGLIST, DOCSTRING) \ SCM_SNARF_HERE(\ -static const char s_ ## FNAME [] = PRIMNAME; \ +SCM_UNUSED static const char s_ ## FNAME [] = PRIMNAME; \ static SCM g_ ## FNAME; \ SCM FNAME ARGLIST\ )\ @@ -155,7 +155,7 @@ 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_UNUSED static const char s_ ## FNAME [] = PRIMNAME; \ SCM FNAME ARGLIST\ )\ SCM_SNARF_INIT(\ @@ -166,12 +166,12 @@ 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_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(static const char RANAME[]=STR) \ +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, \ @@ -179,7 +179,7 @@ SCM_SNARF_DOCS(register, CFN, STR, (), REQ, OPT, VAR, \ #define SCM_GPROC(RANAME, STR, REQ, OPT, VAR, CFN, GF) \ SCM_SNARF_HERE(\ -static const char RANAME[]=STR;\ +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? */ \ @@ -359,12 +359,10 @@ SCM_SNARF_INIT(scm_set_smob_apply((tag), (c_name), (req), (opt), (rest));) (scm_t_bits) &scm_i_paste (c_name, \ _stringbuf), \ (scm_t_bits) 0, \ - (scm_t_bits) sizeof (contents) - 1) + (scm_t_bits) (sizeof (contents) - 1)) -#define SCM_IMMUTABLE_FOREIGN(c_name, ptr) \ - SCM_IMMUTABLE_CELL (c_name, \ - scm_tc7_foreign | (SCM_FOREIGN_TYPE_VOID << 8), \ - ptr) +#define SCM_IMMUTABLE_POINTER(c_name, ptr) \ + SCM_IMMUTABLE_CELL (c_name, scm_tc7_pointer, ptr) /* for primitive-generics, add a foreign to the end */ #define SCM_STATIC_SUBR_OBJVECT(c_name, foreign) \ @@ -374,14 +372,19 @@ SCM_SNARF_INIT(scm_set_smob_apply((tag), (c_name), (req), (opt), (rest));) SCM_PACK (0), \ foreign, \ SCM_BOOL_F, /* the name */ \ - }; \ + } #define SCM_STATIC_PROGRAM(c_name, objcode, objtable, freevars) \ - SCM_STATIC_DOUBLE_CELL (c_name, \ - scm_tc7_program | SCM_F_PROGRAM_IS_PRIMITIVE, \ - (scm_t_bits) objcode, \ - (scm_t_bits) objtable, \ - (scm_t_bits) freevars) + static SCM_ALIGNED (8) SCM_UNUSED SCM \ + scm_i_paste (c_name, _raw_cell)[] = \ + { \ + SCM_PACK (scm_tc7_program | SCM_F_PROGRAM_IS_PRIMITIVE), \ + objcode, \ + objtable, \ + freevars \ + }; \ + static SCM_UNUSED const SCM c_name = \ + SCM_PACK (& scm_i_paste (c_name, _raw_cell)) #endif /* SCM_SUPPORT_STATIC_ALLOCATION */