diff options
| -rw-r--r-- | embed.h | 10 | ||||
| -rwxr-xr-x | embed.pl | 3 | ||||
| -rw-r--r-- | global.sym | 1 | ||||
| -rw-r--r-- | makedef.pl | 1 | ||||
| -rw-r--r-- | objXSUB.h | 6 | ||||
| -rw-r--r-- | perl.c | 6 | ||||
| -rw-r--r-- | perlapi.c | 9 | ||||
| -rw-r--r-- | pod/perlapi.pod | 10 | ||||
| -rw-r--r-- | proto.h | 3 | ||||
| -rw-r--r-- | win32/win32.c | 42 |
10 files changed, 68 insertions, 23 deletions
@@ -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 @@ -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 8aca76e69b..796f8513d4 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 e63034beb0..6fae88be9e 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 @@ -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 @@ -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\" \ @@ -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 0109b27458..58e29515c4 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<sv.h> +in the C<svtype> enum. Test these flags with the C<SvTYPE> macro. + =item SvTYPE Returns the type of the SV. See C<svtype>. svtype SvTYPE(SV* sv) -=item 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. - =item SVt_IV Integer type flag for scalars. See C<svtype>. @@ -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 008d7e0d94..c589ff5e88 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 |