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 | |
6b980173 |
551 | int |
552 | PerlLIOLink(struct IPerlLIO*, const char*oldname, const char *newname) |
553 | { |
554 | return win32_link(oldname, newname); |
555 | } |
556 | |
0cb96387 |
557 | long |
32e30700 |
558 | PerlLIOLseek(struct IPerlLIO *I, int handle, long offset, int origin) |
0cb96387 |
559 | { |
560 | return win32_lseek(handle, offset, origin); |
561 | } |
562 | |
563 | int |
564 | PerlLIOLstat(struct IPerlLIO* p, const char *path, struct stat *buffer) |
565 | { |
566 | return win32_stat(path, buffer); |
567 | } |
568 | |
569 | char* |
32e30700 |
570 | PerlLIOMktemp(struct IPerlLIO *I, char *Template) |
0cb96387 |
571 | { |
572 | return mktemp(Template); |
573 | } |
574 | |
575 | int |
32e30700 |
576 | PerlLIOOpen(struct IPerlLIO *I, const char *filename, int oflag) |
0cb96387 |
577 | { |
578 | return win32_open(filename, oflag); |
579 | } |
580 | |
581 | int |
32e30700 |
582 | PerlLIOOpen3(struct IPerlLIO *I, const char *filename, int oflag, int pmode) |
0cb96387 |
583 | { |
584 | int ret; |
585 | if(stricmp(filename, "/dev/null") == 0) |
586 | ret = open("NUL", oflag, pmode); |
587 | else |
588 | ret = open(filename, oflag, pmode); |
589 | |
590 | return ret; |
591 | } |
592 | |
593 | int |
32e30700 |
594 | PerlLIORead(struct IPerlLIO *I, int handle, void *buffer, unsigned int count) |
0cb96387 |
595 | { |
596 | return win32_read(handle, buffer, count); |
597 | } |
598 | |
599 | int |
32e30700 |
600 | PerlLIORename(struct IPerlLIO *I, const char *OldFileName, const char *newname) |
0cb96387 |
601 | { |
602 | return win32_rename(OldFileName, newname); |
603 | } |
604 | |
605 | int |
32e30700 |
606 | PerlLIOSetmode(struct IPerlLIO *I, int handle, int mode) |
0cb96387 |
607 | { |
608 | return win32_setmode(handle, mode); |
609 | } |
610 | |
611 | int |
32e30700 |
612 | PerlLIONameStat(struct IPerlLIO *I, const char *path, struct stat *buffer) |
0cb96387 |
613 | { |
614 | return win32_stat(path, buffer); |
615 | } |
616 | |
617 | char* |
32e30700 |
618 | PerlLIOTmpnam(struct IPerlLIO *I, char *string) |
0cb96387 |
619 | { |
620 | return tmpnam(string); |
621 | } |
622 | |
623 | int |
32e30700 |
624 | PerlLIOUmask(struct IPerlLIO *I, int pmode) |
0cb96387 |
625 | { |
626 | return umask(pmode); |
627 | } |
628 | |
629 | int |
32e30700 |
630 | PerlLIOUnlink(struct IPerlLIO *I, const char *filename) |
0cb96387 |
631 | { |
632 | chmod(filename, S_IREAD | S_IWRITE); |
633 | return unlink(filename); |
634 | } |
635 | |
636 | int |
32e30700 |
637 | PerlLIOUtime(struct IPerlLIO *I, char *filename, struct utimbuf *times) |
0cb96387 |
638 | { |
639 | return win32_utime(filename, times); |
640 | } |
641 | |
642 | int |
32e30700 |
643 | PerlLIOWrite(struct IPerlLIO *I, int handle, const void *buffer, unsigned int count) |
0cb96387 |
644 | { |
645 | return win32_write(handle, buffer, count); |
646 | } |
647 | |
648 | struct IPerlLIO perlLIO = |
649 | { |
650 | PerlLIOAccess, |
651 | PerlLIOChmod, |
652 | PerlLIOChown, |
653 | PerlLIOChsize, |
654 | PerlLIOClose, |
655 | PerlLIODup, |
656 | PerlLIODup2, |
657 | PerlLIOFlock, |
658 | PerlLIOFileStat, |
659 | PerlLIOIOCtl, |
660 | PerlLIOIsatty, |
6b980173 |
661 | PerlLIOLink, |
0cb96387 |
662 | PerlLIOLseek, |
663 | PerlLIOLstat, |
664 | PerlLIOMktemp, |
665 | PerlLIOOpen, |
666 | PerlLIOOpen3, |
667 | PerlLIORead, |
668 | PerlLIORename, |
669 | PerlLIOSetmode, |
670 | PerlLIONameStat, |
671 | PerlLIOTmpnam, |
672 | PerlLIOUmask, |
673 | PerlLIOUnlink, |
674 | PerlLIOUtime, |
675 | PerlLIOWrite, |
676 | }; |
677 | |
32e30700 |
678 | /* IPerlDIR */ |
0cb96387 |
679 | int |
32e30700 |
680 | PerlDirMakedir(struct IPerlDir *I, const char *dirname, int mode) |
0cb96387 |
681 | { |
682 | return win32_mkdir(dirname, mode); |
683 | } |
684 | |
685 | int |
32e30700 |
686 | PerlDirChdir(struct IPerlDir *I, const char *dirname) |
0cb96387 |
687 | { |
688 | return win32_chdir(dirname); |
689 | } |
690 | |
691 | int |
32e30700 |
692 | PerlDirRmdir(struct IPerlDir *I, const char *dirname) |
0cb96387 |
693 | { |
694 | return win32_rmdir(dirname); |
695 | } |
696 | |
697 | int |
32e30700 |
698 | PerlDirClose(struct IPerlDir *I, DIR *dirp) |
0cb96387 |
699 | { |
700 | return win32_closedir(dirp); |
701 | } |
702 | |
703 | DIR* |
32e30700 |
704 | PerlDirOpen(struct IPerlDir *I, char *filename) |
0cb96387 |
705 | { |
706 | return win32_opendir(filename); |
707 | } |
708 | |
709 | struct direct * |
32e30700 |
710 | PerlDirRead(struct IPerlDir *I, DIR *dirp) |
0cb96387 |
711 | { |
712 | return win32_readdir(dirp); |
713 | } |
714 | |
715 | void |
32e30700 |
716 | PerlDirRewind(struct IPerlDir *I, DIR *dirp) |
0cb96387 |
717 | { |
718 | win32_rewinddir(dirp); |
719 | } |
720 | |
721 | void |
32e30700 |
722 | PerlDirSeek(struct IPerlDir *I, DIR *dirp, long loc) |
0cb96387 |
723 | { |
724 | win32_seekdir(dirp, loc); |
725 | } |
726 | |
727 | long |
32e30700 |
728 | PerlDirTell(struct IPerlDir *I, DIR *dirp) |
0cb96387 |
729 | { |
730 | return win32_telldir(dirp); |
731 | } |
732 | |
733 | struct IPerlDir perlDir = |
734 | { |
735 | PerlDirMakedir, |
736 | PerlDirChdir, |
737 | PerlDirRmdir, |
738 | PerlDirClose, |
739 | PerlDirOpen, |
740 | PerlDirRead, |
741 | PerlDirRewind, |
742 | PerlDirSeek, |
743 | PerlDirTell, |
744 | }; |
745 | |
746 | |
32e30700 |
747 | /* IPerlSock */ |
0cb96387 |
748 | u_long |
32e30700 |
749 | PerlSockHtonl(struct IPerlSock *I, u_long hostlong) |
0cb96387 |
750 | { |
751 | return win32_htonl(hostlong); |
752 | } |
753 | |
754 | u_short |
32e30700 |
755 | PerlSockHtons(struct IPerlSock *I, u_short hostshort) |
0cb96387 |
756 | { |
757 | return win32_htons(hostshort); |
758 | } |
759 | |
760 | u_long |
32e30700 |
761 | PerlSockNtohl(struct IPerlSock *I, u_long netlong) |
0cb96387 |
762 | { |
763 | return win32_ntohl(netlong); |
764 | } |
765 | |
766 | u_short |
32e30700 |
767 | PerlSockNtohs(struct IPerlSock *I, u_short netshort) |
0cb96387 |
768 | { |
769 | return win32_ntohs(netshort); |
770 | } |
771 | |
32e30700 |
772 | SOCKET PerlSockAccept(struct IPerlSock *I, SOCKET s, struct sockaddr* addr, int* addrlen) |
0cb96387 |
773 | { |
774 | return win32_accept(s, addr, addrlen); |
775 | } |
776 | |
777 | int |
32e30700 |
778 | PerlSockBind(struct IPerlSock *I, SOCKET s, const struct sockaddr* name, int namelen) |
0cb96387 |
779 | { |
780 | return win32_bind(s, name, namelen); |
781 | } |
782 | |
783 | int |
32e30700 |
784 | PerlSockConnect(struct IPerlSock *I, SOCKET s, const struct sockaddr* name, int namelen) |
0cb96387 |
785 | { |
786 | return win32_connect(s, name, namelen); |
787 | } |
788 | |
789 | void |
32e30700 |
790 | PerlSockEndhostent(struct IPerlSock *I) |
0cb96387 |
791 | { |
792 | win32_endhostent(); |
793 | } |
794 | |
795 | void |
32e30700 |
796 | PerlSockEndnetent(struct IPerlSock *I) |
0cb96387 |
797 | { |
798 | win32_endnetent(); |
799 | } |
800 | |
801 | void |
32e30700 |
802 | PerlSockEndprotoent(struct IPerlSock *I) |
0cb96387 |
803 | { |
804 | win32_endprotoent(); |
805 | } |
806 | |
807 | void |
32e30700 |
808 | PerlSockEndservent(struct IPerlSock *I) |
0cb96387 |
809 | { |
810 | win32_endservent(); |
811 | } |
812 | |
813 | struct hostent* |
32e30700 |
814 | PerlSockGethostbyaddr(struct IPerlSock *I, const char* addr, int len, int type) |
0cb96387 |
815 | { |
816 | return win32_gethostbyaddr(addr, len, type); |
817 | } |
818 | |
819 | struct hostent* |
32e30700 |
820 | PerlSockGethostbyname(struct IPerlSock *I, const char* name) |
0cb96387 |
821 | { |
822 | return win32_gethostbyname(name); |
823 | } |
824 | |
825 | struct hostent* |
32e30700 |
826 | PerlSockGethostent(struct IPerlSock *I) |
0cb96387 |
827 | { |
c5be433b |
828 | dTHXo; |
32e30700 |
829 | Perl_croak(aTHX_ "gethostent not implemented!\n"); |
0cb96387 |
830 | return NULL; |
831 | } |
832 | |
833 | int |
32e30700 |
834 | PerlSockGethostname(struct IPerlSock *I, char* name, int namelen) |
0cb96387 |
835 | { |
836 | return win32_gethostname(name, namelen); |
837 | } |
838 | |
839 | struct netent * |
32e30700 |
840 | PerlSockGetnetbyaddr(struct IPerlSock *I, long net, int type) |
0cb96387 |
841 | { |
842 | return win32_getnetbyaddr(net, type); |
843 | } |
844 | |
845 | struct netent * |
32e30700 |
846 | PerlSockGetnetbyname(struct IPerlSock *I, const char *name) |
0cb96387 |
847 | { |
848 | return win32_getnetbyname((char*)name); |
849 | } |
850 | |
851 | struct netent * |
32e30700 |
852 | PerlSockGetnetent(struct IPerlSock *I) |
0cb96387 |
853 | { |
854 | return win32_getnetent(); |
855 | } |
856 | |
32e30700 |
857 | int PerlSockGetpeername(struct IPerlSock *I, SOCKET s, struct sockaddr* name, int* namelen) |
0cb96387 |
858 | { |
859 | return win32_getpeername(s, name, namelen); |
860 | } |
861 | |
862 | struct protoent* |
32e30700 |
863 | PerlSockGetprotobyname(struct IPerlSock *I, const char* name) |
0cb96387 |
864 | { |
865 | return win32_getprotobyname(name); |
866 | } |
867 | |
868 | struct protoent* |
32e30700 |
869 | PerlSockGetprotobynumber(struct IPerlSock *I, int number) |
0cb96387 |
870 | { |
871 | return win32_getprotobynumber(number); |
872 | } |
873 | |
874 | struct protoent* |
32e30700 |
875 | PerlSockGetprotoent(struct IPerlSock *I) |
0cb96387 |
876 | { |
877 | return win32_getprotoent(); |
878 | } |
879 | |
880 | struct servent* |
32e30700 |
881 | PerlSockGetservbyname(struct IPerlSock *I, const char* name, const char* proto) |
0cb96387 |
882 | { |
883 | return win32_getservbyname(name, proto); |
884 | } |
885 | |
886 | struct servent* |
32e30700 |
887 | PerlSockGetservbyport(struct IPerlSock *I, int port, const char* proto) |
0cb96387 |
888 | { |
889 | return win32_getservbyport(port, proto); |
890 | } |
891 | |
892 | struct servent* |
32e30700 |
893 | PerlSockGetservent(struct IPerlSock *I) |
0cb96387 |
894 | { |
895 | return win32_getservent(); |
896 | } |
897 | |
898 | int |
32e30700 |
899 | PerlSockGetsockname(struct IPerlSock *I, SOCKET s, struct sockaddr* name, int* namelen) |
0cb96387 |
900 | { |
901 | return win32_getsockname(s, name, namelen); |
902 | } |
903 | |
904 | int |
32e30700 |
905 | PerlSockGetsockopt(struct IPerlSock *I, SOCKET s, int level, int optname, char* optval, int* optlen) |
0cb96387 |
906 | { |
907 | return win32_getsockopt(s, level, optname, optval, optlen); |
908 | } |
909 | |
910 | unsigned long |
32e30700 |
911 | PerlSockInetAddr(struct IPerlSock *I, const char* cp) |
0cb96387 |
912 | { |
913 | return win32_inet_addr(cp); |
914 | } |
915 | |
916 | char* |
32e30700 |
917 | PerlSockInetNtoa(struct IPerlSock *I, struct in_addr in) |
0cb96387 |
918 | { |
919 | return win32_inet_ntoa(in); |
920 | } |
921 | |
922 | int |
32e30700 |
923 | PerlSockListen(struct IPerlSock *I, SOCKET s, int backlog) |
0cb96387 |
924 | { |
925 | return win32_listen(s, backlog); |
926 | } |
927 | |
928 | int |
32e30700 |
929 | PerlSockRecv(struct IPerlSock *I, SOCKET s, char* buffer, int len, int flags) |
0cb96387 |
930 | { |
931 | return win32_recv(s, buffer, len, flags); |
932 | } |
933 | |
934 | int |
32e30700 |
935 | PerlSockRecvfrom(struct IPerlSock *I, SOCKET s, char* buffer, int len, int flags, struct sockaddr* from, int* fromlen) |
0cb96387 |
936 | { |
937 | return win32_recvfrom(s, buffer, len, flags, from, fromlen); |
938 | } |
939 | |
940 | int |
32e30700 |
941 | PerlSockSelect(struct IPerlSock *I, int nfds, char* readfds, char* writefds, char* exceptfds, const struct timeval* timeout) |
0cb96387 |
942 | { |
943 | return win32_select(nfds, (Perl_fd_set*)readfds, (Perl_fd_set*)writefds, (Perl_fd_set*)exceptfds, timeout); |
944 | } |
945 | |
946 | int |
32e30700 |
947 | PerlSockSend(struct IPerlSock *I, SOCKET s, const char* buffer, int len, int flags) |
0cb96387 |
948 | { |
949 | return win32_send(s, buffer, len, flags); |
950 | } |
951 | |
952 | int |
32e30700 |
953 | PerlSockSendto(struct IPerlSock *I, SOCKET s, const char* buffer, int len, int flags, const struct sockaddr* to, int tolen) |
0cb96387 |
954 | { |
955 | return win32_sendto(s, buffer, len, flags, to, tolen); |
956 | } |
957 | |
958 | void |
32e30700 |
959 | PerlSockSethostent(struct IPerlSock *I, int stayopen) |
0cb96387 |
960 | { |
961 | win32_sethostent(stayopen); |
962 | } |
963 | |
964 | void |
32e30700 |
965 | PerlSockSetnetent(struct IPerlSock *I, int stayopen) |
0cb96387 |
966 | { |
967 | win32_setnetent(stayopen); |
968 | } |
969 | |
970 | void |
32e30700 |
971 | PerlSockSetprotoent(struct IPerlSock *I, int stayopen) |
0cb96387 |
972 | { |
973 | win32_setprotoent(stayopen); |
974 | } |
975 | |
976 | void |
32e30700 |
977 | PerlSockSetservent(struct IPerlSock *I, int stayopen) |
0cb96387 |
978 | { |
979 | win32_setservent(stayopen); |
980 | } |
981 | |
982 | int |
32e30700 |
983 | PerlSockSetsockopt(struct IPerlSock *I, SOCKET s, int level, int optname, const char* optval, int optlen) |
0cb96387 |
984 | { |
985 | return win32_setsockopt(s, level, optname, optval, optlen); |
986 | } |
987 | |
988 | int |
32e30700 |
989 | PerlSockShutdown(struct IPerlSock *I, SOCKET s, int how) |
0cb96387 |
990 | { |
991 | return win32_shutdown(s, how); |
992 | } |
993 | |
994 | SOCKET |
32e30700 |
995 | PerlSockSocket(struct IPerlSock *I, int af, int type, int protocol) |
0cb96387 |
996 | { |
997 | return win32_socket(af, type, protocol); |
998 | } |
999 | |
1000 | int |
32e30700 |
1001 | PerlSockSocketpair(struct IPerlSock *I, int domain, int type, int protocol, int* fds) |
0cb96387 |
1002 | { |
c5be433b |
1003 | dTHXo; |
32e30700 |
1004 | Perl_croak(aTHX_ "socketpair not implemented!\n"); |
0cb96387 |
1005 | return 0; |
1006 | } |
1007 | |
1008 | int |
32e30700 |
1009 | PerlSockClosesocket(struct IPerlSock *I, SOCKET s) |
0cb96387 |
1010 | { |
1011 | return win32_closesocket(s); |
1012 | } |
1013 | |
1014 | int |
32e30700 |
1015 | PerlSockIoctlsocket(struct IPerlSock *I, SOCKET s, long cmd, u_long *argp) |
0cb96387 |
1016 | { |
1017 | return win32_ioctlsocket(s, cmd, argp); |
1018 | } |
1019 | |
1020 | struct IPerlSock perlSock = |
1021 | { |
1022 | PerlSockHtonl, |
1023 | PerlSockHtons, |
1024 | PerlSockNtohl, |
1025 | PerlSockNtohs, |
1026 | PerlSockAccept, |
1027 | PerlSockBind, |
1028 | PerlSockConnect, |
1029 | PerlSockEndhostent, |
1030 | PerlSockEndnetent, |
1031 | PerlSockEndprotoent, |
1032 | PerlSockEndservent, |
1033 | PerlSockGethostname, |
1034 | PerlSockGetpeername, |
1035 | PerlSockGethostbyaddr, |
1036 | PerlSockGethostbyname, |
1037 | PerlSockGethostent, |
1038 | PerlSockGetnetbyaddr, |
1039 | PerlSockGetnetbyname, |
1040 | PerlSockGetnetent, |
1041 | PerlSockGetprotobyname, |
1042 | PerlSockGetprotobynumber, |
1043 | PerlSockGetprotoent, |
1044 | PerlSockGetservbyname, |
1045 | PerlSockGetservbyport, |
1046 | PerlSockGetservent, |
1047 | PerlSockGetsockname, |
1048 | PerlSockGetsockopt, |
1049 | PerlSockInetAddr, |
1050 | PerlSockInetNtoa, |
1051 | PerlSockListen, |
1052 | PerlSockRecv, |
1053 | PerlSockRecvfrom, |
1054 | PerlSockSelect, |
1055 | PerlSockSend, |
1056 | PerlSockSendto, |
1057 | PerlSockSethostent, |
1058 | PerlSockSetnetent, |
1059 | PerlSockSetprotoent, |
1060 | PerlSockSetservent, |
1061 | PerlSockSetsockopt, |
1062 | PerlSockShutdown, |
1063 | PerlSockSocket, |
1064 | PerlSockSocketpair, |
1065 | PerlSockClosesocket, |
1066 | }; |
1067 | |
1068 | |
32e30700 |
1069 | /* IPerlProc */ |
0cb96387 |
1070 | |
1071 | #define EXECF_EXEC 1 |
1072 | #define EXECF_SPAWN 2 |
1073 | |
1074 | extern char * g_getlogin(void); |
1075 | extern int do_spawn2(char *cmd, int exectype); |
32e30700 |
1076 | #ifdef PERL_OBJECT |
0cb96387 |
1077 | extern int g_do_aspawn(void *vreally, void **vmark, void **vsp); |
32e30700 |
1078 | #define do_aspawn g_do_aspawn |
1079 | #endif |
1080 | EXTERN_C PerlInterpreter* perl_alloc_using(struct IPerlMem* pMem, |
1081 | struct IPerlEnv* pEnv, struct IPerlStdIO* pStdIO, |
1082 | struct IPerlLIO* pLIO, struct IPerlDir* pDir, |
1083 | struct IPerlSock* pSock, struct IPerlProc* pProc); |
0cb96387 |
1084 | |
1085 | void |
32e30700 |
1086 | PerlProcAbort(struct IPerlProc *I) |
0cb96387 |
1087 | { |
1088 | win32_abort(); |
1089 | } |
1090 | |
1091 | char * |
32e30700 |
1092 | PerlProcCrypt(struct IPerlProc *I, const char* clear, const char* salt) |
0cb96387 |
1093 | { |
1094 | return win32_crypt(clear, salt); |
1095 | } |
1096 | |
1097 | void |
32e30700 |
1098 | PerlProcExit(struct IPerlProc *I, int status) |
0cb96387 |
1099 | { |
1100 | exit(status); |
1101 | } |
1102 | |
1103 | void |
32e30700 |
1104 | PerlProc_Exit(struct IPerlProc *I, int status) |
0cb96387 |
1105 | { |
1106 | _exit(status); |
1107 | } |
1108 | |
1109 | int |
32e30700 |
1110 | PerlProcExecl(struct IPerlProc *I, const char *cmdname, const char *arg0, const char *arg1, const char *arg2, const char *arg3) |
0cb96387 |
1111 | { |
1112 | return execl(cmdname, arg0, arg1, arg2, arg3); |
1113 | } |
1114 | |
1115 | int |
32e30700 |
1116 | PerlProcExecv(struct IPerlProc *I, const char *cmdname, const char *const *argv) |
0cb96387 |
1117 | { |
1118 | return win32_execvp(cmdname, argv); |
1119 | } |
1120 | |
1121 | int |
32e30700 |
1122 | PerlProcExecvp(struct IPerlProc *I, const char *cmdname, const char *const *argv) |
0cb96387 |
1123 | { |
1124 | return win32_execvp(cmdname, argv); |
1125 | } |
1126 | |
1127 | uid_t |
32e30700 |
1128 | PerlProcGetuid(struct IPerlProc *I) |
0cb96387 |
1129 | { |
1130 | return getuid(); |
1131 | } |
1132 | |
1133 | uid_t |
32e30700 |
1134 | PerlProcGeteuid(struct IPerlProc *I) |
0cb96387 |
1135 | { |
1136 | return geteuid(); |
1137 | } |
1138 | |
1139 | gid_t |
32e30700 |
1140 | PerlProcGetgid(struct IPerlProc *I) |
0cb96387 |
1141 | { |
1142 | return getgid(); |
1143 | } |
1144 | |
1145 | gid_t |
32e30700 |
1146 | PerlProcGetegid(struct IPerlProc *I) |
0cb96387 |
1147 | { |
1148 | return getegid(); |
1149 | } |
1150 | |
1151 | char * |
32e30700 |
1152 | PerlProcGetlogin(struct IPerlProc *I) |
0cb96387 |
1153 | { |
1154 | return g_getlogin(); |
1155 | } |
1156 | |
1157 | int |
32e30700 |
1158 | PerlProcKill(struct IPerlProc *I, int pid, int sig) |
0cb96387 |
1159 | { |
1160 | return win32_kill(pid, sig); |
1161 | } |
1162 | |
1163 | int |
32e30700 |
1164 | PerlProcKillpg(struct IPerlProc *I, int pid, int sig) |
0cb96387 |
1165 | { |
c5be433b |
1166 | dTHXo; |
32e30700 |
1167 | Perl_croak(aTHX_ "killpg not implemented!\n"); |
0cb96387 |
1168 | return 0; |
1169 | } |
1170 | |
1171 | int |
32e30700 |
1172 | PerlProcPauseProc(struct IPerlProc *I) |
0cb96387 |
1173 | { |
1174 | return win32_sleep((32767L << 16) + 32767); |
1175 | } |
1176 | |
1177 | PerlIO* |
32e30700 |
1178 | PerlProcPopen(struct IPerlProc *I, const char *command, const char *mode) |
0cb96387 |
1179 | { |
12b99c39 |
1180 | dTHXo; |
32e30700 |
1181 | PERL_FLUSHALL_FOR_CHILD; |
0cb96387 |
1182 | return (PerlIO*)win32_popen(command, mode); |
1183 | } |
1184 | |
1185 | int |
32e30700 |
1186 | PerlProcPclose(struct IPerlProc *I, PerlIO *stream) |
0cb96387 |
1187 | { |
1188 | return win32_pclose((FILE*)stream); |
1189 | } |
1190 | |
1191 | int |
32e30700 |
1192 | PerlProcPipe(struct IPerlProc *I, int *phandles) |
0cb96387 |
1193 | { |
1194 | return win32_pipe(phandles, 512, O_BINARY); |
1195 | } |
1196 | |
1197 | int |
32e30700 |
1198 | PerlProcSetuid(struct IPerlProc *I, uid_t u) |
0cb96387 |
1199 | { |
1200 | return setuid(u); |
1201 | } |
1202 | |
1203 | int |
32e30700 |
1204 | PerlProcSetgid(struct IPerlProc *I, gid_t g) |
0cb96387 |
1205 | { |
1206 | return setgid(g); |
1207 | } |
1208 | |
1209 | int |
32e30700 |
1210 | PerlProcSleep(struct IPerlProc *I, unsigned int s) |
0cb96387 |
1211 | { |
1212 | return win32_sleep(s); |
1213 | } |
1214 | |
1215 | int |
32e30700 |
1216 | PerlProcTimes(struct IPerlProc *I, struct tms *timebuf) |
0cb96387 |
1217 | { |
1218 | return win32_times(timebuf); |
1219 | } |
1220 | |
1221 | int |
32e30700 |
1222 | PerlProcWait(struct IPerlProc *I, int *status) |
0cb96387 |
1223 | { |
1224 | return win32_wait(status); |
1225 | } |
1226 | |
1227 | int |
32e30700 |
1228 | PerlProcWaitpid(struct IPerlProc *I, int pid, int *status, int flags) |
0cb96387 |
1229 | { |
1230 | return win32_waitpid(pid, status, flags); |
1231 | } |
1232 | |
1233 | Sighandler_t |
32e30700 |
1234 | PerlProcSignal(struct IPerlProc *I, int sig, Sighandler_t subcode) |
0cb96387 |
1235 | { |
1236 | return 0; |
1237 | } |
1238 | |
1239 | void* |
32e30700 |
1240 | PerlProcDynaLoader(struct IPerlProc *I, const char* filename) |
0cb96387 |
1241 | { |
1242 | return win32_dynaload(filename); |
1243 | } |
1244 | |
1245 | void |
32e30700 |
1246 | PerlProcGetOSError(struct IPerlProc *I, SV* sv, DWORD dwErr) |
0cb96387 |
1247 | { |
32e30700 |
1248 | win32_str_os_error(sv, dwErr); |
0cb96387 |
1249 | } |
1250 | |
1251 | BOOL |
32e30700 |
1252 | PerlProcDoCmd(struct IPerlProc *I, char *cmd) |
0cb96387 |
1253 | { |
1254 | do_spawn2(cmd, EXECF_EXEC); |
1255 | return FALSE; |
1256 | } |
1257 | |
1258 | int |
32e30700 |
1259 | PerlProcSpawn(struct IPerlProc *I, char* cmds) |
0cb96387 |
1260 | { |
1261 | return do_spawn2(cmds, EXECF_SPAWN); |
1262 | } |
1263 | |
1264 | int |
32e30700 |
1265 | PerlProcSpawnvp(struct IPerlProc *I, int mode, const char *cmdname, const char *const *argv) |
0cb96387 |
1266 | { |
1267 | return win32_spawnvp(mode, cmdname, argv); |
1268 | } |
1269 | |
1270 | int |
32e30700 |
1271 | PerlProcASpawn(struct IPerlProc *I, void *vreally, void **vmark, void **vsp) |
0cb96387 |
1272 | { |
32e30700 |
1273 | return do_aspawn(vreally, vmark, vsp); |
0cb96387 |
1274 | } |
1275 | |
1276 | struct IPerlProc perlProc = |
1277 | { |
1278 | PerlProcAbort, |
1279 | PerlProcCrypt, |
1280 | PerlProcExit, |
1281 | PerlProc_Exit, |
1282 | PerlProcExecl, |
1283 | PerlProcExecv, |
1284 | PerlProcExecvp, |
1285 | PerlProcGetuid, |
1286 | PerlProcGeteuid, |
1287 | PerlProcGetgid, |
1288 | PerlProcGetegid, |
1289 | PerlProcGetlogin, |
1290 | PerlProcKill, |
1291 | PerlProcKillpg, |
1292 | PerlProcPauseProc, |
1293 | PerlProcPopen, |
1294 | PerlProcPclose, |
1295 | PerlProcPipe, |
1296 | PerlProcSetuid, |
1297 | PerlProcSetgid, |
1298 | PerlProcSleep, |
1299 | PerlProcTimes, |
1300 | PerlProcWait, |
1301 | PerlProcWaitpid, |
1302 | PerlProcSignal, |
1303 | PerlProcDynaLoader, |
1304 | PerlProcGetOSError, |
1305 | PerlProcDoCmd, |
1306 | PerlProcSpawn, |
1307 | PerlProcSpawnvp, |
1308 | PerlProcASpawn, |
1309 | }; |
1310 | |
32e30700 |
1311 | /*#include "perlhost.h" */ |
0cb96387 |
1312 | |
0cb96387 |
1313 | |
32e30700 |
1314 | EXTERN_C void |
1315 | perl_get_host_info(struct IPerlMemInfo* perlMemInfo, |
1316 | struct IPerlEnvInfo* perlEnvInfo, |
1317 | struct IPerlStdIOInfo* perlStdIOInfo, |
1318 | struct IPerlLIOInfo* perlLIOInfo, |
1319 | struct IPerlDirInfo* perlDirInfo, |
1320 | struct IPerlSockInfo* perlSockInfo, |
1321 | struct IPerlProcInfo* perlProcInfo) |
0cb96387 |
1322 | { |
1323 | if(perlMemInfo) { |
1324 | Copy(&perlMem, &perlMemInfo->perlMemList, perlMemInfo->nCount, void*); |
1325 | perlMemInfo->nCount = (sizeof(struct IPerlMem)/sizeof(void*)); |
1326 | } |
1327 | if(perlEnvInfo) { |
1328 | Copy(&perlEnv, &perlEnvInfo->perlEnvList, perlEnvInfo->nCount, void*); |
1329 | perlEnvInfo->nCount = (sizeof(struct IPerlEnv)/sizeof(void*)); |
1330 | } |
1331 | if(perlStdIOInfo) { |
1332 | Copy(&perlStdIO, &perlStdIOInfo->perlStdIOList, perlStdIOInfo->nCount, void*); |
1333 | perlStdIOInfo->nCount = (sizeof(struct IPerlStdIO)/sizeof(void*)); |
1334 | } |
1335 | if(perlLIOInfo) { |
1336 | Copy(&perlLIO, &perlLIOInfo->perlLIOList, perlLIOInfo->nCount, void*); |
1337 | perlLIOInfo->nCount = (sizeof(struct IPerlLIO)/sizeof(void*)); |
1338 | } |
1339 | if(perlDirInfo) { |
1340 | Copy(&perlDir, &perlDirInfo->perlDirList, perlDirInfo->nCount, void*); |
1341 | perlDirInfo->nCount = (sizeof(struct IPerlDir)/sizeof(void*)); |
1342 | } |
1343 | if(perlSockInfo) { |
1344 | Copy(&perlSock, &perlSockInfo->perlSockList, perlSockInfo->nCount, void*); |
1345 | perlSockInfo->nCount = (sizeof(struct IPerlSock)/sizeof(void*)); |
1346 | } |
1347 | if(perlProcInfo) { |
1348 | Copy(&perlProc, &perlProcInfo->perlProcList, perlProcInfo->nCount, void*); |
1349 | perlProcInfo->nCount = (sizeof(struct IPerlProc)/sizeof(void*)); |
1350 | } |
1351 | } |
1352 | |
32e30700 |
1353 | #ifdef PERL_OBJECT |
1354 | |
1355 | EXTERN_C PerlInterpreter* perl_alloc_using(struct IPerlMem* pMem, |
1356 | struct IPerlEnv* pEnv, struct IPerlStdIO* pStdIO, |
1357 | struct IPerlLIO* pLIO, struct IPerlDir* pDir, |
1358 | struct IPerlSock* pSock, struct IPerlProc* pProc) |
0cb96387 |
1359 | { |
1360 | CPerlObj* pPerl = NULL; |
1361 | try |
1362 | { |
1363 | pPerl = Perl_alloc(pMem, pEnv, pStdIO, pLIO, pDir, pSock, pProc); |
1364 | } |
1365 | catch(...) |
1366 | { |
1367 | win32_fprintf(stderr, "%s\n", "Error: Unable to allocate memory"); |
1368 | pPerl = NULL; |
1369 | } |
1370 | if(pPerl) |
1371 | { |
1372 | SetPerlInterpreter(pPerl); |
c5be433b |
1373 | return (PerlInterpreter*)pPerl; |
0cb96387 |
1374 | } |
1375 | SetPerlInterpreter(NULL); |
1376 | return NULL; |
1377 | } |
1378 | |
1379 | #undef perl_alloc |
1380 | #undef perl_construct |
1381 | #undef perl_destruct |
1382 | #undef perl_free |
1383 | #undef perl_run |
1384 | #undef perl_parse |
1385 | EXTERN_C PerlInterpreter* perl_alloc(void) |
1386 | { |
1387 | CPerlObj* pPerl = NULL; |
1388 | try |
1389 | { |
1390 | pPerl = Perl_alloc(&perlMem, &perlEnv, &perlStdIO, &perlLIO, |
1391 | &perlDir, &perlSock, &perlProc); |
1392 | } |
1393 | catch(...) |
1394 | { |
1395 | win32_fprintf(stderr, "%s\n", "Error: Unable to allocate memory"); |
1396 | pPerl = NULL; |
1397 | } |
1398 | if(pPerl) |
1399 | { |
1400 | SetPerlInterpreter(pPerl); |
c5be433b |
1401 | return (PerlInterpreter*)pPerl; |
0cb96387 |
1402 | } |
1403 | SetPerlInterpreter(NULL); |
1404 | return NULL; |
1405 | } |
1406 | |
1407 | EXTERN_C void perl_construct(PerlInterpreter* sv_interp) |
1408 | { |
c5be433b |
1409 | CPerlObj* pPerl = (CPerlObj*)sv_interp; |
0cb96387 |
1410 | try |
1411 | { |
1412 | pPerl->perl_construct(); |
1413 | } |
1414 | catch(...) |
1415 | { |
1416 | win32_fprintf(stderr, "%s\n", |
1417 | "Error: Unable to construct data structures"); |
1418 | pPerl->perl_free(); |
1419 | SetPerlInterpreter(NULL); |
1420 | } |
1421 | } |
1422 | |
1423 | EXTERN_C void perl_destruct(PerlInterpreter* sv_interp) |
1424 | { |
c5be433b |
1425 | CPerlObj* pPerl = (CPerlObj*)sv_interp; |
0cb96387 |
1426 | try |
1427 | { |
1428 | pPerl->perl_destruct(); |
1429 | } |
1430 | catch(...) |
1431 | { |
1432 | } |
1433 | } |
1434 | |
1435 | EXTERN_C void perl_free(PerlInterpreter* sv_interp) |
1436 | { |
c5be433b |
1437 | CPerlObj* pPerl = (CPerlObj*)sv_interp; |
0cb96387 |
1438 | try |
1439 | { |
1440 | pPerl->perl_free(); |
1441 | } |
1442 | catch(...) |
1443 | { |
1444 | } |
1445 | SetPerlInterpreter(NULL); |
1446 | } |
1447 | |
1448 | EXTERN_C int perl_run(PerlInterpreter* sv_interp) |
1449 | { |
c5be433b |
1450 | CPerlObj* pPerl = (CPerlObj*)sv_interp; |
0cb96387 |
1451 | int retVal; |
1452 | try |
1453 | { |
1454 | retVal = pPerl->perl_run(); |
1455 | } |
1456 | /* |
1457 | catch(int x) |
1458 | { |
1459 | // this is where exit() should arrive |
1460 | retVal = x; |
1461 | } |
1462 | */ |
1463 | catch(...) |
1464 | { |
1465 | win32_fprintf(stderr, "Error: Runtime exception\n"); |
1466 | retVal = -1; |
1467 | } |
1468 | return retVal; |
1469 | } |
1470 | |
1471 | EXTERN_C int perl_parse(PerlInterpreter* sv_interp, void (*xsinit)(CPerlObj*), int argc, char** argv, char** env) |
1472 | { |
1473 | int retVal; |
c5be433b |
1474 | CPerlObj* pPerl = (CPerlObj*)sv_interp; |
0cb96387 |
1475 | try |
1476 | { |
3075ddba |
1477 | retVal = pPerl->perl_parse(xsinit, argc, argv, env); |
0cb96387 |
1478 | } |
1479 | /* |
1480 | catch(int x) |
1481 | { |
1482 | // this is where exit() should arrive |
1483 | retVal = x; |
1484 | } |
1485 | */ |
1486 | catch(...) |
1487 | { |
1488 | win32_fprintf(stderr, "Error: Parse exception\n"); |
1489 | retVal = -1; |
1490 | } |
1491 | *win32_errno() = 0; |
1492 | return retVal; |
1493 | } |
1494 | |
1495 | #undef PL_perl_destruct_level |
1496 | #define PL_perl_destruct_level int dummy |
32e30700 |
1497 | |
1498 | #else /* !PERL_OBJECT */ |
1499 | |
1500 | EXTERN_C PerlInterpreter* |
1501 | perl_alloc(void) |
1502 | { |
1503 | return perl_alloc_using(&perlMem, &perlEnv, &perlStdIO, &perlLIO, |
1504 | &perlDir, &perlSock, &perlProc); |
1505 | } |
1506 | |
0cb96387 |
1507 | #endif /* PERL_OBJECT */ |
0a753a76 |
1508 | |
32e30700 |
1509 | #endif /* PERL_IMPLICIT_SYS */ |
1510 | |
3075ddba |
1511 | extern HANDLE w32_perldll_handle; |
c5be433b |
1512 | static DWORD g_TlsAllocIndex; |
1513 | |
1514 | EXTERN_C DllExport bool |
1515 | SetPerlInterpreter(void *interp) |
1516 | { |
1517 | return TlsSetValue(g_TlsAllocIndex, interp); |
1518 | } |
1519 | |
1520 | EXTERN_C DllExport void* |
1521 | GetPerlInterpreter(void) |
1522 | { |
1523 | return TlsGetValue(g_TlsAllocIndex); |
1524 | } |
1525 | |
1526 | EXTERN_C DllExport int |
0cb96387 |
1527 | RunPerl(int argc, char **argv, char **env) |
0a753a76 |
1528 | { |
68dc0745 |
1529 | int exitstatus; |
1530 | PerlInterpreter *my_perl; |
4f63d024 |
1531 | struct perl_thread *thr; |
0a753a76 |
1532 | |
0cb96387 |
1533 | #ifndef __BORLANDC__ |
1534 | /* XXX this _may_ be a problem on some compilers (e.g. Borland) that |
1535 | * want to free() argv after main() returns. As luck would have it, |
1536 | * Borland's CRT does the right thing to argv[0] already. */ |
1537 | char szModuleName[MAX_PATH]; |
1538 | char *ptr; |
1539 | |
1540 | GetModuleFileName(NULL, szModuleName, sizeof(szModuleName)); |
1541 | (void)win32_longpath(szModuleName); |
1542 | argv[0] = szModuleName; |
1543 | #endif |
1544 | |
22239a37 |
1545 | #ifdef PERL_GLOBAL_STRUCT |
1546 | #define PERLVAR(var,type) /**/ |
51371543 |
1547 | #define PERLVARA(var,type) /**/ |
533c011a |
1548 | #define PERLVARI(var,type,init) PL_Vars.var = init; |
1549 | #define PERLVARIC(var,type,init) PL_Vars.var = init; |
22239a37 |
1550 | #include "perlvars.h" |
1551 | #undef PERLVAR |
51371543 |
1552 | #undef PERLVARA |
22239a37 |
1553 | #undef PERLVARI |
3fe35a81 |
1554 | #undef PERLVARIC |
22239a37 |
1555 | #endif |
1556 | |
0a753a76 |
1557 | PERL_SYS_INIT(&argc,&argv); |
1558 | |
68dc0745 |
1559 | if (!(my_perl = perl_alloc())) |
1560 | return (1); |
1561 | perl_construct( my_perl ); |
b28d0864 |
1562 | PL_perl_destruct_level = 0; |
0a753a76 |
1563 | |
4f63d024 |
1564 | exitstatus = perl_parse(my_perl, xs_init, argc, argv, env); |
0a753a76 |
1565 | if (!exitstatus) { |
971a9dd3 |
1566 | #ifdef USE_ITHREADS /* XXXXXX testing */ |
d18c6117 |
1567 | extern PerlInterpreter * perl_clone(pTHXx_ IV flags); |
1568 | |
1569 | PerlInterpreter *new_perl = perl_clone(my_perl, 0); |
971a9dd3 |
1570 | Perl_push_scope(new_perl); /* ENTER; (hack in lieu of perl_destruct()) */ |
d18c6117 |
1571 | exitstatus = perl_run( new_perl ); |
971a9dd3 |
1572 | perl_destruct(new_perl); perl_free(new_perl); |
1573 | SetPerlInterpreter(my_perl); |
d18c6117 |
1574 | #else |
0a753a76 |
1575 | exitstatus = perl_run( my_perl ); |
d18c6117 |
1576 | #endif |
0a753a76 |
1577 | } |
1578 | |
0a753a76 |
1579 | perl_destruct( my_perl ); |
1580 | perl_free( my_perl ); |
1581 | |
1582 | PERL_SYS_TERM(); |
1583 | |
68dc0745 |
1584 | return (exitstatus); |
0a753a76 |
1585 | } |
1586 | |
68dc0745 |
1587 | BOOL APIENTRY |
1588 | DllMain(HANDLE hModule, /* DLL module handle */ |
1589 | DWORD fdwReason, /* reason called */ |
1590 | LPVOID lpvReserved) /* reserved */ |
0a753a76 |
1591 | { |
68dc0745 |
1592 | switch (fdwReason) { |
1593 | /* The DLL is attaching to a process due to process |
1594 | * initialization or a call to LoadLibrary. |
1595 | */ |
1596 | case DLL_PROCESS_ATTACH: |
1597 | /* #define DEFAULT_BINMODE */ |
0a753a76 |
1598 | #ifdef DEFAULT_BINMODE |
3e3baf6d |
1599 | setmode( fileno( stdin ), O_BINARY ); |
1600 | setmode( fileno( stdout ), O_BINARY ); |
1601 | setmode( fileno( stderr ), O_BINARY ); |
1602 | _fmode = O_BINARY; |
0a753a76 |
1603 | #endif |
0cb96387 |
1604 | g_TlsAllocIndex = TlsAlloc(); |
1605 | DisableThreadLibraryCalls(hModule); |
2d7a9237 |
1606 | w32_perldll_handle = hModule; |
68dc0745 |
1607 | break; |
0a753a76 |
1608 | |
68dc0745 |
1609 | /* The DLL is detaching from a process due to |
1610 | * process termination or call to FreeLibrary. |
1611 | */ |
1612 | case DLL_PROCESS_DETACH: |
0cb96387 |
1613 | TlsFree(g_TlsAllocIndex); |
68dc0745 |
1614 | break; |
0a753a76 |
1615 | |
68dc0745 |
1616 | /* The attached process creates a new thread. */ |
1617 | case DLL_THREAD_ATTACH: |
1618 | break; |
0a753a76 |
1619 | |
68dc0745 |
1620 | /* The thread of the attached process terminates. */ |
1621 | case DLL_THREAD_DETACH: |
1622 | break; |
0a753a76 |
1623 | |
68dc0745 |
1624 | default: |
1625 | break; |
1626 | } |
1627 | return TRUE; |
0a753a76 |
1628 | } |
8b10511d |
1629 | |