From: Jerry D. Hedden Date: Tue, 6 Nov 2007 14:36:40 +0000 (-0500) Subject: Bug fix for storing shared objects in shared structures X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=eba1666137b7e1350d666a934a5e99ced3f50088;p=p5sagit%2Fp5-mst-13.2.git Bug fix for storing shared objects in shared structures From: "Jerry D. Hedden" Message-ID: <1ff86f510711061136t52a1fe62waf384c4551612181@mail.gmail.com> (core patch only) p4raw-id: //depot/perl@32241 --- diff --git a/embed.fnc b/embed.fnc index 8e5c516..2211eb6 100644 --- a/embed.fnc +++ b/embed.fnc @@ -1114,6 +1114,7 @@ ApR |const char * |custom_op_desc |NN const OP* op Adp |void |sv_nosharing |NULLOK SV *sv Adpbm |void |sv_nolocking |NULLOK SV *sv +Adp |bool |sv_destroyable |NULLOK SV *sv #ifdef NO_MATHOMS Adpbm |void |sv_nounlocking |NULLOK SV *sv #else diff --git a/embed.h b/embed.h index eba1305..deb30b3 100644 --- a/embed.h +++ b/embed.h @@ -1108,6 +1108,7 @@ #define custom_op_name Perl_custom_op_name #define custom_op_desc Perl_custom_op_desc #define sv_nosharing Perl_sv_nosharing +#define sv_destroyable Perl_sv_destroyable #ifdef NO_MATHOMS #else #define sv_nounlocking Perl_sv_nounlocking @@ -3386,6 +3387,7 @@ #define custom_op_name(a) Perl_custom_op_name(aTHX_ a) #define custom_op_desc(a) Perl_custom_op_desc(aTHX_ a) #define sv_nosharing(a) Perl_sv_nosharing(aTHX_ a) +#define sv_destroyable(a) Perl_sv_destroyable(aTHX_ a) #ifdef NO_MATHOMS #else #define sv_nounlocking(a) Perl_sv_nounlocking(aTHX_ a) diff --git a/embedvar.h b/embedvar.h index 27623d0..8eab8c8 100644 --- a/embedvar.h +++ b/embedvar.h @@ -115,6 +115,7 @@ #define PL_defoutgv (vTHX->Idefoutgv) #define PL_defstash (vTHX->Idefstash) #define PL_delaymagic (vTHX->Idelaymagic) +#define PL_destroyhook (vTHX->Idestroyhook) #define PL_diehook (vTHX->Idiehook) #define PL_dirty (vTHX->Idirty) #define PL_doextract (vTHX->Idoextract) @@ -427,6 +428,7 @@ #define PL_Idefoutgv PL_defoutgv #define PL_Idefstash PL_defstash #define PL_Idelaymagic PL_delaymagic +#define PL_Idestroyhook PL_destroyhook #define PL_Idiehook PL_diehook #define PL_Idirty PL_dirty #define PL_Idoextract PL_doextract diff --git a/global.sym b/global.sym index 39cdaf2..4a546c2 100644 --- a/global.sym +++ b/global.sym @@ -693,6 +693,7 @@ Perl_custom_op_name Perl_custom_op_desc Perl_sv_nosharing Perl_sv_nolocking +Perl_sv_destroyable Perl_sv_nounlocking Perl_nothreadhook Perl_Slab_Alloc diff --git a/intrpvar.h b/intrpvar.h index 5d583f0..373d181 100644 --- a/intrpvar.h +++ b/intrpvar.h @@ -669,6 +669,9 @@ PERLVARI(Islabs, I32**, NULL) /* Array of slabs that have been allocated */ PERLVARI(Islab_count, U32, 0) /* Size of the array */ #endif +/* Can shared object be destroyed */ +PERLVARI(Idestroyhook, destroyable_proc_t, MEMBER_TO_FPTR(Perl_sv_destroyable)) + /* If you are adding a U8 or U16, check to see if there are 'Space' comments * above on where there are gaps which currently will be structure padding. */ diff --git a/perl.h b/perl.h index e26e475..b147654 100644 --- a/perl.h +++ b/perl.h @@ -4036,6 +4036,7 @@ typedef int (CPERLscope(*runops_proc_t)) (pTHX); typedef void (CPERLscope(*share_proc_t)) (pTHX_ SV *sv); typedef int (CPERLscope(*thrhook_proc_t)) (pTHX); typedef OP* (CPERLscope(*PPADDR_t)[]) (pTHX); +typedef bool (CPERLscope(*destroyable_proc_t)) (pTHX_ SV *sv); /* _ (for $_) must be first in the following list (DEFSV requires it) */ #define THREADSV_NAMES "_123456789&`'+/.,\\\";^-%=|~:\001\005!@" diff --git a/perlapi.h b/perlapi.h index 42cac35..05479bf 100644 --- a/perlapi.h +++ b/perlapi.h @@ -266,6 +266,8 @@ END_EXTERN_C #define PL_defstash (*Perl_Idefstash_ptr(aTHX)) #undef PL_delaymagic #define PL_delaymagic (*Perl_Idelaymagic_ptr(aTHX)) +#undef PL_destroyhook +#define PL_destroyhook (*Perl_Idestroyhook_ptr(aTHX)) #undef PL_diehook #define PL_diehook (*Perl_Idiehook_ptr(aTHX)) #undef PL_dirty diff --git a/pod/perlapi.pod b/pod/perlapi.pod index e74fb85..ab0463f 100644 --- a/pod/perlapi.pod +++ b/pod/perlapi.pod @@ -2594,6 +2594,19 @@ wrapper for C). =for hackers Found in file handy.h +=item sv_destroyable +X + +Dummy routine which reports that object can be destroyed when there is no +sharing module present. It ignores its single SV argument, and returns +'true'. Exists to avoid test for a NULL function pointer and because it +could potentially warn under some level of strict-ness. + + bool sv_destroyable(SV *sv) + +=for hackers +Found in file util.c + =item sv_nosharing X diff --git a/proto.h b/proto.h index 7fee1dc..a302ec4 100644 --- a/proto.h +++ b/proto.h @@ -2972,6 +2972,7 @@ PERL_CALLCONV const char * Perl_custom_op_desc(pTHX_ const OP* op) PERL_CALLCONV void Perl_sv_nosharing(pTHX_ SV *sv); /* PERL_CALLCONV void Perl_sv_nolocking(pTHX_ SV *sv); */ +PERL_CALLCONV bool Perl_sv_destroyable(pTHX_ SV *sv); #ifdef NO_MATHOMS /* PERL_CALLCONV void Perl_sv_nounlocking(pTHX_ SV *sv); */ #else diff --git a/sv.c b/sv.c index f125409..2059512 100644 --- a/sv.c +++ b/sv.c @@ -5098,7 +5098,9 @@ Perl_sv_clear(pTHX_ register SV *sv) } if (SvOBJECT(sv)) { - if (PL_defstash) { /* Still have a symbol table? */ + if (PL_defstash && /* Still have a symbol table? */ + SvDESTROYABLE(sv)) + { dSP; HV* stash; do { @@ -11365,6 +11367,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags, PL_lockhook = proto_perl->Ilockhook; PL_unlockhook = proto_perl->Iunlockhook; PL_threadhook = proto_perl->Ithreadhook; + PL_destroyhook = proto_perl->Idestroyhook; #ifdef THREADS_HAVE_PIDS PL_ppid = proto_perl->Ippid; diff --git a/sv.h b/sv.h index f12780f..7098088 100644 --- a/sv.h +++ b/sv.h @@ -2008,6 +2008,7 @@ Returns a pointer to the character buffer. #define SvSHARE(sv) CALL_FPTR(PL_sharehook)(aTHX_ sv) #define SvLOCK(sv) CALL_FPTR(PL_lockhook)(aTHX_ sv) #define SvUNLOCK(sv) CALL_FPTR(PL_unlockhook)(aTHX_ sv) +#define SvDESTROYABLE(sv) CALL_FPTR(PL_destroyhook)(aTHX_ sv) #define SvGETMAGIC(x) STMT_START { if (SvGMAGICAL(x)) mg_get(x); } STMT_END #define SvSETMAGIC(x) STMT_START { if (SvSMAGICAL(x)) mg_set(x); } STMT_END diff --git a/util.c b/util.c index 670c823..62fd7ba 100644 --- a/util.c +++ b/util.c @@ -5112,6 +5112,26 @@ Perl_sv_nosharing(pTHX_ SV *sv) PERL_UNUSED_ARG(sv); } +/* + +=for apidoc sv_destroyable + +Dummy routine which reports that object can be destroyed when there is no +sharing module present. It ignores its single SV argument, and returns +'true'. Exists to avoid test for a NULL function pointer and because it +could potentially warn under some level of strict-ness. + +=cut +*/ + +bool +Perl_sv_destroyable(pTHX_ SV *sv) +{ + PERL_UNUSED_CONTEXT; + PERL_UNUSED_ARG(sv); + return TRUE; +} + U32 Perl_parse_unicode_opts(pTHX_ const char **popt) {