From: Nicholas Clark Date: Wed, 3 Jan 2007 15:17:29 +0000 (+0000) Subject: Make the ptr_table functions available in an unthreaded perl, as other X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=4674ade5b759c9369580374e5145fe253ded600d;p=p5sagit%2Fp5-mst-13.2.git Make the ptr_table functions available in an unthreaded perl, as other code (such as Storable) can take advantage of them. p4raw-id: //depot/perl@29673 --- diff --git a/embed.fnc b/embed.fnc index 135e643..e4d2623 100644 --- a/embed.fnc +++ b/embed.fnc @@ -1054,12 +1054,14 @@ ApR |GP* |gp_dup |NULLOK GP* gp|NN CLONE_PARAMS* param ApR |MAGIC* |mg_dup |NULLOK MAGIC* mg|NN CLONE_PARAMS* param ApR |SV* |sv_dup |NULLOK const SV* sstr|NN CLONE_PARAMS* param Ap |void |rvpv_dup |NN SV* dstr|NN const SV *sstr|NN CLONE_PARAMS* param +#endif Apa |PTR_TBL_t*|ptr_table_new ApR |void* |ptr_table_fetch|NN PTR_TBL_t *tbl|NN const void *sv Ap |void |ptr_table_store|NN PTR_TBL_t *tbl|NULLOK const void *oldsv|NN void *newsv Ap |void |ptr_table_split|NN PTR_TBL_t *tbl Ap |void |ptr_table_clear|NULLOK PTR_TBL_t *tbl Ap |void |ptr_table_free|NULLOK PTR_TBL_t *tbl +#if defined(USE_ITHREADS) # if defined(HAVE_INTERP_INTERN) Ap |void |sys_intern_dup |NN struct interp_intern* src|NN struct interp_intern* dst # endif @@ -1449,9 +1451,7 @@ s |void * |more_bodies |svtype sv_type s |bool |sv_2iuv_common |NN SV *sv s |void |glob_assign_glob|NN SV *dstr|NN SV *sstr|const int dtype s |void |glob_assign_ref|NN SV *dstr|NN SV *sstr -# if defined(USE_ITHREADS) sRn |PTR_TBL_ENT_t *|ptr_table_find|NN PTR_TBL_t *tbl|NN const void *sv -# endif #endif #if defined(PERL_IN_TOKE_C) || defined(PERL_DECL_PROT) diff --git a/embed.h b/embed.h index 625c478..7fde462 100644 --- a/embed.h +++ b/embed.h @@ -1056,12 +1056,14 @@ #define mg_dup Perl_mg_dup #define sv_dup Perl_sv_dup #define rvpv_dup Perl_rvpv_dup +#endif #define ptr_table_new Perl_ptr_table_new #define ptr_table_fetch Perl_ptr_table_fetch #define ptr_table_store Perl_ptr_table_store #define ptr_table_split Perl_ptr_table_split #define ptr_table_clear Perl_ptr_table_clear #define ptr_table_free Perl_ptr_table_free +#if defined(USE_ITHREADS) # if defined(HAVE_INTERP_INTERN) #define sys_intern_dup Perl_sys_intern_dup # endif @@ -1446,12 +1448,8 @@ #define sv_2iuv_common S_sv_2iuv_common #define glob_assign_glob S_glob_assign_glob #define glob_assign_ref S_glob_assign_ref -#endif -# if defined(USE_ITHREADS) -#ifdef PERL_CORE #define ptr_table_find S_ptr_table_find #endif -# endif #endif #if defined(PERL_IN_TOKE_C) || defined(PERL_DECL_PROT) #ifdef PERL_CORE @@ -3261,12 +3259,14 @@ #define mg_dup(a,b) Perl_mg_dup(aTHX_ a,b) #define sv_dup(a,b) Perl_sv_dup(aTHX_ a,b) #define rvpv_dup(a,b,c) Perl_rvpv_dup(aTHX_ a,b,c) +#endif #define ptr_table_new() Perl_ptr_table_new(aTHX) #define ptr_table_fetch(a,b) Perl_ptr_table_fetch(aTHX_ a,b) #define ptr_table_store(a,b,c) Perl_ptr_table_store(aTHX_ a,b,c) #define ptr_table_split(a) Perl_ptr_table_split(aTHX_ a) #define ptr_table_clear(a) Perl_ptr_table_clear(aTHX_ a) #define ptr_table_free(a) Perl_ptr_table_free(aTHX_ a) +#if defined(USE_ITHREADS) # if defined(HAVE_INTERP_INTERN) #define sys_intern_dup(a,b) Perl_sys_intern_dup(aTHX_ a,b) # endif @@ -3656,12 +3656,8 @@ #define sv_2iuv_common(a) S_sv_2iuv_common(aTHX_ a) #define glob_assign_glob(a,b,c) S_glob_assign_glob(aTHX_ a,b,c) #define glob_assign_ref(a,b) S_glob_assign_ref(aTHX_ a,b) -#endif -# if defined(USE_ITHREADS) -#ifdef PERL_CORE #define ptr_table_find S_ptr_table_find #endif -# endif #endif #if defined(PERL_IN_TOKE_C) || defined(PERL_DECL_PROT) #ifdef PERL_CORE diff --git a/intrpvar.h b/intrpvar.h index a9e0f46..a8d8131 100644 --- a/intrpvar.h +++ b/intrpvar.h @@ -392,9 +392,7 @@ PERLVAR(ISock, struct IPerlSock*) PERLVAR(IProc, struct IPerlProc*) #endif -#if defined(USE_ITHREADS) PERLVAR(Iptr_table, PTR_TBL_t*) -#endif PERLVARI(Ibeginav_save, AV*, NULL) /* save BEGIN{}s when compiling */ PERLVAR(Ibody_arenas, void*) /* pointer to list of body-arenas */ diff --git a/makedef.pl b/makedef.pl index ff3e747..e181e5f 100644 --- a/makedef.pl +++ b/makedef.pl @@ -707,9 +707,6 @@ unless ($define{'USE_ITHREADS'}) { unless ($define{'USE_ITHREADS'}) { skip_symbols [qw( - PL_ptr_table - PL_pte_root - PL_pte_arenaroot PL_op_mutex PL_regex_pad PL_regex_padav @@ -733,14 +730,6 @@ unless ($define{'USE_ITHREADS'}) { Perl_rvpv_dup Perl_hek_dup Perl_sys_intern_dup - Perl_ptr_table_clear - Perl_ptr_table_fetch - Perl_ptr_table_free - Perl_ptr_table_new - Perl_ptr_table_clear - Perl_ptr_table_free - Perl_ptr_table_split - Perl_ptr_table_store perl_clone perl_clone_using Perl_sharedsv_find diff --git a/proto.h b/proto.h index 7c975b3..3ce04ca 100644 --- a/proto.h +++ b/proto.h @@ -2864,6 +2864,7 @@ PERL_CALLCONV void Perl_rvpv_dup(pTHX_ SV* dstr, const SV *sstr, CLONE_PARAMS* p __attribute__nonnull__(pTHX_2) __attribute__nonnull__(pTHX_3); +#endif PERL_CALLCONV PTR_TBL_t* Perl_ptr_table_new(pTHX) __attribute__malloc__ __attribute__warn_unused_result__; @@ -2882,6 +2883,7 @@ PERL_CALLCONV void Perl_ptr_table_split(pTHX_ PTR_TBL_t *tbl) PERL_CALLCONV void Perl_ptr_table_clear(pTHX_ PTR_TBL_t *tbl); PERL_CALLCONV void Perl_ptr_table_free(pTHX_ PTR_TBL_t *tbl); +#if defined(USE_ITHREADS) # if defined(HAVE_INTERP_INTERN) PERL_CALLCONV void Perl_sys_intern_dup(pTHX_ struct interp_intern* src, struct interp_intern* dst) __attribute__nonnull__(pTHX_1) @@ -3901,13 +3903,11 @@ STATIC void S_glob_assign_ref(pTHX_ SV *dstr, SV *sstr) __attribute__nonnull__(pTHX_1) __attribute__nonnull__(pTHX_2); -# if defined(USE_ITHREADS) STATIC PTR_TBL_ENT_t * S_ptr_table_find(PTR_TBL_t *tbl, const void *sv) __attribute__warn_unused_result__ __attribute__nonnull__(1) __attribute__nonnull__(2); -# endif #endif #if defined(PERL_IN_TOKE_C) || defined(PERL_DECL_PROT) diff --git a/sv.c b/sv.c index 5f066c7..8bed941 100644 --- a/sv.c +++ b/sv.c @@ -9689,6 +9689,8 @@ Perl_mg_dup(pTHX_ MAGIC *mg, CLONE_PARAMS* param) return mgret; } +#endif /* USE_ITHREADS */ + /* create a new pointer-mapping table */ PTR_TBL_t * @@ -9832,6 +9834,7 @@ Perl_ptr_table_free(pTHX_ PTR_TBL_t *tbl) Safefree(tbl); } +#if defined(USE_ITHREADS) void Perl_rvpv_dup(pTHX_ SV *dstr, const SV *sstr, CLONE_PARAMS* param)