This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
integrate cfgperl contents into mainline; merge conflicts
[perl5.git] / win32 / perllib.c
index d1d942c..e8d59cd 100644 (file)
 
 #include "EXTERN.h"
 #include "perl.h"
+
+#ifdef PERL_OBJECT
+#define NO_XSLOCKS
+#endif
+
 #include "XSUB.h"
 
-static void xs_init _((void));
+#ifdef PERL_IMPLICIT_SYS
+#include "win32iop.h"
+#include <fcntl.h>
+#endif
+
+
+/* Register any extra external extensions */
+char *staticlinkmodules[] = {
+    "DynaLoader",
+    NULL,
+};
+
+EXTERN_C void boot_DynaLoader (pTHXo_ CV* cv);
+
+static void
+xs_init(pTHXo)
+{
+    char *file = __FILE__;
+    dXSUB_SYS;
+    newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
+}
+
+#ifdef PERL_IMPLICIT_SYS
+/* IPerlMem */
+void*
+PerlMemMalloc(struct IPerlMem *I, size_t size)
+{
+    return win32_malloc(size);
+}
+void*
+PerlMemRealloc(struct IPerlMem *I, void* ptr, size_t size)
+{
+    return win32_realloc(ptr, size);
+}
+void
+PerlMemFree(struct IPerlMem *I, void* ptr)
+{
+    win32_free(ptr);
+}
+
+struct IPerlMem perlMem =
+{
+    PerlMemMalloc,
+    PerlMemRealloc,
+    PerlMemFree,
+};
+
+
+/* IPerlEnv */
+extern char *          g_win32_get_privlib(char *pl);
+extern char *          g_win32_get_sitelib(char *pl);
+
+
+char*
+PerlEnvGetenv(struct IPerlEnv *I, const char *varname)
+{
+    return win32_getenv(varname);
+};
+int
+PerlEnvPutenv(struct IPerlEnv *I, const char *envstring)
+{
+    return win32_putenv(envstring);
+};
+
+char*
+PerlEnvGetenv_len(struct IPerlEnv *I, const char* varname, unsigned long* len)
+{
+    char *e = win32_getenv(varname);
+    if (e)
+       *len = strlen(e);
+    return e;
+}
+
+int
+PerlEnvUname(struct IPerlEnv *I, struct utsname *name)
+{
+    return win32_uname(name);
+}
+
+void
+PerlEnvClearenv(struct IPerlEnv *I)
+{
+    dTHXo;
+    char *envv = GetEnvironmentStrings();
+    char *cur = envv;
+    STRLEN len;
+    while (*cur) {
+       char *end = strchr(cur,'=');
+       if (end && end != cur) {
+           *end = '\0';
+           my_setenv(cur,Nullch);
+           *end = '=';
+           cur = end + strlen(end+1)+2;
+       }
+       else if ((len = strlen(cur)))
+           cur += len+1;
+    }
+    FreeEnvironmentStrings(envv);
+}
+
+void*
+PerlEnvGetChildEnv(struct IPerlEnv *I)
+{
+    return NULL;
+}
+
+void
+PerlEnvFreeChildEnv(struct IPerlEnv *I, void* env)
+{
+}
+
+char*
+PerlEnvGetChildDir(struct IPerlEnv *I)
+{
+    return NULL;
+}
+
+void
+PerlEnvFreeChildDir(struct IPerlEnv *I, char* dir)
+{
+}
+
+unsigned long
+PerlEnvOsId(struct IPerlEnv *I)
+{
+    return win32_os_id();
+}
+
+char*
+PerlEnvLibPath(struct IPerlEnv *I, char *pl)
+{
+    return g_win32_get_privlib(pl);
+}
+
+char*
+PerlEnvSiteLibPath(struct IPerlEnv *I, char *pl)
+{
+    return g_win32_get_sitelib(pl);
+}
+
+struct IPerlEnv perlEnv = 
+{
+    PerlEnvGetenv,
+    PerlEnvPutenv,
+    PerlEnvGetenv_len,
+    PerlEnvUname,
+    PerlEnvClearenv,
+    PerlEnvGetChildEnv,
+    PerlEnvFreeChildEnv,
+    PerlEnvGetChildDir,
+    PerlEnvFreeChildDir,
+    PerlEnvOsId,
+    PerlEnvLibPath,
+    PerlEnvSiteLibPath,
+};
+
+
+/* PerlStdIO */
+PerlIO*
+PerlStdIOStdin(struct IPerlStdIO *I)
+{
+    return (PerlIO*)win32_stdin();
+}
+
+PerlIO*
+PerlStdIOStdout(struct IPerlStdIO *I)
+{
+    return (PerlIO*)win32_stdout();
+}
+
+PerlIO*
+PerlStdIOStderr(struct IPerlStdIO *I)
+{
+    return (PerlIO*)win32_stderr();
+}
+
+PerlIO*
+PerlStdIOOpen(struct IPerlStdIO *I, const char *path, const char *mode)
+{
+    return (PerlIO*)win32_fopen(path, mode);
+}
+
+int
+PerlStdIOClose(struct IPerlStdIO *I, PerlIO* pf)
+{
+    return win32_fclose(((FILE*)pf));
+}
+
+int
+PerlStdIOEof(struct IPerlStdIO *I, PerlIO* pf)
+{
+    return win32_feof((FILE*)pf);
+}
+
+int
+PerlStdIOError(struct IPerlStdIO *I, PerlIO* pf)
+{
+    return win32_ferror((FILE*)pf);
+}
+
+void
+PerlStdIOClearerr(struct IPerlStdIO *I, PerlIO* pf)
+{
+    win32_clearerr((FILE*)pf);
+}
+
+int
+PerlStdIOGetc(struct IPerlStdIO *I, PerlIO* pf)
+{
+    return win32_getc((FILE*)pf);
+}
+
+char*
+PerlStdIOGetBase(struct IPerlStdIO *I, PerlIO* pf)
+{
+#ifdef FILE_base
+    FILE *f = (FILE*)pf;
+    return FILE_base(f);
+#else
+    return Nullch;
+#endif
+}
+
+int
+PerlStdIOGetBufsiz(struct IPerlStdIO *I, PerlIO* pf)
+{
+#ifdef FILE_bufsiz
+    FILE *f = (FILE*)pf;
+    return FILE_bufsiz(f);
+#else
+    return (-1);
+#endif
+}
+
+int
+PerlStdIOGetCnt(struct IPerlStdIO *I, PerlIO* pf)
+{
+#ifdef USE_STDIO_PTR
+    FILE *f = (FILE*)pf;
+    return FILE_cnt(f);
+#else
+    return (-1);
+#endif
+}
+
+char*
+PerlStdIOGetPtr(struct IPerlStdIO *I, PerlIO* pf)
+{
+#ifdef USE_STDIO_PTR
+    FILE *f = (FILE*)pf;
+    return FILE_ptr(f);
+#else
+    return Nullch;
+#endif
+}
+
+char*
+PerlStdIOGets(struct IPerlStdIO *I, PerlIO* pf, char* s, int n)
+{
+    return win32_fgets(s, n, (FILE*)pf);
+}
+
+int
+PerlStdIOPutc(struct IPerlStdIO *I, PerlIO* pf, int c)
+{
+    return win32_fputc(c, (FILE*)pf);
+}
+
+int
+PerlStdIOPuts(struct IPerlStdIO *I, PerlIO* pf, const char *s)
+{
+    return win32_fputs(s, (FILE*)pf);
+}
+
+int
+PerlStdIOFlush(struct IPerlStdIO *I, PerlIO* pf)
+{
+    return win32_fflush((FILE*)pf);
+}
+
+int
+PerlStdIOUngetc(struct IPerlStdIO *I, PerlIO* pf,int c)
+{
+    return win32_ungetc(c, (FILE*)pf);
+}
+
+int
+PerlStdIOFileno(struct IPerlStdIO *I, PerlIO* pf)
+{
+    return win32_fileno((FILE*)pf);
+}
+
+PerlIO*
+PerlStdIOFdopen(struct IPerlStdIO *I, int fd, const char *mode)
+{
+    return (PerlIO*)win32_fdopen(fd, mode);
+}
+
+PerlIO*
+PerlStdIOReopen(struct IPerlStdIO *I, const char*path, const char*mode, PerlIO* pf)
+{
+    return (PerlIO*)win32_freopen(path, mode, (FILE*)pf);
+}
+
+SSize_t
+PerlStdIORead(struct IPerlStdIO *I, PerlIO* pf, void *buffer, Size_t size)
+{
+    return win32_fread(buffer, 1, size, (FILE*)pf);
+}
+
+SSize_t
+PerlStdIOWrite(struct IPerlStdIO *I, PerlIO* pf, const void *buffer, Size_t size)
+{
+    return win32_fwrite(buffer, 1, size, (FILE*)pf);
+}
+
+void
+PerlStdIOSetBuf(struct IPerlStdIO *I, PerlIO* pf, char* buffer)
+{
+    win32_setbuf((FILE*)pf, buffer);
+}
+
+int
+PerlStdIOSetVBuf(struct IPerlStdIO *I, PerlIO* pf, char* buffer, int type, Size_t size)
+{
+    return win32_setvbuf((FILE*)pf, buffer, type, size);
+}
+
+void
+PerlStdIOSetCnt(struct IPerlStdIO *I, PerlIO* pf, int n)
+{
+#ifdef STDIO_CNT_LVALUE
+    FILE *f = (FILE*)pf;
+    FILE_cnt(f) = n;
+#endif
+}
+
+void
+PerlStdIOSetPtrCnt(struct IPerlStdIO *I, PerlIO* pf, char * ptr, int n)
+{
+#ifdef STDIO_PTR_LVALUE
+    FILE *f = (FILE*)pf;
+    FILE_ptr(f) = ptr;
+    FILE_cnt(f) = n;
+#endif
+}
+
+void
+PerlStdIOSetlinebuf(struct IPerlStdIO *I, PerlIO* pf)
+{
+    win32_setvbuf((FILE*)pf, NULL, _IOLBF, 0);
+}
+
+int
+PerlStdIOPrintf(struct IPerlStdIO *I, PerlIO* pf, const char *format,...)
+{
+    va_list(arglist);
+    va_start(arglist, format);
+    return win32_vfprintf((FILE*)pf, format, arglist);
+}
+
+int
+PerlStdIOVprintf(struct IPerlStdIO *I, PerlIO* pf, const char *format, va_list arglist)
+{
+    return win32_vfprintf((FILE*)pf, format, arglist);
+}
+
+long
+PerlStdIOTell(struct IPerlStdIO *I, PerlIO* pf)
+{
+    return win32_ftell((FILE*)pf);
+}
+
+int
+PerlStdIOSeek(struct IPerlStdIO *I, PerlIO* pf, off_t offset, int origin)
+{
+    return win32_fseek((FILE*)pf, offset, origin);
+}
+
+void
+PerlStdIORewind(struct IPerlStdIO *I, PerlIO* pf)
+{
+    win32_rewind((FILE*)pf);
+}
+
+PerlIO*
+PerlStdIOTmpfile(struct IPerlStdIO *I)
+{
+    return (PerlIO*)win32_tmpfile();
+}
+
+int
+PerlStdIOGetpos(struct IPerlStdIO *I, PerlIO* pf, Fpos_t *p)
+{
+    return win32_fgetpos((FILE*)pf, p);
+}
+
+int
+PerlStdIOSetpos(struct IPerlStdIO *I, PerlIO* pf, const Fpos_t *p)
+{
+    return win32_fsetpos((FILE*)pf, p);
+}
+void
+PerlStdIOInit(struct IPerlStdIO *I)
+{
+}
+
+void
+PerlStdIOInitOSExtras(struct IPerlStdIO *I)
+{
+    Perl_init_os_extras();
+}
+
+int
+PerlStdIOOpenOSfhandle(struct IPerlStdIO *I, long osfhandle, int flags)
+{
+    return win32_open_osfhandle(osfhandle, flags);
+}
+
+int
+PerlStdIOGetOSfhandle(struct IPerlStdIO *I, int filenum)
+{
+    return win32_get_osfhandle(filenum);
+}
+
+
+struct IPerlStdIO perlStdIO = 
+{
+    PerlStdIOStdin,
+    PerlStdIOStdout,
+    PerlStdIOStderr,
+    PerlStdIOOpen,
+    PerlStdIOClose,
+    PerlStdIOEof,
+    PerlStdIOError,
+    PerlStdIOClearerr,
+    PerlStdIOGetc,
+    PerlStdIOGetBase,
+    PerlStdIOGetBufsiz,
+    PerlStdIOGetCnt,
+    PerlStdIOGetPtr,
+    PerlStdIOGets,
+    PerlStdIOPutc,
+    PerlStdIOPuts,
+    PerlStdIOFlush,
+    PerlStdIOUngetc,
+    PerlStdIOFileno,
+    PerlStdIOFdopen,
+    PerlStdIOReopen,
+    PerlStdIORead,
+    PerlStdIOWrite,
+    PerlStdIOSetBuf,
+    PerlStdIOSetVBuf,
+    PerlStdIOSetCnt,
+    PerlStdIOSetPtrCnt,
+    PerlStdIOSetlinebuf,
+    PerlStdIOPrintf,
+    PerlStdIOVprintf,
+    PerlStdIOTell,
+    PerlStdIOSeek,
+    PerlStdIORewind,
+    PerlStdIOTmpfile,
+    PerlStdIOGetpos,
+    PerlStdIOSetpos,
+    PerlStdIOInit,
+    PerlStdIOInitOSExtras,
+};
+
+
+/* IPerlLIO */
+int
+PerlLIOAccess(struct IPerlLIO *I, const char *path, int mode)
+{
+    return access(path, mode);
+}
+
+int
+PerlLIOChmod(struct IPerlLIO *I, const char *filename, int pmode)
+{
+    return chmod(filename, pmode);
+}
+
+int
+PerlLIOChown(struct IPerlLIO *I, const char *filename, uid_t owner, gid_t group)
+{
+    return chown(filename, owner, group);
+}
+
+int
+PerlLIOChsize(struct IPerlLIO *I, int handle, long size)
+{
+    return chsize(handle, size);
+}
+
+int
+PerlLIOClose(struct IPerlLIO *I, int handle)
+{
+    return win32_close(handle);
+}
+
+int
+PerlLIODup(struct IPerlLIO *I, int handle)
+{
+    return win32_dup(handle);
+}
+
+int
+PerlLIODup2(struct IPerlLIO *I, int handle1, int handle2)
+{
+    return win32_dup2(handle1, handle2);
+}
+
+int
+PerlLIOFlock(struct IPerlLIO *I, int fd, int oper)
+{
+    return win32_flock(fd, oper);
+}
+
+int
+PerlLIOFileStat(struct IPerlLIO *I, int handle, struct stat *buffer)
+{
+    return fstat(handle, buffer);
+}
+
+int
+PerlLIOIOCtl(struct IPerlLIO *I, int i, unsigned int u, char *data)
+{
+    return win32_ioctlsocket((SOCKET)i, (long)u, (u_long*)data);
+}
+
+int
+PerlLIOIsatty(struct IPerlLIO *I, int fd)
+{
+    return isatty(fd);
+}
+
+long
+PerlLIOLseek(struct IPerlLIO *I, int handle, long offset, int origin)
+{
+    return win32_lseek(handle, offset, origin);
+}
+
+int
+PerlLIOLstat(struct IPerlLIO* p, const char *path, struct stat *buffer)
+{
+    return win32_stat(path, buffer);
+}
+
+char*
+PerlLIOMktemp(struct IPerlLIO *I, char *Template)
+{
+    return mktemp(Template);
+}
+
+int
+PerlLIOOpen(struct IPerlLIO *I, const char *filename, int oflag)
+{
+    return win32_open(filename, oflag);
+}
+
+int
+PerlLIOOpen3(struct IPerlLIO *I, const char *filename, int oflag, int pmode)
+{
+    int ret;
+    if(stricmp(filename, "/dev/null") == 0)
+       ret = open("NUL", oflag, pmode);
+    else
+       ret = open(filename, oflag, pmode);
+
+    return ret;
+}
+
+int
+PerlLIORead(struct IPerlLIO *I, int handle, void *buffer, unsigned int count)
+{
+    return win32_read(handle, buffer, count);
+}
+
+int
+PerlLIORename(struct IPerlLIO *I, const char *OldFileName, const char *newname)
+{
+    return win32_rename(OldFileName, newname);
+}
+
+int
+PerlLIOSetmode(struct IPerlLIO *I, int handle, int mode)
+{
+    return win32_setmode(handle, mode);
+}
+
+int
+PerlLIONameStat(struct IPerlLIO *I, const char *path, struct stat *buffer)
+{
+    return win32_stat(path, buffer);
+}
+
+char*
+PerlLIOTmpnam(struct IPerlLIO *I, char *string)
+{
+    return tmpnam(string);
+}
+
+int
+PerlLIOUmask(struct IPerlLIO *I, int pmode)
+{
+    return umask(pmode);
+}
+
+int
+PerlLIOUnlink(struct IPerlLIO *I, const char *filename)
+{
+    chmod(filename, S_IREAD | S_IWRITE);
+    return unlink(filename);
+}
+
+int
+PerlLIOUtime(struct IPerlLIO *I, char *filename, struct utimbuf *times)
+{
+    return win32_utime(filename, times);
+}
+
+int
+PerlLIOWrite(struct IPerlLIO *I, int handle, const void *buffer, unsigned int count)
+{
+    return win32_write(handle, buffer, count);
+}
+
+struct IPerlLIO perlLIO =
+{
+    PerlLIOAccess,
+    PerlLIOChmod,
+    PerlLIOChown,
+    PerlLIOChsize,
+    PerlLIOClose,
+    PerlLIODup,
+    PerlLIODup2,
+    PerlLIOFlock,
+    PerlLIOFileStat,
+    PerlLIOIOCtl,
+    PerlLIOIsatty,
+    PerlLIOLseek,
+    PerlLIOLstat,
+    PerlLIOMktemp,
+    PerlLIOOpen,
+    PerlLIOOpen3,
+    PerlLIORead,
+    PerlLIORename,
+    PerlLIOSetmode,
+    PerlLIONameStat,
+    PerlLIOTmpnam,
+    PerlLIOUmask,
+    PerlLIOUnlink,
+    PerlLIOUtime,
+    PerlLIOWrite,
+};
+
+/* IPerlDIR */
+int
+PerlDirMakedir(struct IPerlDir *I, const char *dirname, int mode)
+{
+    return win32_mkdir(dirname, mode);
+}
+
+int
+PerlDirChdir(struct IPerlDir *I, const char *dirname)
+{
+    return win32_chdir(dirname);
+}
+
+int
+PerlDirRmdir(struct IPerlDir *I, const char *dirname)
+{
+    return win32_rmdir(dirname);
+}
+
+int
+PerlDirClose(struct IPerlDir *I, DIR *dirp)
+{
+    return win32_closedir(dirp);
+}
+
+DIR*
+PerlDirOpen(struct IPerlDir *I, char *filename)
+{
+    return win32_opendir(filename);
+}
+
+struct direct *
+PerlDirRead(struct IPerlDir *I, DIR *dirp)
+{
+    return win32_readdir(dirp);
+}
+
+void
+PerlDirRewind(struct IPerlDir *I, DIR *dirp)
+{
+    win32_rewinddir(dirp);
+}
+
+void
+PerlDirSeek(struct IPerlDir *I, DIR *dirp, long loc)
+{
+    win32_seekdir(dirp, loc);
+}
+
+long
+PerlDirTell(struct IPerlDir *I, DIR *dirp)
+{
+    return win32_telldir(dirp);
+}
+
+struct IPerlDir perlDir =
+{
+    PerlDirMakedir,
+    PerlDirChdir,
+    PerlDirRmdir,
+    PerlDirClose,
+    PerlDirOpen,
+    PerlDirRead,
+    PerlDirRewind,
+    PerlDirSeek,
+    PerlDirTell,
+};
+
+
+/* IPerlSock */
+u_long
+PerlSockHtonl(struct IPerlSock *I, u_long hostlong)
+{
+    return win32_htonl(hostlong);
+}
+
+u_short
+PerlSockHtons(struct IPerlSock *I, u_short hostshort)
+{
+    return win32_htons(hostshort);
+}
+
+u_long
+PerlSockNtohl(struct IPerlSock *I, u_long netlong)
+{
+    return win32_ntohl(netlong);
+}
+
+u_short
+PerlSockNtohs(struct IPerlSock *I, u_short netshort)
+{
+    return win32_ntohs(netshort);
+}
+
+SOCKET PerlSockAccept(struct IPerlSock *I, SOCKET s, struct sockaddr* addr, int* addrlen)
+{
+    return win32_accept(s, addr, addrlen);
+}
+
+int
+PerlSockBind(struct IPerlSock *I, SOCKET s, const struct sockaddr* name, int namelen)
+{
+    return win32_bind(s, name, namelen);
+}
+
+int
+PerlSockConnect(struct IPerlSock *I, SOCKET s, const struct sockaddr* name, int namelen)
+{
+    return win32_connect(s, name, namelen);
+}
+
+void
+PerlSockEndhostent(struct IPerlSock *I)
+{
+    win32_endhostent();
+}
+
+void
+PerlSockEndnetent(struct IPerlSock *I)
+{
+    win32_endnetent();
+}
+
+void
+PerlSockEndprotoent(struct IPerlSock *I)
+{
+    win32_endprotoent();
+}
+
+void
+PerlSockEndservent(struct IPerlSock *I)
+{
+    win32_endservent();
+}
+
+struct hostent*
+PerlSockGethostbyaddr(struct IPerlSock *I, const char* addr, int len, int type)
+{
+    return win32_gethostbyaddr(addr, len, type);
+}
+
+struct hostent*
+PerlSockGethostbyname(struct IPerlSock *I, const char* name)
+{
+    return win32_gethostbyname(name);
+}
+
+struct hostent*
+PerlSockGethostent(struct IPerlSock *I)
+{
+    dTHXo;
+    Perl_croak(aTHX_ "gethostent not implemented!\n");
+    return NULL;
+}
+
+int
+PerlSockGethostname(struct IPerlSock *I, char* name, int namelen)
+{
+    return win32_gethostname(name, namelen);
+}
+
+struct netent *
+PerlSockGetnetbyaddr(struct IPerlSock *I, long net, int type)
+{
+    return win32_getnetbyaddr(net, type);
+}
+
+struct netent *
+PerlSockGetnetbyname(struct IPerlSock *I, const char *name)
+{
+    return win32_getnetbyname((char*)name);
+}
+
+struct netent *
+PerlSockGetnetent(struct IPerlSock *I)
+{
+    return win32_getnetent();
+}
+
+int PerlSockGetpeername(struct IPerlSock *I, SOCKET s, struct sockaddr* name, int* namelen)
+{
+    return win32_getpeername(s, name, namelen);
+}
+
+struct protoent*
+PerlSockGetprotobyname(struct IPerlSock *I, const char* name)
+{
+    return win32_getprotobyname(name);
+}
+
+struct protoent*
+PerlSockGetprotobynumber(struct IPerlSock *I, int number)
+{
+    return win32_getprotobynumber(number);
+}
+
+struct protoent*
+PerlSockGetprotoent(struct IPerlSock *I)
+{
+    return win32_getprotoent();
+}
+
+struct servent*
+PerlSockGetservbyname(struct IPerlSock *I, const char* name, const char* proto)
+{
+    return win32_getservbyname(name, proto);
+}
+
+struct servent*
+PerlSockGetservbyport(struct IPerlSock *I, int port, const char* proto)
+{
+    return win32_getservbyport(port, proto);
+}
+
+struct servent*
+PerlSockGetservent(struct IPerlSock *I)
+{
+    return win32_getservent();
+}
+
+int
+PerlSockGetsockname(struct IPerlSock *I, SOCKET s, struct sockaddr* name, int* namelen)
+{
+    return win32_getsockname(s, name, namelen);
+}
+
+int
+PerlSockGetsockopt(struct IPerlSock *I, SOCKET s, int level, int optname, char* optval, int* optlen)
+{
+    return win32_getsockopt(s, level, optname, optval, optlen);
+}
+
+unsigned long
+PerlSockInetAddr(struct IPerlSock *I, const char* cp)
+{
+    return win32_inet_addr(cp);
+}
+
+char*
+PerlSockInetNtoa(struct IPerlSock *I, struct in_addr in)
+{
+    return win32_inet_ntoa(in);
+}
+
+int
+PerlSockListen(struct IPerlSock *I, SOCKET s, int backlog)
+{
+    return win32_listen(s, backlog);
+}
+
+int
+PerlSockRecv(struct IPerlSock *I, SOCKET s, char* buffer, int len, int flags)
+{
+    return win32_recv(s, buffer, len, flags);
+}
+
+int
+PerlSockRecvfrom(struct IPerlSock *I, SOCKET s, char* buffer, int len, int flags, struct sockaddr* from, int* fromlen)
+{
+    return win32_recvfrom(s, buffer, len, flags, from, fromlen);
+}
+
+int
+PerlSockSelect(struct IPerlSock *I, int nfds, char* readfds, char* writefds, char* exceptfds, const struct timeval* timeout)
+{
+    return win32_select(nfds, (Perl_fd_set*)readfds, (Perl_fd_set*)writefds, (Perl_fd_set*)exceptfds, timeout);
+}
+
+int
+PerlSockSend(struct IPerlSock *I, SOCKET s, const char* buffer, int len, int flags)
+{
+    return win32_send(s, buffer, len, flags);
+}
+
+int
+PerlSockSendto(struct IPerlSock *I, SOCKET s, const char* buffer, int len, int flags, const struct sockaddr* to, int tolen)
+{
+    return win32_sendto(s, buffer, len, flags, to, tolen);
+}
+
+void
+PerlSockSethostent(struct IPerlSock *I, int stayopen)
+{
+    win32_sethostent(stayopen);
+}
+
+void
+PerlSockSetnetent(struct IPerlSock *I, int stayopen)
+{
+    win32_setnetent(stayopen);
+}
+
+void
+PerlSockSetprotoent(struct IPerlSock *I, int stayopen)
+{
+    win32_setprotoent(stayopen);
+}
+
+void
+PerlSockSetservent(struct IPerlSock *I, int stayopen)
+{
+    win32_setservent(stayopen);
+}
+
+int
+PerlSockSetsockopt(struct IPerlSock *I, SOCKET s, int level, int optname, const char* optval, int optlen)
+{
+    return win32_setsockopt(s, level, optname, optval, optlen);
+}
+
+int
+PerlSockShutdown(struct IPerlSock *I, SOCKET s, int how)
+{
+    return win32_shutdown(s, how);
+}
+
+SOCKET
+PerlSockSocket(struct IPerlSock *I, int af, int type, int protocol)
+{
+    return win32_socket(af, type, protocol);
+}
+
+int
+PerlSockSocketpair(struct IPerlSock *I, int domain, int type, int protocol, int* fds)
+{
+    dTHXo;
+    Perl_croak(aTHX_ "socketpair not implemented!\n");
+    return 0;
+}
+
+int
+PerlSockClosesocket(struct IPerlSock *I, SOCKET s)
+{
+    return win32_closesocket(s);
+}
+
+int
+PerlSockIoctlsocket(struct IPerlSock *I, SOCKET s, long cmd, u_long *argp)
+{
+    return win32_ioctlsocket(s, cmd, argp);
+}
+
+struct IPerlSock perlSock =
+{
+    PerlSockHtonl,
+    PerlSockHtons,
+    PerlSockNtohl,
+    PerlSockNtohs,
+    PerlSockAccept,
+    PerlSockBind,
+    PerlSockConnect,
+    PerlSockEndhostent,
+    PerlSockEndnetent,
+    PerlSockEndprotoent,
+    PerlSockEndservent,
+    PerlSockGethostname,
+    PerlSockGetpeername,
+    PerlSockGethostbyaddr,
+    PerlSockGethostbyname,
+    PerlSockGethostent,
+    PerlSockGetnetbyaddr,
+    PerlSockGetnetbyname,
+    PerlSockGetnetent,
+    PerlSockGetprotobyname,
+    PerlSockGetprotobynumber,
+    PerlSockGetprotoent,
+    PerlSockGetservbyname,
+    PerlSockGetservbyport,
+    PerlSockGetservent,
+    PerlSockGetsockname,
+    PerlSockGetsockopt,
+    PerlSockInetAddr,
+    PerlSockInetNtoa,
+    PerlSockListen,
+    PerlSockRecv,
+    PerlSockRecvfrom,
+    PerlSockSelect,
+    PerlSockSend,
+    PerlSockSendto,
+    PerlSockSethostent,
+    PerlSockSetnetent,
+    PerlSockSetprotoent,
+    PerlSockSetservent,
+    PerlSockSetsockopt,
+    PerlSockShutdown,
+    PerlSockSocket,
+    PerlSockSocketpair,
+    PerlSockClosesocket,
+};
+
+
+/* IPerlProc */
+
+#define EXECF_EXEC 1
+#define EXECF_SPAWN 2
+
+extern char *          g_getlogin(void);
+extern int             do_spawn2(char *cmd, int exectype);
+#ifdef PERL_OBJECT
+extern int             g_do_aspawn(void *vreally, void **vmark, void **vsp);
+#define do_aspawn g_do_aspawn
+#endif
+EXTERN_C PerlInterpreter* perl_alloc_using(struct IPerlMem* pMem,
+                       struct IPerlEnv* pEnv, struct IPerlStdIO* pStdIO,
+                       struct IPerlLIO* pLIO, struct IPerlDir* pDir,
+                       struct IPerlSock* pSock, struct IPerlProc* pProc);
+
+void
+PerlProcAbort(struct IPerlProc *I)
+{
+    win32_abort();
+}
+
+char *
+PerlProcCrypt(struct IPerlProc *I, const char* clear, const char* salt)
+{
+    return win32_crypt(clear, salt);
+}
+
+void
+PerlProcExit(struct IPerlProc *I, int status)
+{
+    exit(status);
+}
+
+void
+PerlProc_Exit(struct IPerlProc *I, int status)
+{
+    _exit(status);
+}
+
+int
+PerlProcExecl(struct IPerlProc *I, const char *cmdname, const char *arg0, const char *arg1, const char *arg2, const char *arg3)
+{
+    return execl(cmdname, arg0, arg1, arg2, arg3);
+}
+
+int
+PerlProcExecv(struct IPerlProc *I, const char *cmdname, const char *const *argv)
+{
+    return win32_execvp(cmdname, argv);
+}
+
+int
+PerlProcExecvp(struct IPerlProc *I, const char *cmdname, const char *const *argv)
+{
+    return win32_execvp(cmdname, argv);
+}
+
+uid_t
+PerlProcGetuid(struct IPerlProc *I)
+{
+    return getuid();
+}
+
+uid_t
+PerlProcGeteuid(struct IPerlProc *I)
+{
+    return geteuid();
+}
+
+gid_t
+PerlProcGetgid(struct IPerlProc *I)
+{
+    return getgid();
+}
+
+gid_t
+PerlProcGetegid(struct IPerlProc *I)
+{
+    return getegid();
+}
+
+char *
+PerlProcGetlogin(struct IPerlProc *I)
+{
+    return g_getlogin();
+}
+
+int
+PerlProcKill(struct IPerlProc *I, int pid, int sig)
+{
+    return win32_kill(pid, sig);
+}
+
+int
+PerlProcKillpg(struct IPerlProc *I, int pid, int sig)
+{
+    dTHXo;
+    Perl_croak(aTHX_ "killpg not implemented!\n");
+    return 0;
+}
+
+int
+PerlProcPauseProc(struct IPerlProc *I)
+{
+    return win32_sleep((32767L << 16) + 32767);
+}
+
+PerlIO*
+PerlProcPopen(struct IPerlProc *I, const char *command, const char *mode)
+{
+    dTHXo;
+    PERL_FLUSHALL_FOR_CHILD;
+    return (PerlIO*)win32_popen(command, mode);
+}
+
+int
+PerlProcPclose(struct IPerlProc *I, PerlIO *stream)
+{
+    return win32_pclose((FILE*)stream);
+}
+
+int
+PerlProcPipe(struct IPerlProc *I, int *phandles)
+{
+    return win32_pipe(phandles, 512, O_BINARY);
+}
+
+int
+PerlProcSetuid(struct IPerlProc *I, uid_t u)
+{
+    return setuid(u);
+}
+
+int
+PerlProcSetgid(struct IPerlProc *I, gid_t g)
+{
+    return setgid(g);
+}
+
+int
+PerlProcSleep(struct IPerlProc *I, unsigned int s)
+{
+    return win32_sleep(s);
+}
+
+int
+PerlProcTimes(struct IPerlProc *I, struct tms *timebuf)
+{
+    return win32_times(timebuf);
+}
+
+int
+PerlProcWait(struct IPerlProc *I, int *status)
+{
+    return win32_wait(status);
+}
+
+int
+PerlProcWaitpid(struct IPerlProc *I, int pid, int *status, int flags)
+{
+    return win32_waitpid(pid, status, flags);
+}
+
+Sighandler_t
+PerlProcSignal(struct IPerlProc *I, int sig, Sighandler_t subcode)
+{
+    return 0;
+}
+
+void*
+PerlProcDynaLoader(struct IPerlProc *I, const char* filename)
+{
+    return win32_dynaload(filename);
+}
+
+void
+PerlProcGetOSError(struct IPerlProc *I, SV* sv, DWORD dwErr)
+{
+    win32_str_os_error(sv, dwErr);
+}
+
+BOOL
+PerlProcDoCmd(struct IPerlProc *I, char *cmd)
+{
+    do_spawn2(cmd, EXECF_EXEC);
+    return FALSE;
+}
+
+int
+PerlProcSpawn(struct IPerlProc *I, char* cmds)
+{
+    return do_spawn2(cmds, EXECF_SPAWN);
+}
+
+int
+PerlProcSpawnvp(struct IPerlProc *I, int mode, const char *cmdname, const char *const *argv)
+{
+    return win32_spawnvp(mode, cmdname, argv);
+}
+
+int
+PerlProcASpawn(struct IPerlProc *I, void *vreally, void **vmark, void **vsp)
+{
+    return do_aspawn(vreally, vmark, vsp);
+}
+
+struct IPerlProc perlProc =
+{
+    PerlProcAbort,
+    PerlProcCrypt,
+    PerlProcExit,
+    PerlProc_Exit,
+    PerlProcExecl,
+    PerlProcExecv,
+    PerlProcExecvp,
+    PerlProcGetuid,
+    PerlProcGeteuid,
+    PerlProcGetgid,
+    PerlProcGetegid,
+    PerlProcGetlogin,
+    PerlProcKill,
+    PerlProcKillpg,
+    PerlProcPauseProc,
+    PerlProcPopen,
+    PerlProcPclose,
+    PerlProcPipe,
+    PerlProcSetuid,
+    PerlProcSetgid,
+    PerlProcSleep,
+    PerlProcTimes,
+    PerlProcWait,
+    PerlProcWaitpid,
+    PerlProcSignal,
+    PerlProcDynaLoader,
+    PerlProcGetOSError,
+    PerlProcDoCmd,
+    PerlProcSpawn,
+    PerlProcSpawnvp,
+    PerlProcASpawn,
+};
+
+/*#include "perlhost.h" */
+
+
+EXTERN_C void
+perl_get_host_info(struct IPerlMemInfo* perlMemInfo,
+                  struct IPerlEnvInfo* perlEnvInfo,
+                  struct IPerlStdIOInfo* perlStdIOInfo,
+                  struct IPerlLIOInfo* perlLIOInfo,
+                  struct IPerlDirInfo* perlDirInfo,
+                  struct IPerlSockInfo* perlSockInfo,
+                  struct IPerlProcInfo* perlProcInfo)
+{
+    if(perlMemInfo) {
+       Copy(&perlMem, &perlMemInfo->perlMemList, perlMemInfo->nCount, void*);
+       perlMemInfo->nCount = (sizeof(struct IPerlMem)/sizeof(void*));
+    }
+    if(perlEnvInfo) {
+       Copy(&perlEnv, &perlEnvInfo->perlEnvList, perlEnvInfo->nCount, void*);
+       perlEnvInfo->nCount = (sizeof(struct IPerlEnv)/sizeof(void*));
+    }
+    if(perlStdIOInfo) {
+       Copy(&perlStdIO, &perlStdIOInfo->perlStdIOList, perlStdIOInfo->nCount, void*);
+       perlStdIOInfo->nCount = (sizeof(struct IPerlStdIO)/sizeof(void*));
+    }
+    if(perlLIOInfo) {
+       Copy(&perlLIO, &perlLIOInfo->perlLIOList, perlLIOInfo->nCount, void*);
+       perlLIOInfo->nCount = (sizeof(struct IPerlLIO)/sizeof(void*));
+    }
+    if(perlDirInfo) {
+       Copy(&perlDir, &perlDirInfo->perlDirList, perlDirInfo->nCount, void*);
+       perlDirInfo->nCount = (sizeof(struct IPerlDir)/sizeof(void*));
+    }
+    if(perlSockInfo) {
+       Copy(&perlSock, &perlSockInfo->perlSockList, perlSockInfo->nCount, void*);
+       perlSockInfo->nCount = (sizeof(struct IPerlSock)/sizeof(void*));
+    }
+    if(perlProcInfo) {
+       Copy(&perlProc, &perlProcInfo->perlProcList, perlProcInfo->nCount, void*);
+       perlProcInfo->nCount = (sizeof(struct IPerlProc)/sizeof(void*));
+    }
+}
+
+#ifdef PERL_OBJECT
+
+EXTERN_C PerlInterpreter* perl_alloc_using(struct IPerlMem* pMem,
+                       struct IPerlEnv* pEnv, struct IPerlStdIO* pStdIO,
+                       struct IPerlLIO* pLIO, struct IPerlDir* pDir,
+                       struct IPerlSock* pSock, struct IPerlProc* pProc)
+{
+    CPerlObj* pPerl = NULL;
+    try
+    {
+       pPerl = Perl_alloc(pMem, pEnv, pStdIO, pLIO, pDir, pSock, pProc);
+    }
+    catch(...)
+    {
+       win32_fprintf(stderr, "%s\n", "Error: Unable to allocate memory");
+       pPerl = NULL;
+    }
+    if(pPerl)
+    {
+       SetPerlInterpreter(pPerl);
+       return (PerlInterpreter*)pPerl;
+    }
+    SetPerlInterpreter(NULL);
+    return NULL;
+}
+
+#undef perl_alloc
+#undef perl_construct
+#undef perl_destruct
+#undef perl_free
+#undef perl_run
+#undef perl_parse
+EXTERN_C PerlInterpreter* perl_alloc(void)
+{
+    CPerlObj* pPerl = NULL;
+    try
+    {
+       pPerl = Perl_alloc(&perlMem, &perlEnv, &perlStdIO, &perlLIO,
+                          &perlDir, &perlSock, &perlProc);
+    }
+    catch(...)
+    {
+       win32_fprintf(stderr, "%s\n", "Error: Unable to allocate memory");
+       pPerl = NULL;
+    }
+    if(pPerl)
+    {
+       SetPerlInterpreter(pPerl);
+       return (PerlInterpreter*)pPerl;
+    }
+    SetPerlInterpreter(NULL);
+    return NULL;
+}
+
+EXTERN_C void perl_construct(PerlInterpreter* sv_interp)
+{
+    CPerlObj* pPerl = (CPerlObj*)sv_interp;
+    try
+    {
+       pPerl->perl_construct();
+    }
+    catch(...)
+    {
+       win32_fprintf(stderr, "%s\n",
+                     "Error: Unable to construct data structures");
+       pPerl->perl_free();
+       SetPerlInterpreter(NULL);
+    }
+}
+
+EXTERN_C void perl_destruct(PerlInterpreter* sv_interp)
+{
+    CPerlObj* pPerl = (CPerlObj*)sv_interp;
+    try
+    {
+       pPerl->perl_destruct();
+    }
+    catch(...)
+    {
+    }
+}
+
+EXTERN_C void perl_free(PerlInterpreter* sv_interp)
+{
+    CPerlObj* pPerl = (CPerlObj*)sv_interp;
+    try
+    {
+       pPerl->perl_free();
+    }
+    catch(...)
+    {
+    }
+    SetPerlInterpreter(NULL);
+}
+
+EXTERN_C int perl_run(PerlInterpreter* sv_interp)
+{
+    CPerlObj* pPerl = (CPerlObj*)sv_interp;
+    int retVal;
+    try
+    {
+       retVal = pPerl->perl_run();
+    }
+/*
+    catch(int x)
+    {
+       // this is where exit() should arrive
+       retVal = x;
+    }
+*/
+    catch(...)
+    {
+       win32_fprintf(stderr, "Error: Runtime exception\n");
+       retVal = -1;
+    }
+    return retVal;
+}
+
+EXTERN_C int perl_parse(PerlInterpreter* sv_interp, void (*xsinit)(CPerlObj*), int argc, char** argv, char** env)
+{
+    int retVal;
+    CPerlObj* pPerl = (CPerlObj*)sv_interp;
+    try
+    {
+       retVal = pPerl->perl_parse(xsinit, argc, argv, env);
+    }
+/*
+    catch(int x)
+    {
+       // this is where exit() should arrive
+       retVal = x;
+    }
+*/
+    catch(...)
+    {
+       win32_fprintf(stderr, "Error: Parse exception\n");
+       retVal = -1;
+    }
+    *win32_errno() = 0;
+    return retVal;
+}
+
+#undef PL_perl_destruct_level
+#define PL_perl_destruct_level int dummy
+
+#else /* !PERL_OBJECT */
+
+EXTERN_C PerlInterpreter*
+perl_alloc(void)
+{
+    return perl_alloc_using(&perlMem, &perlEnv, &perlStdIO, &perlLIO,
+                          &perlDir, &perlSock, &perlProc);
+}
+
+#endif /* PERL_OBJECT */
+
+#endif /* PERL_IMPLICIT_SYS */
+
+extern HANDLE w32_perldll_handle;
+static DWORD g_TlsAllocIndex;
+
+EXTERN_C DllExport bool
+SetPerlInterpreter(void *interp)
+{
+    return TlsSetValue(g_TlsAllocIndex, interp);
+}
 
-DllExport int
-RunPerl(int argc, char **argv, char **env, void *iosubsystem)
+EXTERN_C DllExport void*
+GetPerlInterpreter(void)
+{
+    return TlsGetValue(g_TlsAllocIndex);
+}
+
+EXTERN_C DllExport int
+RunPerl(int argc, char **argv, char **env)
 {
     int exitstatus;
     PerlInterpreter *my_perl;
+    struct perl_thread *thr;
+
+#ifndef __BORLANDC__
+    /* XXX this _may_ be a problem on some compilers (e.g. Borland) that
+     * want to free() argv after main() returns.  As luck would have it,
+     * Borland's CRT does the right thing to argv[0] already. */
+    char szModuleName[MAX_PATH];
+    char *ptr;
+
+    GetModuleFileName(NULL, szModuleName, sizeof(szModuleName));
+    (void)win32_longpath(szModuleName);
+    argv[0] = szModuleName;
+#endif
 
 #ifdef PERL_GLOBAL_STRUCT
 #define PERLVAR(var,type) /**/
+#define PERLVARA(var,type) /**/
 #define PERLVARI(var,type,init) PL_Vars.var = init;
 #define PERLVARIC(var,type,init) PL_Vars.var = init;
 #include "perlvars.h"
 #undef PERLVAR
+#undef PERLVARA
 #undef PERLVARI
 #undef PERLVARIC
 #endif
 
     PERL_SYS_INIT(&argc,&argv);
 
-    perl_init_i18nl10n(1);
-
     if (!(my_perl = perl_alloc()))
        return (1);
     perl_construct( my_perl );
     PL_perl_destruct_level = 0;
 
-    exitstatus = perl_parse( my_perl, xs_init, argc, argv, env);
+    exitstatus = perl_parse(my_perl, xs_init, argc, argv, env);
     if (!exitstatus) {
        exitstatus = perl_run( my_perl );
     }
@@ -47,8 +1567,6 @@ RunPerl(int argc, char **argv, char **env, void *iosubsystem)
     return (exitstatus);
 }
 
