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