Change 12554 by jhi@alpha on 2001/10/21 22:21:55
Integrate from perlio; restructuring.
Affected files ...
... //depot/perl/embed.h#297 integrate
... //depot/perl/embedvar.h#127 integrate
... //depot/perl/intrpvar.h#91 integrate
... //depot/perl/perl.c#379 integrate
... //depot/perl/perlapi.h#49 integrate
... //depot/perl/perlio.c#128 integrate
... //depot/perl/perlio.h#34 integrate
... //depot/perl/perliol.h#19 integrate
... //depot/perl/pod/perlapi.pod#99 integrate
... //depot/perl/sv.c#476 integrate
... //depot/perl/win32/makefile.mk#211 integrate
... //depot/perl/win32/perlhost.h#43 integrate
Differences ...
==== //depot/perl/embed.h#297 (text+w) ====
==== //depot/perl/embedvar.h#127 (text+w) ====
Index: perl/embedvar.h
--- perl/embedvar.h.~1~ Sun Oct 21 16:30:06 2001
+++ perl/embedvar.h Sun Oct 21 16:30:06 2001
@@ -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)
@@ -350,6 +352,7 @@
#define PL_pending_ident (PERL_GET_INTERP->Ipending_ident)
#define PL_perl_destruct_level (PERL_GET_INTERP->Iperl_destruct_level)
#define PL_perldb (PERL_GET_INTERP->Iperldb)
+#define PL_perlio (PERL_GET_INTERP->Iperlio)
#define PL_pidstatus (PERL_GET_INTERP->Ipidstatus)
#define PL_preambleav (PERL_GET_INTERP->Ipreambleav)
#define PL_preambled (PERL_GET_INTERP->Ipreambled)
@@ -511,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)
@@ -554,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)
@@ -638,6 +643,7 @@
#define PL_pending_ident (vTHX->Ipending_ident)
#define PL_perl_destruct_level (vTHX->Iperl_destruct_level)
#define PL_perldb (vTHX->Iperldb)
+#define PL_perlio (vTHX->Iperlio)
#define PL_pidstatus (vTHX->Ipidstatus)
#define PL_preambleav (vTHX->Ipreambleav)
#define PL_preambled (vTHX->Ipreambled)
@@ -802,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
@@ -845,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
@@ -929,6 +937,7 @@
#define PL_Ipending_ident PL_pending_ident
#define PL_Iperl_destruct_level PL_perl_destruct_level
#define PL_Iperldb PL_perldb
+#define PL_Iperlio PL_perlio
#define PL_Ipidstatus PL_pidstatus
#define PL_Ipreambleav PL_preambleav
#define PL_Ipreambled PL_preambled
==== //depot/perl/intrpvar.h#91 (text) ====
Index: perl/intrpvar.h
--- perl/intrpvar.h.~1~ Sun Oct 21 16:30:06 2001
+++ perl/intrpvar.h Sun Oct 21 16:30:06 2001
@@ -493,6 +493,14 @@
PERLVAR(Icustom_op_names, HV*) /* Names of user defined ops */
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.
* XSUB.h provides wrapper functions via perlapi.h that make this
* irrelevant, but not all code may be expected to #include XSUB.h. */
+
+
==== //depot/perl/perl.c#379 (text) ====
Index: perl/perl.c
--- perl/perl.c.~1~ Sun Oct 21 16:30:06 2001
+++ perl/perl.c Sun Oct 21 16:30:06 2001
@@ -258,7 +258,7 @@
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 @@
* flag is set in regexec.c:S_regtry
*/
SvFLAGS(resv) &= ~SVf_BREAK;
- }
+ }
else if(SvREPADTMP(resv)) {
SvREPADTMP_off(resv);
}
@@ -800,6 +800,11 @@
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)
@@ -883,13 +888,6 @@
# else
void *host = w32_internal_host;
# endif
-# ifndef NETWARE
- if (PerlProc_lasthost()) {
-# ifdef USE_PERLIO
- PerlIO_cleanup();
-# endif
- }
-# endif
PerlMem_free(aTHXx);
# ifdef NETWARE
nw5_delete_internal_host(host);
@@ -897,9 +895,6 @@
win32_delete_internal_host(host);
# endif
# else
-# ifdef USE_PERLIO
- PerlIO_cleanup();
-# endif
PerlMem_free(aTHXx);
# endif
#else
@@ -946,7 +941,7 @@
{
/* 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 +1512,7 @@
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
==== //depot/perl/perlapi.h#49 (text+w) ====
Index: perl/perlapi.h
--- perl/perlapi.h.~1~ Sun Oct 21 16:30:06 2001
+++ perl/perlapi.h Sun Oct 21 16:30:06 2001
@@ -183,6 +183,8 @@
#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 @@
#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
@@ -437,6 +441,8 @@
#define PL_perl_destruct_level (*Perl_Iperl_destruct_level_ptr(aTHX))
#undef PL_perldb
#define PL_perldb (*Perl_Iperldb_ptr(aTHX))
+#undef PL_perlio
+#define PL_perlio (*Perl_Iperlio_ptr(aTHX))
#undef PL_pidstatus
#define PL_pidstatus (*Perl_Ipidstatus_ptr(aTHX))
#undef PL_preambleav
==== //depot/perl/perlio.c#128 (text) ====
Index: perl/perlio.c
--- perl/perlio.c.~1~ Sun Oct 21 16:30:06 2001
+++ perl/perlio.c Sun Oct 21 16:30:06 2001
@@ -40,11 +40,6 @@
#include "XSUB.h"
-#undef PerlMemShared_calloc
-#define PerlMemShared_calloc(x,y) calloc(x,y)
-#undef PerlMemShared_free
-#define PerlMemShared_free(x) free(x)
-
int
perlsio_binmode(FILE *fp, int iotype, int mode)
{
@@ -410,11 +405,8 @@
/*
* Table of pointers to the PerlIO structs (malloc'ed)
*/
-PerlIO *_perlio = NULL;
#define PERLIO_TABLE_SIZE 64
-
-
PerlIO *
PerlIO_allocate(pTHX)
{
@@ -423,7 +415,7 @@
*/
PerlIO **last;
PerlIO *f;
- last = &_perlio;
+ last = &PL_perlio;
while ((f = *last)) {
int i;
last = (PerlIO **) (f);
@@ -433,7 +425,7 @@
}
}
}
- f = PerlMemShared_calloc(PERLIO_TABLE_SIZE, sizeof(PerlIO));
+ Newz('I',f,PERLIO_TABLE_SIZE,PerlIO);
if (!f) {
return NULL;
}
@@ -441,6 +433,23 @@
return f + 1;
}
+#undef PerlIO_fdupopen
+PerlIO *
+PerlIO_fdupopen(pTHX_ PerlIO *f, CLONE_PARAMS *param)
+{
+ if (f && *f) {
+ PerlIO_funcs *tab = PerlIOBase(f)->tab;
+ PerlIO *new;
+ PerlIO_debug("fdupopen f=%p param=%p\n",f,param);
+ new = (*tab->Dup)(aTHX_ PerlIO_allocate(aTHX),f,param);
+ return new;
+ }
+ else {
+ SETERRNO(EBADF, SS$_IVCHAN);
+ return NULL;
+ }
+}
+
void
PerlIO_cleantable(pTHX_ PerlIO **tablep)
{
@@ -454,16 +463,14 @@
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);
@@ -472,12 +479,11 @@
}
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)
@@ -491,9 +497,8 @@
}
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;
@@ -509,27 +514,51 @@
}
}
+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_ & _perlio);
+ PerlIO_cleantable(aTHX_ &PL_perlio);
}
void
PerlIO_destruct(pTHX)
{
- PerlIO **table = &_perlio;
+ PerlIO **table = &PL_perlio;
PerlIO *f;
while ((f = *table)) {
int i;
@@ -550,6 +579,10 @@
f++;
}
}
+ PerlIO_list_free(aTHX_ PL_known_layers);
+ PL_known_layers = NULL;
+ PerlIO_list_free(aTHX_ PL_def_layerlist);
+ PL_def_layerlist = NULL;
}
void
@@ -568,7 +601,7 @@
return;
}
*f = l->next;;
- PerlMemShared_free(l);
+ Safefree(l);
}
}
@@ -583,15 +616,15 @@
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;
@@ -714,9 +747,9 @@
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);
}
@@ -791,7 +824,7 @@
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);
@@ -822,7 +855,7 @@
}
}
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);
}
@@ -848,10 +881,10 @@
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);
@@ -868,20 +901,20 @@
#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
@@ -909,7 +942,7 @@
void
PerlIO_stdstreams(pTHX)
{
- if (!_perlio) {
+ if (!PL_perlio) {
PerlIO_allocate(aTHX);
PerlIO_fdopen(0, "Ir" PERLIO_STDTEXT);
PerlIO_fdopen(1, "Iw" PERLIO_STDTEXT);
@@ -921,7 +954,7 @@
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;
@@ -1007,12 +1040,12 @@
{
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;
}
@@ -1056,23 +1089,6 @@
}
}
-#undef PerlIO_fdupopen
-PerlIO *
-PerlIO_fdupopen(pTHX_ PerlIO *f, CLONE_PARAMS *param)
-{
- if (f && *f) {
- PerlIO_funcs *tab = PerlIOBase(f)->tab;
- PerlIO *new;
- PerlIO_debug("fdupopen f=%p param=%p\n",f,param);
- new = (*tab->Dup)(aTHX_ PerlIO_allocate(aTHX),f,param);
- return new;
- }
- else {
- SETERRNO(EBADF, SS$_IVCHAN);
- return NULL;
- }
-}
-
#undef PerlIO_close
int
PerlIO_close(PerlIO *f)
@@ -1157,7 +1173,7 @@
{
PerlIO_list_t *def = PerlIO_default_layers(aTHX);
int incdef = 1;
- if (!_perlio)
+ if (!PL_perlio)
PerlIO_stdstreams(aTHX);
if (narg) {
SV *arg = *args;
@@ -1168,8 +1184,8 @@
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;
}
/*
@@ -1185,9 +1201,9 @@
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);
}
}
@@ -1226,12 +1242,12 @@
* 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);
}
}
@@ -1272,7 +1288,7 @@
}
}
}
- PerlIO_list_free(layera);
+ PerlIO_list_free(aTHX_ layera);
}
return f;
}
@@ -1394,7 +1410,8 @@
* things on fflush(NULL), but should we be bound by their design
* decisions? --jhi
*/
- PerlIO **table = &_perlio;
+ dTHX;
+ PerlIO **table = &PL_perlio;
int code = 0;
while ((f = *table)) {
int i;
@@ -1412,7 +1429,8 @@
void
PerlIOBase_flush_linebuf()
{
- PerlIO **table = &_perlio;
+ dTHX;
+ PerlIO **table = &PL_perlio;
PerlIO *f;
while ((f = *table)) {
int i;
@@ -3063,7 +3081,7 @@
IV code = PerlIOBase_close(f);
PerlIOBuf *b = PerlIOSelf(f, PerlIOBuf);
if (b->buf && b->buf != (STDCHAR *) & b->oneword) {
- PerlMemShared_free(b->buf);
+ Safefree(b->buf);
}
b->buf = NULL;
b->ptr = b->end = b->buf;
@@ -3098,7 +3116,8 @@
if (!b->buf) {
if (!b->bufsiz)
b->bufsiz = 4096;
- b->buf = PerlMemShared_calloc(b->bufsiz, sizeof(STDCHAR));
+ b->buf =
+ Newz('B',b->buf,b->bufsiz, STDCHAR);
if (!b->buf) {
b->buf = (STDCHAR *) & b->oneword;
b->bufsiz = sizeof(b->oneword);
@@ -3212,7 +3231,7 @@
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);
@@ -3900,50 +3919,42 @@
#endif /* HAS_MMAP */
void
-PerlIO_init(void)
+PerlIO_init(pTHX)
{
- dTHX;
-#ifndef WIN32
- call_atexit(PerlIO_cleanup_layers, NULL);
-#endif
- if (!_perlio) {
-#ifndef WIN32
- atexit(&PerlIO_cleanup);
-#endif
- }
+ /* Place holder for stdstreams call ??? */
}
#undef PerlIO_stdin
PerlIO *
PerlIO_stdin(void)
{
- if (!_perlio) {
- dTHX;
+ dTHX;
+ if (!PL_perlio) {
PerlIO_stdstreams(aTHX);
}
- return &_perlio[1];
+ return &PL_perlio[1];
}
#undef PerlIO_stdout
PerlIO *
PerlIO_stdout(void)
{
- if (!_perlio) {
- dTHX;
+ dTHX;
+ if (!PL_perlio) {
PerlIO_stdstreams(aTHX);
}
- return &_perlio[2];
+ return &PL_perlio[2];
}
#undef PerlIO_stderr
PerlIO *
PerlIO_stderr(void)
{
- if (!_perlio) {
- dTHX;
+ dTHX;
+ if (!PL_perlio) {
PerlIO_stdstreams(aTHX);
}
- return &_perlio[3];
+ return &PL_perlio[3];
}
/*--------------------------------------------------------------------------------------*/
@@ -4227,3 +4238,4 @@
return result;
}
#endif
+
==== //depot/perl/perlio.h#34 (text) ====
Index: perl/perlio.h
--- perl/perlio.h.~1~ Sun Oct 21 16:30:06 2001
+++ perl/perlio.h Sun Oct 21 16:30:06 2001
@@ -93,6 +93,7 @@
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_ PerlInterpreter *proto, CLONE_PARAMS *param);
#endif /* PerlIO */
@@ -184,7 +185,7 @@
#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 *, ...)
@@ -348,11 +349,12 @@
extern int PerlIO_intmode2str(int rawmode, char *mode, int *writing);
-#ifndef PERLIO_IS_STDIO
+#ifdef PERLIO_LAYERS
+extern void PerlIO_cleanup(pTHX);
-extern void PerlIO_cleanup(void);
+extern void PerlIO_debug(const char *fmt, ...);
+typedef struct PerlIO_list_s PerlIO_list_t;
-extern void PerlIO_debug(const char *fmt, ...);
#endif
==== //depot/perl/perliol.h#19 (text) ====
Index: perl/perliol.h
--- perl/perliol.h.~1~ Sun Oct 21 16:30:06 2001
+++ perl/perliol.h Sun Oct 21 16:30:06 2001
@@ -6,12 +6,12 @@
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;
==== //depot/perl/pod/perlapi.pod#99 (text+w) ====
Index: perl/pod/perlapi.pod
--- perl/pod/perlapi.pod.~1~ Sun Oct 21 16:30:06 2001
+++ perl/pod/perlapi.pod Sun Oct 21 16:30:06 2001
@@ -329,7 +329,7 @@
SV* cv_const_sv(CV* cv)
=for hackers
-Found in file opmini.c
+Found in file op.c
=item dAX
@@ -1234,7 +1234,7 @@
void load_module(U32 flags, SV* name, SV* ver, ...)
=for hackers
-Found in file opmini.c
+Found in file op.c
=item looks_like_number
@@ -1373,7 +1373,7 @@
CV* newCONSTSUB(HV* stash, char* name, SV* sv)
=for hackers
-Found in file opmini.c
+Found in file op.c
=item newHV
@@ -1533,7 +1533,7 @@
Used by C<xsubpp> to hook up XSUBs as Perl subs.
=for hackers
-Found in file opmini.c
+Found in file op.c
=item newXSproto
@@ -2397,22 +2397,22 @@
=for hackers
Found in file sv.h
-=item SvNVx
+=item SvNVX
-Coerces the given SV to a double and returns it. Guarantees to evaluate
-sv only once. Use the more efficent C<SvNV> otherwise.
+Returns the raw value in the SV's NV slot, without checks or conversions.
+Only use when you are sure SvNOK is true. See also C<SvNV()>.
- NV SvNVx(SV* sv)
+ NV SvNVX(SV* sv)
=for hackers
Found in file sv.h
-=item SvNVX
+=item SvNVx
-Returns the raw value in the SV's NV slot, without checks or conversions.
-Only use when you are sure SvNOK is true. See also C<SvNV()>.
+Coerces the given SV to a double and returns it. Guarantees to evaluate
+sv only once. Use the more efficent C<SvNV> otherwise.
- NV SvNVX(SV* sv)
+ NV SvNVx(SV* sv)
=for hackers
Found in file sv.h
@@ -2606,21 +2606,21 @@
=for hackers
Found in file sv.h
-=item SvPVX
+=item SvPVx
-Returns a pointer to the physical string in the SV. The SV must contain a
-string.
+A version of C<SvPV> which guarantees to evaluate sv only once.
- char* SvPVX(SV* sv)
+ char* SvPVx(SV* sv, STRLEN len)
=for hackers
Found in file sv.h
-=item SvPVx
+=item SvPVX
-A version of C<SvPV> which guarantees to evaluate sv only once.
+Returns a pointer to the physical string in the SV. The SV must contain a
+string.
- char* SvPVx(SV* sv, STRLEN len)
+ char* SvPVX(SV* sv)
=for hackers
Found in file sv.h
@@ -2827,19 +2827,19 @@
=for hackers
Found in file sv.h
-=item svtype
+=item SvTYPE
+
+Returns the type of the SV. See C<svtype>.
-An enum of flags for Perl types. These are found in the file B<sv.h>
-in the C<svtype> enum. Test these flags with the C<SvTYPE> macro.
+ svtype SvTYPE(SV* sv)
=for hackers
Found in file sv.h
-=item SvTYPE
+=item svtype
-Returns the type of the SV. See C<svtype>.
-
- svtype SvTYPE(SV* sv)
+An enum of flags for Perl types. These are found in the file B<sv.h>
+in the C<svtype> enum. Test these flags with the C<SvTYPE> macro.
=for hackers
Found in file sv.h
@@ -2950,22 +2950,22 @@
=for hackers
Found in file sv.h
-=item SvUVX
+=item SvUVx
-Returns the raw value in the SV's UV slot, without checks or conversions.
-Only use when you are sure SvIOK is true. See also C<SvUV()>.
+Coerces the given SV to an unsigned integer and returns it. Guarantees to
+evaluate sv only once. Use the more efficent C<SvUV> otherwise.
- UV SvUVX(SV* sv)
+ UV SvUVx(SV* sv)
=for hackers
Found in file sv.h
-=item SvUVx
+=item SvUVX
-Coerces the given SV to an unsigned integer and returns it. Guarantees to
-evaluate sv only once. Use the more efficent C<SvUV> otherwise.
+Returns the raw value in the SV's UV slot, without checks or conversions.
+Only use when you are sure SvIOK is true. See also C<SvUV()>.
- UV SvUVx(SV* sv)
+ UV SvUVX(SV* sv)
=for hackers
Found in file sv.h
==== //depot/perl/sv.c#476 (text) ====
Index: perl/sv.c
--- perl/sv.c.~1~ Sun Oct 21 16:30:06 2001
+++ perl/sv.c Sun Oct 21 16:30:06 2001
@@ -9765,9 +9765,12 @@
PL_origargv[i] = SAVEPV(proto_perl->Iorigargv[i]);
}
-
param->stashes = newAV(); /* Setup array of objects to call clone on */
+#ifdef PERLIO_LAYERS
+ /* 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);
PL_incgv = gv_dup(proto_perl->Iincgv, param);
==== //depot/perl/win32/makefile.mk#211 (text) ====
Index: perl/win32/makefile.mk
--- perl/win32/makefile.mk.~1~ Sun Oct 21 16:30:06 2001
+++ perl/win32/makefile.mk Sun Oct 21 16:30:06 2001
@@ -731,7 +731,7 @@
CORE_OBJ = $(MICROCORE_OBJ) $(EXTRACORE_SRC:db:+$(o))
WIN32_OBJ = $(WIN32_SRC:db:+$(o))
MINICORE_OBJ = $(MINIDIR)\{$(MICROCORE_OBJ:f) miniperlmain$(o) perlio$(o)}
-MINIWIN32_OBJ = $(MINIDIR)\{$(WIN32_OBJ:f)} $(MINIDIR)\win32io$(o)
+MINIWIN32_OBJ = $(MINIDIR)\{$(WIN32_OBJ:f)}
MINI_OBJ = $(MINICORE_OBJ) $(MINIWIN32_OBJ)
DLL_OBJ = $(DLL_SRC:db:+$(o))
X2P_OBJ = $(X2P_SRC:db:+$(o))
==== //depot/perl/win32/perlhost.h#43 (text) ====
Index: perl/win32/perlhost.h
--- perl/win32/perlhost.h.~1~ Sun Oct 21 16:30:06 2001
+++ perl/win32/perlhost.h Sun Oct 21 16:30:06 2001
@@ -1,6 +1,6 @@
/* perlhost.h
*
- * (c) 1999 Microsoft Corporation. All rights reserved.
+ * (c) 1999 Microsoft Corporation. All rights reserved.
* Portions (c) 1999 ActiveState Tool Corp, http://www.ActiveState.com/
*
* You may distribute under the terms of either the GNU General Public
@@ -52,6 +52,7 @@
void PerlDestroy(void);
/* IPerlMem */
+ /* Locks provided but should be unnecessary as this is private pool */
inline void* Malloc(size_t size) { return m_pVMem->Malloc(size); };
inline void* Realloc(void* ptr, size_t size) { return m_pVMem->Realloc(ptr,
size); };
inline void Free(void* ptr) { m_pVMem->Free(ptr); };
@@ -68,12 +69,32 @@
inline int IsLocked(void) { return m_pVMem->IsLocked(); };
/* IPerlMemShared */
+ /* Locks used to serialize access to the pool */
+ inline void GetLockShared(void) { m_pVMemShared->GetLock(); };
+ inline void FreeLockShared(void) { m_pVMemShared->FreeLock(); };
+ inline int IsLockedShared(void) { return m_pVMemShared->IsLocked(); };
inline void* MallocShared(size_t size)
{
- return m_pVMemShared->Malloc(size);
+ void *result;
+ GetLockShared();
+ result = m_pVMemShared->Malloc(size);
+ FreeLockShared();
+ return result;
+ };
+ inline void* ReallocShared(void* ptr, size_t size)
+ {
+ void *result;
+ GetLockShared();
+ result = m_pVMemShared->Realloc(ptr, size);
+ FreeLockShared();
+ return result;
+ };
+ inline void FreeShared(void* ptr)
+ {
+ GetLockShared();
+ m_pVMemShared->Free(ptr);
+ FreeLockShared();
};
- inline void* ReallocShared(void* ptr, size_t size) { return
m_pVMemShared->Realloc(ptr, size); };
- inline void FreeShared(void* ptr) { m_pVMemShared->Free(ptr); };
inline void* CallocShared(size_t num, size_t size)
{
size_t count = num*size;
@@ -82,11 +103,14 @@
ZeroMemory(lpVoid, count);
return lpVoid;
};
- inline void GetLockShared(void) { m_pVMem->GetLock(); };
- inline void FreeLockShared(void) { m_pVMem->FreeLock(); };
- inline int IsLockedShared(void) { return m_pVMem->IsLocked(); };
/* IPerlMemParse */
+ /* Assume something else is using locks to mangaging serialize
+ on a batch basis
+ */
+ inline void GetLockParse(void) { m_pVMemParse->GetLock(); };
+ inline void FreeLockParse(void) { m_pVMemParse->FreeLock(); };
+ inline int IsLockedParse(void) { return m_pVMemParse->IsLocked(); };
inline void* MallocParse(size_t size) { return m_pVMemParse->Malloc(size); };
inline void* ReallocParse(void* ptr, size_t size) { return
m_pVMemParse->Realloc(ptr, size); };
inline void FreeParse(void* ptr) { m_pVMemParse->Free(ptr); };
@@ -98,9 +122,6 @@
ZeroMemory(lpVoid, count);
return lpVoid;
};
- inline void GetLockParse(void) { m_pVMem->GetLock(); };
- inline void FreeLockParse(void) { m_pVMem->FreeLock(); };
- inline int IsLockedParse(void) { return m_pVMem->IsLocked(); };
/* IPerlEnv */
char *Getenv(const char *varname);
@@ -497,7 +518,7 @@
win32_get_child_IO(ptr);
}
-struct IPerlEnv perlEnv =
+struct IPerlEnv perlEnv =
{
PerlEnvGetenv,
PerlEnvPutenv,
@@ -824,7 +845,7 @@
}
#endif
- /* it appears that the binmode is attached to the
+ /* it appears that the binmode is attached to the
* file descriptor so binmode files will be handled
* correctly
*/
@@ -837,7 +858,7 @@
return pfdup;
}
-struct IPerlStdIO perlStdIO =
+struct IPerlStdIO perlStdIO =
{
PerlStdIOStdin,
PerlStdIOStdout,
@@ -2115,7 +2136,7 @@
if(c1 != c2) {
if(c1 < c2)
return -1; // string 1 < string 2
-
+
return 1; // string 1 > string 2
}
}
End of Patch.
