From: Doug MacEachern Date: Wed, 7 Feb 2001 19:18:52 +0000 (-0800) Subject: Re: [patch] Re: PL_ptr_table X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=a0739874a58147af36c59eb6d5d23113ccab3a9e;p=p5sagit%2Fp5-mst-13.2.git Re: [patch] Re: PL_ptr_table Message-Id: p4raw-id: //depot/perl@8713 --- diff --git a/embed.pl b/embed.pl index 1b8b7b0..b8f26f5 100755 --- a/embed.pl +++ b/embed.pl @@ -2209,6 +2209,8 @@ Ap |PTR_TBL_t*|ptr_table_new Ap |void* |ptr_table_fetch|PTR_TBL_t *tbl|void *sv Ap |void |ptr_table_store|PTR_TBL_t *tbl|void *oldsv|void *newsv Ap |void |ptr_table_split|PTR_TBL_t *tbl +Ap |void |ptr_table_clear|PTR_TBL_t *tbl +Ap |void |ptr_table_free|PTR_TBL_t *tbl #endif #if defined(HAVE_INTERP_INTERN) Ap |void |sys_intern_clear diff --git a/perl.c b/perl.c index 21ca8aa..c11007e 100644 --- a/perl.c +++ b/perl.c @@ -698,6 +698,9 @@ perl_destruct(pTHXx) } SvREFCNT_dec(PL_strtab); + /* free the pointer table used for cloning */ + ptr_table_free(PL_ptr_table); + /* free special SVs */ SvREFCNT(&PL_sv_yes) = 0; diff --git a/sv.c b/sv.c index 31a90e7..40fa5ca 100644 --- a/sv.c +++ b/sv.c @@ -7700,6 +7700,51 @@ Perl_ptr_table_split(pTHX_ PTR_TBL_t *tbl) } } +void +Perl_ptr_table_clear(pTHX_ PTR_TBL_t *tbl) +{ + register PTR_TBL_ENT_t **array; + register PTR_TBL_ENT_t *entry; + register PTR_TBL_ENT_t *oentry = Null(PTR_TBL_ENT_t*); + UV riter = 0; + UV max; + + if (!tbl || !tbl->tbl_items) { + return; + } + + array = tbl->tbl_ary; + entry = array[0]; + max = tbl->tbl_max; + + for (;;) { + if (entry) { + oentry = entry; + entry = entry->next; + Safefree(oentry); + } + if (!entry) { + if (++riter > max) { + break; + } + entry = array[riter]; + } + } + + tbl->tbl_items = 0; +} + +void +Perl_ptr_table_free(pTHX_ PTR_TBL_t *tbl) +{ + if (!tbl) { + return; + } + ptr_table_clear(tbl); + Safefree(tbl->tbl_ary); + Safefree(tbl); +} + #ifdef DEBUGGING char *PL_watch_pvx; #endif @@ -8910,7 +8955,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags, /* thrdvar.h stuff */ - if (flags & 1) { + if (flags & CLONEf_COPY_STACKS) { /* next allocation will be PL_tmps_stack[PL_tmps_ix+1] */ PL_tmps_ix = proto_perl->Ttmps_ix; PL_tmps_max = proto_perl->Ttmps_max; @@ -9096,6 +9141,11 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags, PL_reginterp_cnt = 0; PL_reg_starttry = 0; + if (!(flags & CLONEf_KEEP_PTR_TABLE)) { + ptr_table_free(PL_ptr_table); + PL_ptr_table = NULL; + } + #ifdef PERL_OBJECT return (PerlInterpreter*)pPerl; #else diff --git a/sv.h b/sv.h index 0ab87e9..2785f14 100644 --- a/sv.h +++ b/sv.h @@ -1107,3 +1107,7 @@ Returns a pointer to the character buffer. #define Sv_Grow sv_grow #define SV_IMMEDIATE_UNREF 1 + +#define CLONEf_COPY_STACKS 1 +#define CLONEf_KEEP_PTR_TABLE 2 +