mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-30 03:40:34 +02:00
scm_new_smob, scm_new_double_smob inline functions
* libguile/smob.h (scm_new_smob, scm_new_double_smob): New constructors, which do what SCM_NEWSMOB / SCM_NEWSMOB3 had done, but with inline functions instead of macros. They also bail to scm_i_new_smob / scm_i_new_double_smob in either the mark or the free case, so that the inline definition doesn't reference other internal details like libgc stuff. (SCM_SMOB_TYPE_MASK et al): Move definitions up so the new_smob see them as already being declared. (SCM_NEWSMOB, SCM_RETURN_NEWSMOB, SCM_NEWSMOB2, SCM_RETURN_NEWSMOB2): (SCM_NEWSMOB3, SCM_RETURN_NEWSMOB3): Reimplement in terms of the new inline functions. Remove now-unneeded bdw-gc include. * libguile/smob.c (finalize_smob): Rename from scm_i_finalize_smob, and make static. (scm_i_new_smob, scm_i_new_double_smob): Slow-path allocators. (scm_i_finalize_smob, scm_i_new_smob_with_mark_proc): Add back-compatibility shims to preserve ABI. * libguile/inline.c: Include smob.h, so as to reify scm_new_smob and scm_new_double_smob.
This commit is contained in:
parent
42d691ee16
commit
c46fee438c
3 changed files with 165 additions and 105 deletions
|
@ -24,3 +24,4 @@
|
|||
#define SCM_INLINE_C_IMPLEMENTING_INLINES 1
|
||||
#include "libguile/inline.h"
|
||||
#include "libguile/gc.h"
|
||||
#include "libguile/smob.h"
|
||||
|
|
115
libguile/smob.c
115
libguile/smob.c
|
@ -1,4 +1,4 @@
|
|||
/* Copyright (C) 1995,1996,1998,1999,2000,2001, 2003, 2004, 2006, 2009, 2010, 2011 Free Software Foundation, Inc.
|
||||
/* Copyright (C) 1995,1996,1998,1999,2000,2001, 2003, 2004, 2006, 2009, 2010, 2011, 2012 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
|
||||
|
@ -472,8 +472,8 @@ scm_make_smob (scm_t_bits tc)
|
|||
static int smob_gc_kind;
|
||||
|
||||
|
||||
/* The generic SMOB mark procedure that gets called for SMOBs allocated with
|
||||
`scm_i_new_smob_with_mark_proc ()'. */
|
||||
/* The generic SMOB mark procedure that gets called for SMOBs allocated
|
||||
with smob_gc_kind. */
|
||||
static struct GC_ms_entry *
|
||||
smob_mark (GC_word *addr, struct GC_ms_entry *mark_stack_ptr,
|
||||
struct GC_ms_entry *mark_stack_limit, GC_word env)
|
||||
|
@ -562,28 +562,10 @@ scm_gc_mark (SCM o)
|
|||
#undef CURRENT_MARK_LIMIT
|
||||
}
|
||||
|
||||
/* Return a SMOB with typecode TC. The SMOB type corresponding to TC may
|
||||
provide a custom mark procedure and it will be honored. */
|
||||
SCM
|
||||
scm_i_new_smob_with_mark_proc (scm_t_bits tc, scm_t_bits data1,
|
||||
scm_t_bits data2, scm_t_bits data3)
|
||||
{
|
||||
/* Return a double cell. */
|
||||
SCM cell = SCM_PACK (GC_generic_malloc (2 * sizeof (scm_t_cell),
|
||||
smob_gc_kind));
|
||||
|
||||
SCM_SET_CELL_WORD_3 (cell, data3);
|
||||
SCM_SET_CELL_WORD_2 (cell, data2);
|
||||
SCM_SET_CELL_WORD_1 (cell, data1);
|
||||
SCM_SET_CELL_WORD_0 (cell, tc);
|
||||
|
||||
return cell;
|
||||
}
|
||||
|
||||
|
||||
/* Finalize SMOB by calling its SMOB type's free function, if any. */
|
||||
void
|
||||
scm_i_finalize_smob (GC_PTR ptr, GC_PTR data)
|
||||
static void
|
||||
finalize_smob (GC_PTR ptr, GC_PTR data)
|
||||
{
|
||||
SCM smob;
|
||||
size_t (* free_smob) (SCM);
|
||||
|
@ -599,6 +581,93 @@ scm_i_finalize_smob (GC_PTR ptr, GC_PTR data)
|
|||
free_smob (smob);
|
||||
}
|
||||
|
||||
/* Return a SMOB with typecode TC. The SMOB type corresponding to TC may
|
||||
provide a custom mark procedure and it will be honored. */
|
||||
SCM
|
||||
scm_i_new_smob (scm_t_bits tc, scm_t_bits data)
|
||||
{
|
||||
scm_t_bits smobnum = SCM_TC2SMOBNUM (tc);
|
||||
SCM ret;
|
||||
|
||||
/* Use the smob_gc_kind if needed to allow the mark procedure to
|
||||
run. Since the marker only deals with double cells, that case
|
||||
allocates a double cell. We leave words 2 and 3 to there initial
|
||||
values, which is 0. */
|
||||
if (scm_smobs [smobnum].mark)
|
||||
ret = PTR2SCM (GC_generic_malloc (2 * sizeof (scm_t_cell), smob_gc_kind));
|
||||
else
|
||||
ret = PTR2SCM (GC_MALLOC (sizeof (scm_t_cell)));
|
||||
|
||||
SCM_SET_CELL_WORD_1 (ret, data);
|
||||
SCM_SET_CELL_WORD_0 (ret, tc);
|
||||
|
||||
if (scm_smobs[smobnum].free)
|
||||
{
|
||||
GC_finalization_proc prev_finalizer;
|
||||
GC_PTR prev_finalizer_data;
|
||||
|
||||
GC_REGISTER_FINALIZER_NO_ORDER (SCM2PTR (ret),
|
||||
finalize_smob, NULL,
|
||||
&prev_finalizer, &prev_finalizer_data);
|
||||
}
|
||||
|
||||
return ret;
|
||||
}
|
||||
|
||||
/* Return a SMOB with typecode TC. The SMOB type corresponding to TC may
|
||||
provide a custom mark procedure and it will be honored. */
|
||||
SCM
|
||||
scm_i_new_double_smob (scm_t_bits tc, scm_t_bits data1,
|
||||
scm_t_bits data2, scm_t_bits data3)
|
||||
{
|
||||
scm_t_bits smobnum = SCM_TC2SMOBNUM (tc);
|
||||
SCM ret;
|
||||
|
||||
/* Use the smob_gc_kind if needed to allow the mark procedure to
|
||||
run. */
|
||||
if (scm_smobs [smobnum].mark)
|
||||
ret = PTR2SCM (GC_generic_malloc (2 * sizeof (scm_t_cell), smob_gc_kind));
|
||||
else
|
||||
ret = PTR2SCM (GC_MALLOC (2 * sizeof (scm_t_cell)));
|
||||
|
||||
SCM_SET_CELL_WORD_3 (ret, data3);
|
||||
SCM_SET_CELL_WORD_2 (ret, data2);
|
||||
SCM_SET_CELL_WORD_1 (ret, data1);
|
||||
SCM_SET_CELL_WORD_0 (ret, tc);
|
||||
|
||||
if (scm_smobs[smobnum].free)
|
||||
{
|
||||
GC_finalization_proc prev_finalizer;
|
||||
GC_PTR prev_finalizer_data;
|
||||
|
||||
GC_REGISTER_FINALIZER_NO_ORDER (SCM2PTR (ret),
|
||||
finalize_smob, NULL,
|
||||
&prev_finalizer, &prev_finalizer_data);
|
||||
}
|
||||
|
||||
return ret;
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
/* These two are internal details of the previous implementation of
|
||||
SCM_NEWSMOB and are no longer used. They are still here to preserve
|
||||
ABI stability in the 2.0 series. */
|
||||
void
|
||||
scm_i_finalize_smob (GC_PTR ptr, GC_PTR data)
|
||||
{
|
||||
finalize_smob (ptr, data);
|
||||
}
|
||||
|
||||
SCM
|
||||
scm_i_new_smob_with_mark_proc (scm_t_bits tc, scm_t_bits word1,
|
||||
scm_t_bits word2, scm_t_bits word3)
|
||||
{
|
||||
return scm_new_double_smob (tc, word1, word2, word3);
|
||||
}
|
||||
|
||||
|
||||
|
||||
void
|
||||
scm_smob_prehistory ()
|
||||
|
|
154
libguile/smob.h
154
libguile/smob.h
|
@ -4,7 +4,7 @@
|
|||
#define SCM_SMOB_H
|
||||
|
||||
/* Copyright (C) 1995, 1996, 1998, 1999, 2000, 2001, 2004, 2006, 2009,
|
||||
* 2010, 2011 Free Software Foundation, Inc.
|
||||
* 2010, 2011, 2012 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
|
||||
|
@ -27,8 +27,6 @@
|
|||
#include "libguile/__scm.h"
|
||||
#include "libguile/print.h"
|
||||
|
||||
#include "libguile/bdw-gc.h"
|
||||
|
||||
|
||||
|
||||
/* This is the internal representation of a smob type */
|
||||
|
@ -46,78 +44,87 @@ typedef struct scm_smob_descriptor
|
|||
} scm_smob_descriptor;
|
||||
|
||||
|
||||
#define SCM_SMOB_TYPE_MASK 0xffff
|
||||
#define SCM_SMOB_TYPE_BITS(tc) (tc)
|
||||
#define SCM_TC2SMOBNUM(x) (0x0ff & ((x) >> 8))
|
||||
#define SCM_SMOBNUM(x) (SCM_TC2SMOBNUM (SCM_CELL_TYPE (x)))
|
||||
/* SCM_SMOBNAME can be 0 if name is missing */
|
||||
#define SCM_SMOBNAME(smobnum) (scm_smobs[smobnum].name)
|
||||
#define SCM_SMOB_PREDICATE(tag, obj) SCM_TYP16_PREDICATE (tag, obj)
|
||||
#define SCM_SMOB_DESCRIPTOR(x) (scm_smobs[SCM_SMOBNUM (x)])
|
||||
#define SCM_SMOB_APPLICABLE_P(x) (SCM_SMOB_DESCRIPTOR (x).apply)
|
||||
|
||||
/* Maximum number of SMOB types. */
|
||||
#define SCM_I_MAX_SMOB_TYPE_COUNT 256
|
||||
|
||||
SCM_API long scm_numsmob;
|
||||
SCM_API scm_smob_descriptor scm_smobs[];
|
||||
|
||||
|
||||
|
||||
SCM_API SCM scm_i_new_smob_with_mark_proc (scm_t_bits tc,
|
||||
scm_t_bits, scm_t_bits, scm_t_bits);
|
||||
|
||||
SCM_API SCM scm_i_new_smob (scm_t_bits tc, scm_t_bits);
|
||||
SCM_API SCM scm_i_new_double_smob (scm_t_bits tc, scm_t_bits,
|
||||
scm_t_bits, scm_t_bits);
|
||||
|
||||
|
||||
SCM_INLINE SCM scm_new_smob (scm_t_bits tc, scm_t_bits);
|
||||
SCM_INLINE SCM scm_new_double_smob (scm_t_bits tc, scm_t_bits,
|
||||
scm_t_bits, scm_t_bits);
|
||||
|
||||
#define SCM_NEWSMOB(z, tc, data) \
|
||||
do \
|
||||
{ \
|
||||
register scm_t_bits _smobnum = SCM_TC2SMOBNUM (tc); \
|
||||
z = (scm_smobs[_smobnum].mark \
|
||||
? scm_i_new_smob_with_mark_proc ((tc), (scm_t_bits)(data), \
|
||||
0, 0) \
|
||||
: scm_cell (tc, (scm_t_bits)(data))); \
|
||||
if (scm_smobs[_smobnum].free) \
|
||||
{ \
|
||||
GC_finalization_proc _prev_finalizer; \
|
||||
GC_PTR _prev_finalizer_data; \
|
||||
\
|
||||
GC_REGISTER_FINALIZER_NO_ORDER (SCM2PTR (z), scm_i_finalize_smob, \
|
||||
NULL, \
|
||||
&_prev_finalizer, \
|
||||
&_prev_finalizer_data); \
|
||||
} \
|
||||
} \
|
||||
while (0)
|
||||
/* These two are internal details of the previous implementation of
|
||||
SCM_NEWSMOB and are no longer used. They are still here to preserve
|
||||
ABI stability in the 2.0 series. */
|
||||
SCM_API void scm_i_finalize_smob (GC_PTR ptr, GC_PTR data);
|
||||
SCM_API SCM scm_i_new_smob_with_mark_proc (scm_t_bits tc, scm_t_bits,
|
||||
scm_t_bits, scm_t_bits);
|
||||
|
||||
#define SCM_RETURN_NEWSMOB(tc, data) \
|
||||
do { SCM __SCM_smob_answer; \
|
||||
SCM_NEWSMOB (__SCM_smob_answer, (tc), (data)); \
|
||||
return __SCM_smob_answer; \
|
||||
} while (0)
|
||||
|
||||
#define SCM_NEWSMOB2(z, tc, data1, data2) \
|
||||
SCM_NEWSMOB3 (z, tc, data1, data2, 0)
|
||||
#if SCM_CAN_INLINE || defined SCM_INLINE_C_IMPLEMENTING_INLINES
|
||||
SCM_INLINE_IMPLEMENTATION SCM
|
||||
scm_new_smob (scm_t_bits tc, scm_t_bits data)
|
||||
{
|
||||
scm_t_bits smobnum = SCM_TC2SMOBNUM (tc);
|
||||
|
||||
#define SCM_RETURN_NEWSMOB2(tc, data1, data2) \
|
||||
do { SCM __SCM_smob_answer; \
|
||||
SCM_NEWSMOB2 (__SCM_smob_answer, (tc), (data1), (data2)); \
|
||||
return __SCM_smob_answer; \
|
||||
} while (0)
|
||||
if (SCM_UNLIKELY (scm_smobs[smobnum].mark || scm_smobs[smobnum].free))
|
||||
return scm_i_new_smob (tc, data);
|
||||
else
|
||||
return scm_cell (tc, data);
|
||||
}
|
||||
|
||||
#define SCM_NEWSMOB3(z, tc, data1, data2, data3) \
|
||||
do \
|
||||
{ \
|
||||
register scm_t_bits _smobnum = SCM_TC2SMOBNUM (tc); \
|
||||
z = (scm_smobs[_smobnum].mark \
|
||||
? scm_i_new_smob_with_mark_proc (tc, (scm_t_bits)(data1), \
|
||||
(scm_t_bits)(data2), \
|
||||
(scm_t_bits)(data3)) \
|
||||
: scm_double_cell ((tc), (scm_t_bits)(data1), \
|
||||
(scm_t_bits)(data2), \
|
||||
(scm_t_bits)(data3))); \
|
||||
if (scm_smobs[_smobnum].free) \
|
||||
{ \
|
||||
GC_finalization_proc _prev_finalizer; \
|
||||
GC_PTR _prev_finalizer_data; \
|
||||
\
|
||||
GC_REGISTER_FINALIZER_NO_ORDER (SCM2PTR (z), scm_i_finalize_smob, \
|
||||
NULL, \
|
||||
&_prev_finalizer, \
|
||||
&_prev_finalizer_data); \
|
||||
} \
|
||||
} \
|
||||
while (0)
|
||||
SCM_INLINE_IMPLEMENTATION SCM
|
||||
scm_new_double_smob (scm_t_bits tc, scm_t_bits data1,
|
||||
scm_t_bits data2, scm_t_bits data3)
|
||||
{
|
||||
scm_t_bits smobnum = SCM_TC2SMOBNUM (tc);
|
||||
|
||||
#define SCM_RETURN_NEWSMOB3(tc, data1, data2, data3) \
|
||||
do { SCM __SCM_smob_answer; \
|
||||
SCM_NEWSMOB3 (__SCM_smob_answer, (tc), (data1), (data2), (data3)); \
|
||||
return __SCM_smob_answer; \
|
||||
} while (0)
|
||||
if (SCM_UNLIKELY (scm_smobs[smobnum].mark || scm_smobs[smobnum].free))
|
||||
return scm_i_new_double_smob (tc, data1, data2, data3);
|
||||
else
|
||||
return scm_double_cell (tc, data1, data2, data3);
|
||||
}
|
||||
#endif
|
||||
|
||||
#define SCM_NEWSMOB(z, tc, data) \
|
||||
z = scm_new_smob ((tc), (scm_t_bits)(data))
|
||||
#define SCM_RETURN_NEWSMOB(tc, data) \
|
||||
return scm_new_smob ((tc), (scm_t_bits)(data))
|
||||
|
||||
#define SCM_NEWSMOB2(z, tc, data1, data2) \
|
||||
z = scm_new_double_smob ((tc), (scm_t_bits)(data1), \
|
||||
(scm_t_bits)(data2), 0)
|
||||
#define SCM_RETURN_NEWSMOB2(tc, data1, data2) \
|
||||
return scm_new_double_smob ((tc), (scm_t_bits)(data1), \
|
||||
(scm_t_bits)(data2), 0)
|
||||
|
||||
#define SCM_NEWSMOB3(z, tc, data1, data2, data3) \
|
||||
z = scm_new_double_smob ((tc), (scm_t_bits)(data1), \
|
||||
(scm_t_bits)(data2), (scm_t_bits)(data3))
|
||||
#define SCM_RETURN_NEWSMOB3(tc, data1, data2, data3) \
|
||||
return scm_new_double_smob ((tc), (scm_t_bits)(data1), \
|
||||
(scm_t_bits)(data2), (scm_t_bits)(data3))
|
||||
|
||||
|
||||
|
||||
#define SCM_SMOB_DATA_N(x, n) (SCM_CELL_WORD ((x), (n)))
|
||||
#define SCM_SET_SMOB_DATA_N(x, n, data) (SCM_SET_CELL_WORD ((x), (n), (data)))
|
||||
|
@ -158,28 +165,11 @@ while (0)
|
|||
#define SCM_SMOB_OBJECT_LOC(x) (SCM_SMOB_OBJECT_1_LOC (x)))
|
||||
|
||||
|
||||
#define SCM_SMOB_TYPE_MASK 0xffff
|
||||
#define SCM_SMOB_TYPE_BITS(tc) (tc)
|
||||
#define SCM_TC2SMOBNUM(x) (0x0ff & ((x) >> 8))
|
||||
#define SCM_SMOBNUM(x) (SCM_TC2SMOBNUM (SCM_CELL_TYPE (x)))
|
||||
/* SCM_SMOBNAME can be 0 if name is missing */
|
||||
#define SCM_SMOBNAME(smobnum) (scm_smobs[smobnum].name)
|
||||
#define SCM_SMOB_PREDICATE(tag, obj) SCM_TYP16_PREDICATE (tag, obj)
|
||||
#define SCM_SMOB_DESCRIPTOR(x) (scm_smobs[SCM_SMOBNUM (x)])
|
||||
#define SCM_SMOB_APPLICABLE_P(x) (SCM_SMOB_DESCRIPTOR (x).apply)
|
||||
#define SCM_SMOB_APPLY_0(x) (scm_call_0 (x))
|
||||
#define SCM_SMOB_APPLY_1(x, a1) (scm_call_1 (x, a1))
|
||||
#define SCM_SMOB_APPLY_2(x, a1, a2) (scm_call_2 (x, a1, a2))
|
||||
#define SCM_SMOB_APPLY_3(x, a1, a2, rst) (scm_call_3 (x, a1, a2, a3))
|
||||
|
||||
/* Maximum number of SMOB types. */
|
||||
#define SCM_I_MAX_SMOB_TYPE_COUNT 256
|
||||
|
||||
SCM_API long scm_numsmob;
|
||||
SCM_API scm_smob_descriptor scm_smobs[];
|
||||
|
||||
SCM_API void scm_i_finalize_smob (GC_PTR obj, GC_PTR data);
|
||||
|
||||
|
||||
|
||||
SCM_API SCM scm_mark0 (SCM ptr);
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue