From: Gurusamy Sarathy Date: Thu, 11 May 2000 03:39:07 +0000 (+0000) Subject: PL_sys_intern was being initialized too late on windows X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=52853b95ebed443e023862f2a1db2614404699e5;p=p5sagit%2Fp5-mst-13.2.git PL_sys_intern was being initialized too late on windows p4raw-id: //depot/perl@6104 --- diff --git a/embed.h b/embed.h index d372b20..b19115f 100644 --- a/embed.h +++ b/embed.h @@ -830,6 +830,9 @@ #define ptr_table_store Perl_ptr_table_store #define ptr_table_split Perl_ptr_table_split #endif +#if defined(HAVE_INTERP_INTERN) +#define sys_intern_init Perl_sys_intern_init +#endif #if defined(PERL_OBJECT) #else #endif @@ -2266,6 +2269,9 @@ #define ptr_table_store(a,b,c) Perl_ptr_table_store(aTHX_ a,b,c) #define ptr_table_split(a) Perl_ptr_table_split(aTHX_ a) #endif +#if defined(HAVE_INTERP_INTERN) +#define sys_intern_init() Perl_sys_intern_init(aTHX) +#endif #if defined(PERL_OBJECT) #else #endif @@ -4441,6 +4447,10 @@ #define Perl_ptr_table_split CPerlObj::Perl_ptr_table_split #define ptr_table_split Perl_ptr_table_split #endif +#if defined(HAVE_INTERP_INTERN) +#define Perl_sys_intern_init CPerlObj::Perl_sys_intern_init +#define sys_intern_init Perl_sys_intern_init +#endif #if defined(PERL_OBJECT) #else #endif diff --git a/embed.pl b/embed.pl index eb7e38c..bbea4dc 100755 --- a/embed.pl +++ b/embed.pl @@ -2161,6 +2161,9 @@ 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 #endif +#if defined(HAVE_INTERP_INTERN) +Ap |void |sys_intern_init +#endif #if defined(PERL_OBJECT) protected: diff --git a/global.sym b/global.sym index 8aca76e..796f851 100644 --- a/global.sym +++ b/global.sym @@ -540,3 +540,4 @@ Perl_ptr_table_new Perl_ptr_table_fetch Perl_ptr_table_store Perl_ptr_table_split +Perl_sys_intern_init diff --git a/makedef.pl b/makedef.pl index e63034b..6fae88b 100644 --- a/makedef.pl +++ b/makedef.pl @@ -260,6 +260,7 @@ elsif ($PLATFORM eq 'aix') { Perl_same_dirent Perl_unlnk Perl_sys_intern_dup + Perl_sys_intern_init PL_cryptseen PL_opsave PL_statusvalue_vms diff --git a/objXSUB.h b/objXSUB.h index 8a0a81e..97e9ba4 100644 --- a/objXSUB.h +++ b/objXSUB.h @@ -2184,6 +2184,12 @@ #undef ptr_table_split #define ptr_table_split Perl_ptr_table_split #endif +#if defined(HAVE_INTERP_INTERN) +#undef Perl_sys_intern_init +#define Perl_sys_intern_init pPerl->Perl_sys_intern_init +#undef sys_intern_init +#define sys_intern_init Perl_sys_intern_init +#endif #if defined(PERL_OBJECT) #else #endif diff --git a/perl.c b/perl.c index 6244753..acf3bd8 100644 --- a/perl.c +++ b/perl.c @@ -272,6 +272,10 @@ perl_construct(pTHXx) PL_localpatches = local_patches; /* For possible -v */ #endif +#ifdef HAVE_INTERP_INTERN + sys_intern_init(); +#endif + PerlIO_init(); /* Hook to IO system */ PL_fdpid = newAV(); /* for remembering popen pids by fd */ @@ -2505,7 +2509,7 @@ S_open_script(pTHX_ char *scriptname, bool dosearch, SV *sv, int *fdscript) sv_catpvn(sv, "-I", 2); sv_catpv(sv,PRIVLIB_EXP); -#ifdef MSDOS +#if defined(MSDOS) || defined(WIN32) Perl_sv_setpvf(aTHX_ cmd, "\ sed %s -e \"/^[^#]/b\" \ -e \"/^#[ ]*include[ ]/b\" \ diff --git a/perlapi.c b/perlapi.c index fc71fb3..125c6e1 100644 --- a/perlapi.c +++ b/perlapi.c @@ -3943,6 +3943,15 @@ Perl_ptr_table_split(pTHXo_ PTR_TBL_t *tbl) ((CPerlObj*)pPerl)->Perl_ptr_table_split(tbl); } #endif +#if defined(HAVE_INTERP_INTERN) + +#undef Perl_sys_intern_init +void +Perl_sys_intern_init(pTHXo) +{ + ((CPerlObj*)pPerl)->Perl_sys_intern_init(); +} +#endif #if defined(PERL_OBJECT) #else #endif diff --git a/pod/perlapi.pod b/pod/perlapi.pod index 0109b27..58e2951 100644 --- a/pod/perlapi.pod +++ b/pod/perlapi.pod @@ -1597,17 +1597,17 @@ false, defined or undefined. Does not handle 'get' magic. bool SvTRUE(SV* sv) +=item svtype + +An enum of flags for Perl types. These are found in the file B +in the C enum. Test these flags with the C macro. + =item SvTYPE Returns the type of the SV. See C. svtype SvTYPE(SV* sv) -=item svtype - -An enum of flags for Perl types. These are found in the file B -in the C enum. Test these flags with the C macro. - =item SVt_IV Integer type flag for scalars. See C. diff --git a/proto.h b/proto.h index 454ca54..3e0aaef 100644 --- a/proto.h +++ b/proto.h @@ -938,6 +938,9 @@ PERL_CALLCONV void* Perl_ptr_table_fetch(pTHX_ PTR_TBL_t *tbl, void *sv); PERL_CALLCONV void Perl_ptr_table_store(pTHX_ PTR_TBL_t *tbl, void *oldsv, void *newsv); PERL_CALLCONV void Perl_ptr_table_split(pTHX_ PTR_TBL_t *tbl); #endif +#if defined(HAVE_INTERP_INTERN) +PERL_CALLCONV void Perl_sys_intern_init(pTHX); +#endif #if defined(PERL_OBJECT) protected: diff --git a/win32/win32.c b/win32/win32.c index 008d7e0..c589ff5 100644 --- a/win32/win32.c +++ b/win32/win32.c @@ -3968,18 +3968,6 @@ Perl_init_os_extras(void) char *file = __FILE__; dXSUB_SYS; - w32_perlshell_tokens = Nullch; - w32_perlshell_items = -1; - w32_fdpid = newAV(); /* XXX needs to be in Perl_win32_init()? */ - New(1313, w32_children, 1, child_tab); - w32_num_children = 0; - w32_init_socktype = 0; -#ifdef USE_ITHREADS - w32_pseudo_id = 0; - New(1313, w32_pseudo_children, 1, child_tab); - w32_num_pseudo_children = 0; -#endif - /* these names are Activeware compatible */ newXS("Win32::GetCwd", w32_GetCwd, file); newXS("Win32::SetCwd", w32_SetCwd, file); @@ -4037,16 +4025,36 @@ win32_get_child_IO(child_IO_table* ptbl) ptbl->childStdErr = GetStdHandle(STD_ERROR_HANDLE); } - -#ifdef USE_ITHREADS +#ifdef HAVE_INTERP_INTERN # ifdef PERL_OBJECT +# undef Perl_sys_intern_init +# define Perl_sys_intern_init CPerlObj::Perl_sys_intern_init # undef Perl_sys_intern_dup # define Perl_sys_intern_dup CPerlObj::Perl_sys_intern_dup # define pPerl this # endif void +Perl_sys_intern_init(pTHX) +{ + w32_perlshell_tokens = Nullch; + w32_perlshell_vec = (char**)NULL; + w32_perlshell_items = 0; + w32_fdpid = newAV(); + New(1313, w32_children, 1, child_tab); + w32_num_children = 0; +# ifdef USE_ITHREADS + w32_pseudo_id = 0; + New(1313, w32_pseudo_children, 1, child_tab); + w32_num_pseudo_children = 0; +# endif + w32_init_socktype = 0; +} + +# ifdef USE_ITHREADS + +void Perl_sys_intern_dup(pTHX_ struct interp_intern *src, struct interp_intern *dst) { dst->perlshell_tokens = Nullch; @@ -4054,12 +4062,12 @@ Perl_sys_intern_dup(pTHX_ struct interp_intern *src, struct interp_intern *dst) dst->perlshell_items = 0; dst->fdpid = newAV(); Newz(1313, dst->children, 1, child_tab); - Newz(1313, dst->pseudo_children, 1, child_tab); dst->pseudo_id = 0; - dst->children->num = 0; + Newz(1313, dst->pseudo_children, 1, child_tab); dst->thr_intern.Winit_socktype = src->thr_intern.Winit_socktype; } -#endif +# endif /* USE_ITHREADS */ +#endif /* HAVE_INTERP_INTERN */ #ifdef PERL_OBJECT # undef this