2 * "The Road goes ever on and on, down from the door where it began."
15 #ifdef PERL_IMPLICIT_SYS
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);
37 #ifdef PERL_IMPLICIT_SYS
40 PerlMemMalloc(struct IPerlMem *I, size_t size)
42 return win32_malloc(size);
45 PerlMemRealloc(struct IPerlMem *I, void* ptr, size_t size)
47 return win32_realloc(ptr, size);
50 PerlMemFree(struct IPerlMem *I, 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 *I, const char *varname)
71 return win32_getenv(varname);
74 PerlEnvPutenv(struct IPerlEnv *I, const char *envstring)
76 return win32_putenv(envstring);
80 PerlEnvGetenv_len(struct IPerlEnv *I, const char* varname, unsigned long* len)
82 char *e = win32_getenv(varname);
89 PerlEnvUname(struct IPerlEnv *I, struct utsname *name)
91 return win32_uname(name);
95 PerlEnvClearenv(struct IPerlEnv *I)
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 *I)
122 PerlEnvFreeChildEnv(struct IPerlEnv *I, void* env)
127 PerlEnvGetChildDir(struct IPerlEnv *I)
133 PerlEnvFreeChildDir(struct IPerlEnv *I, char* dir)
138 PerlEnvOsId(struct IPerlEnv *I)
140 return win32_os_id();
144 PerlEnvLibPath(struct IPerlEnv *I, char *pl)
146 return g_win32_get_privlib(pl);
150 PerlEnvSiteLibPath(struct IPerlEnv *I, char *pl)
152 return g_win32_get_sitelib(pl);
155 struct IPerlEnv perlEnv =
174 PerlStdIOStdin(struct IPerlStdIO *I)
176 return (PerlIO*)win32_stdin();
180 PerlStdIOStdout(struct IPerlStdIO *I)
182 return (PerlIO*)win32_stdout();
186 PerlStdIOStderr(struct IPerlStdIO *I)
188 return (PerlIO*)win32_stderr();
192 PerlStdIOOpen(struct IPerlStdIO *I, const char *path, const char *mode)
194 return (PerlIO*)win32_fopen(path, mode);
198 PerlStdIOClose(struct IPerlStdIO *I, PerlIO* pf)
200 return win32_fclose(((FILE*)pf));
204 PerlStdIOEof(struct IPerlStdIO *I, PerlIO* pf)
206 return win32_feof((FILE*)pf);
210 PerlStdIOError(struct IPerlStdIO *I, PerlIO* pf)
212 return win32_ferror((FILE*)pf);
216 PerlStdIOClearerr(struct IPerlStdIO *I, PerlIO* pf)
218 win32_clearerr((FILE*)pf);
222 PerlStdIOGetc(struct IPerlStdIO *I, PerlIO* pf)
224 return win32_getc((FILE*)pf);
228 PerlStdIOGetBase(struct IPerlStdIO *I, PerlIO* pf)
239 PerlStdIOGetBufsiz(struct IPerlStdIO *I, PerlIO* pf)
243 return FILE_bufsiz(f);
250 PerlStdIOGetCnt(struct IPerlStdIO *I, PerlIO* pf)
261 PerlStdIOGetPtr(struct IPerlStdIO *I, PerlIO* pf)
272 PerlStdIOGets(struct IPerlStdIO *I, PerlIO* pf, char* s, int n)
274 return win32_fgets(s, n, (FILE*)pf);
278 PerlStdIOPutc(struct IPerlStdIO *I, PerlIO* pf, int c)
280 return win32_fputc(c, (FILE*)pf);
284 PerlStdIOPuts(struct IPerlStdIO *I, PerlIO* pf, const char *s)
286 return win32_fputs(s, (FILE*)pf);
290 PerlStdIOFlush(struct IPerlStdIO *I, PerlIO* pf)
292 return win32_fflush((FILE*)pf);
296 PerlStdIOUngetc(struct IPerlStdIO *I, PerlIO* pf,int c)
298 return win32_ungetc(c, (FILE*)pf);
302 PerlStdIOFileno(struct IPerlStdIO *I, PerlIO* pf)
304 return win32_fileno((FILE*)pf);
308 PerlStdIOFdopen(struct IPerlStdIO *I, int fd, const char *mode)
310 return (PerlIO*)win32_fdopen(fd, mode);
314 PerlStdIOReopen(struct IPerlStdIO *I, const char*path, const char*mode, PerlIO* pf)
316 return (PerlIO*)win32_freopen(path, mode, (FILE*)pf);
320 PerlStdIORead(struct IPerlStdIO *I, PerlIO* pf, void *buffer, Size_t size)
322 return win32_fread(buffer, 1, size, (FILE*)pf);
326 PerlStdIOWrite(struct IPerlStdIO *I, PerlIO* pf, const void *buffer, Size_t size)
328 return win32_fwrite(buffer, 1, size, (FILE*)pf);
332 PerlStdIOSetBuf(struct IPerlStdIO *I, PerlIO* pf, char* buffer)
334 win32_setbuf((FILE*)pf, buffer);
338 PerlStdIOSetVBuf(struct IPerlStdIO *I, PerlIO* pf, char* buffer, int type, Size_t size)
340 return win32_setvbuf((FILE*)pf, buffer, type, size);
344 PerlStdIOSetCnt(struct IPerlStdIO *I, PerlIO* pf, int n)
346 #ifdef STDIO_CNT_LVALUE
353 PerlStdIOSetPtrCnt(struct IPerlStdIO *I, PerlIO* pf, char * ptr, int n)
355 #ifdef STDIO_PTR_LVALUE
363 PerlStdIOSetlinebuf(struct IPerlStdIO *I, PerlIO* pf)
365 win32_setvbuf((FILE*)pf, NULL, _IOLBF, 0);
369 PerlStdIOPrintf(struct IPerlStdIO *I, PerlIO* pf, const char *format,...)
372 va_start(arglist, format);
373 return win32_vfprintf((FILE*)pf, format, arglist);
377 PerlStdIOVprintf(struct IPerlStdIO *I, PerlIO* pf, const char *format, va_list arglist)
379 return win32_vfprintf((FILE*)pf, format, arglist);
383 PerlStdIOTell(struct IPerlStdIO *I, PerlIO* pf)
385 return win32_ftell((FILE*)pf);
389 PerlStdIOSeek(struct IPerlStdIO *I, PerlIO* pf, off_t offset, int origin)
391 return win32_fseek((FILE*)pf, offset, origin);
395 PerlStdIORewind(struct IPerlStdIO *I, PerlIO* pf)
397 win32_rewind((FILE*)pf);
401 PerlStdIOTmpfile(struct IPerlStdIO *I)
403 return (PerlIO*)win32_tmpfile();
407 PerlStdIOGetpos(struct IPerlStdIO *I, PerlIO* pf, Fpos_t *p)
409 return win32_fgetpos((FILE*)pf, p);
413 PerlStdIOSetpos(struct IPerlStdIO *I, PerlIO* pf, const Fpos_t *p)
415 return win32_fsetpos((FILE*)pf, p);
418 PerlStdIOInit(struct IPerlStdIO *I)
423 PerlStdIOInitOSExtras(struct IPerlStdIO *I)
425 Perl_init_os_extras();
429 PerlStdIOOpenOSfhandle(struct IPerlStdIO *I, long osfhandle, int flags)
431 return win32_open_osfhandle(osfhandle, flags);
435 PerlStdIOGetOSfhandle(struct IPerlStdIO *I, int filenum)
437 return win32_get_osfhandle(filenum);
441 struct IPerlStdIO perlStdIO =
480 PerlStdIOInitOSExtras,
486 PerlLIOAccess(struct IPerlLIO *I, const char *path, int mode)
488 return access(path, mode);
492 PerlLIOChmod(struct IPerlLIO *I, const char *filename, int pmode)
494 return chmod(filename, pmode);
498 PerlLIOChown(struct IPerlLIO *I, const char *filename, uid_t owner, gid_t group)
500 return chown(filename, owner, group);
504 PerlLIOChsize(struct IPerlLIO *I, int handle, long size)
506 return chsize(handle, size);
510 PerlLIOClose(struct IPerlLIO *I, int handle)
512 return win32_close(handle);
516 PerlLIODup(struct IPerlLIO *I, int handle)
518 return win32_dup(handle);
522 PerlLIODup2(struct IPerlLIO *I, int handle1, int handle2)
524 return win32_dup2(handle1, handle2);
528 PerlLIOFlock(struct IPerlLIO *I, int fd, int oper)
530 return win32_flock(fd, oper);
534 PerlLIOFileStat(struct IPerlLIO *I, int handle, struct stat *buffer)
536 return fstat(handle, buffer);
540 PerlLIOIOCtl(struct IPerlLIO *I, int i, unsigned int u, char *data)
542 return win32_ioctlsocket((SOCKET)i, (long)u, (u_long*)data);
546 PerlLIOIsatty(struct IPerlLIO *I, int fd)
552 PerlLIOLseek(struct IPerlLIO *I, int handle, long offset, int origin)
554 return win32_lseek(handle, offset, origin);
558 PerlLIOLstat(struct IPerlLIO* p, const char *path, struct stat *buffer)
560 return win32_stat(path, buffer);
564 PerlLIOMktemp(struct IPerlLIO *I, char *Template)
566 return mktemp(Template);
570 PerlLIOOpen(struct IPerlLIO *I, const char *filename, int oflag)
572 return win32_open(filename, oflag);
576 PerlLIOOpen3(struct IPerlLIO *I, const char *filename, int oflag, int pmode)
579 if(stricmp(filename, "/dev/null") == 0)
580 ret = open("NUL", oflag, pmode);
582 ret = open(filename, oflag, pmode);
588 PerlLIORead(struct IPerlLIO *I, int handle, void *buffer, unsigned int count)
590 return win32_read(handle, buffer, count);
594 PerlLIORename(struct IPerlLIO *I, const char *OldFileName, const char *newname)
596 return win32_rename(OldFileName, newname);
600 PerlLIOSetmode(struct IPerlLIO *I, int handle, int mode)
602 return win32_setmode(handle, mode);
606 PerlLIONameStat(struct IPerlLIO *I, const char *path, struct stat *buffer)
608 return win32_stat(path, buffer);
612 PerlLIOTmpnam(struct IPerlLIO *I, char *string)
614 return tmpnam(string);
618 PerlLIOUmask(struct IPerlLIO *I, int pmode)
624 PerlLIOUnlink(struct IPerlLIO *I, const char *filename)
626 chmod(filename, S_IREAD | S_IWRITE);
627 return unlink(filename);
631 PerlLIOUtime(struct IPerlLIO *I, char *filename, struct utimbuf *times)
633 return win32_utime(filename, times);
637 PerlLIOWrite(struct IPerlLIO *I, int handle, const void *buffer, unsigned int count)
639 return win32_write(handle, buffer, count);
642 struct IPerlLIO perlLIO =
673 PerlDirMakedir(struct IPerlDir *I, const char *dirname, int mode)
675 return win32_mkdir(dirname, mode);
679 PerlDirChdir(struct IPerlDir *I, const char *dirname)
681 return win32_chdir(dirname);
685 PerlDirRmdir(struct IPerlDir *I, const char *dirname)
687 return win32_rmdir(dirname);
691 PerlDirClose(struct IPerlDir *I, DIR *dirp)
693 return win32_closedir(dirp);
697 PerlDirOpen(struct IPerlDir *I, char *filename)
699 return win32_opendir(filename);
703 PerlDirRead(struct IPerlDir *I, DIR *dirp)
705 return win32_readdir(dirp);
709 PerlDirRewind(struct IPerlDir *I, DIR *dirp)
711 win32_rewinddir(dirp);
715 PerlDirSeek(struct IPerlDir *I, DIR *dirp, long loc)
717 win32_seekdir(dirp, loc);
721 PerlDirTell(struct IPerlDir *I, DIR *dirp)
723 return win32_telldir(dirp);
726 struct IPerlDir perlDir =
742 PerlSockHtonl(struct IPerlSock *I, u_long hostlong)
744 return win32_htonl(hostlong);
748 PerlSockHtons(struct IPerlSock *I, u_short hostshort)
750 return win32_htons(hostshort);
754 PerlSockNtohl(struct IPerlSock *I, u_long netlong)
756 return win32_ntohl(netlong);
760 PerlSockNtohs(struct IPerlSock *I, u_short netshort)
762 return win32_ntohs(netshort);
765 SOCKET PerlSockAccept(struct IPerlSock *I, SOCKET s, struct sockaddr* addr, int* addrlen)
767 return win32_accept(s, addr, addrlen);
771 PerlSockBind(struct IPerlSock *I, SOCKET s, const struct sockaddr* name, int namelen)
773 return win32_bind(s, name, namelen);
777 PerlSockConnect(struct IPerlSock *I, SOCKET s, const struct sockaddr* name, int namelen)
779 return win32_connect(s, name, namelen);
783 PerlSockEndhostent(struct IPerlSock *I)
789 PerlSockEndnetent(struct IPerlSock *I)
795 PerlSockEndprotoent(struct IPerlSock *I)
801 PerlSockEndservent(struct IPerlSock *I)
807 PerlSockGethostbyaddr(struct IPerlSock *I, const char* addr, int len, int type)
809 return win32_gethostbyaddr(addr, len, type);
813 PerlSockGethostbyname(struct IPerlSock *I, const char* name)
815 return win32_gethostbyname(name);
819 PerlSockGethostent(struct IPerlSock *I)
822 Perl_croak(aTHX_ "gethostent not implemented!\n");
827 PerlSockGethostname(struct IPerlSock *I, char* name, int namelen)
829 return win32_gethostname(name, namelen);
833 PerlSockGetnetbyaddr(struct IPerlSock *I, long net, int type)
835 return win32_getnetbyaddr(net, type);
839 PerlSockGetnetbyname(struct IPerlSock *I, const char *name)
841 return win32_getnetbyname((char*)name);
845 PerlSockGetnetent(struct IPerlSock *I)
847 return win32_getnetent();
850 int PerlSockGetpeername(struct IPerlSock *I, SOCKET s, struct sockaddr* name, int* namelen)
852 return win32_getpeername(s, name, namelen);
856 PerlSockGetprotobyname(struct IPerlSock *I, const char* name)
858 return win32_getprotobyname(name);
862 PerlSockGetprotobynumber(struct IPerlSock *I, int number)
864 return win32_getprotobynumber(number);
868 PerlSockGetprotoent(struct IPerlSock *I)
870 return win32_getprotoent();
874 PerlSockGetservbyname(struct IPerlSock *I, const char* name, const char* proto)
876 return win32_getservbyname(name, proto);
880 PerlSockGetservbyport(struct IPerlSock *I, int port, const char* proto)
882 return win32_getservbyport(port, proto);
886 PerlSockGetservent(struct IPerlSock *I)
888 return win32_getservent();
892 PerlSockGetsockname(struct IPerlSock *I, SOCKET s, struct sockaddr* name, int* namelen)
894 return win32_getsockname(s, name, namelen);
898 PerlSockGetsockopt(struct IPerlSock *I, SOCKET s, int level, int optname, char* optval, int* optlen)
900 return win32_getsockopt(s, level, optname, optval, optlen);
904 PerlSockInetAddr(struct IPerlSock *I, const char* cp)
906 return win32_inet_addr(cp);
910 PerlSockInetNtoa(struct IPerlSock *I, struct in_addr in)
912 return win32_inet_ntoa(in);
916 PerlSockListen(struct IPerlSock *I, SOCKET s, int backlog)
918 return win32_listen(s, backlog);
922 PerlSockRecv(struct IPerlSock *I, SOCKET s, char* buffer, int len, int flags)
924 return win32_recv(s, buffer, len, flags);
928 PerlSockRecvfrom(struct IPerlSock *I, SOCKET s, char* buffer, int len, int flags, struct sockaddr* from, int* fromlen)
930 return win32_recvfrom(s, buffer, len, flags, from, fromlen);
934 PerlSockSelect(struct IPerlSock *I, int nfds, char* readfds, char* writefds, char* exceptfds, const struct timeval* timeout)
936 return win32_select(nfds, (Perl_fd_set*)readfds, (Perl_fd_set*)writefds, (Perl_fd_set*)exceptfds, timeout);
940 PerlSockSend(struct IPerlSock *I, SOCKET s, const char* buffer, int len, int flags)
942 return win32_send(s, buffer, len, flags);
946 PerlSockSendto(struct IPerlSock *I, SOCKET s, const char* buffer, int len, int flags, const struct sockaddr* to, int tolen)
948 return win32_sendto(s, buffer, len, flags, to, tolen);
952 PerlSockSethostent(struct IPerlSock *I, int stayopen)
954 win32_sethostent(stayopen);
958 PerlSockSetnetent(struct IPerlSock *I, int stayopen)
960 win32_setnetent(stayopen);
964 PerlSockSetprotoent(struct IPerlSock *I, int stayopen)
966 win32_setprotoent(stayopen);
970 PerlSockSetservent(struct IPerlSock *I, int stayopen)
972 win32_setservent(stayopen);
976 PerlSockSetsockopt(struct IPerlSock *I, SOCKET s, int level, int optname, const char* optval, int optlen)
978 return win32_setsockopt(s, level, optname, optval, optlen);
982 PerlSockShutdown(struct IPerlSock *I, SOCKET s, int how)
984 return win32_shutdown(s, how);
988 PerlSockSocket(struct IPerlSock *I, int af, int type, int protocol)
990 return win32_socket(af, type, protocol);
994 PerlSockSocketpair(struct IPerlSock *I, int domain, int type, int protocol, int* fds)
997 Perl_croak(aTHX_ "socketpair not implemented!\n");
1002 PerlSockClosesocket(struct IPerlSock *I, SOCKET s)
1004 return win32_closesocket(s);
1008 PerlSockIoctlsocket(struct IPerlSock *I, SOCKET s, long cmd, u_long *argp)
1010 return win32_ioctlsocket(s, cmd, argp);
1013 struct IPerlSock perlSock =
1024 PerlSockEndprotoent,
1026 PerlSockGethostname,
1027 PerlSockGetpeername,
1028 PerlSockGethostbyaddr,
1029 PerlSockGethostbyname,
1031 PerlSockGetnetbyaddr,
1032 PerlSockGetnetbyname,
1034 PerlSockGetprotobyname,
1035 PerlSockGetprotobynumber,
1036 PerlSockGetprotoent,
1037 PerlSockGetservbyname,
1038 PerlSockGetservbyport,
1040 PerlSockGetsockname,
1052 PerlSockSetprotoent,
1058 PerlSockClosesocket,
1064 #define EXECF_EXEC 1
1065 #define EXECF_SPAWN 2
1067 extern char * g_getlogin(void);
1068 extern int do_spawn2(char *cmd, int exectype);
1070 extern int g_do_aspawn(void *vreally, void **vmark, void **vsp);
1071 #define do_aspawn g_do_aspawn
1073 EXTERN_C PerlInterpreter* perl_alloc_using(struct IPerlMem* pMem,
1074 struct IPerlEnv* pEnv, struct IPerlStdIO* pStdIO,
1075 struct IPerlLIO* pLIO, struct IPerlDir* pDir,
1076 struct IPerlSock* pSock, struct IPerlProc* pProc);
1079 PerlProcAbort(struct IPerlProc *I)
1085 PerlProcCrypt(struct IPerlProc *I, const char* clear, const char* salt)
1087 return win32_crypt(clear, salt);
1091 PerlProcExit(struct IPerlProc *I, int status)
1097 PerlProc_Exit(struct IPerlProc *I, int status)
1103 PerlProcExecl(struct IPerlProc *I, const char *cmdname, const char *arg0, const char *arg1, const char *arg2, const char *arg3)
1105 return execl(cmdname, arg0, arg1, arg2, arg3);
1109 PerlProcExecv(struct IPerlProc *I, const char *cmdname, const char *const *argv)
1111 return win32_execvp(cmdname, argv);
1115 PerlProcExecvp(struct IPerlProc *I, const char *cmdname, const char *const *argv)
1117 return win32_execvp(cmdname, argv);
1121 PerlProcGetuid(struct IPerlProc *I)
1127 PerlProcGeteuid(struct IPerlProc *I)
1133 PerlProcGetgid(struct IPerlProc *I)
1139 PerlProcGetegid(struct IPerlProc *I)
1145 PerlProcGetlogin(struct IPerlProc *I)
1147 return g_getlogin();
1151 PerlProcKill(struct IPerlProc *I, int pid, int sig)
1153 return win32_kill(pid, sig);
1157 PerlProcKillpg(struct IPerlProc *I, int pid, int sig)
1160 Perl_croak(aTHX_ "killpg not implemented!\n");
1165 PerlProcPauseProc(struct IPerlProc *I)
1167 return win32_sleep((32767L << 16) + 32767);
1171 PerlProcPopen(struct IPerlProc *I, const char *command, const char *mode)
1174 PERL_FLUSHALL_FOR_CHILD;
1175 return (PerlIO*)win32_popen(command, mode);
1179 PerlProcPclose(struct IPerlProc *I, PerlIO *stream)
1181 return win32_pclose((FILE*)stream);
1185 PerlProcPipe(struct IPerlProc *I, int *phandles)
1187 return win32_pipe(phandles, 512, O_BINARY);
1191 PerlProcSetuid(struct IPerlProc *I, uid_t u)
1197 PerlProcSetgid(struct IPerlProc *I, gid_t g)
1203 PerlProcSleep(struct IPerlProc *I, unsigned int s)
1205 return win32_sleep(s);
1209 PerlProcTimes(struct IPerlProc *I, struct tms *timebuf)
1211 return win32_times(timebuf);
1215 PerlProcWait(struct IPerlProc *I, int *status)
1217 return win32_wait(status);
1221 PerlProcWaitpid(struct IPerlProc *I, int pid, int *status, int flags)
1223 return win32_waitpid(pid, status, flags);
1227 PerlProcSignal(struct IPerlProc *I, int sig, Sighandler_t subcode)
1233 PerlProcDynaLoader(struct IPerlProc *I, const char* filename)
1235 return win32_dynaload(filename);
1239 PerlProcGetOSError(struct IPerlProc *I, SV* sv, DWORD dwErr)
1241 win32_str_os_error(sv, dwErr);
1245 PerlProcDoCmd(struct IPerlProc *I, char *cmd)
1247 do_spawn2(cmd, EXECF_EXEC);
1252 PerlProcSpawn(struct IPerlProc *I, char* cmds)
1254 return do_spawn2(cmds, EXECF_SPAWN);
1258 PerlProcSpawnvp(struct IPerlProc *I, int mode, const char *cmdname, const char *const *argv)
1260 return win32_spawnvp(mode, cmdname, argv);
1264 PerlProcASpawn(struct IPerlProc *I, void *vreally, void **vmark, void **vsp)
1266 return do_aspawn(vreally, vmark, vsp);
1269 struct IPerlProc perlProc =
1304 /*#include "perlhost.h" */
1308 perl_get_host_info(struct IPerlMemInfo* perlMemInfo,
1309 struct IPerlEnvInfo* perlEnvInfo,
1310 struct IPerlStdIOInfo* perlStdIOInfo,
1311 struct IPerlLIOInfo* perlLIOInfo,
1312 struct IPerlDirInfo* perlDirInfo,
1313 struct IPerlSockInfo* perlSockInfo,
1314 struct IPerlProcInfo* perlProcInfo)
1317 Copy(&perlMem, &perlMemInfo->perlMemList, perlMemInfo->nCount, void*);
1318 perlMemInfo->nCount = (sizeof(struct IPerlMem)/sizeof(void*));
1321 Copy(&perlEnv, &perlEnvInfo->perlEnvList, perlEnvInfo->nCount, void*);
1322 perlEnvInfo->nCount = (sizeof(struct IPerlEnv)/sizeof(void*));
1325 Copy(&perlStdIO, &perlStdIOInfo->perlStdIOList, perlStdIOInfo->nCount, void*);
1326 perlStdIOInfo->nCount = (sizeof(struct IPerlStdIO)/sizeof(void*));
1329 Copy(&perlLIO, &perlLIOInfo->perlLIOList, perlLIOInfo->nCount, void*);
1330 perlLIOInfo->nCount = (sizeof(struct IPerlLIO)/sizeof(void*));
1333 Copy(&perlDir, &perlDirInfo->perlDirList, perlDirInfo->nCount, void*);
1334 perlDirInfo->nCount = (sizeof(struct IPerlDir)/sizeof(void*));
1337 Copy(&perlSock, &perlSockInfo->perlSockList, perlSockInfo->nCount, void*);
1338 perlSockInfo->nCount = (sizeof(struct IPerlSock)/sizeof(void*));
1341 Copy(&perlProc, &perlProcInfo->perlProcList, perlProcInfo->nCount, void*);
1342 perlProcInfo->nCount = (sizeof(struct IPerlProc)/sizeof(void*));
1348 EXTERN_C PerlInterpreter* perl_alloc_using(struct IPerlMem* pMem,
1349 struct IPerlEnv* pEnv, struct IPerlStdIO* pStdIO,
1350 struct IPerlLIO* pLIO, struct IPerlDir* pDir,
1351 struct IPerlSock* pSock, struct IPerlProc* pProc)
1353 CPerlObj* pPerl = NULL;
1356 pPerl = Perl_alloc(pMem, pEnv, pStdIO, pLIO, pDir, pSock, pProc);
1360 win32_fprintf(stderr, "%s\n", "Error: Unable to allocate memory");
1365 SetPerlInterpreter(pPerl);
1366 return (PerlInterpreter*)pPerl;
1368 SetPerlInterpreter(NULL);
1373 #undef perl_construct
1374 #undef perl_destruct
1378 EXTERN_C PerlInterpreter* perl_alloc(void)
1380 CPerlObj* pPerl = NULL;
1383 pPerl = Perl_alloc(&perlMem, &perlEnv, &perlStdIO, &perlLIO,
1384 &perlDir, &perlSock, &perlProc);
1388 win32_fprintf(stderr, "%s\n", "Error: Unable to allocate memory");
1393 SetPerlInterpreter(pPerl);
1394 return (PerlInterpreter*)pPerl;
1396 SetPerlInterpreter(NULL);
1400 EXTERN_C void perl_construct(PerlInterpreter* sv_interp)
1402 CPerlObj* pPerl = (CPerlObj*)sv_interp;
1405 pPerl->perl_construct();
1409 win32_fprintf(stderr, "%s\n",
1410 "Error: Unable to construct data structures");
1412 SetPerlInterpreter(NULL);
1416 EXTERN_C void perl_destruct(PerlInterpreter* sv_interp)
1418 CPerlObj* pPerl = (CPerlObj*)sv_interp;
1421 pPerl->perl_destruct();
1428 EXTERN_C void perl_free(PerlInterpreter* sv_interp)
1430 CPerlObj* pPerl = (CPerlObj*)sv_interp;
1438 SetPerlInterpreter(NULL);
1441 EXTERN_C int perl_run(PerlInterpreter* sv_interp)
1443 CPerlObj* pPerl = (CPerlObj*)sv_interp;
1447 retVal = pPerl->perl_run();
1452 // this is where exit() should arrive
1458 win32_fprintf(stderr, "Error: Runtime exception\n");
1464 EXTERN_C int perl_parse(PerlInterpreter* sv_interp, void (*xsinit)(CPerlObj*), int argc, char** argv, char** env)
1467 CPerlObj* pPerl = (CPerlObj*)sv_interp;
1470 retVal = pPerl->perl_parse(xsinit, argc, argv, env);
1475 // this is where exit() should arrive
1481 win32_fprintf(stderr, "Error: Parse exception\n");
1488 #undef PL_perl_destruct_level
1489 #define PL_perl_destruct_level int dummy
1491 #else /* !PERL_OBJECT */
1493 EXTERN_C PerlInterpreter*
1496 return perl_alloc_using(&perlMem, &perlEnv, &perlStdIO, &perlLIO,
1497 &perlDir, &perlSock, &perlProc);
1500 #endif /* PERL_OBJECT */
1502 #endif /* PERL_IMPLICIT_SYS */
1504 extern HANDLE w32_perldll_handle;
1505 static DWORD g_TlsAllocIndex;
1507 EXTERN_C DllExport bool
1508 SetPerlInterpreter(void *interp)
1510 return TlsSetValue(g_TlsAllocIndex, interp);
1513 EXTERN_C DllExport void*
1514 GetPerlInterpreter(void)
1516 return TlsGetValue(g_TlsAllocIndex);
1519 EXTERN_C DllExport int
1520 RunPerl(int argc, char **argv, char **env)
1523 PerlInterpreter *my_perl;
1524 struct perl_thread *thr;
1526 #ifndef __BORLANDC__
1527 /* XXX this _may_ be a problem on some compilers (e.g. Borland) that
1528 * want to free() argv after main() returns. As luck would have it,
1529 * Borland's CRT does the right thing to argv[0] already. */
1530 char szModuleName[MAX_PATH];
1533 GetModuleFileName(NULL, szModuleName, sizeof(szModuleName));
1534 (void)win32_longpath(szModuleName);
1535 argv[0] = szModuleName;
1538 #ifdef PERL_GLOBAL_STRUCT
1539 #define PERLVAR(var,type) /**/
1540 #define PERLVARA(var,type) /**/
1541 #define PERLVARI(var,type,init) PL_Vars.var = init;
1542 #define PERLVARIC(var,type,init) PL_Vars.var = init;
1543 #include "perlvars.h"
1550 PERL_SYS_INIT(&argc,&argv);
1552 if (!(my_perl = perl_alloc()))
1554 perl_construct( my_perl );
1555 PL_perl_destruct_level = 0;
1557 exitstatus = perl_parse(my_perl, xs_init, argc, argv, env);
1559 #ifdef USE_ITHREADS /* XXXXXX testing */
1560 extern PerlInterpreter * perl_clone(pTHXx_ IV flags);
1562 PerlInterpreter *new_perl = perl_clone(my_perl, 0);
1563 Perl_push_scope(new_perl); /* ENTER; (hack in lieu of perl_destruct()) */
1564 exitstatus = perl_run( new_perl );
1565 perl_destruct(new_perl); perl_free(new_perl);
1566 SetPerlInterpreter(my_perl);
1568 exitstatus = perl_run( my_perl );
1572 perl_destruct( my_perl );
1573 perl_free( my_perl );
1577 return (exitstatus);
1581 DllMain(HANDLE hModule, /* DLL module handle */
1582 DWORD fdwReason, /* reason called */
1583 LPVOID lpvReserved) /* reserved */
1585 switch (fdwReason) {
1586 /* The DLL is attaching to a process due to process
1587 * initialization or a call to LoadLibrary.
1589 case DLL_PROCESS_ATTACH:
1590 /* #define DEFAULT_BINMODE */
1591 #ifdef DEFAULT_BINMODE
1592 setmode( fileno( stdin ), O_BINARY );
1593 setmode( fileno( stdout ), O_BINARY );
1594 setmode( fileno( stderr ), O_BINARY );
1597 g_TlsAllocIndex = TlsAlloc();
1598 DisableThreadLibraryCalls(hModule);
1599 w32_perldll_handle = hModule;
1602 /* The DLL is detaching from a process due to
1603 * process termination or call to FreeLibrary.
1605 case DLL_PROCESS_DETACH:
1606 TlsFree(g_TlsAllocIndex);
1609 /* The attached process creates a new thread. */
1610 case DLL_THREAD_ATTACH:
1613 /* The thread of the attached process terminates. */
1614 case DLL_THREAD_DETACH: