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
CommitLineData
0a753a76
PP
1/*
2 * "The Road goes ever on and on, down from the door where it began."
3 */
4
0a753a76
PP
5
6#include "EXTERN.h"
7#include "perl.h"
0cb96387
GS
8
9#ifdef PERL_OBJECT
10#define NO_XSLOCKS
11#endif
12
96e4d5b1 13#include "XSUB.h"
0a753a76 14
32e30700 15#ifdef PERL_IMPLICIT_SYS
0cb96387
GS
16#include "win32iop.h"
17#include <fcntl.h>
18#endif
19
20
21/* Register any extra external extensions */
22char *staticlinkmodules[] = {
23 "DynaLoader",
24 NULL,
25};
26
27EXTERN_C void boot_DynaLoader (pTHXo_ CV* cv);
28
29static void
30xs_init(pTHXo)
31{
32 char *file = __FILE__;
33 dXSUB_SYS;
34 newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
35}
36
32e30700
GS
37#ifdef PERL_IMPLICIT_SYS
38/* IPerlMem */
0cb96387 39void*
32e30700 40PerlMemMalloc(struct IPerlMem *I, size_t size)
0cb96387
GS
41{
42 return win32_malloc(size);
43}
44void*
32e30700 45PerlMemRealloc(struct IPerlMem *I, void* ptr, size_t size)
0cb96387
GS
46{
47 return win32_realloc(ptr, size);
48}
49void
32e30700 50PerlMemFree(struct IPerlMem *I, void* ptr)
0cb96387
GS
51{
52 win32_free(ptr);
53}
54
55struct IPerlMem perlMem =
56{
57 PerlMemMalloc,
58 PerlMemRealloc,
59 PerlMemFree,
60};
61
62
32e30700 63/* IPerlEnv */
0cb96387
GS
64extern char * g_win32_get_privlib(char *pl);
65extern char * g_win32_get_sitelib(char *pl);
66
67
68char*
32e30700 69PerlEnvGetenv(struct IPerlEnv *I, const char *varname)
0cb96387
GS
70{
71 return win32_getenv(varname);
72};
73int
32e30700 74PerlEnvPutenv(struct IPerlEnv *I, const char *envstring)
0cb96387
GS
75{
76 return win32_putenv(envstring);
77};
78
79char*
32e30700 80PerlEnvGetenv_len(struct IPerlEnv *I, const char* varname, unsigned long* len)
0cb96387
GS
81{
82 char *e = win32_getenv(varname);
83 if (e)
84 *len = strlen(e);
85 return e;
86}
87
88int
32e30700 89PerlEnvUname(struct IPerlEnv *I, struct utsname *name)
0cb96387
GS
90{
91 return win32_uname(name);
92}
93
3075ddba 94void
32e30700 95PerlEnvClearenv(struct IPerlEnv *I)
3075ddba
GS
96{
97 dTHXo;
98 char *envv = GetEnvironmentStrings();
99 char *cur = envv;
100 STRLEN len;
101 while (*cur) {
102 char *end = strchr(cur,'=');
103 if (end && end != cur) {
104 *end = '\0';
105 my_setenv(cur,Nullch);
106 *end = '=';
107 cur = end + strlen(end+1)+2;
108 }
109 else if ((len = strlen(cur)))
110 cur += len+1;
111 }
112 FreeEnvironmentStrings(envv);
113}
114
115void*
32e30700 116PerlEnvGetChildEnv(struct IPerlEnv *I)
3075ddba
GS
117{
118 return NULL;
119}
120
121void
32e30700 122PerlEnvFreeChildEnv(struct IPerlEnv *I, void* env)
3075ddba
GS
123{
124}
125
126char*
32e30700 127PerlEnvGetChildDir(struct IPerlEnv *I)
3075ddba
GS
128{
129 return NULL;
130}
131
132void
32e30700 133PerlEnvFreeChildDir(struct IPerlEnv *I, char* dir)
3075ddba
GS
134{
135}
136
0cb96387 137unsigned long
32e30700 138PerlEnvOsId(struct IPerlEnv *I)
0cb96387
GS
139{
140 return win32_os_id();
141}
142
143char*
32e30700 144PerlEnvLibPath(struct IPerlEnv *I, char *pl)
0cb96387
GS
145{
146 return g_win32_get_privlib(pl);
147}
148
149char*
32e30700 150PerlEnvSiteLibPath(struct IPerlEnv *I, char *pl)
0cb96387
GS
151{
152 return g_win32_get_sitelib(pl);
153}
154
155struct IPerlEnv perlEnv =
156{
157 PerlEnvGetenv,
158 PerlEnvPutenv,
159 PerlEnvGetenv_len,
160 PerlEnvUname,
3075ddba
GS
161 PerlEnvClearenv,
162 PerlEnvGetChildEnv,
163 PerlEnvFreeChildEnv,
164 PerlEnvGetChildDir,
165 PerlEnvFreeChildDir,
0cb96387
GS
166 PerlEnvOsId,
167 PerlEnvLibPath,
168 PerlEnvSiteLibPath,
169};
170
171
32e30700 172/* PerlStdIO */
0cb96387 173PerlIO*
32e30700 174PerlStdIOStdin(struct IPerlStdIO *I)
0cb96387
GS
175{
176 return (PerlIO*)win32_stdin();
177}
178
179PerlIO*
32e30700 180PerlStdIOStdout(struct IPerlStdIO *I)
0cb96387
GS
181{
182 return (PerlIO*)win32_stdout();
183}
184
185PerlIO*
32e30700 186PerlStdIOStderr(struct IPerlStdIO *I)
0cb96387
GS
187{
188 return (PerlIO*)win32_stderr();
189}
190
191PerlIO*
32e30700 192PerlStdIOOpen(struct IPerlStdIO *I, const char *path, const char *mode)
0cb96387
GS
193{
194 return (PerlIO*)win32_fopen(path, mode);
195}
196
197int
32e30700 198PerlStdIOClose(struct IPerlStdIO *I, PerlIO* pf)
0cb96387
GS
199{
200 return win32_fclose(((FILE*)pf));
201}
202
203int
32e30700 204PerlStdIOEof(struct IPerlStdIO *I, PerlIO* pf)
0cb96387
GS
205{
206 return win32_feof((FILE*)pf);
207}
208
209int
32e30700 210PerlStdIOError(struct IPerlStdIO *I, PerlIO* pf)
0cb96387
GS
211{
212 return win32_ferror((FILE*)pf);
213}
214
215void
32e30700 216PerlStdIOClearerr(struct IPerlStdIO *I, PerlIO* pf)
0cb96387
GS
217{
218 win32_clearerr((FILE*)pf);
219}
220
221int
32e30700 222PerlStdIOGetc(struct IPerlStdIO *I, PerlIO* pf)
0cb96387
GS
223{
224 return win32_getc((FILE*)pf);
225}
226
227char*
32e30700 228PerlStdIOGetBase(struct IPerlStdIO *I, PerlIO* pf)
0cb96387
GS
229{
230#ifdef FILE_base
231 FILE *f = (FILE*)pf;
232 return FILE_base(f);
233#else
234 return Nullch;
235#endif
236}
237
238int
32e30700 239PerlStdIOGetBufsiz(struct IPerlStdIO *I, PerlIO* pf)
0cb96387
GS
240{
241#ifdef FILE_bufsiz
242 FILE *f = (FILE*)pf;
243 return FILE_bufsiz(f);
244#else
245 return (-1);
246#endif
247}
248
249int
32e30700 250PerlStdIOGetCnt(struct IPerlStdIO *I, PerlIO* pf)
0cb96387
GS
251{
252#ifdef USE_STDIO_PTR
253 FILE *f = (FILE*)pf;
254 return FILE_cnt(f);
255#else
256 return (-1);
257#endif
258}
259
260char*
32e30700 261PerlStdIOGetPtr(struct IPerlStdIO *I, PerlIO* pf)
0cb96387
GS
262{
263#ifdef USE_STDIO_PTR
264 FILE *f = (FILE*)pf;
265 return FILE_ptr(f);
266#else
267 return Nullch;
268#endif
269}
270
271char*
32e30700 272PerlStdIOGets(struct IPerlStdIO *I, PerlIO* pf, char* s, int n)
0cb96387
GS
273{
274 return win32_fgets(s, n, (FILE*)pf);
275}
276
277int
32e30700 278PerlStdIOPutc(struct IPerlStdIO *I, PerlIO* pf, int c)
0cb96387
GS
279{
280 return win32_fputc(c, (FILE*)pf);
281}
282
283int
32e30700 284PerlStdIOPuts(struct IPerlStdIO *I, PerlIO* pf, const char *s)
0cb96387
GS
285{
286 return win32_fputs(s, (FILE*)pf);
287}
288
289int
32e30700 290PerlStdIOFlush(struct IPerlStdIO *I, PerlIO* pf)
0cb96387
GS
291{
292 return win32_fflush((FILE*)pf);
293}
294
295int
32e30700 296PerlStdIOUngetc(struct IPerlStdIO *I, PerlIO* pf,int c)
0cb96387
GS
297{
298 return win32_ungetc(c, (FILE*)pf);
299}
300
301int
32e30700 302PerlStdIOFileno(struct IPerlStdIO *I, PerlIO* pf)
0cb96387
GS
303{
304 return win32_fileno((FILE*)pf);
305}
306
307PerlIO*
32e30700 308PerlStdIOFdopen(struct IPerlStdIO *I, int fd, const char *mode)
0cb96387
GS
309{
310 return (PerlIO*)win32_fdopen(fd, mode);
311}
312
313PerlIO*
32e30700 314PerlStdIOReopen(struct IPerlStdIO *I, const char*path, const char*mode, PerlIO* pf)
0cb96387
GS
315{
316 return (PerlIO*)win32_freopen(path, mode, (FILE*)pf);
317}
318
319SSize_t
32e30700 320PerlStdIORead(struct IPerlStdIO *I, PerlIO* pf, void *buffer, Size_t size)
0cb96387
GS
321{
322 return win32_fread(buffer, 1, size, (FILE*)pf);
323}
324
325SSize_t
32e30700 326PerlStdIOWrite(struct IPerlStdIO *I, PerlIO* pf, const void *buffer, Size_t size)
0cb96387
GS
327{
328 return win32_fwrite(buffer, 1, size, (FILE*)pf);
329}
330
331void
32e30700 332PerlStdIOSetBuf(struct IPerlStdIO *I, PerlIO* pf, char* buffer)
0cb96387
GS
333{
334 win32_setbuf((FILE*)pf, buffer);
335}
336
337int
32e30700 338PerlStdIOSetVBuf(struct IPerlStdIO *I, PerlIO* pf, char* buffer, int type, Size_t size)
0cb96387
GS
339{
340 return win32_setvbuf((FILE*)pf, buffer, type, size);
341}
342
343void
32e30700 344PerlStdIOSetCnt(struct IPerlStdIO *I, PerlIO* pf, int n)
0cb96387
GS
345{
346#ifdef STDIO_CNT_LVALUE
347 FILE *f = (FILE*)pf;
348 FILE_cnt(f) = n;
349#endif
350}
351
352void
32e30700 353PerlStdIOSetPtrCnt(struct IPerlStdIO *I, PerlIO* pf, char * ptr, int n)
0cb96387
GS
354{
355#ifdef STDIO_PTR_LVALUE
356 FILE *f = (FILE*)pf;
357 FILE_ptr(f) = ptr;
358 FILE_cnt(f) = n;
359#endif
360}
361
362void
32e30700 363PerlStdIOSetlinebuf(struct IPerlStdIO *I, PerlIO* pf)
0cb96387
GS
364{
365 win32_setvbuf((FILE*)pf, NULL, _IOLBF, 0);
366}
367
368int
32e30700 369PerlStdIOPrintf(struct IPerlStdIO *I, PerlIO* pf, const char *format,...)
0cb96387
GS
370{
371 va_list(arglist);
372 va_start(arglist, format);
373 return win32_vfprintf((FILE*)pf, format, arglist);
374}
375
376int
32e30700 377PerlStdIOVprintf(struct IPerlStdIO *I, PerlIO* pf, const char *format, va_list arglist)
0cb96387
GS
378{
379 return win32_vfprintf((FILE*)pf, format, arglist);
380}
381
382long
32e30700 383PerlStdIOTell(struct IPerlStdIO *I, PerlIO* pf)
0cb96387
GS
384{
385 return win32_ftell((FILE*)pf);
386}
387
388int
32e30700 389PerlStdIOSeek(struct IPerlStdIO *I, PerlIO* pf, off_t offset, int origin)
0cb96387
GS
390{
391 return win32_fseek((FILE*)pf, offset, origin);
392}
393
394void
32e30700 395PerlStdIORewind(struct IPerlStdIO *I, PerlIO* pf)
0cb96387
GS
396{
397 win32_rewind((FILE*)pf);
398}
399
400PerlIO*
32e30700 401PerlStdIOTmpfile(struct IPerlStdIO *I)
0cb96387
GS
402{
403 return (PerlIO*)win32_tmpfile();
404}
405
406int
32e30700 407PerlStdIOGetpos(struct IPerlStdIO *I, PerlIO* pf, Fpos_t *p)
0cb96387
GS
408{
409 return win32_fgetpos((FILE*)pf, p);
410}
411
412int
32e30700 413PerlStdIOSetpos(struct IPerlStdIO *I, PerlIO* pf, const Fpos_t *p)
0cb96387
GS
414{
415 return win32_fsetpos((FILE*)pf, p);
416}
417void
32e30700 418PerlStdIOInit(struct IPerlStdIO *I)
0cb96387
GS
419{
420}
421
422void
32e30700 423PerlStdIOInitOSExtras(struct IPerlStdIO *I)
0cb96387
GS
424{
425 Perl_init_os_extras();
426}
427
428int
32e30700 429PerlStdIOOpenOSfhandle(struct IPerlStdIO *I, long osfhandle, int flags)
0cb96387
GS
430{
431 return win32_open_osfhandle(osfhandle, flags);
432}
433
434int
32e30700 435PerlStdIOGetOSfhandle(struct IPerlStdIO *I, int filenum)
0cb96387
GS
436{
437 return win32_get_osfhandle(filenum);
438}
439
440
441struct IPerlStdIO perlStdIO =
442{
443 PerlStdIOStdin,
444 PerlStdIOStdout,
445 PerlStdIOStderr,
446 PerlStdIOOpen,
447 PerlStdIOClose,
448 PerlStdIOEof,
449 PerlStdIOError,
450 PerlStdIOClearerr,
451 PerlStdIOGetc,
452 PerlStdIOGetBase,
453 PerlStdIOGetBufsiz,
454 PerlStdIOGetCnt,
455 PerlStdIOGetPtr,
456 PerlStdIOGets,
457 PerlStdIOPutc,
458 PerlStdIOPuts,
459 PerlStdIOFlush,
460 PerlStdIOUngetc,
461 PerlStdIOFileno,
462 PerlStdIOFdopen,
463 PerlStdIOReopen,
464 PerlStdIORead,
465 PerlStdIOWrite,
466 PerlStdIOSetBuf,
467 PerlStdIOSetVBuf,
468 PerlStdIOSetCnt,
469 PerlStdIOSetPtrCnt,
470 PerlStdIOSetlinebuf,
471 PerlStdIOPrintf,
472 PerlStdIOVprintf,
473 PerlStdIOTell,
474 PerlStdIOSeek,
475 PerlStdIORewind,
476 PerlStdIOTmpfile,
477 PerlStdIOGetpos,
478 PerlStdIOSetpos,
479 PerlStdIOInit,
480 PerlStdIOInitOSExtras,
481};
482
483
32e30700 484/* IPerlLIO */
0cb96387 485int
32e30700 486PerlLIOAccess(struct IPerlLIO *I, const char *path, int mode)
0cb96387
GS
487{
488 return access(path, mode);
489}
490
491int
32e30700 492PerlLIOChmod(struct IPerlLIO *I, const char *filename, int pmode)
0cb96387
GS
493{
494 return chmod(filename, pmode);
495}
496
497int
32e30700 498PerlLIOChown(struct IPerlLIO *I, const char *filename, uid_t owner, gid_t group)
0cb96387
GS
499{
500 return chown(filename, owner, group);
501}
502
503int
32e30700 504PerlLIOChsize(struct IPerlLIO *I, int handle, long size)
0cb96387
GS
505{
506 return chsize(handle, size);
507}
508
509int
32e30700 510PerlLIOClose(struct IPerlLIO *I, int handle)
0cb96387
GS
511{
512 return win32_close(handle);
513}
514
515int
32e30700 516PerlLIODup(struct IPerlLIO *I, int handle)
0cb96387
GS
517{
518 return win32_dup(handle);
519}
520
521int
32e30700 522PerlLIODup2(struct IPerlLIO *I, int handle1, int handle2)
0cb96387
GS
523{
524 return win32_dup2(handle1, handle2);
525}
526
527int
32e30700 528PerlLIOFlock(struct IPerlLIO *I, int fd, int oper)
0cb96387
GS
529{
530 return win32_flock(fd, oper);
531}
532
533int
32e30700 534PerlLIOFileStat(struct IPerlLIO *I, int handle, struct stat *buffer)
0cb96387
GS
535{
536 return fstat(handle, buffer);
537}
538
539int
32e30700 540PerlLIOIOCtl(struct IPerlLIO *I, int i, unsigned int u, char *data)
0cb96387
GS
541{
542 return win32_ioctlsocket((SOCKET)i, (long)u, (u_long*)data);
543}
544
545int
32e30700 546PerlLIOIsatty(struct IPerlLIO *I, int fd)
0cb96387
GS
547{
548 return isatty(fd);
549}
550
551long
32e30700 552PerlLIOLseek(struct IPerlLIO *I, int handle, long offset, int origin)
0cb96387
GS
553{
554 return win32_lseek(handle, offset, origin);
555}
556
557int
558PerlLIOLstat(struct IPerlLIO* p, const char *path, struct stat *buffer)
559{
560 return win32_stat(path, buffer);
561}
562
563char*
32e30700 564PerlLIOMktemp(struct IPerlLIO *I, char *Template)
0cb96387
GS
565{
566 return mktemp(Template);
567}
568
569int
32e30700 570PerlLIOOpen(struct IPerlLIO *I, const char *filename, int oflag)
0cb96387
GS
571{
572 return win32_open(filename, oflag);
573}
574
575int
32e30700 576PerlLIOOpen3(struct IPerlLIO *I, const char *filename, int oflag, int pmode)
0cb96387
GS
577{
578 int ret;
579 if(stricmp(filename, "/dev/null") == 0)
580 ret = open("NUL", oflag, pmode);
581 else
582 ret = open(filename, oflag, pmode);
583
584 return ret;
585}
586
587int
32e30700 588PerlLIORead(struct IPerlLIO *I, int handle, void *buffer, unsigned int count)
0cb96387
GS
589{
590 return win32_read(handle, buffer, count);
591}
592
593int
32e30700 594PerlLIORename(struct IPerlLIO *I, const char *OldFileName, const char *newname)
0cb96387
GS
595{
596 return win32_rename(OldFileName, newname);
597}
598
599int
32e30700 600PerlLIOSetmode(struct IPerlLIO *I, int handle, int mode)
0cb96387
GS
601{
602 return win32_setmode(handle, mode);
603}
604
605int
32e30700 606PerlLIONameStat(struct IPerlLIO *I, const char *path, struct stat *buffer)
0cb96387
GS
607{
608 return win32_stat(path, buffer);
609}
610
611char*
32e30700 612PerlLIOTmpnam(struct IPerlLIO *I, char *string)
0cb96387
GS
613{
614 return tmpnam(string);
615}
616
617int
32e30700 618PerlLIOUmask(struct IPerlLIO *I, int pmode)
0cb96387
GS
619{
620 return umask(pmode);
621}
622
623int
32e30700 624PerlLIOUnlink(struct IPerlLIO *I, const char *filename)
0cb96387
GS
625{
626 chmod(filename, S_IREAD | S_IWRITE);
627 return unlink(filename);
628}
629
630int
32e30700 631PerlLIOUtime(struct IPerlLIO *I, char *filename, struct utimbuf *times)
0cb96387
GS
632{
633 return win32_utime(filename, times);
634}
635
636int
32e30700 637PerlLIOWrite(struct IPerlLIO *I, int handle, const void *buffer, unsigned int count)
0cb96387
GS
638{
639 return win32_write(handle, buffer, count);
640}
641
642struct IPerlLIO perlLIO =
643{
644 PerlLIOAccess,
645 PerlLIOChmod,
646 PerlLIOChown,
647 PerlLIOChsize,
648 PerlLIOClose,
649 PerlLIODup,
650 PerlLIODup2,
651 PerlLIOFlock,
652 PerlLIOFileStat,
653 PerlLIOIOCtl,
654 PerlLIOIsatty,
655 PerlLIOLseek,
656 PerlLIOLstat,
657 PerlLIOMktemp,
658 PerlLIOOpen,
659 PerlLIOOpen3,
660 PerlLIORead,
661 PerlLIORename,
662 PerlLIOSetmode,
663 PerlLIONameStat,
664 PerlLIOTmpnam,
665 PerlLIOUmask,
666 PerlLIOUnlink,
667 PerlLIOUtime,
668 PerlLIOWrite,
669};
670
32e30700 671/* IPerlDIR */
0cb96387 672int
32e30700 673PerlDirMakedir(struct IPerlDir *I, const char *dirname, int mode)
0cb96387
GS
674{
675 return win32_mkdir(dirname, mode);
676}
677
678int
32e30700 679PerlDirChdir(struct IPerlDir *I, const char *dirname)
0cb96387
GS
680{
681 return win32_chdir(dirname);
682}
683
684int
32e30700 685PerlDirRmdir(struct IPerlDir *I, const char *dirname)
0cb96387
GS
686{
687 return win32_rmdir(dirname);
688}
689
690int
32e30700 691PerlDirClose(struct IPerlDir *I, DIR *dirp)
0cb96387
GS
692{
693 return win32_closedir(dirp);
694}
695
696DIR*
32e30700 697PerlDirOpen(struct IPerlDir *I, char *filename)
0cb96387
GS
698{
699 return win32_opendir(filename);
700}
701
702struct direct *
32e30700 703PerlDirRead(struct IPerlDir *I, DIR *dirp)
0cb96387
GS
704{
705 return win32_readdir(dirp);
706}
707
708void
32e30700 709PerlDirRewind(struct IPerlDir *I, DIR *dirp)
0cb96387
GS
710{
711 win32_rewinddir(dirp);
712}
713
714void
32e30700 715PerlDirSeek(struct IPerlDir *I, DIR *dirp, long loc)
0cb96387
GS
716{
717 win32_seekdir(dirp, loc);
718}
719
720long
32e30700 721PerlDirTell(struct IPerlDir *I, DIR *dirp)
0cb96387
GS
722{
723 return win32_telldir(dirp);
724}
725
726struct IPerlDir perlDir =
727{
728 PerlDirMakedir,
729 PerlDirChdir,
730 PerlDirRmdir,
731 PerlDirClose,
732 PerlDirOpen,
733 PerlDirRead,
734 PerlDirRewind,
735 PerlDirSeek,
736 PerlDirTell,
737};
738
739
32e30700 740/* IPerlSock */
0cb96387 741u_long
32e30700 742PerlSockHtonl(struct IPerlSock *I, u_long hostlong)
0cb96387
GS
743{
744 return win32_htonl(hostlong);
745}
746
747u_short
32e30700 748PerlSockHtons(struct IPerlSock *I, u_short hostshort)
0cb96387
GS
749{
750 return win32_htons(hostshort);
751}
752
753u_long
32e30700 754PerlSockNtohl(struct IPerlSock *I, u_long netlong)
0cb96387
GS
755{
756 return win32_ntohl(netlong);
757}
758
759u_short
32e30700 760PerlSockNtohs(struct IPerlSock *I, u_short netshort)
0cb96387
GS
761{
762 return win32_ntohs(netshort);
763}
764
32e30700 765SOCKET PerlSockAccept(struct IPerlSock *I, SOCKET s, struct sockaddr* addr, int* addrlen)
0cb96387
GS
766{
767 return win32_accept(s, addr, addrlen);
768}
769
770int
32e30700 771PerlSockBind(struct IPerlSock *I, SOCKET s, const struct sockaddr* name, int namelen)
0cb96387
GS
772{
773 return win32_bind(s, name, namelen);
774}
775
776int
32e30700 777PerlSockConnect(struct IPerlSock *I, SOCKET s, const struct sockaddr* name, int namelen)
0cb96387
GS
778{
779 return win32_connect(s, name, namelen);
780}
781
782void
32e30700 783PerlSockEndhostent(struct IPerlSock *I)
0cb96387
GS
784{
785 win32_endhostent();
786}
787
788void
32e30700 789PerlSockEndnetent(struct IPerlSock *I)
0cb96387
GS
790{
791 win32_endnetent();
792}
793
794void
32e30700 795PerlSockEndprotoent(struct IPerlSock *I)
0cb96387
GS
796{
797 win32_endprotoent();
798}
799
800void
32e30700 801PerlSockEndservent(struct IPerlSock *I)
0cb96387
GS
802{
803 win32_endservent();
804}
805
806struct hostent*
32e30700 807PerlSockGethostbyaddr(struct IPerlSock *I, const char* addr, int len, int type)
0cb96387
GS
808{
809 return win32_gethostbyaddr(addr, len, type);
810}
811
812struct hostent*
32e30700 813PerlSockGethostbyname(struct IPerlSock *I, const char* name)
0cb96387
GS
814{
815 return win32_gethostbyname(name);
816}
817
818struct hostent*
32e30700 819PerlSockGethostent(struct IPerlSock *I)
0cb96387 820{
c5be433b 821 dTHXo;
32e30700 822 Perl_croak(aTHX_ "gethostent not implemented!\n");
0cb96387
GS
823 return NULL;
824}
825
826int
32e30700 827PerlSockGethostname(struct IPerlSock *I, char* name, int namelen)
0cb96387
GS
828{
829 return win32_gethostname(name, namelen);
830}
831
832struct netent *
32e30700 833PerlSockGetnetbyaddr(struct IPerlSock *I, long net, int type)
0cb96387
GS
834{
835 return win32_getnetbyaddr(net, type);
836}
837
838struct netent *
32e30700 839PerlSockGetnetbyname(struct IPerlSock *I, const char *name)
0cb96387
GS
840{
841 return win32_getnetbyname((char*)name);
842}
843
844struct netent *
32e30700 845PerlSockGetnetent(struct IPerlSock *I)
0cb96387
GS
846{
847 return win32_getnetent();
848}
849
32e30700 850int PerlSockGetpeername(struct IPerlSock *I, SOCKET s, struct sockaddr* name, int* namelen)
0cb96387
GS
851{
852 return win32_getpeername(s, name, namelen);
853}
854
855struct protoent*
32e30700 856PerlSockGetprotobyname(struct IPerlSock *I, const char* name)
0cb96387
GS
857{
858 return win32_getprotobyname(name);
859}
860
861struct protoent*
32e30700 862PerlSockGetprotobynumber(struct IPerlSock *I, int number)
0cb96387
GS
863{
864 return win32_getprotobynumber(number);
865}
866
867struct protoent*
32e30700 868PerlSockGetprotoent(struct IPerlSock *I)
0cb96387
GS
869{
870 return win32_getprotoent();
871}
872
873struct servent*
32e30700 874PerlSockGetservbyname(struct IPerlSock *I, const char* name, const char* proto)
0cb96387
GS
875{
876 return win32_getservbyname(name, proto);
877}
878
879struct servent*
32e30700 880PerlSockGetservbyport(struct IPerlSock *I, int port, const char* proto)
0cb96387
GS
881{
882 return win32_getservbyport(port, proto);
883}
884
885struct servent*
32e30700 886PerlSockGetservent(struct IPerlSock *I)
0cb96387
GS
887{
888 return win32_getservent();
889}
890
891int
32e30700 892PerlSockGetsockname(struct IPerlSock *I, SOCKET s, struct sockaddr* name, int* namelen)
0cb96387
GS
893{
894 return win32_getsockname(s, name, namelen);
895}
896
897int
32e30700 898PerlSockGetsockopt(struct IPerlSock *I, SOCKET s, int level, int optname, char* optval, int* optlen)
0cb96387
GS
899{
900 return win32_getsockopt(s, level, optname, optval, optlen);
901}
902
903unsigned long
32e30700 904PerlSockInetAddr(struct IPerlSock *I, const char* cp)
0cb96387
GS
905{
906 return win32_inet_addr(cp);
907}
908
909char*
32e30700 910PerlSockInetNtoa(struct IPerlSock *I, struct in_addr in)
0cb96387
GS
911{
912 return win32_inet_ntoa(in);
913}
914
915int
32e30700 916PerlSockListen(struct IPerlSock *I, SOCKET s, int backlog)
0cb96387
GS
917{
918 return win32_listen(s, backlog);
919}
920
921int
32e30700 922PerlSockRecv(struct IPerlSock *I, SOCKET s, char* buffer, int len, int flags)
0cb96387
GS
923{
924 return win32_recv(s, buffer, len, flags);
925}
926
927int
32e30700 928PerlSockRecvfrom(struct IPerlSock *I, SOCKET s, char* buffer, int len, int flags, struct sockaddr* from, int* fromlen)
0cb96387
GS
929{
930 return win32_recvfrom(s, buffer, len, flags, from, fromlen);
931}
932
933int
32e30700 934PerlSockSelect(struct IPerlSock *I, int nfds, char* readfds, char* writefds, char* exceptfds, const struct timeval* timeout)
0cb96387
GS
935{
936 return win32_select(nfds, (Perl_fd_set*)readfds, (Perl_fd_set*)writefds, (Perl_fd_set*)exceptfds, timeout);
937}
938
939int
32e30700 940PerlSockSend(struct IPerlSock *I, SOCKET s, const char* buffer, int len, int flags)
0cb96387
GS
941{
942 return win32_send(s, buffer, len, flags);
943}
944
945int
32e30700 946PerlSockSendto(struct IPerlSock *I, SOCKET s, const char* buffer, int len, int flags, const struct sockaddr* to, int tolen)
0cb96387
GS
947{
948 return win32_sendto(s, buffer, len, flags, to, tolen);
949}
950
951void
32e30700 952PerlSockSethostent(struct IPerlSock *I, int stayopen)
0cb96387
GS
953{
954 win32_sethostent(stayopen);
955}
956
957void
32e30700 958PerlSockSetnetent(struct IPerlSock *I, int stayopen)
0cb96387
GS
959{
960 win32_setnetent(stayopen);
961}
962
963void
32e30700 964PerlSockSetprotoent(struct IPerlSock *I, int stayopen)
0cb96387
GS
965{
966 win32_setprotoent(stayopen);
967}
968
969void
32e30700 970PerlSockSetservent(struct IPerlSock *I, int stayopen)
0cb96387
GS
971{
972 win32_setservent(stayopen);
973}
974
975int
32e30700 976PerlSockSetsockopt(struct IPerlSock *I, SOCKET s, int level, int optname, const char* optval, int optlen)
0cb96387
GS
977{
978 return win32_setsockopt(s, level, optname, optval, optlen);
979}
980
981int
32e30700 982PerlSockShutdown(struct IPerlSock *I, SOCKET s, int how)
0cb96387
GS
983{
984 return win32_shutdown(s, how);
985}
986
987SOCKET
32e30700 988PerlSockSocket(struct IPerlSock *I, int af, int type, int protocol)
0cb96387
GS
989{
990 return win32_socket(af, type, protocol);
991}
992
993int
32e30700 994PerlSockSocketpair(struct IPerlSock *I, int domain, int type, int protocol, int* fds)
0cb96387 995{
c5be433b 996 dTHXo;
32e30700 997 Perl_croak(aTHX_ "socketpair not implemented!\n");
0cb96387
GS
998 return 0;
999}
1000
1001int
32e30700 1002PerlSockClosesocket(struct IPerlSock *I, SOCKET s)
0cb96387
GS
1003{
1004 return win32_closesocket(s);
1005}
1006
1007int
32e30700 1008PerlSockIoctlsocket(struct IPerlSock *I, SOCKET s, long cmd, u_long *argp)
0cb96387
GS
1009{
1010 return win32_ioctlsocket(s, cmd, argp);
1011}
1012
1013struct IPerlSock perlSock =
1014{
1015 PerlSockHtonl,
1016 PerlSockHtons,
1017 PerlSockNtohl,
1018 PerlSockNtohs,
1019 PerlSockAccept,
1020 PerlSockBind,
1021 PerlSockConnect,
1022 PerlSockEndhostent,
1023 PerlSockEndnetent,
1024 PerlSockEndprotoent,
1025 PerlSockEndservent,
1026 PerlSockGethostname,
1027 PerlSockGetpeername,
1028 PerlSockGethostbyaddr,
1029 PerlSockGethostbyname,
1030 PerlSockGethostent,
1031 PerlSockGetnetbyaddr,
1032 PerlSockGetnetbyname,
1033 PerlSockGetnetent,
1034 PerlSockGetprotobyname,
1035 PerlSockGetprotobynumber,
1036 PerlSockGetprotoent,
1037 PerlSockGetservbyname,
1038 PerlSockGetservbyport,
1039 PerlSockGetservent,
1040 PerlSockGetsockname,
1041 PerlSockGetsockopt,
1042 PerlSockInetAddr,
1043 PerlSockInetNtoa,
1044 PerlSockListen,
1045 PerlSockRecv,
1046 PerlSockRecvfrom,
1047 PerlSockSelect,
1048 PerlSockSend,
1049 PerlSockSendto,
1050 PerlSockSethostent,
1051 PerlSockSetnetent,
1052 PerlSockSetprotoent,
1053 PerlSockSetservent,
1054 PerlSockSetsockopt,
1055 PerlSockShutdown,
1056 PerlSockSocket,
1057 PerlSockSocketpair,
1058 PerlSockClosesocket,
1059};
1060
1061
32e30700 1062/* IPerlProc */
0cb96387
GS
1063
1064#define EXECF_EXEC 1
1065#define EXECF_SPAWN 2
1066
1067extern char * g_getlogin(void);
1068extern int do_spawn2(char *cmd, int exectype);
32e30700 1069#ifdef PERL_OBJECT
0cb96387 1070extern int g_do_aspawn(void *vreally, void **vmark, void **vsp);
32e30700
GS
1071#define do_aspawn g_do_aspawn
1072#endif
1073EXTERN_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);
0cb96387
GS
1077
1078void
32e30700 1079PerlProcAbort(struct IPerlProc *I)
0cb96387
GS
1080{
1081 win32_abort();
1082}
1083
1084char *
32e30700 1085PerlProcCrypt(struct IPerlProc *I, const char* clear, const char* salt)
0cb96387
GS
1086{
1087 return win32_crypt(clear, salt);
1088}
1089
1090void
32e30700 1091PerlProcExit(struct IPerlProc *I, int status)
0cb96387
GS
1092{
1093 exit(status);
1094}
1095
1096void
32e30700 1097PerlProc_Exit(struct IPerlProc *I, int status)
0cb96387
GS
1098{
1099 _exit(status);
1100}
1101
1102int
32e30700 1103PerlProcExecl(struct IPerlProc *I, const char *cmdname, const char *arg0, const char *arg1, const char *arg2, const char *arg3)
0cb96387
GS
1104{
1105 return execl(cmdname, arg0, arg1, arg2, arg3);
1106}
1107
1108int
32e30700 1109PerlProcExecv(struct IPerlProc *I, const char *cmdname, const char *const *argv)
0cb96387
GS
1110{
1111 return win32_execvp(cmdname, argv);
1112}
1113
1114int
32e30700 1115PerlProcExecvp(struct IPerlProc *I, const char *cmdname, const char *const *argv)
0cb96387
GS
1116{
1117 return win32_execvp(cmdname, argv);
1118}
1119
1120uid_t
32e30700 1121PerlProcGetuid(struct IPerlProc *I)
0cb96387
GS
1122{
1123 return getuid();
1124}
1125
1126uid_t
32e30700 1127PerlProcGeteuid(struct IPerlProc *I)
0cb96387
GS
1128{
1129 return geteuid();
1130}
1131
1132gid_t
32e30700 1133PerlProcGetgid(struct IPerlProc *I)
0cb96387
GS
1134{
1135 return getgid();
1136}
1137
1138gid_t
32e30700 1139PerlProcGetegid(struct IPerlProc *I)
0cb96387
GS
1140{
1141 return getegid();
1142}
1143
1144char *
32e30700 1145PerlProcGetlogin(struct IPerlProc *I)
0cb96387
GS
1146{
1147 return g_getlogin();
1148}
1149
1150int
32e30700 1151PerlProcKill(struct IPerlProc *I, int pid, int sig)
0cb96387
GS
1152{
1153 return win32_kill(pid, sig);
1154}
1155
1156int
32e30700 1157PerlProcKillpg(struct IPerlProc *I, int pid, int sig)
0cb96387 1158{
c5be433b 1159 dTHXo;
32e30700 1160 Perl_croak(aTHX_ "killpg not implemented!\n");
0cb96387
GS
1161 return 0;
1162}
1163
1164int
32e30700 1165PerlProcPauseProc(struct IPerlProc *I)
0cb96387
GS
1166{
1167 return win32_sleep((32767L << 16) + 32767);
1168}
1169
1170PerlIO*
32e30700 1171PerlProcPopen(struct IPerlProc *I, const char *command, const char *mode)
0cb96387 1172{
12b99c39 1173 dTHXo;
32e30700 1174 PERL_FLUSHALL_FOR_CHILD;
0cb96387
GS
1175 return (PerlIO*)win32_popen(command, mode);
1176}
1177
1178int
32e30700 1179PerlProcPclose(struct IPerlProc *I, PerlIO *stream)
0cb96387
GS
1180{
1181 return win32_pclose((FILE*)stream);
1182}
1183
1184int
32e30700 1185PerlProcPipe(struct IPerlProc *I, int *phandles)
0cb96387
GS
1186{
1187 return win32_pipe(phandles, 512, O_BINARY);
1188}
1189
1190int
32e30700 1191PerlProcSetuid(struct IPerlProc *I, uid_t u)
0cb96387
GS
1192{
1193 return setuid(u);
1194}
1195
1196int
32e30700 1197PerlProcSetgid(struct IPerlProc *I, gid_t g)
0cb96387
GS
1198{
1199 return setgid(g);
1200}
1201
1202int
32e30700 1203PerlProcSleep(struct IPerlProc *I, unsigned int s)
0cb96387
GS
1204{
1205 return win32_sleep(s);
1206}
1207
1208int
32e30700 1209PerlProcTimes(struct IPerlProc *I, struct tms *timebuf)
0cb96387
GS
1210{
1211 return win32_times(timebuf);
1212}
1213
1214int
32e30700 1215PerlProcWait(struct IPerlProc *I, int *status)
0cb96387
GS
1216{
1217 return win32_wait(status);
1218}
1219
1220int
32e30700 1221PerlProcWaitpid(struct IPerlProc *I, int pid, int *status, int flags)
0cb96387
GS
1222{
1223 return win32_waitpid(pid, status, flags);
1224}
1225
1226Sighandler_t
32e30700 1227PerlProcSignal(struct IPerlProc *I, int sig, Sighandler_t subcode)
0cb96387
GS
1228{
1229 return 0;
1230}
1231
1232void*
32e30700 1233PerlProcDynaLoader(struct IPerlProc *I, const char* filename)
0cb96387
GS
1234{
1235 return win32_dynaload(filename);
1236}
1237
1238void
32e30700 1239PerlProcGetOSError(struct IPerlProc *I, SV* sv, DWORD dwErr)
0cb96387 1240{
32e30700 1241 win32_str_os_error(sv, dwErr);
0cb96387
GS
1242}
1243
1244BOOL
32e30700 1245PerlProcDoCmd(struct IPerlProc *I, char *cmd)
0cb96387
GS
1246{
1247 do_spawn2(cmd, EXECF_EXEC);
1248 return FALSE;
1249}
1250
1251int
32e30700 1252PerlProcSpawn(struct IPerlProc *I, char* cmds)
0cb96387
GS
1253{
1254 return do_spawn2(cmds, EXECF_SPAWN);
1255}
1256
1257int
32e30700 1258PerlProcSpawnvp(struct IPerlProc *I, int mode, const char *cmdname, const char *const *argv)
0cb96387
GS
1259{
1260 return win32_spawnvp(mode, cmdname, argv);
1261}
1262
1263int
32e30700 1264PerlProcASpawn(struct IPerlProc *I, void *vreally, void **vmark, void **vsp)
0cb96387 1265{
32e30700 1266 return do_aspawn(vreally, vmark, vsp);
0cb96387
GS
1267}
1268
1269struct IPerlProc perlProc =
1270{
1271 PerlProcAbort,
1272 PerlProcCrypt,
1273 PerlProcExit,
1274 PerlProc_Exit,
1275 PerlProcExecl,
1276 PerlProcExecv,
1277 PerlProcExecvp,
1278 PerlProcGetuid,
1279 PerlProcGeteuid,
1280 PerlProcGetgid,
1281 PerlProcGetegid,
1282 PerlProcGetlogin,
1283 PerlProcKill,
1284 PerlProcKillpg,
1285 PerlProcPauseProc,
1286 PerlProcPopen,
1287 PerlProcPclose,
1288 PerlProcPipe,
1289 PerlProcSetuid,
1290 PerlProcSetgid,
1291 PerlProcSleep,
1292 PerlProcTimes,
1293 PerlProcWait,
1294 PerlProcWaitpid,
1295 PerlProcSignal,
1296 PerlProcDynaLoader,
1297 PerlProcGetOSError,
1298 PerlProcDoCmd,
1299 PerlProcSpawn,
1300 PerlProcSpawnvp,
1301 PerlProcASpawn,
1302};
1303
32e30700 1304/*#include "perlhost.h" */
0cb96387 1305
0cb96387 1306
32e30700
GS
1307EXTERN_C void
1308perl_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)
0cb96387
GS
1315{
1316 if(perlMemInfo) {
1317 Copy(&perlMem, &perlMemInfo->perlMemList, perlMemInfo->nCount, void*);
1318 perlMemInfo->nCount = (sizeof(struct IPerlMem)/sizeof(void*));
1319 }
1320 if(perlEnvInfo) {
1321 Copy(&perlEnv, &perlEnvInfo->perlEnvList, perlEnvInfo->nCount, void*);
1322 perlEnvInfo->nCount = (sizeof(struct IPerlEnv)/sizeof(void*));
1323 }
1324 if(perlStdIOInfo) {
1325 Copy(&perlStdIO, &perlStdIOInfo->perlStdIOList, perlStdIOInfo->nCount, void*);
1326 perlStdIOInfo->nCount = (sizeof(struct IPerlStdIO)/sizeof(void*));
1327 }
1328 if(perlLIOInfo) {
1329 Copy(&perlLIO, &perlLIOInfo->perlLIOList, perlLIOInfo->nCount, void*);
1330 perlLIOInfo->nCount = (sizeof(struct IPerlLIO)/sizeof(void*));
1331 }
1332 if(perlDirInfo) {
1333 Copy(&perlDir, &perlDirInfo->perlDirList, perlDirInfo->nCount, void*);
1334 perlDirInfo->nCount = (sizeof(struct IPerlDir)/sizeof(void*));
1335 }
1336 if(perlSockInfo) {
1337 Copy(&perlSock, &perlSockInfo->perlSockList, perlSockInfo->nCount, void*);
1338 perlSockInfo->nCount = (sizeof(struct IPerlSock)/sizeof(void*));
1339 }
1340 if(perlProcInfo) {
1341 Copy(&perlProc, &perlProcInfo->perlProcList, perlProcInfo->nCount, void*);
1342 perlProcInfo->nCount = (sizeof(struct IPerlProc)/sizeof(void*));
1343 }
1344}
1345
32e30700
GS
1346#ifdef PERL_OBJECT
1347
1348EXTERN_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)
0cb96387
GS
1352{
1353 CPerlObj* pPerl = NULL;
1354 try
1355 {
1356 pPerl = Perl_alloc(pMem, pEnv, pStdIO, pLIO, pDir, pSock, pProc);
1357 }
1358 catch(...)
1359 {
1360 win32_fprintf(stderr, "%s\n", "Error: Unable to allocate memory");
1361 pPerl = NULL;
1362 }
1363 if(pPerl)
1364 {
1365 SetPerlInterpreter(pPerl);
c5be433b 1366 return (PerlInterpreter*)pPerl;
0cb96387
GS
1367 }
1368 SetPerlInterpreter(NULL);
1369 return NULL;
1370}
1371
1372#undef perl_alloc
1373#undef perl_construct
1374#undef perl_destruct
1375#undef perl_free
1376#undef perl_run
1377#undef perl_parse
1378EXTERN_C PerlInterpreter* perl_alloc(void)
1379{
1380 CPerlObj* pPerl = NULL;
1381 try
1382 {
1383 pPerl = Perl_alloc(&perlMem, &perlEnv, &perlStdIO, &perlLIO,
1384 &perlDir, &perlSock, &perlProc);
1385 }
1386 catch(...)
1387 {
1388 win32_fprintf(stderr, "%s\n", "Error: Unable to allocate memory");
1389 pPerl = NULL;
1390 }
1391 if(pPerl)
1392 {
1393 SetPerlInterpreter(pPerl);
c5be433b 1394 return (PerlInterpreter*)pPerl;
0cb96387
GS
1395 }
1396 SetPerlInterpreter(NULL);
1397 return NULL;
1398}
1399
1400EXTERN_C void perl_construct(PerlInterpreter* sv_interp)
1401{
c5be433b 1402 CPerlObj* pPerl = (CPerlObj*)sv_interp;
0cb96387
GS
1403 try
1404 {
1405 pPerl->perl_construct();
1406 }
1407 catch(...)
1408 {
1409 win32_fprintf(stderr, "%s\n",
1410 "Error: Unable to construct data structures");
1411 pPerl->perl_free();
1412 SetPerlInterpreter(NULL);
1413 }
1414}
1415
1416EXTERN_C void perl_destruct(PerlInterpreter* sv_interp)
1417{
c5be433b 1418 CPerlObj* pPerl = (CPerlObj*)sv_interp;
0cb96387
GS
1419 try
1420 {
1421 pPerl->perl_destruct();
1422 }
1423 catch(...)
1424 {
1425 }
1426}
1427
1428EXTERN_C void perl_free(PerlInterpreter* sv_interp)
1429{
c5be433b 1430 CPerlObj* pPerl = (CPerlObj*)sv_interp;
0cb96387
GS
1431 try
1432 {
1433 pPerl->perl_free();
1434 }
1435 catch(...)
1436 {
1437 }
1438 SetPerlInterpreter(NULL);
1439}
1440
1441EXTERN_C int perl_run(PerlInterpreter* sv_interp)
1442{
c5be433b 1443 CPerlObj* pPerl = (CPerlObj*)sv_interp;
0cb96387
GS
1444 int retVal;
1445 try
1446 {
1447 retVal = pPerl->perl_run();
1448 }
1449/*
1450 catch(int x)
1451 {
1452 // this is where exit() should arrive
1453 retVal = x;
1454 }
1455*/
1456 catch(...)
1457 {
1458 win32_fprintf(stderr, "Error: Runtime exception\n");
1459 retVal = -1;
1460 }
1461 return retVal;
1462}
1463
1464EXTERN_C int perl_parse(PerlInterpreter* sv_interp, void (*xsinit)(CPerlObj*), int argc, char** argv, char** env)
1465{
1466 int retVal;
c5be433b 1467 CPerlObj* pPerl = (CPerlObj*)sv_interp;
0cb96387
GS
1468 try
1469 {
3075ddba 1470 retVal = pPerl->perl_parse(xsinit, argc, argv, env);
0cb96387
GS
1471 }
1472/*
1473 catch(int x)
1474 {
1475 // this is where exit() should arrive
1476 retVal = x;
1477 }
1478*/
1479 catch(...)
1480 {
1481 win32_fprintf(stderr, "Error: Parse exception\n");
1482 retVal = -1;
1483 }
1484 *win32_errno() = 0;
1485 return retVal;
1486}
1487
1488#undef PL_perl_destruct_level
1489#define PL_perl_destruct_level int dummy
32e30700
GS
1490
1491#else /* !PERL_OBJECT */
1492
1493EXTERN_C PerlInterpreter*
1494perl_alloc(void)
1495{
1496 return perl_alloc_using(&perlMem, &perlEnv, &perlStdIO, &perlLIO,
1497 &perlDir, &perlSock, &perlProc);
1498}
1499
0cb96387 1500#endif /* PERL_OBJECT */
0a753a76 1501
32e30700
GS
1502#endif /* PERL_IMPLICIT_SYS */
1503
3075ddba 1504extern HANDLE w32_perldll_handle;
c5be433b
GS
1505static DWORD g_TlsAllocIndex;
1506
1507EXTERN_C DllExport bool
1508SetPerlInterpreter(void *interp)
1509{
1510 return TlsSetValue(g_TlsAllocIndex, interp);
1511}
1512
1513EXTERN_C DllExport void*
1514GetPerlInterpreter(void)
1515{
1516 return TlsGetValue(g_TlsAllocIndex);
1517}
1518
1519EXTERN_C DllExport int
0cb96387 1520RunPerl(int argc, char **argv, char **env)
0a753a76 1521{
68dc0745
PP
1522 int exitstatus;
1523 PerlInterpreter *my_perl;
4f63d024 1524 struct perl_thread *thr;
0a753a76 1525
0cb96387
GS
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];
1531 char *ptr;
1532
1533 GetModuleFileName(NULL, szModuleName, sizeof(szModuleName));
1534 (void)win32_longpath(szModuleName);
1535 argv[0] = szModuleName;
1536#endif
1537
22239a37
NIS
1538#ifdef PERL_GLOBAL_STRUCT
1539#define PERLVAR(var,type) /**/
51371543 1540#define PERLVARA(var,type) /**/
533c011a
NIS
1541#define PERLVARI(var,type,init) PL_Vars.var = init;
1542#define PERLVARIC(var,type,init) PL_Vars.var = init;
22239a37
NIS
1543#include "perlvars.h"
1544#undef PERLVAR
51371543 1545#undef PERLVARA
22239a37 1546#undef PERLVARI
3fe35a81 1547#undef PERLVARIC
22239a37
NIS
1548#endif
1549
0a753a76
PP
1550 PERL_SYS_INIT(&argc,&argv);
1551
68dc0745
PP
1552 if (!(my_perl = perl_alloc()))
1553 return (1);
1554 perl_construct( my_perl );
b28d0864 1555 PL_perl_destruct_level = 0;
0a753a76 1556
4f63d024 1557 exitstatus = perl_parse(my_perl, xs_init, argc, argv, env);
0a753a76
PP
1558 if (!exitstatus) {
1559 exitstatus = perl_run( my_perl );
1560 }
1561
0a753a76
PP
1562 perl_destruct( my_perl );
1563 perl_free( my_perl );
1564
1565 PERL_SYS_TERM();
1566
68dc0745 1567 return (exitstatus);
0a753a76
PP
1568}
1569
68dc0745
PP
1570BOOL APIENTRY
1571DllMain(HANDLE hModule, /* DLL module handle */
1572 DWORD fdwReason, /* reason called */
1573 LPVOID lpvReserved) /* reserved */
0a753a76 1574{
68dc0745
PP
1575 switch (fdwReason) {
1576 /* The DLL is attaching to a process due to process
1577 * initialization or a call to LoadLibrary.
1578 */
1579 case DLL_PROCESS_ATTACH:
1580/* #define DEFAULT_BINMODE */
0a753a76 1581#ifdef DEFAULT_BINMODE
3e3baf6d
TB
1582 setmode( fileno( stdin ), O_BINARY );
1583 setmode( fileno( stdout ), O_BINARY );
1584 setmode( fileno( stderr ), O_BINARY );
1585 _fmode = O_BINARY;
0a753a76 1586#endif
0cb96387
GS
1587 g_TlsAllocIndex = TlsAlloc();
1588 DisableThreadLibraryCalls(hModule);
2d7a9237 1589 w32_perldll_handle = hModule;
68dc0745 1590 break;
0a753a76 1591
68dc0745
PP
1592 /* The DLL is detaching from a process due to
1593 * process termination or call to FreeLibrary.
1594 */
1595 case DLL_PROCESS_DETACH:
0cb96387 1596 TlsFree(g_TlsAllocIndex);
68dc0745 1597 break;
0a753a76 1598
68dc0745
PP
1599 /* The attached process creates a new thread. */
1600 case DLL_THREAD_ATTACH:
1601 break;
0a753a76 1602
68dc0745
PP
1603 /* The thread of the attached process terminates. */
1604 case DLL_THREAD_DETACH:
1605 break;
0a753a76 1606
68dc0745
PP
1607 default:
1608 break;
1609 }
1610 return TRUE;
0a753a76 1611}
8b10511d 1612