#ifndef ___PerlHost_H___
#define ___PerlHost_H___
+#include <signal.h>
#include "iperlsys.h"
#include "vmem.h"
#include "vdir.h"
#if !defined(PERL_OBJECT)
START_EXTERN_C
#endif
-extern char * g_win32_get_privlib(char *pl);
-extern char * g_win32_get_sitelib(char *pl);
+extern char * g_win32_get_privlib(const char *pl);
+extern char * g_win32_get_sitelib(const char *pl);
+extern char * g_win32_get_vendorlib(const char *pl);
extern char * g_getlogin(void);
extern int do_spawn2(char *cmd, int exectype);
#if !defined(PERL_OBJECT)
}
char*
-PerlEnvLibPath(struct IPerlEnv* piPerl, char *pl)
+PerlEnvLibPath(struct IPerlEnv* piPerl, const char *pl)
{
return g_win32_get_privlib(pl);
}
char*
-PerlEnvSiteLibPath(struct IPerlEnv* piPerl, char *pl)
+PerlEnvSiteLibPath(struct IPerlEnv* piPerl, const char *pl)
{
return g_win32_get_sitelib(pl);
}
+char*
+PerlEnvVendorLibPath(struct IPerlEnv* piPerl, const char *pl)
+{
+ return g_win32_get_vendorlib(pl);
+}
+
void
PerlEnvGetChildIO(struct IPerlEnv* piPerl, child_IO_table* ptr)
{
PerlEnvOsId,
PerlEnvLibPath,
PerlEnvSiteLibPath,
+ PerlEnvVendorLibPath,
PerlEnvGetChildIO,
};
Sighandler_t
PerlProcSignal(struct IPerlProc* piPerl, int sig, Sighandler_t subcode)
{
- return 0;
+ return signal(sig, subcode);
}
#ifdef USE_ITHREADS
#endif
- PERL_SET_INTERP(my_perl);
+ PERL_SET_THX(my_perl);
/* set $$ to pseudo id */
#ifdef PERL_SYNC_FORK
w32_pseudo_id = id;
#else
w32_pseudo_id = GetCurrentThreadId();
+ if (IsWin95()) {
+ int pid = (int)w32_pseudo_id;
+ if (pid < 0)
+ w32_pseudo_id = -pid;
+ }
#endif
if (tmpgv = gv_fetchpv("$", TRUE, SVt_PV))
sv_setiv(GvSV(tmpgv), -(IV)w32_pseudo_id);
PL_main_root = Nullop;
}
+ /* close the std handles to avoid fd leaks */
+ {
+ do_close(gv_fetchpv("STDIN", TRUE, SVt_PVIO), FALSE);
+ do_close(gv_fetchpv("STDOUT", TRUE, SVt_PVIO), FALSE);
+ do_close(gv_fetchpv("STDERR", TRUE, SVt_PVIO), FALSE);
+ }
+
/* destroy everything (waits for any pseudo-forked children) */
perl_destruct(my_perl);
perl_free(my_perl);
#ifdef USE_ITHREADS
DWORD id;
HANDLE handle;
- CPerlHost *h = new CPerlHost(*(CPerlHost*)w32_internal_host);
+ CPerlHost *h;
+
+ if (w32_num_pseudo_children >= MAXIMUM_WAIT_OBJECTS) {
+ errno = EAGAIN;
+ return -1;
+ }
+ h = new CPerlHost(*(CPerlHost*)w32_internal_host);
PerlInterpreter *new_perl = perl_clone_using((PerlInterpreter*)aTHXo, 1,
h->m_pHostperlMem,
h->m_pHostperlMemShared,
new_perl->Isys_intern.internal_host = h;
# ifdef PERL_SYNC_FORK
id = win32_start_child((LPVOID)new_perl);
- PERL_SET_INTERP(aTHXo);
+ PERL_SET_THX(aTHXo);
# else
# ifdef USE_RTL_THREAD_API
handle = (HANDLE)_beginthreadex((void*)NULL, 0, win32_start_child,
handle = CreateThread(NULL, 0, win32_start_child,
(LPVOID)new_perl, 0, &id);
# endif
- PERL_SET_INTERP(aTHXo); /* XXX perl_clone*() set TLS */
- if (!handle)
- Perl_croak(aTHX_ "panic: pseudo fork() failed");
+ PERL_SET_THX(aTHXo); /* XXX perl_clone*() set TLS */
+ if (!handle) {
+ errno = EAGAIN;
+ return -1;
+ }
+ if (IsWin95()) {
+ int pid = (int)id;
+ if (pid < 0)
+ id = -pid;
+ }
w32_pseudo_child_handles[w32_num_pseudo_children] = handle;
w32_pseudo_child_pids[w32_num_pseudo_children] = id;
++w32_num_pseudo_children;