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 | |
32e30700 |
15 | #ifdef PERL_IMPLICIT_SYS |
0cb96387 |
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 | |
32e30700 |
37 | #ifdef PERL_IMPLICIT_SYS |
38 | /* IPerlMem */ |
0cb96387 |
39 | void* |
32e30700 |
40 | PerlMemMalloc(struct IPerlMem *I, size_t size) |
0cb96387 |
41 | { |
42 | return win32_malloc(size); |
43 | } |
44 | void* |
32e30700 |
45 | PerlMemRealloc(struct IPerlMem *I, void* ptr, size_t size) |
0cb96387 |
46 | { |
47 | return win32_realloc(ptr, size); |
48 | } |
49 | void |
32e30700 |
50 | PerlMemFree(struct IPerlMem *I, void* ptr) |
0cb96387 |
51 | { |
52 | win32_free(ptr); |
53 | } |
54 | |
55 | struct IPerlMem perlMem = |
56 | { |
57 | PerlMemMalloc, |
58 | PerlMemRealloc, |
59 | PerlMemFree, |
60 | }; |
61 | |
62 | |
32e30700 |
63 | /* IPerlEnv */ |
0cb96387 |
64 | extern char * g_win32_get_privlib(char *pl); |
65 | extern char * g_win32_get_sitelib(char *pl); |
66 | |
67 | |
68 | char* |
32e30700 |
69 | PerlEnvGetenv(struct IPerlEnv *I, const char *varname) |
0cb96387 |
70 | { |
71 | return win32_getenv(varname); |
72 | }; |
73 | int |
32e30700 |
74 | PerlEnvPutenv(struct IPerlEnv *I, const char *envstring) |
0cb96387 |
75 | { |
76 | return win32_putenv(envstring); |
77 | }; |
78 | |
79 | char* |
32e30700 |
80 | PerlEnvGetenv_len(struct IPerlEnv *I, const char* varname, unsigned long* len) |
0cb96387 |
81 | { |
82 | char *e = win32_getenv(varname); |
83 | if (e) |
84 | *len = strlen(e); |
85 | return e; |
86 | } |
87 | |
88 | int |
32e30700 |
89 | PerlEnvUname(struct IPerlEnv *I, struct utsname *name) |
0cb96387 |
90 | { |
91 | return win32_uname(name); |
92 | } |
93 | |
3075ddba |
94 | void |
32e30700 |
95 | PerlEnvClearenv(struct IPerlEnv *I) |
3075ddba |
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 | |
115 | void* |
32e30700 |
116 | PerlEnvGetChildEnv(struct IPerlEnv *I) |
3075ddba |
117 | { |
118 | return NULL; |
119 | } |
120 | |
121 | void |
32e30700 |
122 | PerlEnvFreeChildEnv(struct IPerlEnv *I, void* env) |
3075ddba |
123 | { |
124 | } |
125 | |
126 | char* |
32e30700 |
127 | PerlEnvGetChildDir(struct IPerlEnv *I) |
3075ddba |
128 | { |
129 | return NULL; |
130 | } |
131 | |
132 | void |
32e30700 |
133 | PerlEnvFreeChildDir(struct IPerlEnv *I, char* dir) |
3075ddba |
134 | { |
135 | } |
136 | |
0cb96387 |
137 | unsigned long |
32e30700 |
138 | PerlEnvOsId(struct IPerlEnv *I) |
0cb96387 |
139 | { |
140 | return win32_os_id(); |
141 | } |
142 | |
143 | char* |
32e30700 |
144 | PerlEnvLibPath(struct IPerlEnv *I, char *pl) |
0cb96387 |
145 | { |
146 | return g_win32_get_privlib(pl); |
147 | } |
148 | |
149 | char* |
32e30700 |
150 | PerlEnvSiteLibPath(struct IPerlEnv *I, char *pl) |
0cb96387 |
151 | { |
152 | return g_win32_get_sitelib(pl); |
153 | } |
154 | |
155 | struct IPerlEnv perlEnv = |
156 | { |
157 | PerlEnvGetenv, |
158 | PerlEnvPutenv, |
159 | PerlEnvGetenv_len, |
160 | PerlEnvUname, |
3075ddba |
161 | PerlEnvClearenv, |
162 | PerlEnvGetChildEnv, |
163 | PerlEnvFreeChildEnv, |
164 | PerlEnvGetChildDir, |
165 | PerlEnvFreeChildDir, |
0cb96387 |
166 | PerlEnvOsId, |
167 | PerlEnvLibPath, |
168 | PerlEnvSiteLibPath, |
169 | }; |
170 | |
171 | |
32e30700 |
172 | /* PerlStdIO */ |
0cb96387 |
173 | PerlIO* |
32e30700 |
174 | PerlStdIOStdin(struct IPerlStdIO *I) |
0cb96387 |
175 | { |
176 | return (PerlIO*)win32_stdin(); |
177 | } |
178 | |
179 | PerlIO* |
32e30700 |
180 | PerlStdIOStdout(struct IPerlStdIO *I) |
0cb96387 |
181 | { |
182 | return (PerlIO*)win32_stdout(); |
183 | } |
184 | |
185 | PerlIO* |
32e30700 |
186 | PerlStdIOStderr(struct IPerlStdIO *I) |
0cb96387 |
187 | { |
188 | return (PerlIO*)win32_stderr(); |
189 | } |
190 | |
191 | PerlIO* |
32e30700 |
192 | PerlStdIOOpen(struct IPerlStdIO *I, const char *path, const char *mode) |
0cb96387 |
193 | { |
194 | return (PerlIO*)win32_fopen(path, mode); |
195 | } |
196 | |
197 | int |
32e30700 |
198 | PerlStdIOClose(struct IPerlStdIO *I, PerlIO* pf) |
0cb96387 |
199 | { |
200 | return win32_fclose(((FILE*)pf)); |
201 | } |
202 | |
203 | int |
32e30700 |
204 | PerlStdIOEof(struct IPerlStdIO *I, PerlIO* pf) |
0cb96387 |
205 | { |
206 | return win32_feof((FILE*)pf); |
207 | } |
208 | |
209 | int |
32e30700 |
210 | PerlStdIOError(struct IPerlStdIO *I, PerlIO* pf) |
0cb96387 |
211 | { |
212 | return win32_ferror((FILE*)pf); |
213 | } |
214 | |
215 | void |
32e30700 |
216 | PerlStdIOClearerr(struct IPerlStdIO *I, PerlIO* pf) |
0cb96387 |
217 | { |
218 | win32_clearerr((FILE*)pf); |
219 | } |
220 | |
221 | int |
32e30700 |
222 | PerlStdIOGetc(struct IPerlStdIO *I, PerlIO* pf) |
0cb96387 |
223 | { |
224 | return win32_getc((FILE*)pf); |
225 | } |
226 | |
227 | char* |
32e30700 |
228 | PerlStdIOGetBase(struct IPerlStdIO *I, PerlIO* pf) |
0cb96387 |
229 | { |
230 | #ifdef FILE_base |
231 | FILE *f = (FILE*)pf; |
232 | return FILE_base(f); |
233 | #else |
234 | return Nullch; |
235 | #endif |
236 | } |
237 | |
238 | int |
32e30700 |
239 | PerlStdIOGetBufsiz(struct IPerlStdIO *I, PerlIO* pf) |
0cb96387 |
240 | { |
241 | #ifdef FILE_bufsiz |
242 | FILE *f = (FILE*)pf; |
243 | return FILE_bufsiz(f); |
244 | #else |
245 | return (-1); |
246 | #endif |
247 | } |
248 | |
249 | int |
32e30700 |
250 | PerlStdIOGetCnt(struct IPerlStdIO *I, PerlIO* pf) |
0cb96387 |
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 | |
260 | char* |
32e30700 |
261 | PerlStdIOGetPtr(struct IPerlStdIO *I, PerlIO* pf) |
0cb96387 |
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 | |
271 | char* |
32e30700 |
272 | PerlStdIOGets(struct IPerlStdIO *I, PerlIO* pf, char* s, int n) |
0cb96387 |
273 | { |
274 | return win32_fgets(s, n, (FILE*)pf); |
275 | } |
276 | |
277 | int |
32e30700 |
278 | PerlStdIOPutc(struct IPerlStdIO *I, PerlIO* pf, int c) |
0cb96387 |
279 | { |
280 | return win32_fputc(c, (FILE*)pf); |
281 | } |
282 | |
283 | int |
32e30700 |
284 | PerlStdIOPuts(struct IPerlStdIO *I, PerlIO* pf, const char *s) |
0cb96387 |
285 | { |
286 | return win32_fputs(s, (FILE*)pf); |
287 | } |
288 | |
289 | int |
32e30700 |
290 | PerlStdIOFlush(struct IPerlStdIO *I, PerlIO* pf) |
0cb96387 |
291 | { |
292 | return win32_fflush((FILE*)pf); |
293 | } |
294 | |
295 | int |
32e30700 |
296 | PerlStdIOUngetc(struct IPerlStdIO *I, PerlIO* pf,int c) |
0cb96387 |
297 | { |
298 | return win32_ungetc(c, (FILE*)pf); |
299 | } |
300 | |
301 | int |
32e30700 |
302 | PerlStdIOFileno(struct IPerlStdIO *I, PerlIO* pf) |
0cb96387 |
303 | { |
304 | return win32_fileno((FILE*)pf); |
305 | } |
306 | |
307 | PerlIO* |
32e30700 |
308 | PerlStdIOFdopen(struct IPerlStdIO *I, int fd, const char *mode) |
0cb96387 |
309 | { |
310 | return (PerlIO*)win32_fdopen(fd, mode); |
311 | } |
312 | |
313 | PerlIO* |
32e30700 |
314 | PerlStdIOReopen(struct IPerlStdIO *I, const char*path, const char*mode, PerlIO* pf) |
0cb96387 |
315 | { |
316 | return (PerlIO*)win32_freopen(path, mode, (FILE*)pf); |
317 | } |
318 | |
319 | SSize_t |
32e30700 |
320 | PerlStdIORead(struct IPerlStdIO *I, PerlIO* pf, void *buffer, Size_t size) |
0cb96387 |
321 | { |
322 | return win32_fread(buffer, 1, size, (FILE*)pf); |
323 | } |
324 | |
325 | SSize_t |
32e30700 |
326 | PerlStdIOWrite(struct IPerlStdIO *I, PerlIO* pf, const void *buffer, Size_t size) |
0cb96387 |
327 | { |
328 | return win32_fwrite(buffer, 1, size, (FILE*)pf); |
329 | } |
330 | |
331 | void |
32e30700 |
332 | PerlStdIOSetBuf(struct IPerlStdIO *I, PerlIO* pf, char* buffer) |
0cb96387 |
333 | { |
334 | win32_setbuf((FILE*)pf, buffer); |
335 | } |
336 | |
337 | int |
32e30700 |
338 | PerlStdIOSetVBuf(struct IPerlStdIO *I, PerlIO* pf, char* buffer, int type, Size_t size) |
0cb96387 |
339 | { |
340 | return win32_setvbuf((FILE*)pf, buffer, type, size); |
341 | } |
342 | |
343 | void |
32e30700 |
344 | PerlStdIOSetCnt(struct IPerlStdIO *I, PerlIO* pf, int n) |
0cb96387 |
345 | { |
346 | #ifdef STDIO_CNT_LVALUE |
347 | FILE *f = (FILE*)pf; |
348 | FILE_cnt(f) = n; |
349 | #endif |
350 | } |
351 | |
352 | void |
32e30700 |
353 | PerlStdIOSetPtrCnt(struct IPerlStdIO *I, PerlIO* pf, char * ptr, int n) |
0cb96387 |
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 | |
362 | void |
32e30700 |
363 | PerlStdIOSetlinebuf(struct IPerlStdIO *I, PerlIO* pf) |
0cb96387 |
364 | { |
365 | win32_setvbuf((FILE*)pf, NULL, _IOLBF, 0); |
366 | } |
367 | |
368 | int |
32e30700 |
369 | PerlStdIOPrintf(struct IPerlStdIO *I, PerlIO* pf, const char *format,...) |
0cb96387 |
370 | { |
371 | va_list(arglist); |
372 | va_start(arglist, format); |
373 | return win32_vfprintf((FILE*)pf, format, arglist); |
374 | } |
375 | |
376 | int |
32e30700 |
377 | PerlStdIOVprintf(struct IPerlStdIO *I, PerlIO* pf, const char *format, va_list arglist) |
0cb96387 |
378 | { |
379 | return win32_vfprintf((FILE*)pf, format, arglist); |
380 | } |
381 | |
382 | long |
32e30700 |
383 | PerlStdIOTell(struct IPerlStdIO *I, PerlIO* pf) |
0cb96387 |
384 | { |
385 | return win32_ftell((FILE*)pf); |
386 | } |
387 | |
388 | int |
32e30700 |
389 | PerlStdIOSeek(struct IPerlStdIO *I, PerlIO* pf, off_t offset, int origin) |
0cb96387 |
390 | { |
391 | return win32_fseek((FILE*)pf, offset, origin); |
392 | } |
393 | |
394 | void |
32e30700 |
395 | PerlStdIORewind(struct IPerlStdIO *I, PerlIO* pf) |
0cb96387 |
396 | { |
397 | win32_rewind((FILE*)pf); |
398 | } |
399 | |
400 | PerlIO* |
32e30700 |
401 | PerlStdIOTmpfile(struct IPerlStdIO *I) |
0cb96387 |
402 | { |
403 | return (PerlIO*)win32_tmpfile(); |
404 | } |
405 | |
406 | int |
32e30700 |
407 | PerlStdIOGetpos(struct IPerlStdIO *I, PerlIO* pf, Fpos_t *p) |
0cb96387 |
408 | { |
409 | return win32_fgetpos((FILE*)pf, p); |
410 | } |
411 | |
412 | int |
32e30700 |
413 | PerlStdIOSetpos(struct IPerlStdIO *I, PerlIO* pf, const Fpos_t *p) |
0cb96387 |
414 | { |
415 | return win32_fsetpos((FILE*)pf, p); |
416 | } |
417 | void |
32e30700 |
418 | PerlStdIOInit(struct IPerlStdIO *I) |
0cb96387 |
419 | { |
420 | } |
421 | |
422 | void |
32e30700 |
423 | PerlStdIOInitOSExtras(struct IPerlStdIO *I) |
0cb96387 |
424 | { |
425 | Perl_init_os_extras(); |
426 | } |
427 | |
428 | int |
32e30700 |
429 | PerlStdIOOpenOSfhandle(struct IPerlStdIO *I, long osfhandle, int flags) |
0cb96387 |
430 | { |
431 | return win32_open_osfhandle(osfhandle, flags); |
432 | } |
433 | |
434 | int |
32e30700 |
435 | PerlStdIOGetOSfhandle(struct IPerlStdIO *I, int filenum) |
0cb96387 |
436 | { |
437 | return win32_get_osfhandle(filenum); |
438 | } |
439 | |
440 | |
441 | struct 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 |
485 | int |
32e30700 |
486 | PerlLIOAccess(struct IPerlLIO *I, const char *path, int mode) |
0cb96387 |
487 | { |
488 | return access(path, mode); |
489 | } |
490 | |
491 | int |
32e30700 |
492 | PerlLIOChmod(struct IPerlLIO *I, const char *filename, int pmode) |
0cb96387 |
493 | { |
494 | return chmod(filename, pmode); |
495 | } |
496 | |
497 | int |
32e30700 |
498 | PerlLIOChown(struct IPerlLIO *I, const char *filename, uid_t owner, gid_t group) |
0cb96387 |
499 | { |
500 | return chown(filename, owner, group); |
501 | } |
502 | |
503 | int |
32e30700 |
504 | PerlLIOChsize(struct IPerlLIO *I, int handle, long size) |
0cb96387 |
505 | { |
506 | return chsize(handle, size); |
507 | } |
508 | |
509 | int |
32e30700 |
510 | PerlLIOClose(struct IPerlLIO *I, int handle) |
0cb96387 |
511 | { |
512 | return win32_close(handle); |
513 | } |
514 | |
515 | int |
32e30700 |
516 | PerlLIODup(struct IPerlLIO *I, int handle) |
0cb96387 |
517 | { |
518 | return win32_dup(handle); |
519 | } |
520 | |
521 | int |
32e30700 |
522 | PerlLIODup2(struct IPerlLIO *I, int handle1, int handle2) |
0cb96387 |
523 | { |
524 | return win32_dup2(handle1, handle2); |
525 | } |
526 | |
527 | int |
32e30700 |
528 | PerlLIOFlock(struct IPerlLIO *I, int fd, int oper) |
0cb96387 |
529 | { |
530 | return win32_flock(fd, oper); |
531 | } |
532 | |
533 | int |
32e30700 |
534 | PerlLIOFileStat(struct IPerlLIO *I, int handle, struct stat *buffer) |
0cb96387 |
535 | { |
536 | return fstat(handle, buffer); |
537 | } |
538 | |
539 | int |
32e30700 |
540 | PerlLIOIOCtl(struct IPerlLIO *I, int i, unsigned int u, char *data) |
0cb96387 |
541 | { |
542 | return win32_ioctlsocket((SOCKET)i, (long)u, (u_long*)data); |
543 | } |
544 | |
545 | int |
32e30700 |
546 | PerlLIOIsatty(struct IPerlLIO *I, int fd) |
0cb96387 |
547 | { |
548 | return isatty(fd); |
549 | } |
550 | |
551 | long |
32e30700 |
552 | PerlLIOLseek(struct IPerlLIO *I, int handle, long offset, int origin) |
0cb96387 |
553 | { |
554 | return win32_lseek(handle, offset, origin); |
555 | } |
556 | |
557 | int |
558 | PerlLIOLstat(struct IPerlLIO* p, const char *path, struct stat *buffer) |
559 | { |
560 | return win32_stat(path, buffer); |
561 | } |
562 | |
563 | char* |
32e30700 |
564 | PerlLIOMktemp(struct IPerlLIO *I, char *Template) |
0cb96387 |
565 | { |
566 | return mktemp(Template); |
567 | } |
568 | |
569 | int |
32e30700 |
570 | PerlLIOOpen(struct IPerlLIO *I, const char *filename, int oflag) |
0cb96387 |
571 | { |
572 | return win32_open(filename, oflag); |
573 | } |
574 | |
575 | int |
32e30700 |
576 | PerlLIOOpen3(struct IPerlLIO *I, const char *filename, int oflag, int pmode) |
0cb96387 |
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 | |
587 | int |
32e30700 |
588 | PerlLIORead(struct IPerlLIO *I, int handle, void *buffer, unsigned int count) |
0cb96387 |
589 | { |
590 | return win32_read(handle, buffer, count); |
591 | } |
592 | |
593 | int |
32e30700 |
594 | PerlLIORename(struct IPerlLIO *I, const char *OldFileName, const char *newname) |
0cb96387 |
595 | { |
596 | return win32_rename(OldFileName, newname); |
597 | } |
598 | |
599 | int |
32e30700 |
600 | PerlLIOSetmode(struct IPerlLIO *I, int handle, int mode) |
0cb96387 |
601 | { |
602 | return win32_setmode(handle, mode); |
603 | } |
604 | |
605 | int |
32e30700 |
606 | PerlLIONameStat(struct IPerlLIO *I, const char *path, struct stat *buffer) |
0cb96387 |
607 | { |
608 | return win32_stat(path, buffer); |
609 | } |
610 | |
611 | char* |
32e30700 |
612 | PerlLIOTmpnam(struct IPerlLIO *I, char *string) |
0cb96387 |
613 | { |
614 | return tmpnam(string); |
615 | } |
616 | |
617 | int |
32e30700 |
618 | PerlLIOUmask(struct IPerlLIO *I, int pmode) |
0cb96387 |
619 | { |
620 | return umask(pmode); |
621 | } |
622 | |
623 | int |
32e30700 |
624 | PerlLIOUnlink(struct IPerlLIO *I, const char *filename) |
0cb96387 |
625 | { |
626 | chmod(filename, S_IREAD | S_IWRITE); |
627 | return unlink(filename); |
628 | } |
629 | |
630 | int |
32e30700 |
631 | PerlLIOUtime(struct IPerlLIO *I, char *filename, struct utimbuf *times) |
0cb96387 |
632 | { |
633 | return win32_utime(filename, times); |
634 | } |
635 | |
636 | int |
32e30700 |
637 | PerlLIOWrite(struct IPerlLIO *I, int handle, const void *buffer, unsigned int count) |
0cb96387 |
638 | { |
639 | return win32_write(handle, buffer, count); |
640 | } |
641 | |
642 | struct 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 |
672 | int |
32e30700 |
673 | PerlDirMakedir(struct IPerlDir *I, const char *dirname, int mode) |
0cb96387 |
674 | { |
675 | return win32_mkdir(dirname, mode); |
676 | } |
677 | |
678 | int |
32e30700 |
679 | PerlDirChdir(struct IPerlDir *I, const char *dirname) |
0cb96387 |
680 | { |
681 | return win32_chdir(dirname); |
682 | } |
683 | |
684 | int |
32e30700 |
685 | PerlDirRmdir(struct IPerlDir *I, const char *dirname) |
0cb96387 |
686 | { |
687 | return win32_rmdir(dirname); |
688 | } |
689 | |
690 | int |
32e30700 |
691 | PerlDirClose(struct IPerlDir *I, DIR *dirp) |
0cb96387 |
692 | { |
693 | return win32_closedir(dirp); |
694 | } |
695 | |
696 | DIR* |
32e30700 |
697 | PerlDirOpen(struct IPerlDir *I, char *filename) |
0cb96387 |
698 | { |
699 | return win32_opendir(filename); |
700 | } |
701 | |
702 | struct direct * |
32e30700 |
703 | PerlDirRead(struct IPerlDir *I, DIR *dirp) |
0cb96387 |
704 | { |
705 | return win32_readdir(dirp); |
706 | } |
707 | |
708 | void |
32e30700 |
709 | PerlDirRewind(struct IPerlDir *I, DIR *dirp) |
0cb96387 |
710 | { |
711 | win32_rewinddir(dirp); |
712 | } |
713 | |
714 | void |
32e30700 |
715 | PerlDirSeek(struct IPerlDir *I, DIR *dirp, long loc) |
0cb96387 |
716 | { |
717 | win32_seekdir(dirp, loc); |
718 | } |
719 | |
720 | long |
32e30700 |
721 | PerlDirTell(struct IPerlDir *I, DIR *dirp) |
0cb96387 |
722 | { |
723 | return win32_telldir(dirp); |
724 | } |
725 | |
726 | struct 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 |
741 | u_long |
32e30700 |
742 | PerlSockHtonl(struct IPerlSock *I, u_long hostlong) |
0cb96387 |
743 | { |
744 | return win32_htonl(hostlong); |
745 | } |
746 | |
747 | u_short |
32e30700 |
748 | PerlSockHtons(struct IPerlSock *I, u_short hostshort) |
0cb96387 |
749 | { |
750 | return win32_htons(hostshort); |
751 | } |
752 | |
753 | u_long |
32e30700 |
754 | PerlSockNtohl(struct IPerlSock *I, u_long netlong) |
0cb96387 |
755 | { |
756 | return win32_ntohl(netlong); |
757 | } |
758 | |
759 | u_short |
32e30700 |
760 | PerlSockNtohs(struct IPerlSock *I, u_short netshort) |
0cb96387 |
761 | { |
762 | return win32_ntohs(netshort); |
763 | } |
764 | |
32e30700 |
765 | SOCKET PerlSockAccept(struct IPerlSock *I, SOCKET s, struct sockaddr* addr, int* addrlen) |
0cb96387 |
766 | { |
767 | return win32_accept(s, addr, addrlen); |
768 | } |
769 | |
770 | int |
32e30700 |
771 | PerlSockBind(struct IPerlSock *I, SOCKET s, const struct sockaddr* name, int namelen) |
0cb96387 |
772 | { |
773 | return win32_bind(s, name, namelen); |
774 | } |
775 | |
776 | int |
32e30700 |
777 | PerlSockConnect(struct IPerlSock *I, SOCKET s, const struct sockaddr* name, int namelen) |
0cb96387 |
778 | { |
779 | return win32_connect(s, name, namelen); |
780 | } |
781 | |
782 | void |
32e30700 |
783 | PerlSockEndhostent(struct IPerlSock *I) |
0cb96387 |
784 | { |
785 | win32_endhostent(); |
786 | } |
787 | |
788 | void |
32e30700 |
789 | PerlSockEndnetent(struct IPerlSock *I) |
0cb96387 |
790 | { |
791 | win32_endnetent(); |
792 | } |
793 | |
794 | void |
32e30700 |
795 | PerlSockEndprotoent(struct IPerlSock *I) |
0cb96387 |
796 | { |
797 | win32_endprotoent(); |
798 | } |
799 | |
800 | void |
32e30700 |
801 | PerlSockEndservent(struct IPerlSock *I) |
0cb96387 |
802 | { |
803 | win32_endservent(); |
804 | } |
805 | |
806 | struct hostent* |
32e30700 |
807 | PerlSockGethostbyaddr(struct IPerlSock *I, const char* addr, int len, int type) |
0cb96387 |
808 | { |
809 | return win32_gethostbyaddr(addr, len, type); |
810 | } |
811 | |
812 | struct hostent* |
32e30700 |
813 | PerlSockGethostbyname(struct IPerlSock *I, const char* name) |
0cb96387 |
814 | { |
815 | return win32_gethostbyname(name); |
816 | } |
817 | |
818 | struct hostent* |
32e30700 |
819 | PerlSockGethostent(struct IPerlSock *I) |
0cb96387 |
820 | { |
c5be433b |
821 | dTHXo; |
32e30700 |
822 | Perl_croak(aTHX_ "gethostent not implemented!\n"); |
0cb96387 |
823 | return NULL; |
824 | } |
825 | |
826 | int |
32e30700 |
827 | PerlSockGethostname(struct IPerlSock *I, char* name, int namelen) |
0cb96387 |
828 | { |
829 | return win32_gethostname(name, namelen); |
830 | } |
831 | |
832 | struct netent * |
32e30700 |
833 | PerlSockGetnetbyaddr(struct IPerlSock *I, long net, int type) |
0cb96387 |
834 | { |
835 | return win32_getnetbyaddr(net, type); |
836 | } |
837 | |
838 | struct netent * |
32e30700 |
839 | PerlSockGetnetbyname(struct IPerlSock *I, const char *name) |
0cb96387 |
840 | { |
841 | return win32_getnetbyname((char*)name); |
842 | } |
843 | |
844 | struct netent * |
32e30700 |
845 | PerlSockGetnetent(struct IPerlSock *I) |
0cb96387 |
846 | { |
847 | return win32_getnetent(); |
848 | } |
849 | |
32e30700 |
850 | int PerlSockGetpeername(struct IPerlSock *I, SOCKET s, struct sockaddr* name, int* namelen) |
0cb96387 |
851 | { |
852 | return win32_getpeername(s, name, namelen); |
853 | } |
854 | |
855 | struct protoent* |
32e30700 |
856 | PerlSockGetprotobyname(struct IPerlSock *I, const char* name) |
0cb96387 |
857 | { |
858 | return win32_getprotobyname(name); |
859 | } |
860 | |
861 | struct protoent* |
32e30700 |
862 | PerlSockGetprotobynumber(struct IPerlSock *I, int number) |
0cb96387 |
863 | { |
864 | return win32_getprotobynumber(number); |
865 | } |
866 | |
867 | struct protoent* |
32e30700 |
868 | PerlSockGetprotoent(struct IPerlSock *I) |
0cb96387 |
869 | { |
870 | return win32_getprotoent(); |
871 | } |
872 | |
873 | struct servent* |
32e30700 |
874 | PerlSockGetservbyname(struct IPerlSock *I, const char* name, const char* proto) |
0cb96387 |
875 | { |
876 | return win32_getservbyname(name, proto); |
877 | } |
878 | |
879 | struct servent* |
32e30700 |
880 | PerlSockGetservbyport(struct IPerlSock *I, int port, const char* proto) |
0cb96387 |
881 | { |
882 | return win32_getservbyport(port, proto); |
883 | } |
884 | |
885 | struct servent* |
32e30700 |
886 | PerlSockGetservent(struct IPerlSock *I) |
0cb96387 |
887 | { |
888 | return win32_getservent(); |
889 | } |
890 | |
891 | int |
32e30700 |
892 | PerlSockGetsockname(struct IPerlSock *I, SOCKET s, struct sockaddr* name, int* namelen) |
0cb96387 |
893 | { |
894 | return win32_getsockname(s, name, namelen); |
895 | } |
896 | |
897 | int |
32e30700 |
898 | PerlSockGetsockopt(struct IPerlSock *I, SOCKET s, int level, int optname, char* optval, int* optlen) |
0cb96387 |
899 | { |
900 | return win32_getsockopt(s, level, optname, optval, optlen); |
901 | } |
902 | |
903 | unsigned long |
32e30700 |
904 | PerlSockInetAddr(struct IPerlSock *I, const char* cp) |
0cb96387 |
905 | { |
906 | return win32_inet_addr(cp); |
907 | } |
908 | |
909 | char* |
32e30700 |
910 | PerlSockInetNtoa(struct IPerlSock *I, struct in_addr in) |
0cb96387 |
911 | { |
912 | return win32_inet_ntoa(in); |
913 | } |
914 | |
915 | int |
32e30700 |
916 | PerlSockListen(struct IPerlSock *I, SOCKET s, int backlog) |
0cb96387 |
917 | { |
918 | return win32_listen(s, backlog); |
919 | } |
920 | |
921 | int |
32e30700 |
922 | PerlSockRecv(struct IPerlSock *I, SOCKET s, char* buffer, int len, int flags) |
0cb96387 |
923 | { |
924 | return win32_recv(s, buffer, len, flags); |
925 | } |
926 | |
927 | int |
32e30700 |
928 | PerlSockRecvfrom(struct IPerlSock *I, SOCKET s, char* buffer, int len, int flags, struct sockaddr* from, int* fromlen) |
0cb96387 |
929 | { |
930 | return win32_recvfrom(s, buffer, len, flags, from, fromlen); |
931 | } |
932 | |
933 | int |
32e30700 |
934 | PerlSockSelect(struct IPerlSock *I, int nfds, char* readfds, char* writefds, char* exceptfds, const struct timeval* timeout) |
0cb96387 |
935 | { |
936 | return win32_select(nfds, (Perl_fd_set*)readfds, (Perl_fd_set*)writefds, (Perl_fd_set*)exceptfds, timeout); |
937 | } |
938 | |
939 | int |
32e30700 |
940 | PerlSockSend(struct IPerlSock *I, SOCKET s, const char* buffer, int len, int flags) |
0cb96387 |
941 | { |
942 | return win32_send(s, buffer, len, flags); |
943 | } |
944 | |
945 | int |
32e30700 |
946 | PerlSockSendto(struct IPerlSock *I, SOCKET s, const char* buffer, int len, int flags, const struct sockaddr* to, int tolen) |
0cb96387 |
947 | { |
948 | return win32_sendto(s, buffer, len, flags, to, tolen); |
949 | } |
950 | |
951 | void |
32e30700 |
952 | PerlSockSethostent(struct IPerlSock *I, int stayopen) |
0cb96387 |
953 | { |
954 | win32_sethostent(stayopen); |
955 | } |
956 | |
957 | void |
32e30700 |
958 | PerlSockSetnetent(struct IPerlSock *I, int stayopen) |
0cb96387 |
959 | { |
960 | win32_setnetent(stayopen); |
961 | } |
962 | |
963 | void |
32e30700 |
964 | PerlSockSetprotoent(struct IPerlSock *I, int stayopen) |
0cb96387 |
965 | { |
966 | win32_setprotoent(stayopen); |
967 | } |
968 | |
969 | void |
32e30700 |
970 | PerlSockSetservent(struct IPerlSock *I, int stayopen) |
0cb96387 |
971 | { |
972 | win32_setservent(stayopen); |
973 | } |
974 | |
975 | int |
32e30700 |
976 | PerlSockSetsockopt(struct IPerlSock *I, SOCKET s, int level, int optname, const char* optval, int optlen) |
0cb96387 |
977 | { |
978 | return win32_setsockopt(s, level, optname, optval, optlen); |
979 | } |
980 | |
981 | int |
32e30700 |
982 | PerlSockShutdown(struct IPerlSock *I, SOCKET s, int how) |
0cb96387 |
983 | { |
984 | return win32_shutdown(s, how); |
985 | } |
986 | |
987 | SOCKET |
32e30700 |
988 | PerlSockSocket(struct IPerlSock *I, int af, int type, int protocol) |
0cb96387 |
989 | { |
990 | return win32_socket(af, type, protocol); |
991 | } |
992 | |
993 | int |
32e30700 |
994 | PerlSockSocketpair(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 |
998 | return 0; |
999 | } |
1000 | |
1001 | int |
32e30700 |
1002 | PerlSockClosesocket(struct IPerlSock *I, SOCKET s) |
0cb96387 |
1003 | { |
1004 | return win32_closesocket(s); |
1005 | } |
1006 | |
1007 | int |
32e30700 |
1008 | PerlSockIoctlsocket(struct IPerlSock *I, SOCKET s, long cmd, u_long *argp) |
0cb96387 |
1009 | { |
1010 | return win32_ioctlsocket(s, cmd, argp); |
1011 | } |
1012 | |
1013 | struct 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 |
1063 | |
1064 | #define EXECF_EXEC 1 |
1065 | #define EXECF_SPAWN 2 |
1066 | |
1067 | extern char * g_getlogin(void); |
1068 | extern int do_spawn2(char *cmd, int exectype); |
32e30700 |
1069 | #ifdef PERL_OBJECT |
0cb96387 |
1070 | extern int g_do_aspawn(void *vreally, void **vmark, void **vsp); |
32e30700 |
1071 | #define do_aspawn g_do_aspawn |
1072 | #endif |
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); |
0cb96387 |
1077 | |
1078 | void |
32e30700 |
1079 | PerlProcAbort(struct IPerlProc *I) |
0cb96387 |
1080 | { |
1081 | win32_abort(); |
1082 | } |
1083 | |
1084 | char * |
32e30700 |
1085 | PerlProcCrypt(struct IPerlProc *I, const char* clear, const char* salt) |
0cb96387 |
1086 | { |
1087 | return win32_crypt(clear, salt); |
1088 | } |
1089 | |
1090 | void |
32e30700 |
1091 | PerlProcExit(struct IPerlProc *I, int status) |
0cb96387 |
1092 | { |
1093 | exit(status); |
1094 | } |
1095 | |
1096 | void |
32e30700 |
1097 | PerlProc_Exit(struct IPerlProc *I, int status) |
0cb96387 |
1098 | { |
1099 | _exit(status); |
1100 | } |
1101 | |
1102 | int |
32e30700 |
1103 | PerlProcExecl(struct IPerlProc *I, const char *cmdname, const char *arg0, const char *arg1, const char *arg2, const char *arg3) |
0cb96387 |
1104 | { |
1105 | return execl(cmdname, arg0, arg1, arg2, arg3); |
1106 | } |
1107 | |
1108 | int |
32e30700 |
1109 | PerlProcExecv(struct IPerlProc *I, const char *cmdname, const char *const *argv) |
0cb96387 |
1110 | { |
1111 | return win32_execvp(cmdname, argv); |
1112 | } |
1113 | |
1114 | int |
32e30700 |
1115 | PerlProcExecvp(struct IPerlProc *I, const char *cmdname, const char *const *argv) |
0cb96387 |
1116 | { |
1117 | return win32_execvp(cmdname, argv); |
1118 | } |
1119 | |
1120 | uid_t |
32e30700 |
1121 | PerlProcGetuid(struct IPerlProc *I) |
0cb96387 |
1122 | { |
1123 | return getuid(); |
1124 | } |
1125 | |
1126 | uid_t |
32e30700 |
1127 | PerlProcGeteuid(struct IPerlProc *I) |
0cb96387 |
1128 | { |
1129 | return geteuid(); |
1130 | } |
1131 | |
1132 | gid_t |
32e30700 |
1133 | PerlProcGetgid(struct IPerlProc *I) |
0cb96387 |
1134 | { |
1135 | return getgid(); |
1136 | } |
1137 | |
1138 | gid_t |
32e30700 |
1139 | PerlProcGetegid(struct IPerlProc *I) |
0cb96387 |
1140 | { |
1141 | return getegid(); |
1142 | } |
1143 | |
1144 | char * |
32e30700 |
1145 | PerlProcGetlogin(struct IPerlProc *I) |
0cb96387 |
1146 | { |
1147 | return g_getlogin(); |
1148 | } |
1149 | |
1150 | int |
32e30700 |
1151 | PerlProcKill(struct IPerlProc *I, int pid, int sig) |
0cb96387 |
1152 | { |
1153 | return win32_kill(pid, sig); |
1154 | } |
1155 | |
1156 | int |
32e30700 |
1157 | PerlProcKillpg(struct IPerlProc *I, int pid, int sig) |
0cb96387 |
1158 | { |
c5be433b |
1159 | dTHXo; |
32e30700 |
1160 | Perl_croak(aTHX_ "killpg not implemented!\n"); |
0cb96387 |
1161 | return 0; |
1162 | } |
1163 | |
1164 | int |
32e30700 |
1165 | PerlProcPauseProc(struct IPerlProc *I) |
0cb96387 |
1166 | { |
1167 | return win32_sleep((32767L << 16) + 32767); |
1168 | } |
1169 | |
1170 | PerlIO* |
32e30700 |
1171 | PerlProcPopen(struct IPerlProc *I, const char *command, const char *mode) |
0cb96387 |
1172 | { |
12b99c39 |
1173 | dTHXo; |
32e30700 |
1174 | PERL_FLUSHALL_FOR_CHILD; |
0cb96387 |
1175 | return (PerlIO*)win32_popen(command, mode); |
1176 | } |
1177 | |
1178 | int |
32e30700 |
1179 | PerlProcPclose(struct IPerlProc *I, PerlIO *stream) |
0cb96387 |
1180 | { |
1181 | return win32_pclose((FILE*)stream); |
1182 | } |
1183 | |
1184 | int |
32e30700 |
1185 | PerlProcPipe(struct IPerlProc *I, int *phandles) |
0cb96387 |
1186 | { |
1187 | return win32_pipe(phandles, 512, O_BINARY); |
1188 | } |
1189 | |
1190 | int |
32e30700 |
1191 | PerlProcSetuid(struct IPerlProc *I, uid_t u) |
0cb96387 |
1192 | { |
1193 | return setuid(u); |
1194 | } |
1195 | |
1196 | int |
32e30700 |
1197 | PerlProcSetgid(struct IPerlProc *I, gid_t g) |
0cb96387 |
1198 | { |
1199 | return setgid(g); |
1200 | } |
1201 | |
1202 | int |
32e30700 |
1203 | PerlProcSleep(struct IPerlProc *I, unsigned int s) |
0cb96387 |
1204 | { |
1205 | return win32_sleep(s); |
1206 | } |
1207 | |
1208 | int |
32e30700 |
1209 | PerlProcTimes(struct IPerlProc *I, struct tms *timebuf) |
0cb96387 |
1210 | { |
1211 | return win32_times(timebuf); |
1212 | } |
1213 | |
1214 | int |
32e30700 |
1215 | PerlProcWait(struct IPerlProc *I, int *status) |
0cb96387 |
1216 | { |
1217 | return win32_wait(status); |
1218 | } |
1219 | |
1220 | int |
32e30700 |
1221 | PerlProcWaitpid(struct IPerlProc *I, int pid, int *status, int flags) |
0cb96387 |
1222 | { |
1223 | return win32_waitpid(pid, status, flags); |
1224 | } |
1225 | |
1226 | Sighandler_t |
32e30700 |
1227 | PerlProcSignal(struct IPerlProc *I, int sig, Sighandler_t subcode) |
0cb96387 |
1228 | { |
1229 | return 0; |
1230 | } |
1231 | |
1232 | void* |
32e30700 |
1233 | PerlProcDynaLoader(struct IPerlProc *I, const char* filename) |
0cb96387 |
1234 | { |
1235 | return win32_dynaload(filename); |
1236 | } |
1237 | |
1238 | void |
32e30700 |
1239 | PerlProcGetOSError(struct IPerlProc *I, SV* sv, DWORD dwErr) |
0cb96387 |
1240 | { |
32e30700 |
1241 | win32_str_os_error(sv, dwErr); |
0cb96387 |
1242 | } |
1243 | |
1244 | BOOL |
32e30700 |
1245 | PerlProcDoCmd(struct IPerlProc *I, char *cmd) |
0cb96387 |
1246 | { |
1247 | do_spawn2(cmd, EXECF_EXEC); |
1248 | return FALSE; |
1249 | } |
1250 | |
1251 | int |
32e30700 |
1252 | PerlProcSpawn(struct IPerlProc *I, char* cmds) |
0cb96387 |
1253 | { |
1254 | return do_spawn2(cmds, EXECF_SPAWN); |
1255 | } |
1256 | |
1257 | int |
32e30700 |
1258 | PerlProcSpawnvp(struct IPerlProc *I, int mode, const char *cmdname, const char *const *argv) |
0cb96387 |
1259 | { |
1260 | return win32_spawnvp(mode, cmdname, argv); |
1261 | } |
1262 | |
1263 | int |
32e30700 |
1264 | PerlProcASpawn(struct IPerlProc *I, void *vreally, void **vmark, void **vsp) |
0cb96387 |
1265 | { |
32e30700 |
1266 | return do_aspawn(vreally, vmark, vsp); |
0cb96387 |
1267 | } |
1268 | |
1269 | struct 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 |
1307 | EXTERN_C void |
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) |
0cb96387 |
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 |
1346 | #ifdef PERL_OBJECT |
1347 | |
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) |
0cb96387 |
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 |
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 |
1378 | EXTERN_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 |
1395 | } |
1396 | SetPerlInterpreter(NULL); |
1397 | return NULL; |
1398 | } |
1399 | |
1400 | EXTERN_C void perl_construct(PerlInterpreter* sv_interp) |
1401 | { |
c5be433b |
1402 | CPerlObj* pPerl = (CPerlObj*)sv_interp; |
0cb96387 |
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 | |
1416 | EXTERN_C void perl_destruct(PerlInterpreter* sv_interp) |
1417 | { |
c5be433b |
1418 | CPerlObj* pPerl = (CPerlObj*)sv_interp; |
0cb96387 |
1419 | try |
1420 | { |
1421 | pPerl->perl_destruct(); |
1422 | } |
1423 | catch(...) |
1424 | { |
1425 | } |
1426 | } |
1427 | |
1428 | EXTERN_C void perl_free(PerlInterpreter* sv_interp) |
1429 | { |
c5be433b |
1430 | CPerlObj* pPerl = (CPerlObj*)sv_interp; |
0cb96387 |
1431 | try |
1432 | { |
1433 | pPerl->perl_free(); |
1434 | } |
1435 | catch(...) |
1436 | { |
1437 | } |
1438 | SetPerlInterpreter(NULL); |
1439 | } |
1440 | |
1441 | EXTERN_C int perl_run(PerlInterpreter* sv_interp) |
1442 | { |
c5be433b |
1443 | CPerlObj* pPerl = (CPerlObj*)sv_interp; |
0cb96387 |
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 | |
1464 | EXTERN_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 |
1468 | try |
1469 | { |
3075ddba |
1470 | retVal = pPerl->perl_parse(xsinit, argc, argv, env); |
0cb96387 |
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 |
1490 | |
1491 | #else /* !PERL_OBJECT */ |
1492 | |
1493 | EXTERN_C PerlInterpreter* |
1494 | perl_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 |
1502 | #endif /* PERL_IMPLICIT_SYS */ |
1503 | |
3075ddba |
1504 | extern HANDLE w32_perldll_handle; |
c5be433b |
1505 | static DWORD g_TlsAllocIndex; |
1506 | |
1507 | EXTERN_C DllExport bool |
1508 | SetPerlInterpreter(void *interp) |
1509 | { |
1510 | return TlsSetValue(g_TlsAllocIndex, interp); |
1511 | } |
1512 | |
1513 | EXTERN_C DllExport void* |
1514 | GetPerlInterpreter(void) |
1515 | { |
1516 | return TlsGetValue(g_TlsAllocIndex); |
1517 | } |
1518 | |
1519 | EXTERN_C DllExport int |
0cb96387 |
1520 | RunPerl(int argc, char **argv, char **env) |
0a753a76 |
1521 | { |
68dc0745 |
1522 | int exitstatus; |
1523 | PerlInterpreter *my_perl; |
4f63d024 |
1524 | struct perl_thread *thr; |
0a753a76 |
1525 | |
0cb96387 |
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 |
1538 | #ifdef PERL_GLOBAL_STRUCT |
1539 | #define PERLVAR(var,type) /**/ |
51371543 |
1540 | #define PERLVARA(var,type) /**/ |
533c011a |
1541 | #define PERLVARI(var,type,init) PL_Vars.var = init; |
1542 | #define PERLVARIC(var,type,init) PL_Vars.var = init; |
22239a37 |
1543 | #include "perlvars.h" |
1544 | #undef PERLVAR |
51371543 |
1545 | #undef PERLVARA |
22239a37 |
1546 | #undef PERLVARI |
3fe35a81 |
1547 | #undef PERLVARIC |
22239a37 |
1548 | #endif |
1549 | |
0a753a76 |
1550 | PERL_SYS_INIT(&argc,&argv); |
1551 | |
68dc0745 |
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 |
1558 | if (!exitstatus) { |
1559 | exitstatus = perl_run( my_perl ); |
1560 | } |
1561 | |
0a753a76 |
1562 | perl_destruct( my_perl ); |
1563 | perl_free( my_perl ); |
1564 | |
1565 | PERL_SYS_TERM(); |
1566 | |
68dc0745 |
1567 | return (exitstatus); |
0a753a76 |
1568 | } |
1569 | |
68dc0745 |
1570 | BOOL APIENTRY |
1571 | DllMain(HANDLE hModule, /* DLL module handle */ |
1572 | DWORD fdwReason, /* reason called */ |
1573 | LPVOID lpvReserved) /* reserved */ |
0a753a76 |
1574 | { |
68dc0745 |
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 |
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 |
1587 | g_TlsAllocIndex = TlsAlloc(); |
1588 | DisableThreadLibraryCalls(hModule); |
2d7a9237 |
1589 | w32_perldll_handle = hModule; |
68dc0745 |
1590 | break; |
0a753a76 |
1591 | |
68dc0745 |
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 |
1599 | /* The attached process creates a new thread. */ |
1600 | case DLL_THREAD_ATTACH: |
1601 | break; |
0a753a76 |
1602 | |
68dc0745 |
1603 | /* The thread of the attached process terminates. */ |
1604 | case DLL_THREAD_DETACH: |
1605 | break; |
0a753a76 |
1606 | |
68dc0745 |
1607 | default: |
1608 | break; |
1609 | } |
1610 | return TRUE; |
0a753a76 |
1611 | } |
8b10511d |
1612 | |