X-Git-Url: https://git.hcoop.net/bpt/guile.git/blobdiff_plain/5f236208d0d864546e59afa0f5a11c9b3ba14b10..48ffc52cc96fc0665183d9a9e3f68e7e031487f4:/libguile/smob.h diff --git a/libguile/smob.h b/libguile/smob.h index d435bacb8..60abe3733 100644 --- a/libguile/smob.h +++ b/libguile/smob.h @@ -3,7 +3,8 @@ #ifndef SCM_SMOB_H #define SCM_SMOB_H -/* Copyright (C) 1995,1996,1998,1999,2000,2001, 2004, 2006, 2009 Free Software Foundation, Inc. +/* Copyright (C) 1995, 1996, 1998, 1999, 2000, 2001, 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 @@ -26,8 +27,6 @@ #include "libguile/__scm.h" #include "libguile/print.h" -#include "libguile/boehm-gc.h" - /* This is the internal representation of a smob type */ @@ -40,107 +39,14 @@ typedef struct scm_smob_descriptor size_t (*free) (SCM); int (*print) (SCM exp, SCM port, scm_print_state *pstate); SCM (*equalp) (SCM, SCM); - SCM (*apply) (); - SCM (*apply_0) (SCM); - SCM (*apply_1) (SCM, SCM); - SCM (*apply_2) (SCM, SCM, SCM); - SCM (*apply_3) (SCM, SCM, SCM, SCM); - int gsubr_type; /* Used in procprop.c */ + scm_t_subr apply; + /* In 2.2 this field is renamed to "apply_trampoline". */ + SCM apply_trampoline_objcode; } scm_smob_descriptor; - -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_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) - -#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) - -#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) - -#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) - -#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) - - -#define SCM_SMOB_FLAGS(x) (SCM_CELL_WORD_0 (x) >> 16) -#define SCM_SMOB_DATA(x) (SCM_CELL_WORD_1 (x)) -#define SCM_SMOB_DATA_2(x) (SCM_CELL_WORD_2 (x)) -#define SCM_SMOB_DATA_3(x) (SCM_CELL_WORD_3 (x)) -#define SCM_SET_SMOB_DATA(x, data) (SCM_SET_CELL_WORD_1 ((x), (data))) -#define SCM_SET_SMOB_DATA_2(x, data) (SCM_SET_CELL_WORD_2 ((x), (data))) -#define SCM_SET_SMOB_DATA_3(x, data) (SCM_SET_CELL_WORD_3 ((x), (data))) -#define SCM_SET_SMOB_FLAGS(x, data) (scm_i_set_smob_flags((x),(data)<<16)) - -#define SCM_SMOB_OBJECT(x) (SCM_CELL_OBJECT_1 (x)) -#define SCM_SMOB_OBJECT_2(x) (SCM_CELL_OBJECT_2 (x)) -#define SCM_SMOB_OBJECT_3(x) (SCM_CELL_OBJECT_3 (x)) -#define SCM_SET_SMOB_OBJECT(x,obj) (SCM_SET_CELL_OBJECT_1 ((x), (obj))) -#define SCM_SET_SMOB_OBJECT_2(x,obj) (SCM_SET_CELL_OBJECT_2 ((x), (obj))) -#define SCM_SET_SMOB_OBJECT_3(x,obj) (SCM_SET_CELL_OBJECT_3 ((x), (obj))) -#define SCM_SMOB_OBJECT_LOC(x) (SCM_CELL_OBJECT_LOC ((x), 1)) -#define SCM_SMOB_OBJECT_2_LOC(x) (SCM_CELL_OBJECT_LOC ((x), 2)) -#define SCM_SMOB_OBJECT_3_LOC(x) (SCM_CELL_OBJECT_LOC ((x), 3)) - +#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 */ @@ -148,10 +54,6 @@ while (0) #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_SMOB_DESCRIPTOR (x).apply_0 (x)) -#define SCM_SMOB_APPLY_1(x, a1) (SCM_SMOB_DESCRIPTOR (x).apply_1 (x, (a1))) -#define SCM_SMOB_APPLY_2(x, a1, a2) (SCM_SMOB_DESCRIPTOR (x).apply_2 (x, (a1), (a2))) -#define SCM_SMOB_APPLY_3(x, a1, a2, rst) (SCM_SMOB_DESCRIPTOR (x).apply_3 (x, (a1), (a2), (rst))) /* Maximum number of SMOB types. */ #define SCM_I_MAX_SMOB_TYPE_COUNT 256 @@ -159,15 +61,121 @@ while (0) SCM_API long scm_numsmob; SCM_API scm_smob_descriptor scm_smobs[]; -SCM_API void scm_i_set_smob_flags (SCM x, scm_t_bits data); -SCM_API void scm_i_finalize_smob (GC_PTR obj, GC_PTR data); + + + +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); + +/* 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 (void *ptr, void *data); +SCM_API SCM scm_i_new_smob_with_mark_proc (scm_t_bits tc, scm_t_bits, + scm_t_bits, scm_t_bits); + + +#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); + + if (SCM_UNLIKELY (scm_smobs[smobnum].mark || scm_smobs[smobnum].free)) + return scm_i_new_smob (tc, data); + else + return scm_cell (tc, data); +} + +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); + + 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))) + +#define SCM_SMOB_DATA_0(x) (SCM_SMOB_DATA_N ((x), 0)) +#define SCM_SMOB_DATA_1(x) (SCM_SMOB_DATA_N ((x), 1)) +#define SCM_SMOB_DATA_2(x) (SCM_SMOB_DATA_N ((x), 2)) +#define SCM_SMOB_DATA_3(x) (SCM_SMOB_DATA_N ((x), 3)) +#define SCM_SET_SMOB_DATA_0(x, data) (SCM_SET_SMOB_DATA_N ((x), 0, (data))) +#define SCM_SET_SMOB_DATA_1(x, data) (SCM_SET_SMOB_DATA_N ((x), 1, (data))) +#define SCM_SET_SMOB_DATA_2(x, data) (SCM_SET_SMOB_DATA_N ((x), 2, (data))) +#define SCM_SET_SMOB_DATA_3(x, data) (SCM_SET_SMOB_DATA_N ((x), 3, (data))) + +#define SCM_SMOB_FLAGS(x) (SCM_SMOB_DATA_0 (x) >> 16) +#define SCM_SMOB_DATA(x) (SCM_SMOB_DATA_1 (x)) +#define SCM_SET_SMOB_FLAGS(x, data) (SCM_SET_SMOB_DATA_0 ((x), (SCM_CELL_TYPE (x)&0xffff)|((data)<<16))) +#define SCM_SET_SMOB_DATA(x, data) (SCM_SET_SMOB_DATA_1 ((x), (data))) + +#define SCM_SMOB_OBJECT_N(x,n) (SCM_CELL_OBJECT ((x), (n))) +#define SCM_SET_SMOB_OBJECT_N(x,n,obj) (SCM_SET_CELL_OBJECT ((x), (n), (obj))) +#define SCM_SMOB_OBJECT_N_LOC(x,n) (SCM_CELL_OBJECT_LOC ((x), (n))) + +/*#define SCM_SMOB_OBJECT_0(x) (SCM_SMOB_OBJECT_N ((x), 0))*/ +#define SCM_SMOB_OBJECT_1(x) (SCM_SMOB_OBJECT_N ((x), 1)) +#define SCM_SMOB_OBJECT_2(x) (SCM_SMOB_OBJECT_N ((x), 2)) +#define SCM_SMOB_OBJECT_3(x) (SCM_SMOB_OBJECT_N ((x), 3)) +/*#define SCM_SET_SMOB_OBJECT_0(x,obj) (SCM_SET_SMOB_OBJECT_N ((x), 0, (obj)))*/ +#define SCM_SET_SMOB_OBJECT_1(x,obj) (SCM_SET_SMOB_OBJECT_N ((x), 1, (obj))) +#define SCM_SET_SMOB_OBJECT_2(x,obj) (SCM_SET_SMOB_OBJECT_N ((x), 2, (obj))) +#define SCM_SET_SMOB_OBJECT_3(x,obj) (SCM_SET_SMOB_OBJECT_N ((x), 3, (obj))) +#define SCM_SMOB_OBJECT_0_LOC(x) (SCM_SMOB_OBJECT_N_LOC ((x), 0))) +#define SCM_SMOB_OBJECT_1_LOC(x) (SCM_SMOB_OBJECT_N_LOC ((x), 1))) +#define SCM_SMOB_OBJECT_2_LOC(x) (SCM_SMOB_OBJECT_N_LOC ((x), 2))) +#define SCM_SMOB_OBJECT_3_LOC(x) (SCM_SMOB_OBJECT_N_LOC ((x), 3))) + +#define SCM_SMOB_OBJECT(x) (SCM_SMOB_OBJECT_1 (x)) +#define SCM_SET_SMOB_OBJECT(x,obj) (SCM_SET_SMOB_OBJECT_1 ((x), (obj))) +#define SCM_SMOB_OBJECT_LOC(x) (SCM_SMOB_OBJECT_1_LOC (x))) + + +#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)) SCM_API SCM scm_mark0 (SCM ptr); SCM_API SCM scm_markcdr (SCM ptr); SCM_API size_t scm_free0 (SCM ptr); -SCM_API size_t scm_smob_free (SCM obj); SCM_API int scm_smob_print (SCM exp, SCM port, scm_print_state *pstate); /* The following set of functions is the standard way to create new @@ -186,7 +194,7 @@ SCM_API void scm_set_smob_print (scm_t_bits tc, int (*print) (SCM, SCM, scm_print_state*)); SCM_API void scm_set_smob_equalp (scm_t_bits tc, SCM (*equalp) (SCM, SCM)); SCM_API void scm_set_smob_apply (scm_t_bits tc, - SCM (*apply) (), + scm_t_subr apply, unsigned int req, unsigned int opt, unsigned int rst);