-extern HANDLE w32_perldll_handle;
-
 BOOL APIENTRY
 DllMain(HANDLE hModule,                /* DLL module handle */
        DWORD fdwReason,        /* reason called */
@@ -66,6 +1584,8 @@ DllMain(HANDLE hModule,             /* DLL module handle */
        setmode( fileno( stderr ), O_BINARY );
        _fmode = O_BINARY;
 #endif
+       g_TlsAllocIndex = TlsAlloc();
+       DisableThreadLibraryCalls(hModule);
        w32_perldll_handle = hModule;
        break;
 
@@ -73,6 +1593,7 @@ DllMain(HANDLE hModule,             /* DLL module handle */
         * process termination or call to FreeLibrary.
         */
     case DLL_PROCESS_DETACH:
+       TlsFree(g_TlsAllocIndex);
        break;
 
        /* The attached process creates a new thread. */
@@ -89,20 +1610,3 @@ DllMain(HANDLE hModule,            /* DLL module handle */
     return TRUE;
 }
 
-/* Register any extra external extensions */
-
-char *staticlinkmodules[] = {
-    "DynaLoader",
-    NULL,
-};
-
-EXTERN_C void boot_DynaLoader _((CV* cv));
-
-static void
-xs_init()
-{
-    char *file = __FILE__;
-    dXSUB_SYS;
-    newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
-}
-