Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Convert rest of PerlIO's memory tables to per-interp and add clone fu…

…nctions

for them. Call explicit cleanup during destruct process.
 - one binmode test is failing
 - also ext/threads/t/basic.t fails under make test, and is noisy under
   harness. (Threads results are intermingled and don't match order expected.)

p4raw-id: //depot/perlio@12547
  • Loading branch information...
commit 3a1ee7e89ce6793a321c9c259b0464c3f464c5ce 1 parent a1ea730
Nick Ing-Simmons authored
View
6 embedvar.h
@@ -223,6 +223,7 @@
#define PL_dbargs (PERL_GET_INTERP->Idbargs)
#define PL_debstash (PERL_GET_INTERP->Idebstash)
#define PL_debug (PERL_GET_INTERP->Idebug)
+#define PL_def_layerlist (PERL_GET_INTERP->Idef_layerlist)
#define PL_defgv (PERL_GET_INTERP->Idefgv)
#define PL_diehook (PERL_GET_INTERP->Idiehook)
#define PL_doextract (PERL_GET_INTERP->Idoextract)
@@ -266,6 +267,7 @@
#define PL_incgv (PERL_GET_INTERP->Iincgv)
#define PL_initav (PERL_GET_INTERP->Iinitav)
#define PL_inplace (PERL_GET_INTERP->Iinplace)
+#define PL_known_layers (PERL_GET_INTERP->Iknown_layers)
#define PL_last_lop (PERL_GET_INTERP->Ilast_lop)
#define PL_last_lop_op (PERL_GET_INTERP->Ilast_lop_op)
#define PL_last_swash_hv (PERL_GET_INTERP->Ilast_swash_hv)
@@ -512,6 +514,7 @@
#define PL_dbargs (vTHX->Idbargs)
#define PL_debstash (vTHX->Idebstash)
#define PL_debug (vTHX->Idebug)
+#define PL_def_layerlist (vTHX->Idef_layerlist)
#define PL_defgv (vTHX->Idefgv)
#define PL_diehook (vTHX->Idiehook)
#define PL_doextract (vTHX->Idoextract)
@@ -555,6 +558,7 @@
#define PL_incgv (vTHX->Iincgv)
#define PL_initav (vTHX->Iinitav)
#define PL_inplace (vTHX->Iinplace)
+#define PL_known_layers (vTHX->Iknown_layers)
#define PL_last_lop (vTHX->Ilast_lop)
#define PL_last_lop_op (vTHX->Ilast_lop_op)
#define PL_last_swash_hv (vTHX->Ilast_swash_hv)
@@ -804,6 +808,7 @@
#define PL_Idbargs PL_dbargs
#define PL_Idebstash PL_debstash
#define PL_Idebug PL_debug
+#define PL_Idef_layerlist PL_def_layerlist
#define PL_Idefgv PL_defgv
#define PL_Idiehook PL_diehook
#define PL_Idoextract PL_doextract
@@ -847,6 +852,7 @@
#define PL_Iincgv PL_incgv
#define PL_Iinitav PL_initav
#define PL_Iinplace PL_inplace
+#define PL_Iknown_layers PL_known_layers
#define PL_Ilast_lop PL_last_lop
#define PL_Ilast_lop_op PL_last_lop_op
#define PL_Ilast_swash_hv PL_last_swash_hv
View
2  intrpvar.h
@@ -495,6 +495,8 @@ PERLVAR(Icustom_op_descs, HV*) /* Descriptions of user defined ops */
#ifdef PERLIO_LAYERS
PERLVARI(Iperlio, PerlIO *,NULL)
+PERLVARI(Iknown_layers, PerlIO_list_t *,NULL)
+PERLVARI(Idef_layerlist, PerlIO_list_t *,NULL)
#endif
/* New variables must be added to the very end for binary compatibility.
View
13 perl.c
@@ -258,7 +258,7 @@ perl_construct(pTHXx)
sys_intern_init();
#endif
- PerlIO_init(); /* Hook to IO system */
+ PerlIO_init(aTHX); /* Hook to IO system */
PL_fdpid = newAV(); /* for remembering popen pids by fd */
PL_modglobal = newHV(); /* pointers to per-interpreter module globals */
@@ -498,7 +498,7 @@ perl_destruct(pTHXx)
* flag is set in regexec.c:S_regtry
*/
SvFLAGS(resv) &= ~SVf_BREAK;
- }
+ }
else if(SvREPADTMP(resv)) {
SvREPADTMP_off(resv);
}
@@ -800,6 +800,11 @@ perl_destruct(pTHXx)
if (PL_sv_count != 0 && ckWARN_d(WARN_INTERNAL))
Perl_warner(aTHX_ WARN_INTERNAL,"Scalars leaked: %ld\n", (long)PL_sv_count);
+#if 1 && defined(PERLIO_LAYERS)
+ /* No more IO - including error messages ! */
+ PerlIO_cleanup(aTHX);
+#endif
+
Safefree(PL_origfilename);
Safefree(PL_reg_start_tmp);
if (PL_reg_curpm)
@@ -946,7 +951,7 @@ setuid perl scripts securely.\n");
{
/* we copy rather than point to argv
* since perl_clone will copy and perl_destruct
- * has no way of knowing if we've made a copy or
+ * has no way of knowing if we've made a copy or
* just point to argv
*/
int i = PL_origargc;
@@ -1517,7 +1522,7 @@ perl_run(pTHXx)
LEAVE;
FREETMPS;
PL_curstash = PL_defstash;
- if (!(PL_exit_flags & PERL_EXIT_DESTRUCT_END) &&
+ if (!(PL_exit_flags & PERL_EXIT_DESTRUCT_END) &&
PL_endav && !PL_minus_c)
call_list(oldscope, PL_endav);
#ifdef MYMALLOC
View
4 perlapi.h
@@ -183,6 +183,8 @@ END_EXTERN_C
#define PL_debstash (*Perl_Idebstash_ptr(aTHX))
#undef PL_debug
#define PL_debug (*Perl_Idebug_ptr(aTHX))
+#undef PL_def_layerlist
+#define PL_def_layerlist (*Perl_Idef_layerlist_ptr(aTHX))
#undef PL_defgv
#define PL_defgv (*Perl_Idefgv_ptr(aTHX))
#undef PL_diehook
@@ -269,6 +271,8 @@ END_EXTERN_C
#define PL_initav (*Perl_Iinitav_ptr(aTHX))
#undef PL_inplace
#define PL_inplace (*Perl_Iinplace_ptr(aTHX))
+#undef PL_known_layers
+#define PL_known_layers (*Perl_Iknown_layers_ptr(aTHX))
#undef PL_last_lop
#define PL_last_lop (*Perl_Ilast_lop_ptr(aTHX))
#undef PL_last_lop_op
View
147 perlio.c
@@ -425,7 +425,7 @@ PerlIO_allocate(pTHX)
}
}
}
- f = PerlMemShared_calloc(PERLIO_TABLE_SIZE, sizeof(PerlIO));
+ Newz('I',f,PERLIO_TABLE_SIZE,PerlIO);
if (!f) {
return NULL;
}
@@ -451,25 +451,6 @@ PerlIO_fdupopen(pTHX_ PerlIO *f, CLONE_PARAMS *param)
}
void
-PerlIO_clone(pTHX_ PerlIO *proto, CLONE_PARAMS *param)
-{
- PerlIO **table = &proto;
- PerlIO *f;
- PL_perlio = NULL;
- PerlIO_allocate(aTHX); /* root slot is never used */
- while ((f = *table)) {
- int i;
- table = (PerlIO **) (f++);
- for (i = 1; i < PERLIO_TABLE_SIZE; i++) {
- if (*f) {
- PerlIO_fdupopen(aTHX_ f, param);
- }
- f++;
- }
- }
-}
-
-void
PerlIO_cleantable(pTHX_ PerlIO **tablep)
{
PerlIO *table = *tablep;
@@ -482,16 +463,14 @@ PerlIO_cleantable(pTHX_ PerlIO **tablep)
PerlIO_close(f);
}
}
- PerlMemShared_free(table);
+ Safefree(table);
*tablep = NULL;
}
}
-PerlIO_list_t *PerlIO_known_layers;
-PerlIO_list_t *PerlIO_def_layerlist;
PerlIO_list_t *
-PerlIO_list_alloc(void)
+PerlIO_list_alloc(pTHX)
{
PerlIO_list_t *list;
Newz('L', list, 1, PerlIO_list_t);
@@ -500,12 +479,11 @@ PerlIO_list_alloc(void)
}
void
-PerlIO_list_free(PerlIO_list_t *list)
+PerlIO_list_free(pTHX_ PerlIO_list_t *list)
{
if (list) {
if (--list->refcnt == 0) {
if (list->array) {
- dTHX;
IV i;
for (i = 0; i < list->cur; i++) {
if (list->array[i].arg)
@@ -519,9 +497,8 @@ PerlIO_list_free(PerlIO_list_t *list)
}
void
-PerlIO_list_push(PerlIO_list_t *list, PerlIO_funcs *funcs, SV *arg)
+PerlIO_list_push(pTHX_ PerlIO_list_t *list, PerlIO_funcs *funcs, SV *arg)
{
- dTHX;
PerlIO_pair_t *p;
if (list->cur >= list->len) {
list->len += 8;
@@ -537,20 +514,44 @@ PerlIO_list_push(PerlIO_list_t *list, PerlIO_funcs *funcs, SV *arg)
}
}
+PerlIO_list_t *
+PerlIO_clone_list(pTHX_ PerlIO_list_t *proto, CLONE_PARAMS *param)
+{
+ int i;
+ PerlIO_list_t *list = PerlIO_list_alloc(aTHX);
+ for (i=0; i < proto->cur; i++) {
+ SV *arg = Nullsv;
+ if (proto->array[i].arg)
+ arg = sv_dup(proto->array[i].arg,param);
+ PerlIO_list_push(aTHX_ list, proto->array[i].funcs, arg);
+ }
+ return list;
+}
void
-PerlIO_cleanup_layers(pTHX_ void *data)
+PerlIO_clone(pTHX_ PerlInterpreter *proto, CLONE_PARAMS *param)
{
-#if 0
- PerlIO_known_layers = Nullhv;
- PerlIO_def_layerlist = Nullav;
-#endif
+ PerlIO **table = &proto->Iperlio;
+ PerlIO *f;
+ PL_perlio = NULL;
+ PL_known_layers = PerlIO_clone_list(aTHX_ proto->Iknown_layers, param);
+ PL_def_layerlist = PerlIO_clone_list(aTHX_ proto->Idef_layerlist, param);
+ PerlIO_allocate(aTHX); /* root slot is never used */
+ while ((f = *table)) {
+ int i;
+ table = (PerlIO **) (f++);
+ for (i = 1; i < PERLIO_TABLE_SIZE; i++) {
+ if (*f) {
+ PerlIO_fdupopen(aTHX_ f, param);
+ }
+ f++;
+ }
+ }
}
void
-PerlIO_cleanup()
+PerlIO_cleanup(pTHX)
{
- dTHX;
PerlIO_cleantable(aTHX_ &PL_perlio);
}
@@ -578,6 +579,10 @@ PerlIO_destruct(pTHX)
f++;
}
}
+ PerlIO_list_free(aTHX_ PL_known_layers);
+ PL_known_layers = NULL;
+ PerlIO_list_free(aTHX_ PL_def_layerlist);
+ PL_def_layerlist = NULL;
}
void
@@ -596,7 +601,7 @@ PerlIO_pop(pTHX_ PerlIO *f)
return;
}
*f = l->next;;
- PerlMemShared_free(l);
+ Safefree(l);
}
}
@@ -611,15 +616,15 @@ PerlIO_find_layer(pTHX_ const char *name, STRLEN len, int load)
IV i;
if ((SSize_t) len <= 0)
len = strlen(name);
- for (i = 0; i < PerlIO_known_layers->cur; i++) {
- PerlIO_funcs *f = PerlIO_known_layers->array[i].funcs;
+ for (i = 0; i < PL_known_layers->cur; i++) {
+ PerlIO_funcs *f = PL_known_layers->array[i].funcs;
if (memEQ(f->name, name, len)) {
PerlIO_debug("%.*s => %p\n", (int) len, name, f);
return f;
}
}
- if (load && PL_subname && PerlIO_def_layerlist
- && PerlIO_def_layerlist->cur >= 2) {
+ if (load && PL_subname && PL_def_layerlist
+ && PL_def_layerlist->cur >= 2) {
SV *pkgsv = newSVpvn("PerlIO", 6);
SV *layer = newSVpvn(name, len);
ENTER;
@@ -742,9 +747,9 @@ XS(XS_PerlIO__Layer__find)
void
PerlIO_define_layer(pTHX_ PerlIO_funcs *tab)
{
- if (!PerlIO_known_layers)
- PerlIO_known_layers = PerlIO_list_alloc();
- PerlIO_list_push(PerlIO_known_layers, tab, Nullsv);
+ if (!PL_known_layers)
+ PL_known_layers = PerlIO_list_alloc(aTHX);
+ PerlIO_list_push(aTHX_ PL_known_layers, tab, Nullsv);
PerlIO_debug("define %s %p\n", tab->name, tab);
}
@@ -819,7 +824,7 @@ PerlIO_parse_layers(pTHX_ PerlIO_list_t *av, const char *names)
PerlIO_funcs *layer =
PerlIO_find_layer(aTHX_ s, llen, 1);
if (layer) {
- PerlIO_list_push(av, layer,
+ PerlIO_list_push(aTHX_ av, layer,
(as) ? newSVpvn(as,
alen) :
&PL_sv_undef);
@@ -850,7 +855,7 @@ PerlIO_default_buffer(pTHX_ PerlIO_list_t *av)
}
}
PerlIO_debug("Pushing %s\n", tab->name);
- PerlIO_list_push(av, PerlIO_find_layer(aTHX_ tab->name, 0, 0),
+ PerlIO_list_push(aTHX_ av, PerlIO_find_layer(aTHX_ tab->name, 0, 0),
&PL_sv_undef);
}
@@ -876,10 +881,10 @@ PerlIO_layer_fetch(pTHX_ PerlIO_list_t *av, IV n, PerlIO_funcs *def)
PerlIO_list_t *
PerlIO_default_layers(pTHX)
{
- if (!PerlIO_def_layerlist) {
+ if (!PL_def_layerlist) {
const char *s = (PL_tainting) ? Nullch : PerlEnv_getenv("PERLIO");
PerlIO_funcs *osLayer = &PerlIO_unix;
- PerlIO_def_layerlist = PerlIO_list_alloc();
+ PL_def_layerlist = PerlIO_list_alloc(aTHX);
PerlIO_define_layer(aTHX_ & PerlIO_unix);
#if defined(WIN32) && !defined(UNDER_CE)
PerlIO_define_layer(aTHX_ & PerlIO_win32);
@@ -896,20 +901,20 @@ PerlIO_default_layers(pTHX)
#endif
PerlIO_define_layer(aTHX_ & PerlIO_utf8);
PerlIO_define_layer(aTHX_ & PerlIO_byte);
- PerlIO_list_push(PerlIO_def_layerlist,
+ PerlIO_list_push(aTHX_ PL_def_layerlist,
PerlIO_find_layer(aTHX_ osLayer->name, 0, 0),
&PL_sv_undef);
if (s) {
- PerlIO_parse_layers(aTHX_ PerlIO_def_layerlist, s);
+ PerlIO_parse_layers(aTHX_ PL_def_layerlist, s);
}
else {
- PerlIO_default_buffer(aTHX_ PerlIO_def_layerlist);
+ PerlIO_default_buffer(aTHX_ PL_def_layerlist);
}
}
- if (PerlIO_def_layerlist->cur < 2) {
- PerlIO_default_buffer(aTHX_ PerlIO_def_layerlist);
+ if (PL_def_layerlist->cur < 2) {
+ PerlIO_default_buffer(aTHX_ PL_def_layerlist);
}
- return PerlIO_def_layerlist;
+ return PL_def_layerlist;
}
void
@@ -949,7 +954,7 @@ PerlIO *
PerlIO_push(pTHX_ PerlIO *f, PerlIO_funcs *tab, const char *mode, SV *arg)
{
PerlIOl *l = NULL;
- l = PerlMemShared_calloc(tab->size, sizeof(char));
+ Newc('L',l,tab->size,char,PerlIOl);
if (l) {
Zero(l, tab->size, char);
l->next = *f;
@@ -1035,12 +1040,12 @@ PerlIO_apply_layers(pTHX_ PerlIO *f, const char *mode, const char *names)
{
int code = 0;
if (names) {
- PerlIO_list_t *layers = PerlIO_list_alloc();
+ PerlIO_list_t *layers = PerlIO_list_alloc(aTHX);
code = PerlIO_parse_layers(aTHX_ layers, names);
if (code == 0) {
code = PerlIO_apply_layera(aTHX_ f, mode, layers, 0);
}
- PerlIO_list_free(layers);
+ PerlIO_list_free(aTHX_ layers);
}
return code;
}
@@ -1179,8 +1184,8 @@ PerlIO_resolve_layers(pTHX_ const char *layers,
if (SvROK(arg) && !sv_isobject(arg)) {
PerlIO_funcs *handler = PerlIO_layer_from_ref(aTHX_ SvRV(arg));
if (handler) {
- def = PerlIO_list_alloc();
- PerlIO_list_push(def, handler, &PL_sv_undef);
+ def = PerlIO_list_alloc(aTHX);
+ PerlIO_list_push(aTHX_ def, handler, &PL_sv_undef);
incdef = 0;
}
/*
@@ -1196,9 +1201,9 @@ PerlIO_resolve_layers(pTHX_ const char *layers,
PerlIO_list_t *av;
if (incdef) {
IV i = def->cur;
- av = PerlIO_list_alloc();
+ av = PerlIO_list_alloc(aTHX);
for (i = 0; i < def->cur; i++) {
- PerlIO_list_push(av, def->array[i].funcs,
+ PerlIO_list_push(aTHX_ av, def->array[i].funcs,
def->array[i].arg);
}
}
@@ -1237,12 +1242,12 @@ PerlIO_openn(pTHX_ const char *layers, const char *mode, int fd,
* yet
*/
PerlIOl *l = *f;
- layera = PerlIO_list_alloc();
+ layera = PerlIO_list_alloc(aTHX);
while (l) {
SV *arg =
(l->tab->Getarg) ? (*l->tab->
Getarg) (&l) : &PL_sv_undef;
- PerlIO_list_push(layera, l->tab, arg);
+ PerlIO_list_push(aTHX_ layera, l->tab, arg);
l = *PerlIONext(&l);
}
}
@@ -1283,7 +1288,7 @@ PerlIO_openn(pTHX_ const char *layers, const char *mode, int fd,
}
}
}
- PerlIO_list_free(layera);
+ PerlIO_list_free(aTHX_ layera);
}
return f;
}
@@ -3076,7 +3081,7 @@ PerlIOBuf_close(PerlIO *f)
IV code = PerlIOBase_close(f);
PerlIOBuf *b = PerlIOSelf(f, PerlIOBuf);
if (b->buf && b->buf != (STDCHAR *) & b->oneword) {
- safefree(b->buf);
+ Safefree(b->buf);
}
b->buf = NULL;
b->ptr = b->end = b->buf;
@@ -3226,7 +3231,7 @@ PerlIOPending_flush(PerlIO *f)
dTHX;
PerlIOBuf *b = PerlIOSelf(f, PerlIOBuf);
if (b->buf && b->buf != (STDCHAR *) & b->oneword) {
- PerlMemShared_free(b->buf);
+ Safefree(b->buf);
b->buf = NULL;
}
PerlIO_pop(aTHX_ f);
@@ -3914,17 +3919,9 @@ PerlIO_funcs PerlIO_mmap = {
#endif /* HAS_MMAP */
void
-PerlIO_init(void)
+PerlIO_init(pTHX)
{
- dTHX;
-#ifndef WIN32
- call_atexit(PerlIO_cleanup_layers, NULL);
-#endif
- if (!PL_perlio) {
-#ifndef WIN32
- atexit(&PerlIO_cleanup);
-#endif
- }
+ /* Place holder for stdstreams call ??? */
}
#undef PerlIO_stdin
View
11 perlio.h
@@ -93,7 +93,7 @@ extern PerlIO_funcs *PerlIO_find_layer(pTHX_ const char *name, STRLEN len,
extern PerlIO *PerlIO_push(pTHX_ PerlIO *f, PerlIO_funcs *tab,
const char *mode, SV *arg);
extern void PerlIO_pop(pTHX_ PerlIO *f);
-extern void PerlIO_clone(pTHX_ PerlIO *proto, CLONE_PARAMS *param);
+extern void PerlIO_clone(pTHX_ PerlInterpreter *proto, CLONE_PARAMS *param);
#endif /* PerlIO */
@@ -185,7 +185,7 @@ START_EXTERN_C
#endif
#endif
#ifndef PerlIO_init
-extern void PerlIO_init(void);
+extern void PerlIO_init(pTHX);
#endif
#ifndef PerlIO_stdoutf
extern int PerlIO_stdoutf(const char *, ...)
@@ -349,11 +349,12 @@ extern void PerlIO_destruct(pTHX);
extern int PerlIO_intmode2str(int rawmode, char *mode, int *writing);
-#ifndef PERLIO_IS_STDIO
-
-extern void PerlIO_cleanup(void);
+#ifdef PERLIO_LAYERS
+extern void PerlIO_cleanup(pTHX);
extern void PerlIO_debug(const char *fmt, ...);
+typedef struct PerlIO_list_s PerlIO_list_t;
+
#endif
View
4 perliol.h
@@ -6,12 +6,12 @@ typedef struct {
SV *arg;
} PerlIO_pair_t;
-typedef struct {
+struct PerlIO_list_s {
IV refcnt;
IV cur;
IV len;
PerlIO_pair_t *array;
-} PerlIO_list_t;
+};
struct _PerlIO_funcs {
char *name;
View
4 sv.c
@@ -9768,8 +9768,8 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
param->stashes = newAV(); /* Setup array of objects to call clone on */
#ifdef PERLIO_LAYERS
- /* Clone PerlIO table as soon as we can handle general xx_dup() */
- PerlIO_clone(aTHX_ proto_perl->Iperlio, param);
+ /* Clone PerlIO tables as soon as we can handle general xx_dup() */
+ PerlIO_clone(aTHX_ proto_perl, param);
#endif
PL_envgv = gv_dup(proto_perl->Ienvgv, param);

0 comments on commit 3a1ee7e

Please sign in to comment.
Something went wrong with that request. Please try again.