2 * "The Road goes ever on and on, down from the door where it began."
21 /* Register any extra external extensions */
22 char *staticlinkmodules[] = {
27 EXTERN_C void boot_DynaLoader (pTHXo_ CV* cv);
32 char *file = __FILE__;
34 newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
40 PerlMemMalloc(struct IPerlMem*, size_t size)
42 return win32_malloc(size);
45 PerlMemRealloc(struct IPerlMem*, void* ptr, size_t size)
47 return win32_realloc(ptr, size);
50 PerlMemFree(struct IPerlMem*, void* ptr)
55 struct IPerlMem perlMem =
64 extern char * g_win32_get_privlib(char *pl);
65 extern char * g_win32_get_sitelib(char *pl);
69 PerlEnvGetenv(struct IPerlEnv*, const char *varname)
71 return win32_getenv(varname);
74 PerlEnvPutenv(struct IPerlEnv*, const char *envstring)
76 return win32_putenv(envstring);
80 PerlEnvGetenv_len(struct IPerlEnv*, const char* varname, unsigned long* len)
82 char *e = win32_getenv(varname);
89 PerlEnvUname(struct IPerlEnv*, struct utsname *name)
91 return win32_uname(name);
95 PerlEnvClearenv(struct IPerlEnv*)
98 char *envv = GetEnvironmentStrings();
102 char *end = strchr(cur,'=');
103 if (end && end != cur) {
105 my_setenv(cur,Nullch);
107 cur = end + strlen(end+1)+2;
109 else if ((len = strlen(cur)))
112 FreeEnvironmentStrings(envv);
116 PerlEnvGetChildEnv(struct IPerlEnv*)
122 PerlEnvFreeChildEnv(struct IPerlEnv*, void* env)
127 PerlEnvGetChildDir(struct IPerlEnv*)
133 PerlEnvFreeChildDir(struct IPerlEnv*, char* dir)
138 PerlEnvOsId(struct IPerlEnv*)
140 return win32_os_id();
144 PerlEnvLibPath(struct IPerlEnv*, char *pl)
146 return g_win32_get_privlib(pl);
150 PerlEnvSiteLibPath(struct IPerlEnv*, char *pl)
152 return g_win32_get_sitelib(pl);
155 struct IPerlEnv perlEnv =
174 PerlStdIOStdin(struct IPerlStdIO*)
176 return (PerlIO*)win32_stdin();
180 PerlStdIOStdout(struct IPerlStdIO*)
182 return (PerlIO*)win32_stdout();
186 PerlStdIOStderr(struct IPerlStdIO*)
188 return (PerlIO*)win32_stderr();
192 PerlStdIOOpen(struct IPerlStdIO*, const char *path, const char *mode)
194 return (PerlIO*)win32_fopen(path, mode);
198 PerlStdIOClose(struct IPerlStdIO*, PerlIO* pf)
200 return win32_fclose(((FILE*)pf));
204 PerlStdIOEof(struct IPerlStdIO*, PerlIO* pf)
206 return win32_feof((FILE*)pf);
210 PerlStdIOError(struct IPerlStdIO*, PerlIO* pf)
212 return win32_ferror((FILE*)pf);
216 PerlStdIOClearerr(struct IPerlStdIO*, PerlIO* pf)
218 win32_clearerr((FILE*)pf);
222 PerlStdIOGetc(struct IPerlStdIO*, PerlIO* pf)
224 return win32_getc((FILE*)pf);
228 PerlStdIOGetBase(struct IPerlStdIO*, PerlIO* pf)
239 PerlStdIOGetBufsiz(struct IPerlStdIO*, PerlIO* pf)
243 return FILE_bufsiz(f);
250 PerlStdIOGetCnt(struct IPerlStdIO*, PerlIO* pf)
261 PerlStdIOGetPtr(struct IPerlStdIO*, PerlIO* pf)
272 PerlStdIOGets(struct IPerlStdIO*, PerlIO* pf, char* s, int n)
274 return win32_fgets(s, n, (FILE*)pf);
278 PerlStdIOPutc(struct IPerlStdIO*, PerlIO* pf, int c)
280 return win32_fputc(c, (FILE*)pf);
284 PerlStdIOPuts(struct IPerlStdIO*, PerlIO* pf, const char *s)
286 return win32_fputs(s, (FILE*)pf);
290 PerlStdIOFlush(struct IPerlStdIO*, PerlIO* pf)
292 return win32_fflush((FILE*)pf);
296 PerlStdIOUngetc(struct IPerlStdIO*, PerlIO* pf,int c)
298 return win32_ungetc(c, (FILE*)pf);
302 PerlStdIOFileno(struct IPerlStdIO*, PerlIO* pf)
304 return win32_fileno((FILE*)pf);
308 PerlStdIOFdopen(struct IPerlStdIO*, int fd, const char *mode)
310 return (PerlIO*)win32_fdopen(fd, mode);
314 PerlStdIOReopen(struct IPerlStdIO*, const char*path, const char*mode, PerlIO* pf)
316 return (PerlIO*)win32_freopen(path, mode, (FILE*)pf);
320 PerlStdIORead(struct IPerlStdIO*, PerlIO* pf, void *buffer, Size_t size)
322 return win32_fread(buffer, 1, size, (FILE*)pf);
326 PerlStdIOWrite(struct IPerlStdIO*, PerlIO* pf, const void *buffer, Size_t size)
328 return win32_fwrite(buffer, 1, size, (FILE*)pf);
332 PerlStdIOSetBuf(struct IPerlStdIO*, PerlIO* pf, char* buffer)
334 win32_setbuf((FILE*)pf, buffer);
338 PerlStdIOSetVBuf(struct IPerlStdIO*, PerlIO* pf, char* buffer, int type, Size_t size)
340 return win32_setvbuf((FILE*)pf, buffer, type, size);
344 PerlStdIOSetCnt(struct IPerlStdIO*, PerlIO* pf, int n)
346 #ifdef STDIO_CNT_LVALUE
353 PerlStdIOSetPtrCnt(struct IPerlStdIO*, PerlIO* pf, char * ptr, int n)
355 #ifdef STDIO_PTR_LVALUE
363 PerlStdIOSetlinebuf(struct IPerlStdIO*, PerlIO* pf)
365 win32_setvbuf((FILE*)pf, NULL, _IOLBF, 0);
369 PerlStdIOPrintf(struct IPerlStdIO*, PerlIO* pf, const char *format,...)
372 va_start(arglist, format);
373 return win32_vfprintf((FILE*)pf, format, arglist);
377 PerlStdIOVprintf(struct IPerlStdIO*, PerlIO* pf, const char *format, va_list arglist)
379 return win32_vfprintf((FILE*)pf, format, arglist);
383 PerlStdIOTell(struct IPerlStdIO*, PerlIO* pf)
385 return win32_ftell((FILE*)pf);
389 PerlStdIOSeek(struct IPerlStdIO*, PerlIO* pf, off_t offset, int origin)
391 return win32_fseek((FILE*)pf, offset, origin);
395 PerlStdIORewind(struct IPerlStdIO*, PerlIO* pf)
397 win32_rewind((FILE*)pf);
401 PerlStdIOTmpfile(struct IPerlStdIO*)
403 return (PerlIO*)win32_tmpfile();
407 PerlStdIOGetpos(struct IPerlStdIO*, PerlIO* pf, Fpos_t *p)
409 return win32_fgetpos((FILE*)pf, p);
413 PerlStdIOSetpos(struct IPerlStdIO*, PerlIO* pf, const Fpos_t *p)
415 return win32_fsetpos((FILE*)pf, p);
418 PerlStdIOInit(struct IPerlStdIO*)
423 PerlStdIOInitOSExtras(struct IPerlStdIO*)
427 Perl_init_os_extras();
431 PerlStdIOOpenOSfhandle(struct IPerlStdIO*, long osfhandle, int flags)
433 return win32_open_osfhandle(osfhandle, flags);
437 PerlStdIOGetOSfhandle(struct IPerlStdIO*, int filenum)
439 return win32_get_osfhandle(filenum);
443 struct IPerlStdIO perlStdIO =
482 PerlStdIOInitOSExtras,
488 PerlLIOAccess(struct IPerlLIO*, const char *path, int mode)
490 return access(path, mode);
494 PerlLIOChmod(struct IPerlLIO*, const char *filename, int pmode)
496 return chmod(filename, pmode);
500 PerlLIOChown(struct IPerlLIO*, const char *filename, uid_t owner, gid_t group)
502 return chown(filename, owner, group);
506 PerlLIOChsize(struct IPerlLIO*, int handle, long size)
508 return chsize(handle, size);
512 PerlLIOClose(struct IPerlLIO*, int handle)
514 return win32_close(handle);
518 PerlLIODup(struct IPerlLIO*, int handle)
520 return win32_dup(handle);
524 PerlLIODup2(struct IPerlLIO*, int handle1, int handle2)
526 return win32_dup2(handle1, handle2);
530 PerlLIOFlock(struct IPerlLIO*, int fd, int oper)
532 return win32_flock(fd, oper);
536 PerlLIOFileStat(struct IPerlLIO*, int handle, struct stat *buffer)
538 return fstat(handle, buffer);
542 PerlLIOIOCtl(struct IPerlLIO*, int i, unsigned int u, char *data)
544 return win32_ioctlsocket((SOCKET)i, (long)u, (u_long*)data);
548 PerlLIOIsatty(struct IPerlLIO*, int fd)
554 PerlLIOLseek(struct IPerlLIO*, int handle, long offset, int origin)
556 return win32_lseek(handle, offset, origin);
560 PerlLIOLstat(struct IPerlLIO* p, const char *path, struct stat *buffer)
562 return win32_stat(path, buffer);
566 PerlLIOMktemp(struct IPerlLIO*, char *Template)
568 return mktemp(Template);
572 PerlLIOOpen(struct IPerlLIO*, const char *filename, int oflag)
574 return win32_open(filename, oflag);
578 PerlLIOOpen3(struct IPerlLIO*, const char *filename, int oflag, int pmode)
581 if(stricmp(filename, "/dev/null") == 0)
582 ret = open("NUL", oflag, pmode);
584 ret = open(filename, oflag, pmode);
590 PerlLIORead(struct IPerlLIO*, int handle, void *buffer, unsigned int count)
592 return win32_read(handle, buffer, count);
596 PerlLIORename(struct IPerlLIO*, const char *OldFileName, const char *newname)
598 return win32_rename(OldFileName, newname);
602 PerlLIOSetmode(struct IPerlLIO*, int handle, int mode)
604 return win32_setmode(handle, mode);
608 PerlLIONameStat(struct IPerlLIO*, const char *path, struct stat *buffer)
610 return win32_stat(path, buffer);
614 PerlLIOTmpnam(struct IPerlLIO*, char *string)
616 return tmpnam(string);
620 PerlLIOUmask(struct IPerlLIO*, int pmode)
626 PerlLIOUnlink(struct IPerlLIO*, const char *filename)
628 chmod(filename, S_IREAD | S_IWRITE);
629 return unlink(filename);
633 PerlLIOUtime(struct IPerlLIO*, char *filename, struct utimbuf *times)
635 return win32_utime(filename, times);
639 PerlLIOWrite(struct IPerlLIO*, int handle, const void *buffer, unsigned int count)
641 return win32_write(handle, buffer, count);
644 struct IPerlLIO perlLIO =
675 PerlDirMakedir(struct IPerlDir*, const char *dirname, int mode)
677 return win32_mkdir(dirname, mode);
681 PerlDirChdir(struct IPerlDir*, const char *dirname)
683 return win32_chdir(dirname);
687 PerlDirRmdir(struct IPerlDir*, const char *dirname)
689 return win32_rmdir(dirname);
693 PerlDirClose(struct IPerlDir*, DIR *dirp)
695 return win32_closedir(dirp);
699 PerlDirOpen(struct IPerlDir*, char *filename)
701 return win32_opendir(filename);
705 PerlDirRead(struct IPerlDir*, DIR *dirp)
707 return win32_readdir(dirp);
711 PerlDirRewind(struct IPerlDir*, DIR *dirp)
713 win32_rewinddir(dirp);
717 PerlDirSeek(struct IPerlDir*, DIR *dirp, long loc)
719 win32_seekdir(dirp, loc);
723 PerlDirTell(struct IPerlDir*, DIR *dirp)
725 return win32_telldir(dirp);
728 struct IPerlDir perlDir =
744 PerlSockHtonl(struct IPerlSock*, u_long hostlong)
746 return win32_htonl(hostlong);
750 PerlSockHtons(struct IPerlSock*, u_short hostshort)
752 return win32_htons(hostshort);
756 PerlSockNtohl(struct IPerlSock*, u_long netlong)
758 return win32_ntohl(netlong);
762 PerlSockNtohs(struct IPerlSock*, u_short netshort)
764 return win32_ntohs(netshort);
767 SOCKET PerlSockAccept(struct IPerlSock*, SOCKET s, struct sockaddr* addr, int* addrlen)
769 return win32_accept(s, addr, addrlen);
773 PerlSockBind(struct IPerlSock*, SOCKET s, const struct sockaddr* name, int namelen)
775 return win32_bind(s, name, namelen);
779 PerlSockConnect(struct IPerlSock*, SOCKET s, const struct sockaddr* name, int namelen)
781 return win32_connect(s, name, namelen);
785 PerlSockEndhostent(struct IPerlSock*)
791 PerlSockEndnetent(struct IPerlSock*)
797 PerlSockEndprotoent(struct IPerlSock*)
803 PerlSockEndservent(struct IPerlSock*)
809 PerlSockGethostbyaddr(struct IPerlSock*, const char* addr, int len, int type)
811 return win32_gethostbyaddr(addr, len, type);
815 PerlSockGethostbyname(struct IPerlSock*, const char* name)
817 return win32_gethostbyname(name);
821 PerlSockGethostent(struct IPerlSock*)
824 croak("gethostent not implemented!\n");
829 PerlSockGethostname(struct IPerlSock*, char* name, int namelen)
831 return win32_gethostname(name, namelen);
835 PerlSockGetnetbyaddr(struct IPerlSock*, long net, int type)
837 return win32_getnetbyaddr(net, type);
841 PerlSockGetnetbyname(struct IPerlSock*, const char *name)
843 return win32_getnetbyname((char*)name);
847 PerlSockGetnetent(struct IPerlSock*)
849 return win32_getnetent();
852 int PerlSockGetpeername(struct IPerlSock*, SOCKET s, struct sockaddr* name, int* namelen)
854 return win32_getpeername(s, name, namelen);
858 PerlSockGetprotobyname(struct IPerlSock*, const char* name)
860 return win32_getprotobyname(name);
864 PerlSockGetprotobynumber(struct IPerlSock*, int number)
866 return win32_getprotobynumber(number);
870 PerlSockGetprotoent(struct IPerlSock*)
872 return win32_getprotoent();
876 PerlSockGetservbyname(struct IPerlSock*, const char* name, const char* proto)
878 return win32_getservbyname(name, proto);
882 PerlSockGetservbyport(struct IPerlSock*, int port, const char* proto)
884 return win32_getservbyport(port, proto);
888 PerlSockGetservent(struct IPerlSock*)
890 return win32_getservent();
894 PerlSockGetsockname(struct IPerlSock*, SOCKET s, struct sockaddr* name, int* namelen)
896 return win32_getsockname(s, name, namelen);
900 PerlSockGetsockopt(struct IPerlSock*, SOCKET s, int level, int optname, char* optval, int* optlen)
902 return win32_getsockopt(s, level, optname, optval, optlen);
906 PerlSockInetAddr(struct IPerlSock*, const char* cp)
908 return win32_inet_addr(cp);
912 PerlSockInetNtoa(struct IPerlSock*, struct in_addr in)
914 return win32_inet_ntoa(in);
918 PerlSockListen(struct IPerlSock*, SOCKET s, int backlog)
920 return win32_listen(s, backlog);
924 PerlSockRecv(struct IPerlSock*, SOCKET s, char* buffer, int len, int flags)
926 return win32_recv(s, buffer, len, flags);
930 PerlSockRecvfrom(struct IPerlSock*, SOCKET s, char* buffer, int len, int flags, struct sockaddr* from, int* fromlen)
932 return win32_recvfrom(s, buffer, len, flags, from, fromlen);
936 PerlSockSelect(struct IPerlSock*, int nfds, char* readfds, char* writefds, char* exceptfds, const struct timeval* timeout)
938 return win32_select(nfds, (Perl_fd_set*)readfds, (Perl_fd_set*)writefds, (Perl_fd_set*)exceptfds, timeout);
942 PerlSockSend(struct IPerlSock*, SOCKET s, const char* buffer, int len, int flags)
944 return win32_send(s, buffer, len, flags);
948 PerlSockSendto(struct IPerlSock*, SOCKET s, const char* buffer, int len, int flags, const struct sockaddr* to, int tolen)
950 return win32_sendto(s, buffer, len, flags, to, tolen);
954 PerlSockSethostent(struct IPerlSock*, int stayopen)
956 win32_sethostent(stayopen);
960 PerlSockSetnetent(struct IPerlSock*, int stayopen)
962 win32_setnetent(stayopen);
966 PerlSockSetprotoent(struct IPerlSock*, int stayopen)
968 win32_setprotoent(stayopen);
972 PerlSockSetservent(struct IPerlSock*, int stayopen)
974 win32_setservent(stayopen);
978 PerlSockSetsockopt(struct IPerlSock*, SOCKET s, int level, int optname, const char* optval, int optlen)
980 return win32_setsockopt(s, level, optname, optval, optlen);
984 PerlSockShutdown(struct IPerlSock*, SOCKET s, int how)
986 return win32_shutdown(s, how);
990 PerlSockSocket(struct IPerlSock*, int af, int type, int protocol)
992 return win32_socket(af, type, protocol);
996 PerlSockSocketpair(struct IPerlSock*, int domain, int type, int protocol, int* fds)
999 croak("socketpair not implemented!\n");
1004 PerlSockClosesocket(struct IPerlSock*, SOCKET s)
1006 return win32_closesocket(s);
1010 PerlSockIoctlsocket(struct IPerlSock*, SOCKET s, long cmd, u_long *argp)
1012 return win32_ioctlsocket(s, cmd, argp);
1015 struct IPerlSock perlSock =
1026 PerlSockEndprotoent,
1028 PerlSockGethostname,
1029 PerlSockGetpeername,
1030 PerlSockGethostbyaddr,
1031 PerlSockGethostbyname,
1033 PerlSockGetnetbyaddr,
1034 PerlSockGetnetbyname,
1036 PerlSockGetprotobyname,
1037 PerlSockGetprotobynumber,
1038 PerlSockGetprotoent,
1039 PerlSockGetservbyname,
1040 PerlSockGetservbyport,
1042 PerlSockGetsockname,
1054 PerlSockSetprotoent,
1060 PerlSockClosesocket,
1066 #define EXECF_EXEC 1
1067 #define EXECF_SPAWN 2
1069 extern char * g_getlogin(void);
1070 extern int do_spawn2(char *cmd, int exectype);
1071 extern int g_do_aspawn(void *vreally, void **vmark, void **vsp);
1074 PerlProcAbort(struct IPerlProc*)
1080 PerlProcCrypt(struct IPerlProc*, const char* clear, const char* salt)
1082 return win32_crypt(clear, salt);
1086 PerlProcExit(struct IPerlProc*, int status)
1092 PerlProc_Exit(struct IPerlProc*, int status)
1098 PerlProcExecl(struct IPerlProc*, const char *cmdname, const char *arg0, const char *arg1, const char *arg2, const char *arg3)
1100 return execl(cmdname, arg0, arg1, arg2, arg3);
1104 PerlProcExecv(struct IPerlProc*, const char *cmdname, const char *const *argv)
1106 return win32_execvp(cmdname, argv);
1110 PerlProcExecvp(struct IPerlProc*, const char *cmdname, const char *const *argv)
1112 return win32_execvp(cmdname, argv);
1116 PerlProcGetuid(struct IPerlProc*)
1122 PerlProcGeteuid(struct IPerlProc*)
1128 PerlProcGetgid(struct IPerlProc*)
1134 PerlProcGetegid(struct IPerlProc*)
1140 PerlProcGetlogin(struct IPerlProc*)
1142 return g_getlogin();
1146 PerlProcKill(struct IPerlProc*, int pid, int sig)
1148 return win32_kill(pid, sig);
1152 PerlProcKillpg(struct IPerlProc*, int pid, int sig)
1155 croak("killpg not implemented!\n");
1160 PerlProcPauseProc(struct IPerlProc*)
1162 return win32_sleep((32767L << 16) + 32767);
1166 PerlProcPopen(struct IPerlProc*, const char *command, const char *mode)
1168 win32_fflush(stdout);
1169 win32_fflush(stderr);
1170 return (PerlIO*)win32_popen(command, mode);
1174 PerlProcPclose(struct IPerlProc*, PerlIO *stream)
1176 return win32_pclose((FILE*)stream);
1180 PerlProcPipe(struct IPerlProc*, int *phandles)
1182 return win32_pipe(phandles, 512, O_BINARY);
1186 PerlProcSetuid(struct IPerlProc*, uid_t u)
1192 PerlProcSetgid(struct IPerlProc*, gid_t g)
1198 PerlProcSleep(struct IPerlProc*, unsigned int s)
1200 return win32_sleep(s);
1204 PerlProcTimes(struct IPerlProc*, struct tms *timebuf)
1206 return win32_times(timebuf);
1210 PerlProcWait(struct IPerlProc*, int *status)
1212 return win32_wait(status);
1216 PerlProcWaitpid(struct IPerlProc*, int pid, int *status, int flags)
1218 return win32_waitpid(pid, status, flags);
1222 PerlProcSignal(struct IPerlProc*, int sig, Sighandler_t subcode)
1228 PerlProcDynaLoader(struct IPerlProc*, const char* filename)
1230 return win32_dynaload(filename);
1234 PerlProcGetOSError(struct IPerlProc*, SV* sv, DWORD dwErr)
1236 win32_str_os_error(aTHX_ sv, dwErr);
1240 PerlProcDoCmd(struct IPerlProc*, char *cmd)
1242 do_spawn2(cmd, EXECF_EXEC);
1247 PerlProcSpawn(struct IPerlProc*, char* cmds)
1249 return do_spawn2(cmds, EXECF_SPAWN);
1253 PerlProcSpawnvp(struct IPerlProc*, int mode, const char *cmdname, const char *const *argv)
1255 return win32_spawnvp(mode, cmdname, argv);
1259 PerlProcASpawn(struct IPerlProc*, void *vreally, void **vmark, void **vsp)
1261 return g_do_aspawn(vreally, vmark, vsp);
1264 struct IPerlProc perlProc =
1299 //#include "perlhost.h"
1302 EXTERN_C void perl_get_host_info(IPerlMemInfo* perlMemInfo,
1303 IPerlEnvInfo* perlEnvInfo, IPerlStdIOInfo* perlStdIOInfo,
1304 IPerlLIOInfo* perlLIOInfo, IPerlDirInfo* perlDirInfo,
1305 IPerlSockInfo* perlSockInfo, IPerlProcInfo* perlProcInfo)
1308 Copy(&perlMem, &perlMemInfo->perlMemList, perlMemInfo->nCount, void*);
1309 perlMemInfo->nCount = (sizeof(struct IPerlMem)/sizeof(void*));
1312 Copy(&perlEnv, &perlEnvInfo->perlEnvList, perlEnvInfo->nCount, void*);
1313 perlEnvInfo->nCount = (sizeof(struct IPerlEnv)/sizeof(void*));
1316 Copy(&perlStdIO, &perlStdIOInfo->perlStdIOList, perlStdIOInfo->nCount, void*);
1317 perlStdIOInfo->nCount = (sizeof(struct IPerlStdIO)/sizeof(void*));
1320 Copy(&perlLIO, &perlLIOInfo->perlLIOList, perlLIOInfo->nCount, void*);
1321 perlLIOInfo->nCount = (sizeof(struct IPerlLIO)/sizeof(void*));
1324 Copy(&perlDir, &perlDirInfo->perlDirList, perlDirInfo->nCount, void*);
1325 perlDirInfo->nCount = (sizeof(struct IPerlDir)/sizeof(void*));
1328 Copy(&perlSock, &perlSockInfo->perlSockList, perlSockInfo->nCount, void*);
1329 perlSockInfo->nCount = (sizeof(struct IPerlSock)/sizeof(void*));
1332 Copy(&perlProc, &perlProcInfo->perlProcList, perlProcInfo->nCount, void*);
1333 perlProcInfo->nCount = (sizeof(struct IPerlProc)/sizeof(void*));
1337 EXTERN_C PerlInterpreter* perl_alloc_using(IPerlMem* pMem,
1338 IPerlEnv* pEnv, IPerlStdIO* pStdIO,
1339 IPerlLIO* pLIO, IPerlDir* pDir,
1340 IPerlSock* pSock, IPerlProc* pProc)
1342 CPerlObj* pPerl = NULL;
1345 pPerl = Perl_alloc(pMem, pEnv, pStdIO, pLIO, pDir, pSock, pProc);
1349 win32_fprintf(stderr, "%s\n", "Error: Unable to allocate memory");
1354 SetPerlInterpreter(pPerl);
1355 return (PerlInterpreter*)pPerl;
1357 SetPerlInterpreter(NULL);
1362 #undef perl_construct
1363 #undef perl_destruct
1367 EXTERN_C PerlInterpreter* perl_alloc(void)
1369 CPerlObj* pPerl = NULL;
1372 pPerl = Perl_alloc(&perlMem, &perlEnv, &perlStdIO, &perlLIO,
1373 &perlDir, &perlSock, &perlProc);
1377 win32_fprintf(stderr, "%s\n", "Error: Unable to allocate memory");
1382 SetPerlInterpreter(pPerl);
1383 return (PerlInterpreter*)pPerl;
1385 SetPerlInterpreter(NULL);
1389 EXTERN_C void perl_construct(PerlInterpreter* sv_interp)
1391 CPerlObj* pPerl = (CPerlObj*)sv_interp;
1394 pPerl->perl_construct();
1398 win32_fprintf(stderr, "%s\n",
1399 "Error: Unable to construct data structures");
1401 SetPerlInterpreter(NULL);
1405 EXTERN_C void perl_destruct(PerlInterpreter* sv_interp)
1407 CPerlObj* pPerl = (CPerlObj*)sv_interp;
1410 pPerl->perl_destruct();
1417 EXTERN_C void perl_free(PerlInterpreter* sv_interp)
1419 CPerlObj* pPerl = (CPerlObj*)sv_interp;
1427 SetPerlInterpreter(NULL);
1430 EXTERN_C int perl_run(PerlInterpreter* sv_interp)
1432 CPerlObj* pPerl = (CPerlObj*)sv_interp;
1436 retVal = pPerl->perl_run();
1441 // this is where exit() should arrive
1447 win32_fprintf(stderr, "Error: Runtime exception\n");
1453 EXTERN_C int perl_parse(PerlInterpreter* sv_interp, void (*xsinit)(CPerlObj*), int argc, char** argv, char** env)
1456 CPerlObj* pPerl = (CPerlObj*)sv_interp;
1459 retVal = pPerl->perl_parse(xsinit, argc, argv, env);
1464 // this is where exit() should arrive
1470 win32_fprintf(stderr, "Error: Parse exception\n");
1477 #undef PL_perl_destruct_level
1478 #define PL_perl_destruct_level int dummy
1479 #endif /* PERL_OBJECT */
1481 extern HANDLE w32_perldll_handle;
1482 static DWORD g_TlsAllocIndex;
1484 EXTERN_C DllExport bool
1485 SetPerlInterpreter(void *interp)
1487 return TlsSetValue(g_TlsAllocIndex, interp);
1490 EXTERN_C DllExport void*
1491 GetPerlInterpreter(void)
1493 return TlsGetValue(g_TlsAllocIndex);
1496 EXTERN_C DllExport int
1497 RunPerl(int argc, char **argv, char **env)
1500 PerlInterpreter *my_perl;
1501 struct perl_thread *thr;
1503 #ifndef __BORLANDC__
1504 /* XXX this _may_ be a problem on some compilers (e.g. Borland) that
1505 * want to free() argv after main() returns. As luck would have it,
1506 * Borland's CRT does the right thing to argv[0] already. */
1507 char szModuleName[MAX_PATH];
1510 GetModuleFileName(NULL, szModuleName, sizeof(szModuleName));
1511 (void)win32_longpath(szModuleName);
1512 argv[0] = szModuleName;
1515 #ifdef PERL_GLOBAL_STRUCT
1516 #define PERLVAR(var,type) /**/
1517 #define PERLVARA(var,type) /**/
1518 #define PERLVARI(var,type,init) PL_Vars.var = init;
1519 #define PERLVARIC(var,type,init) PL_Vars.var = init;
1520 #include "perlvars.h"
1527 PERL_SYS_INIT(&argc,&argv);
1529 if (!(my_perl = perl_alloc()))
1531 perl_construct( my_perl );
1532 PL_perl_destruct_level = 0;
1535 /* PERL_OBJECT build sets Dynaloader in PerlStdIOInitOSExtras */
1536 exitstatus = perl_parse(my_perl, NULL, argc, argv, env);
1538 exitstatus = perl_parse(my_perl, xs_init, argc, argv, env);
1541 exitstatus = perl_run( my_perl );
1544 perl_destruct( my_perl );
1545 perl_free( my_perl );
1549 return (exitstatus);
1553 DllMain(HANDLE hModule, /* DLL module handle */
1554 DWORD fdwReason, /* reason called */
1555 LPVOID lpvReserved) /* reserved */
1557 switch (fdwReason) {
1558 /* The DLL is attaching to a process due to process
1559 * initialization or a call to LoadLibrary.
1561 case DLL_PROCESS_ATTACH:
1562 /* #define DEFAULT_BINMODE */
1563 #ifdef DEFAULT_BINMODE
1564 setmode( fileno( stdin ), O_BINARY );
1565 setmode( fileno( stdout ), O_BINARY );
1566 setmode( fileno( stderr ), O_BINARY );
1569 g_TlsAllocIndex = TlsAlloc();
1570 DisableThreadLibraryCalls(hModule);
1571 w32_perldll_handle = hModule;
1574 /* The DLL is detaching from a process due to
1575 * process termination or call to FreeLibrary.
1577 case DLL_PROCESS_DETACH:
1578 TlsFree(g_TlsAllocIndex);
1581 /* The attached process creates a new thread. */
1582 case DLL_THREAD_ATTACH:
1585 /* The thread of the attached process terminates. */
1586 case DLL_THREAD_DETACH: