Adds perl_clone_host under IMPLICIT SYS

Message-ID: <B75E5BA5.1A7C%artur@contiller.se>

p4raw-id: //depot/perl@10954

diff --git a/makedef.pl b/makedef.pl
index 376f328..4fe193b 100644 (file)
--- a/makedef.pl
+++ b/makedef.pl
@@ -148,6 +148,7 @@ if ($PLATFORM eq 'win32') {
     if ($define{PERL_IMPLICIT_SYS}) {
        output_symbol("perl_get_host_info");
        output_symbol("perl_alloc_override");
+    output_symbol("perl_clone_host");
     }
 }
 elsif ($PLATFORM eq 'os2') {
@@ -185,6 +186,7 @@ elsif ($PLATFORM eq 'netware') {
        if ($define{PERL_IMPLICIT_SYS}) {
        output_symbol("perl_get_host_info");
        output_symbol("perl_alloc_override");
+    output_symbol("perl_clone_host");
        }
 }
 

diff --git a/sv.c b/sv.c
index 3425ac1..8ba5016 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -8957,7 +8957,7 @@ Perl_sv_dup(pTHX_ SV *sstr, clone_params* param)
        }
        HvPMROOT((HV*)dstr)     = HvPMROOT((HV*)sstr);          /* XXX */
        HvNAME((HV*)dstr)       = SAVEPV(HvNAME((HV*)sstr));
-    /* Record stashes for possible cloning in Perl_clone_using(). */
+    /* Record stashes for possible cloning in Perl_clone(). */
        if(HvNAME((HV*)dstr))
            av_push(param->stashes, dstr);
        break;
@@ -9451,7 +9451,14 @@ perl_clone(PerlInterpreter *proto_perl, UV flags)
 #endif
 
 #ifdef PERL_IMPLICIT_SYS
-    return perl_clone_using(proto_perl, flags,
+
+   /* perlhost.h so we need to call into it
+   to clone the host, CPerlHost should have a c interface, sky */
+
+   if (flags & CLONEf_CLONE_HOST) {
+       return perl_clone_host(proto_perl,flags);
+   }
+   return perl_clone_using(proto_perl, flags,
                            proto_perl->IMem,
                            proto_perl->IMemShared,
                            proto_perl->IMemParse,

diff --git a/sv.h b/sv.h
index 4a4363b..0085b36 100644 (file)
--- a/sv.h
+++ b/sv.h
@@ -1215,6 +1215,7 @@ Returns a pointer to the character buffer.
 
 #define CLONEf_COPY_STACKS 1
 #define CLONEf_KEEP_PTR_TABLE 2
+#define CLONEf_CLONE_HOST 4
 
 typedef struct {
   AV* stashes;

diff --git a/win32/perllib.c b/win32/perllib.c
index 87b79c0..36b19a3 100644 (file)
--- a/win32/perllib.c
+++ b/win32/perllib.c
@@ -396,3 +396,26 @@ DllMain(HANDLE hModule,            /* DLL module handle */
     }
     return TRUE;
 }
+
+#ifdef USE_ITHREADS
+EXTERN_C PerlInterpreter *
+perl_clone_host(PerlInterpreter* proto_perl, UV flags) {
+    dTHXo;
+    CPerlHost *h;
+    h = new CPerlHost(*(CPerlHost*)PL_sys_intern.internal_host);
+    proto_perl = perl_clone_using(proto_perl, flags,
+                        h->m_pHostperlMem,
+                        h->m_pHostperlMemShared,
+                        h->m_pHostperlMemParse,
+                        h->m_pHostperlEnv,
+                        h->m_pHostperlStdIO,
+                        h->m_pHostperlLIO,
+                        h->m_pHostperlDir,
+                        h->m_pHostperlSock,
+                        h->m_pHostperlProc
+    );
+    proto_perl->Isys_intern.internal_host = h;
+    return proto_perl;
+       
+}
+#endif