mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-30 06:50:31 +02:00
Code Activity

fix static allocation with debug_typing_strictness==2

Browse source 
* libguile/tags.h (SCM): For SCM_DEBUG_TYPING_STRICTNESS==2, give the
  union a tag, and use C99 compound literals to construct the value.
  This allows SCM_PACK to be a constant expression.

* libguile/snarf.h: Allow SCM_SUPPORT_STATIC_ALLOCATION for
  SCM_DEBUG_TYPING_STRICTNESS==2.
  (SCM_IMMUTABLE_STRING): Properly parenthesize the string length.
  (SCM_STATIC_PROGRAM): Fix for SCM_DEBUG_TYPING_STRICTNESS==2.
This commit is contained in:
Andy Wingo 2011-05-12 23:29:16 +02:00
parent b5070556c5
commit 544a29de14
2 changed files with 14 additions and 10 deletions
Download patch file Download diff file Expand all files Collapse all files

19
libguile/snarf.h
View file

@ -30,7 +30,7 @@
#define SCM_FUNC_CAST_ARBITRARY_ARGS scm_t_subr #define SCM_FUNC_CAST_ARBITRARY_ARGS scm_t_subr
#if (defined SCM_ALIGNED) && (SCM_DEBUG_TYPING_STRICTNESS <= 1) #ifdef SCM_ALIGNED
/* We support static allocation of some `SCM' objects. */ /* We support static allocation of some `SCM' objects. */
# define SCM_SUPPORT_STATIC_ALLOCATION # define SCM_SUPPORT_STATIC_ALLOCATION
#endif #endif
@ -359,7 +359,7 @@ SCM_SNARF_INIT(scm_set_smob_apply((tag), (c_name), (req), (opt), (rest));)
(scm_t_bits) &scm_i_paste (c_name, \ (scm_t_bits) &scm_i_paste (c_name, \
_stringbuf), \ _stringbuf), \
(scm_t_bits) 0, \ (scm_t_bits) 0, \
(scm_t_bits) sizeof (contents) - 1) (scm_t_bits) (sizeof (contents) - 1))
#define SCM_IMMUTABLE_POINTER(c_name, ptr) \ #define SCM_IMMUTABLE_POINTER(c_name, ptr) \
SCM_IMMUTABLE_CELL (c_name, scm_tc7_pointer, ptr) SCM_IMMUTABLE_CELL (c_name, scm_tc7_pointer, ptr)
@ -375,11 +375,16 @@ SCM_SNARF_INIT(scm_set_smob_apply((tag), (c_name), (req), (opt), (rest));)
}; \ }; \
#define SCM_STATIC_PROGRAM(c_name, objcode, objtable, freevars) \ #define SCM_STATIC_PROGRAM(c_name, objcode, objtable, freevars) \
SCM_STATIC_DOUBLE_CELL (c_name, \ static SCM_ALIGNED (8) SCM_UNUSED SCM \
scm_tc7_program | SCM_F_PROGRAM_IS_PRIMITIVE, \ scm_i_paste (c_name, _raw_cell)[] = \
(scm_t_bits) objcode, \ { \
(scm_t_bits) objtable, \ SCM_PACK (scm_tc7_program | SCM_F_PROGRAM_IS_PRIMITIVE), \
(scm_t_bits) freevars) objcode, \
objtable, \
freevars \
}; \
static SCM_UNUSED const SCM c_name = \
SCM_PACK (& scm_i_paste (c_name, _raw_cell))
#endif /* SCM_SUPPORT_STATIC_ALLOCATION */ #endif /* SCM_SUPPORT_STATIC_ALLOCATION */

5
libguile/tags.h
View file

@ -74,10 +74,9 @@ typedef scm_t_uintptr scm_t_bits;
* desired level of type checking, be defined in several ways: * desired level of type checking, be defined in several ways:
*/ */
#if (SCM_DEBUG_TYPING_STRICTNESS == 2) #if (SCM_DEBUG_TYPING_STRICTNESS == 2)
typedef union { struct { scm_t_bits n; } n; } SCM; typedef union SCM { struct { scm_t_bits n; } n; } SCM;
static SCM scm_pack(scm_t_bits b) { SCM s; s.n.n = b; return s; }
# define SCM_UNPACK(x) ((x).n.n) # define SCM_UNPACK(x) ((x).n.n)
# define SCM_PACK(x) (scm_pack ((scm_t_bits) (x))) # define SCM_PACK(x) ((SCM) { { (scm_t_bits) (x) } })
#elif (SCM_DEBUG_TYPING_STRICTNESS == 1) #elif (SCM_DEBUG_TYPING_STRICTNESS == 1)
/* This is the default, which provides an intermediate level of compile time /* This is the default, which provides an intermediate level of compile time
* type checking while still resulting in very efficient code. * type checking while still resulting in very efficient code.