X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=perlio.c;h=0de282934fd7ffb6bda42690a081e62eeccc30d0;hb=3a1ee7e89ce6793a321c9c259b0464c3f464c5ce;hp=793a4e863729c115f47072dd0e42b36a3ea4efa8;hpb=a1ea730d96bcc07b3d616a92ace3927de8290cdd;p=p5sagit%2Fp5-mst-13.2.git diff --git a/perlio.c b/perlio.c index 793a4e8..0de2829 100644 --- a/perlio.c +++ b/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