diff --git a/libguile/inline.c b/libguile/inline.c index 7209f3cbc..be7670ad7 100644 --- a/libguile/inline.c +++ b/libguile/inline.c @@ -24,3 +24,4 @@ #define SCM_INLINE_C_IMPLEMENTING_INLINES 1 #include "libguile/inline.h" #include "libguile/gc.h" +#include "libguile/smob.h" diff --git a/libguile/smob.c b/libguile/smob.c index 8b038f5de..3a3e688ba 100644 --- a/libguile/smob.c +++ b/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 () diff --git a/libguile/smob.h b/libguile/smob.h index 6a7ceeae6..cfe12c3b1 100644 --- a/libguile/smob.h +++ b/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);