xref: /openbsd-src/gnu/usr.bin/perl/win32/perlhost.h (revision b2ea75c1b17e1a9a339660e7ed45cd24946b230e) 
1 /* perlhost.h
2  *
3  * (c) 1999 Microsoft Corporation. All rights reserved.
4  * Portions (c) 1999 ActiveState Tool Corp, http://www.ActiveState.com/
5  *
6  *    You may distribute under the terms of either the GNU General Public
7  *    License or the Artistic License, as specified in the README file.
8  */
9 
10 #ifndef ___PerlHost_H___
11 #define ___PerlHost_H___
12 
13 #include <signal.h>
14 #include "iperlsys.h"
15 #include "vmem.h"
16 #include "vdir.h"
17 
18 #if !defined(PERL_OBJECT)
19 START_EXTERN_C
20 #endif
21 extern char *		g_win32_get_privlib(const char *pl);
22 extern char *		g_win32_get_sitelib(const char *pl);
23 extern char *		g_win32_get_vendorlib(const char *pl);
24 extern char *		g_getlogin(void);
25 extern int		do_spawn2(char *cmd, int exectype);
26 #if !defined(PERL_OBJECT)
27 END_EXTERN_C
28 #endif
29 
30 #ifdef PERL_OBJECT
31 extern int		g_do_aspawn(void *vreally, void **vmark, void **vsp);
32 #define do_aspawn	g_do_aspawn
33 #endif
34 
35 class CPerlHost
36 {
37 public:
38     CPerlHost(void);
39     CPerlHost(struct IPerlMem** ppMem, struct IPerlMem** ppMemShared,
40 		 struct IPerlMem** ppMemParse, struct IPerlEnv** ppEnv,
41 		 struct IPerlStdIO** ppStdIO, struct IPerlLIO** ppLIO,
42 		 struct IPerlDir** ppDir, struct IPerlSock** ppSock,
43 		 struct IPerlProc** ppProc);
44     CPerlHost(CPerlHost& host);
45     ~CPerlHost(void);
46 
47     static CPerlHost* IPerlMem2Host(struct IPerlMem* piPerl);
48     static CPerlHost* IPerlMemShared2Host(struct IPerlMem* piPerl);
49     static CPerlHost* IPerlMemParse2Host(struct IPerlMem* piPerl);
50     static CPerlHost* IPerlEnv2Host(struct IPerlEnv* piPerl);
51     static CPerlHost* IPerlStdIO2Host(struct IPerlStdIO* piPerl);
52     static CPerlHost* IPerlLIO2Host(struct IPerlLIO* piPerl);
53     static CPerlHost* IPerlDir2Host(struct IPerlDir* piPerl);
54     static CPerlHost* IPerlSock2Host(struct IPerlSock* piPerl);
55     static CPerlHost* IPerlProc2Host(struct IPerlProc* piPerl);
56 
57     BOOL PerlCreate(void);
58     int PerlParse(int argc, char** argv, char** env);
59     int PerlRun(void);
60     void PerlDestroy(void);
61 
62 /* IPerlMem */
63     inline void* Malloc(size_t size) { return m_pVMem->Malloc(size); };
64     inline void* Realloc(void* ptr, size_t size) { return m_pVMem->Realloc(ptr, size); };
65     inline void Free(void* ptr) { m_pVMem->Free(ptr); };
66     inline void* Calloc(size_t num, size_t size)
67     {
68 	size_t count = num*size;
69 	void* lpVoid = Malloc(count);
70 	if (lpVoid)
71 	    ZeroMemory(lpVoid, count);
72 	return lpVoid;
73     };
74     inline void GetLock(void) { m_pVMem->GetLock(); };
75     inline void FreeLock(void) { m_pVMem->FreeLock(); };
76     inline int IsLocked(void) { return m_pVMem->IsLocked(); };
77 
78 /* IPerlMemShared */
79     inline void* MallocShared(size_t size)
80     {
81 	return m_pVMemShared->Malloc(size);
82     };
83     inline void* ReallocShared(void* ptr, size_t size) { return m_pVMemShared->Realloc(ptr, size); };
84     inline void FreeShared(void* ptr) { m_pVMemShared->Free(ptr); };
85     inline void* CallocShared(size_t num, size_t size)
86     {
87 	size_t count = num*size;
88 	void* lpVoid = MallocShared(count);
89 	if (lpVoid)
90 	    ZeroMemory(lpVoid, count);
91 	return lpVoid;
92     };
93     inline void GetLockShared(void) { m_pVMem->GetLock(); };
94     inline void FreeLockShared(void) { m_pVMem->FreeLock(); };
95     inline int IsLockedShared(void) { return m_pVMem->IsLocked(); };
96 
97 /* IPerlMemParse */
98     inline void* MallocParse(size_t size) { return m_pVMemParse->Malloc(size); };
99     inline void* ReallocParse(void* ptr, size_t size) { return m_pVMemParse->Realloc(ptr, size); };
100     inline void FreeParse(void* ptr) { m_pVMemParse->Free(ptr); };
101     inline void* CallocParse(size_t num, size_t size)
102     {
103 	size_t count = num*size;
104 	void* lpVoid = MallocParse(count);
105 	if (lpVoid)
106 	    ZeroMemory(lpVoid, count);
107 	return lpVoid;
108     };
109     inline void GetLockParse(void) { m_pVMem->GetLock(); };
110     inline void FreeLockParse(void) { m_pVMem->FreeLock(); };
111     inline int IsLockedParse(void) { return m_pVMem->IsLocked(); };
112 
113 /* IPerlEnv */
114     char *Getenv(const char *varname);
115     int Putenv(const char *envstring);
116     inline char *Getenv(const char *varname, unsigned long *len)
117     {
118 	*len = 0;
119 	char *e = Getenv(varname);
120 	if (e)
121 	    *len = strlen(e);
122 	return e;
123     }
124     void* CreateChildEnv(void) { return CreateLocalEnvironmentStrings(*m_pvDir); };
125     void FreeChildEnv(void* pStr) { FreeLocalEnvironmentStrings((char*)pStr); };
126     char* GetChildDir(void);
127     void FreeChildDir(char* pStr);
128     void Reset(void);
129     void Clearenv(void);
130 
131     inline LPSTR GetIndex(DWORD &dwIndex)
132     {
133 	if(dwIndex < m_dwEnvCount)
134 	{
135 	    ++dwIndex;
136 	    return m_lppEnvList[dwIndex-1];
137 	}
138 	return NULL;
139     };
140 
141 protected:
142     LPSTR Find(LPCSTR lpStr);
143     void Add(LPCSTR lpStr);
144 
145     LPSTR CreateLocalEnvironmentStrings(VDir &vDir);
146     void FreeLocalEnvironmentStrings(LPSTR lpStr);
147     LPSTR* Lookup(LPCSTR lpStr);
148     DWORD CalculateEnvironmentSpace(void);
149 
150 public:
151 
152 /* IPerlDIR */
153     virtual int Chdir(const char *dirname);
154 
155 /* IPerllProc */
156     void Abort(void);
157     void Exit(int status);
158     void _Exit(int status);
159     int Execl(const char *cmdname, const char *arg0, const char *arg1, const char *arg2, const char *arg3);
160     int Execv(const char *cmdname, const char *const *argv);
161     int Execvp(const char *cmdname, const char *const *argv);
162 
163     inline VMem* GetMemShared(void) { m_pVMemShared->AddRef(); return m_pVMemShared; };
164     inline VMem* GetMemParse(void) { m_pVMemParse->AddRef(); return m_pVMemParse; };
165     inline VDir* GetDir(void) { return m_pvDir; };
166 
167 public:
168 
169     struct IPerlMem	    m_hostperlMem;
170     struct IPerlMem	    m_hostperlMemShared;
171     struct IPerlMem	    m_hostperlMemParse;
172     struct IPerlEnv	    m_hostperlEnv;
173     struct IPerlStdIO	    m_hostperlStdIO;
174     struct IPerlLIO	    m_hostperlLIO;
175     struct IPerlDir	    m_hostperlDir;
176     struct IPerlSock	    m_hostperlSock;
177     struct IPerlProc	    m_hostperlProc;
178 
179     struct IPerlMem*	    m_pHostperlMem;
180     struct IPerlMem*	    m_pHostperlMemShared;
181     struct IPerlMem*	    m_pHostperlMemParse;
182     struct IPerlEnv*	    m_pHostperlEnv;
183     struct IPerlStdIO*	    m_pHostperlStdIO;
184     struct IPerlLIO*	    m_pHostperlLIO;
185     struct IPerlDir*	    m_pHostperlDir;
186     struct IPerlSock*	    m_pHostperlSock;
187     struct IPerlProc*	    m_pHostperlProc;
188 
189     inline char* MapPathA(const char *pInName) { return m_pvDir->MapPathA(pInName); };
190     inline WCHAR* MapPathW(const WCHAR *pInName) { return m_pvDir->MapPathW(pInName); };
191 protected:
192 
193     VDir*   m_pvDir;
194     VMem*   m_pVMem;
195     VMem*   m_pVMemShared;
196     VMem*   m_pVMemParse;
197 
198     DWORD   m_dwEnvCount;
199     LPSTR*  m_lppEnvList;
200 };
201 
202 
203 #define STRUCT2PTR(x, y) (CPerlHost*)(((LPBYTE)x)-offsetof(CPerlHost, y))
204 
205 inline CPerlHost* IPerlMem2Host(struct IPerlMem* piPerl)
206 {
207     return STRUCT2PTR(piPerl, m_hostperlMem);
208 }
209 
210 inline CPerlHost* IPerlMemShared2Host(struct IPerlMem* piPerl)
211 {
212     return STRUCT2PTR(piPerl, m_hostperlMemShared);
213 }
214 
215 inline CPerlHost* IPerlMemParse2Host(struct IPerlMem* piPerl)
216 {
217     return STRUCT2PTR(piPerl, m_hostperlMemParse);
218 }
219 
220 inline CPerlHost* IPerlEnv2Host(struct IPerlEnv* piPerl)
221 {
222     return STRUCT2PTR(piPerl, m_hostperlEnv);
223 }
224 
225 inline CPerlHost* IPerlStdIO2Host(struct IPerlStdIO* piPerl)
226 {
227     return STRUCT2PTR(piPerl, m_hostperlStdIO);
228 }
229 
230 inline CPerlHost* IPerlLIO2Host(struct IPerlLIO* piPerl)
231 {
232     return STRUCT2PTR(piPerl, m_hostperlLIO);
233 }
234 
235 inline CPerlHost* IPerlDir2Host(struct IPerlDir* piPerl)
236 {
237     return STRUCT2PTR(piPerl, m_hostperlDir);
238 }
239 
240 inline CPerlHost* IPerlSock2Host(struct IPerlSock* piPerl)
241 {
242     return STRUCT2PTR(piPerl, m_hostperlSock);
243 }
244 
245 inline CPerlHost* IPerlProc2Host(struct IPerlProc* piPerl)
246 {
247     return STRUCT2PTR(piPerl, m_hostperlProc);
248 }
249 
250 
251 
252 #undef IPERL2HOST
253 #define IPERL2HOST(x) IPerlMem2Host(x)
254 
255 /* IPerlMem */
256 void*
257 PerlMemMalloc(struct IPerlMem* piPerl, size_t size)
258 {
259     return IPERL2HOST(piPerl)->Malloc(size);
260 }
261 void*
262 PerlMemRealloc(struct IPerlMem* piPerl, void* ptr, size_t size)
263 {
264     return IPERL2HOST(piPerl)->Realloc(ptr, size);
265 }
266 void
267 PerlMemFree(struct IPerlMem* piPerl, void* ptr)
268 {
269     IPERL2HOST(piPerl)->Free(ptr);
270 }
271 void*
272 PerlMemCalloc(struct IPerlMem* piPerl, size_t num, size_t size)
273 {
274     return IPERL2HOST(piPerl)->Calloc(num, size);
275 }
276 
277 void
278 PerlMemGetLock(struct IPerlMem* piPerl)
279 {
280     IPERL2HOST(piPerl)->GetLock();
281 }
282 
283 void
284 PerlMemFreeLock(struct IPerlMem* piPerl)
285 {
286     IPERL2HOST(piPerl)->FreeLock();
287 }
288 
289 int
290 PerlMemIsLocked(struct IPerlMem* piPerl)
291 {
292     return IPERL2HOST(piPerl)->IsLocked();
293 }
294 
295 struct IPerlMem perlMem =
296 {
297     PerlMemMalloc,
298     PerlMemRealloc,
299     PerlMemFree,
300     PerlMemCalloc,
301     PerlMemGetLock,
302     PerlMemFreeLock,
303     PerlMemIsLocked,
304 };
305 
306 #undef IPERL2HOST
307 #define IPERL2HOST(x) IPerlMemShared2Host(x)
308 
309 /* IPerlMemShared */
310 void*
311 PerlMemSharedMalloc(struct IPerlMem* piPerl, size_t size)
312 {
313     return IPERL2HOST(piPerl)->MallocShared(size);
314 }
315 void*
316 PerlMemSharedRealloc(struct IPerlMem* piPerl, void* ptr, size_t size)
317 {
318     return IPERL2HOST(piPerl)->ReallocShared(ptr, size);
319 }
320 void
321 PerlMemSharedFree(struct IPerlMem* piPerl, void* ptr)
322 {
323     IPERL2HOST(piPerl)->FreeShared(ptr);
324 }
325 void*
326 PerlMemSharedCalloc(struct IPerlMem* piPerl, size_t num, size_t size)
327 {
328     return IPERL2HOST(piPerl)->CallocShared(num, size);
329 }
330 
331 void
332 PerlMemSharedGetLock(struct IPerlMem* piPerl)
333 {
334     IPERL2HOST(piPerl)->GetLockShared();
335 }
336 
337 void
338 PerlMemSharedFreeLock(struct IPerlMem* piPerl)
339 {
340     IPERL2HOST(piPerl)->FreeLockShared();
341 }
342 
343 int
344 PerlMemSharedIsLocked(struct IPerlMem* piPerl)
345 {
346     return IPERL2HOST(piPerl)->IsLockedShared();
347 }
348 
349 struct IPerlMem perlMemShared =
350 {
351     PerlMemSharedMalloc,
352     PerlMemSharedRealloc,
353     PerlMemSharedFree,
354     PerlMemSharedCalloc,
355     PerlMemSharedGetLock,
356     PerlMemSharedFreeLock,
357     PerlMemSharedIsLocked,
358 };
359 
360 #undef IPERL2HOST
361 #define IPERL2HOST(x) IPerlMemParse2Host(x)
362 
363 /* IPerlMemParse */
364 void*
365 PerlMemParseMalloc(struct IPerlMem* piPerl, size_t size)
366 {
367     return IPERL2HOST(piPerl)->MallocParse(size);
368 }
369 void*
370 PerlMemParseRealloc(struct IPerlMem* piPerl, void* ptr, size_t size)
371 {
372     return IPERL2HOST(piPerl)->ReallocParse(ptr, size);
373 }
374 void
375 PerlMemParseFree(struct IPerlMem* piPerl, void* ptr)
376 {
377     IPERL2HOST(piPerl)->FreeParse(ptr);
378 }
379 void*
380 PerlMemParseCalloc(struct IPerlMem* piPerl, size_t num, size_t size)
381 {
382     return IPERL2HOST(piPerl)->CallocParse(num, size);
383 }
384 
385 void
386 PerlMemParseGetLock(struct IPerlMem* piPerl)
387 {
388     IPERL2HOST(piPerl)->GetLockParse();
389 }
390 
391 void
392 PerlMemParseFreeLock(struct IPerlMem* piPerl)
393 {
394     IPERL2HOST(piPerl)->FreeLockParse();
395 }
396 
397 int
398 PerlMemParseIsLocked(struct IPerlMem* piPerl)
399 {
400     return IPERL2HOST(piPerl)->IsLockedParse();
401 }
402 
403 struct IPerlMem perlMemParse =
404 {
405     PerlMemParseMalloc,
406     PerlMemParseRealloc,
407     PerlMemParseFree,
408     PerlMemParseCalloc,
409     PerlMemParseGetLock,
410     PerlMemParseFreeLock,
411     PerlMemParseIsLocked,
412 };
413 
414 
415 #undef IPERL2HOST
416 #define IPERL2HOST(x) IPerlEnv2Host(x)
417 
418 /* IPerlEnv */
419 char*
420 PerlEnvGetenv(struct IPerlEnv* piPerl, const char *varname)
421 {
422     return IPERL2HOST(piPerl)->Getenv(varname);
423 };
424 
425 int
426 PerlEnvPutenv(struct IPerlEnv* piPerl, const char *envstring)
427 {
428     return IPERL2HOST(piPerl)->Putenv(envstring);
429 };
430 
431 char*
432 PerlEnvGetenv_len(struct IPerlEnv* piPerl, const char* varname, unsigned long* len)
433 {
434     return IPERL2HOST(piPerl)->Getenv(varname, len);
435 }
436 
437 int
438 PerlEnvUname(struct IPerlEnv* piPerl, struct utsname *name)
439 {
440     return win32_uname(name);
441 }
442 
443 void
444 PerlEnvClearenv(struct IPerlEnv* piPerl)
445 {
446     IPERL2HOST(piPerl)->Clearenv();
447 }
448 
449 void*
450 PerlEnvGetChildenv(struct IPerlEnv* piPerl)
451 {
452     return IPERL2HOST(piPerl)->CreateChildEnv();
453 }
454 
455 void
456 PerlEnvFreeChildenv(struct IPerlEnv* piPerl, void* childEnv)
457 {
458     IPERL2HOST(piPerl)->FreeChildEnv(childEnv);
459 }
460 
461 char*
462 PerlEnvGetChilddir(struct IPerlEnv* piPerl)
463 {
464     return IPERL2HOST(piPerl)->GetChildDir();
465 }
466 
467 void
468 PerlEnvFreeChilddir(struct IPerlEnv* piPerl, char* childDir)
469 {
470     IPERL2HOST(piPerl)->FreeChildDir(childDir);
471 }
472 
473 unsigned long
474 PerlEnvOsId(struct IPerlEnv* piPerl)
475 {
476     return win32_os_id();
477 }
478 
479 char*
480 PerlEnvLibPath(struct IPerlEnv* piPerl, const char *pl)
481 {
482     return g_win32_get_privlib(pl);
483 }
484 
485 char*
486 PerlEnvSiteLibPath(struct IPerlEnv* piPerl, const char *pl)
487 {
488     return g_win32_get_sitelib(pl);
489 }
490 
491 char*
492 PerlEnvVendorLibPath(struct IPerlEnv* piPerl, const char *pl)
493 {
494     return g_win32_get_vendorlib(pl);
495 }
496 
497 void
498 PerlEnvGetChildIO(struct IPerlEnv* piPerl, child_IO_table* ptr)
499 {
500     win32_get_child_IO(ptr);
501 }
502 
503 struct IPerlEnv perlEnv =
504 {
505     PerlEnvGetenv,
506     PerlEnvPutenv,
507     PerlEnvGetenv_len,
508     PerlEnvUname,
509     PerlEnvClearenv,
510     PerlEnvGetChildenv,
511     PerlEnvFreeChildenv,
512     PerlEnvGetChilddir,
513     PerlEnvFreeChilddir,
514     PerlEnvOsId,
515     PerlEnvLibPath,
516     PerlEnvSiteLibPath,
517     PerlEnvVendorLibPath,
518     PerlEnvGetChildIO,
519 };
520 
521 #undef IPERL2HOST
522 #define IPERL2HOST(x) IPerlStdIO2Host(x)
523 
524 /* PerlStdIO */
525 PerlIO*
526 PerlStdIOStdin(struct IPerlStdIO* piPerl)
527 {
528     return (PerlIO*)win32_stdin();
529 }
530 
531 PerlIO*
532 PerlStdIOStdout(struct IPerlStdIO* piPerl)
533 {
534     return (PerlIO*)win32_stdout();
535 }
536 
537 PerlIO*
538 PerlStdIOStderr(struct IPerlStdIO* piPerl)
539 {
540     return (PerlIO*)win32_stderr();
541 }
542 
543 PerlIO*
544 PerlStdIOOpen(struct IPerlStdIO* piPerl, const char *path, const char *mode)
545 {
546     return (PerlIO*)win32_fopen(path, mode);
547 }
548 
549 int
550 PerlStdIOClose(struct IPerlStdIO* piPerl, PerlIO* pf)
551 {
552     return win32_fclose(((FILE*)pf));
553 }
554 
555 int
556 PerlStdIOEof(struct IPerlStdIO* piPerl, PerlIO* pf)
557 {
558     return win32_feof((FILE*)pf);
559 }
560 
561 int
562 PerlStdIOError(struct IPerlStdIO* piPerl, PerlIO* pf)
563 {
564     return win32_ferror((FILE*)pf);
565 }
566 
567 void
568 PerlStdIOClearerr(struct IPerlStdIO* piPerl, PerlIO* pf)
569 {
570     win32_clearerr((FILE*)pf);
571 }
572 
573 int
574 PerlStdIOGetc(struct IPerlStdIO* piPerl, PerlIO* pf)
575 {
576     return win32_getc((FILE*)pf);
577 }
578 
579 char*
580 PerlStdIOGetBase(struct IPerlStdIO* piPerl, PerlIO* pf)
581 {
582 #ifdef FILE_base
583     FILE *f = (FILE*)pf;
584     return FILE_base(f);
585 #else
586     return Nullch;
587 #endif
588 }
589 
590 int
591 PerlStdIOGetBufsiz(struct IPerlStdIO* piPerl, PerlIO* pf)
592 {
593 #ifdef FILE_bufsiz
594     FILE *f = (FILE*)pf;
595     return FILE_bufsiz(f);
596 #else
597     return (-1);
598 #endif
599 }
600 
601 int
602 PerlStdIOGetCnt(struct IPerlStdIO* piPerl, PerlIO* pf)
603 {
604 #ifdef USE_STDIO_PTR
605     FILE *f = (FILE*)pf;
606     return FILE_cnt(f);
607 #else
608     return (-1);
609 #endif
610 }
611 
612 char*
613 PerlStdIOGetPtr(struct IPerlStdIO* piPerl, PerlIO* pf)
614 {
615 #ifdef USE_STDIO_PTR
616     FILE *f = (FILE*)pf;
617     return FILE_ptr(f);
618 #else
619     return Nullch;
620 #endif
621 }
622 
623 char*
624 PerlStdIOGets(struct IPerlStdIO* piPerl, PerlIO* pf, char* s, int n)
625 {
626     return win32_fgets(s, n, (FILE*)pf);
627 }
628 
629 int
630 PerlStdIOPutc(struct IPerlStdIO* piPerl, PerlIO* pf, int c)
631 {
632     return win32_fputc(c, (FILE*)pf);
633 }
634 
635 int
636 PerlStdIOPuts(struct IPerlStdIO* piPerl, PerlIO* pf, const char *s)
637 {
638     return win32_fputs(s, (FILE*)pf);
639 }
640 
641 int
642 PerlStdIOFlush(struct IPerlStdIO* piPerl, PerlIO* pf)
643 {
644     return win32_fflush((FILE*)pf);
645 }
646 
647 int
648 PerlStdIOUngetc(struct IPerlStdIO* piPerl, PerlIO* pf,int c)
649 {
650     return win32_ungetc(c, (FILE*)pf);
651 }
652 
653 int
654 PerlStdIOFileno(struct IPerlStdIO* piPerl, PerlIO* pf)
655 {
656     return win32_fileno((FILE*)pf);
657 }
658 
659 PerlIO*
660 PerlStdIOFdopen(struct IPerlStdIO* piPerl, int fd, const char *mode)
661 {
662     return (PerlIO*)win32_fdopen(fd, mode);
663 }
664 
665 PerlIO*
666 PerlStdIOReopen(struct IPerlStdIO* piPerl, const char*path, const char*mode, PerlIO* pf)
667 {
668     return (PerlIO*)win32_freopen(path, mode, (FILE*)pf);
669 }
670 
671 SSize_t
672 PerlStdIORead(struct IPerlStdIO* piPerl, PerlIO* pf, void *buffer, Size_t size)
673 {
674     return win32_fread(buffer, 1, size, (FILE*)pf);
675 }
676 
677 SSize_t
678 PerlStdIOWrite(struct IPerlStdIO* piPerl, PerlIO* pf, const void *buffer, Size_t size)
679 {
680     return win32_fwrite(buffer, 1, size, (FILE*)pf);
681 }
682 
683 void
684 PerlStdIOSetBuf(struct IPerlStdIO* piPerl, PerlIO* pf, char* buffer)
685 {
686     win32_setbuf((FILE*)pf, buffer);
687 }
688 
689 int
690 PerlStdIOSetVBuf(struct IPerlStdIO* piPerl, PerlIO* pf, char* buffer, int type, Size_t size)
691 {
692     return win32_setvbuf((FILE*)pf, buffer, type, size);
693 }
694 
695 void
696 PerlStdIOSetCnt(struct IPerlStdIO* piPerl, PerlIO* pf, int n)
697 {
698 #ifdef STDIO_CNT_LVALUE
699     FILE *f = (FILE*)pf;
700     FILE_cnt(f) = n;
701 #endif
702 }
703 
704 void
705 PerlStdIOSetPtrCnt(struct IPerlStdIO* piPerl, PerlIO* pf, char * ptr, int n)
706 {
707 #ifdef STDIO_PTR_LVALUE
708     FILE *f = (FILE*)pf;
709     FILE_ptr(f) = ptr;
710     FILE_cnt(f) = n;
711 #endif
712 }
713 
714 void
715 PerlStdIOSetlinebuf(struct IPerlStdIO* piPerl, PerlIO* pf)
716 {
717     win32_setvbuf((FILE*)pf, NULL, _IOLBF, 0);
718 }
719 
720 int
721 PerlStdIOPrintf(struct IPerlStdIO* piPerl, PerlIO* pf, const char *format,...)
722 {
723     va_list(arglist);
724     va_start(arglist, format);
725     return win32_vfprintf((FILE*)pf, format, arglist);
726 }
727 
728 int
729 PerlStdIOVprintf(struct IPerlStdIO* piPerl, PerlIO* pf, const char *format, va_list arglist)
730 {
731     return win32_vfprintf((FILE*)pf, format, arglist);
732 }
733 
734 long
735 PerlStdIOTell(struct IPerlStdIO* piPerl, PerlIO* pf)
736 {
737     return win32_ftell((FILE*)pf);
738 }
739 
740 int
741 PerlStdIOSeek(struct IPerlStdIO* piPerl, PerlIO* pf, off_t offset, int origin)
742 {
743     return win32_fseek((FILE*)pf, offset, origin);
744 }
745 
746 void
747 PerlStdIORewind(struct IPerlStdIO* piPerl, PerlIO* pf)
748 {
749     win32_rewind((FILE*)pf);
750 }
751 
752 PerlIO*
753 PerlStdIOTmpfile(struct IPerlStdIO* piPerl)
754 {
755     return (PerlIO*)win32_tmpfile();
756 }
757 
758 int
759 PerlStdIOGetpos(struct IPerlStdIO* piPerl, PerlIO* pf, Fpos_t *p)
760 {
761     return win32_fgetpos((FILE*)pf, p);
762 }
763 
764 int
765 PerlStdIOSetpos(struct IPerlStdIO* piPerl, PerlIO* pf, const Fpos_t *p)
766 {
767     return win32_fsetpos((FILE*)pf, p);
768 }
769 void
770 PerlStdIOInit(struct IPerlStdIO* piPerl)
771 {
772 }
773 
774 void
775 PerlStdIOInitOSExtras(struct IPerlStdIO* piPerl)
776 {
777     Perl_init_os_extras();
778 }
779 
780 int
781 PerlStdIOOpenOSfhandle(struct IPerlStdIO* piPerl, long osfhandle, int flags)
782 {
783     return win32_open_osfhandle(osfhandle, flags);
784 }
785 
786 int
787 PerlStdIOGetOSfhandle(struct IPerlStdIO* piPerl, int filenum)
788 {
789     return win32_get_osfhandle(filenum);
790 }
791 
792 PerlIO*
793 PerlStdIOFdupopen(struct IPerlStdIO* piPerl, PerlIO* pf)
794 {
795     PerlIO* pfdup;
796     fpos_t pos;
797     char mode[3];
798     int fileno = win32_dup(win32_fileno((FILE*)pf));
799 
800     /* open the file in the same mode */
801 #ifdef __BORLANDC__
802     if(((FILE*)pf)->flags & _F_READ) {
803 	mode[0] = 'r';
804 	mode[1] = 0;
805     }
806     else if(((FILE*)pf)->flags & _F_WRIT) {
807 	mode[0] = 'a';
808 	mode[1] = 0;
809     }
810     else if(((FILE*)pf)->flags & _F_RDWR) {
811 	mode[0] = 'r';
812 	mode[1] = '+';
813 	mode[2] = 0;
814     }
815 #else
816     if(((FILE*)pf)->_flag & _IOREAD) {
817 	mode[0] = 'r';
818 	mode[1] = 0;
819     }
820     else if(((FILE*)pf)->_flag & _IOWRT) {
821 	mode[0] = 'a';
822 	mode[1] = 0;
823     }
824     else if(((FILE*)pf)->_flag & _IORW) {
825 	mode[0] = 'r';
826 	mode[1] = '+';
827 	mode[2] = 0;
828     }
829 #endif
830 
831     /* it appears that the binmode is attached to the
832      * file descriptor so binmode files will be handled
833      * correctly
834      */
835     pfdup = (PerlIO*)win32_fdopen(fileno, mode);
836 
837     /* move the file pointer to the same position */
838     if (!fgetpos((FILE*)pf, &pos)) {
839 	fsetpos((FILE*)pfdup, &pos);
840     }
841     return pfdup;
842 }
843 
844 struct IPerlStdIO perlStdIO =
845 {
846     PerlStdIOStdin,
847     PerlStdIOStdout,
848     PerlStdIOStderr,
849     PerlStdIOOpen,
850     PerlStdIOClose,
851     PerlStdIOEof,
852     PerlStdIOError,
853     PerlStdIOClearerr,
854     PerlStdIOGetc,
855     PerlStdIOGetBase,
856     PerlStdIOGetBufsiz,
857     PerlStdIOGetCnt,
858     PerlStdIOGetPtr,
859     PerlStdIOGets,
860     PerlStdIOPutc,
861     PerlStdIOPuts,
862     PerlStdIOFlush,
863     PerlStdIOUngetc,
864     PerlStdIOFileno,
865     PerlStdIOFdopen,
866     PerlStdIOReopen,
867     PerlStdIORead,
868     PerlStdIOWrite,
869     PerlStdIOSetBuf,
870     PerlStdIOSetVBuf,
871     PerlStdIOSetCnt,
872     PerlStdIOSetPtrCnt,
873     PerlStdIOSetlinebuf,
874     PerlStdIOPrintf,
875     PerlStdIOVprintf,
876     PerlStdIOTell,
877     PerlStdIOSeek,
878     PerlStdIORewind,
879     PerlStdIOTmpfile,
880     PerlStdIOGetpos,
881     PerlStdIOSetpos,
882     PerlStdIOInit,
883     PerlStdIOInitOSExtras,
884     PerlStdIOFdupopen,
885 };
886 
887 
888 #undef IPERL2HOST
889 #define IPERL2HOST(x) IPerlLIO2Host(x)
890 
891 /* IPerlLIO */
892 int
893 PerlLIOAccess(struct IPerlLIO* piPerl, const char *path, int mode)
894 {
895     return win32_access(path, mode);
896 }
897 
898 int
899 PerlLIOChmod(struct IPerlLIO* piPerl, const char *filename, int pmode)
900 {
901     return win32_chmod(filename, pmode);
902 }
903 
904 int
905 PerlLIOChown(struct IPerlLIO* piPerl, const char *filename, uid_t owner, gid_t group)
906 {
907     return chown(filename, owner, group);
908 }
909 
910 int
911 PerlLIOChsize(struct IPerlLIO* piPerl, int handle, long size)
912 {
913     return chsize(handle, size);
914 }
915 
916 int
917 PerlLIOClose(struct IPerlLIO* piPerl, int handle)
918 {
919     return win32_close(handle);
920 }
921 
922 int
923 PerlLIODup(struct IPerlLIO* piPerl, int handle)
924 {
925     return win32_dup(handle);
926 }
927 
928 int
929 PerlLIODup2(struct IPerlLIO* piPerl, int handle1, int handle2)
930 {
931     return win32_dup2(handle1, handle2);
932 }
933 
934 int
935 PerlLIOFlock(struct IPerlLIO* piPerl, int fd, int oper)
936 {
937     return win32_flock(fd, oper);
938 }
939 
940 int
941 PerlLIOFileStat(struct IPerlLIO* piPerl, int handle, struct stat *buffer)
942 {
943     return win32_fstat(handle, buffer);
944 }
945 
946 int
947 PerlLIOIOCtl(struct IPerlLIO* piPerl, int i, unsigned int u, char *data)
948 {
949     return win32_ioctlsocket((SOCKET)i, (long)u, (u_long*)data);
950 }
951 
952 int
953 PerlLIOIsatty(struct IPerlLIO* piPerl, int fd)
954 {
955     return isatty(fd);
956 }
957 
958 int
959 PerlLIOLink(struct IPerlLIO* piPerl, const char*oldname, const char *newname)
960 {
961     return win32_link(oldname, newname);
962 }
963 
964 long
965 PerlLIOLseek(struct IPerlLIO* piPerl, int handle, long offset, int origin)
966 {
967     return win32_lseek(handle, offset, origin);
968 }
969 
970 int
971 PerlLIOLstat(struct IPerlLIO* piPerl, const char *path, struct stat *buffer)
972 {
973     return win32_stat(path, buffer);
974 }
975 
976 char*
977 PerlLIOMktemp(struct IPerlLIO* piPerl, char *Template)
978 {
979     return mktemp(Template);
980 }
981 
982 int
983 PerlLIOOpen(struct IPerlLIO* piPerl, const char *filename, int oflag)
984 {
985     return win32_open(filename, oflag);
986 }
987 
988 int
989 PerlLIOOpen3(struct IPerlLIO* piPerl, const char *filename, int oflag, int pmode)
990 {
991     return win32_open(filename, oflag, pmode);
992 }
993 
994 int
995 PerlLIORead(struct IPerlLIO* piPerl, int handle, void *buffer, unsigned int count)
996 {
997     return win32_read(handle, buffer, count);
998 }
999 
1000 int
1001 PerlLIORename(struct IPerlLIO* piPerl, const char *OldFileName, const char *newname)
1002 {
1003     return win32_rename(OldFileName, newname);
1004 }
1005 
1006 int
1007 PerlLIOSetmode(struct IPerlLIO* piPerl, int handle, int mode)
1008 {
1009     return win32_setmode(handle, mode);
1010 }
1011 
1012 int
1013 PerlLIONameStat(struct IPerlLIO* piPerl, const char *path, struct stat *buffer)
1014 {
1015     return win32_stat(path, buffer);
1016 }
1017 
1018 char*
1019 PerlLIOTmpnam(struct IPerlLIO* piPerl, char *string)
1020 {
1021     return tmpnam(string);
1022 }
1023 
1024 int
1025 PerlLIOUmask(struct IPerlLIO* piPerl, int pmode)
1026 {
1027     return umask(pmode);
1028 }
1029 
1030 int
1031 PerlLIOUnlink(struct IPerlLIO* piPerl, const char *filename)
1032 {
1033     return win32_unlink(filename);
1034 }
1035 
1036 int
1037 PerlLIOUtime(struct IPerlLIO* piPerl, char *filename, struct utimbuf *times)
1038 {
1039     return win32_utime(filename, times);
1040 }
1041 
1042 int
1043 PerlLIOWrite(struct IPerlLIO* piPerl, int handle, const void *buffer, unsigned int count)
1044 {
1045     return win32_write(handle, buffer, count);
1046 }
1047 
1048 struct IPerlLIO perlLIO =
1049 {
1050     PerlLIOAccess,
1051     PerlLIOChmod,
1052     PerlLIOChown,
1053     PerlLIOChsize,
1054     PerlLIOClose,
1055     PerlLIODup,
1056     PerlLIODup2,
1057     PerlLIOFlock,
1058     PerlLIOFileStat,
1059     PerlLIOIOCtl,
1060     PerlLIOIsatty,
1061     PerlLIOLink,
1062     PerlLIOLseek,
1063     PerlLIOLstat,
1064     PerlLIOMktemp,
1065     PerlLIOOpen,
1066     PerlLIOOpen3,
1067     PerlLIORead,
1068     PerlLIORename,
1069     PerlLIOSetmode,
1070     PerlLIONameStat,
1071     PerlLIOTmpnam,
1072     PerlLIOUmask,
1073     PerlLIOUnlink,
1074     PerlLIOUtime,
1075     PerlLIOWrite,
1076 };
1077 
1078 
1079 #undef IPERL2HOST
1080 #define IPERL2HOST(x) IPerlDir2Host(x)
1081 
1082 /* IPerlDIR */
1083 int
1084 PerlDirMakedir(struct IPerlDir* piPerl, const char *dirname, int mode)
1085 {
1086     return win32_mkdir(dirname, mode);
1087 }
1088 
1089 int
1090 PerlDirChdir(struct IPerlDir* piPerl, const char *dirname)
1091 {
1092     return IPERL2HOST(piPerl)->Chdir(dirname);
1093 }
1094 
1095 int
1096 PerlDirRmdir(struct IPerlDir* piPerl, const char *dirname)
1097 {
1098     return win32_rmdir(dirname);
1099 }
1100 
1101 int
1102 PerlDirClose(struct IPerlDir* piPerl, DIR *dirp)
1103 {
1104     return win32_closedir(dirp);
1105 }
1106 
1107 DIR*
1108 PerlDirOpen(struct IPerlDir* piPerl, char *filename)
1109 {
1110     return win32_opendir(filename);
1111 }
1112 
1113 struct direct *
1114 PerlDirRead(struct IPerlDir* piPerl, DIR *dirp)
1115 {
1116     return win32_readdir(dirp);
1117 }
1118 
1119 void
1120 PerlDirRewind(struct IPerlDir* piPerl, DIR *dirp)
1121 {
1122     win32_rewinddir(dirp);
1123 }
1124 
1125 void
1126 PerlDirSeek(struct IPerlDir* piPerl, DIR *dirp, long loc)
1127 {
1128     win32_seekdir(dirp, loc);
1129 }
1130 
1131 long
1132 PerlDirTell(struct IPerlDir* piPerl, DIR *dirp)
1133 {
1134     return win32_telldir(dirp);
1135 }
1136 
1137 char*
1138 PerlDirMapPathA(struct IPerlDir* piPerl, const char* path)
1139 {
1140     return IPERL2HOST(piPerl)->MapPathA(path);
1141 }
1142 
1143 WCHAR*
1144 PerlDirMapPathW(struct IPerlDir* piPerl, const WCHAR* path)
1145 {
1146     return IPERL2HOST(piPerl)->MapPathW(path);
1147 }
1148 
1149 struct IPerlDir perlDir =
1150 {
1151     PerlDirMakedir,
1152     PerlDirChdir,
1153     PerlDirRmdir,
1154     PerlDirClose,
1155     PerlDirOpen,
1156     PerlDirRead,
1157     PerlDirRewind,
1158     PerlDirSeek,
1159     PerlDirTell,
1160     PerlDirMapPathA,
1161     PerlDirMapPathW,
1162 };
1163 
1164 
1165 /* IPerlSock */
1166 u_long
1167 PerlSockHtonl(struct IPerlSock* piPerl, u_long hostlong)
1168 {
1169     return win32_htonl(hostlong);
1170 }
1171 
1172 u_short
1173 PerlSockHtons(struct IPerlSock* piPerl, u_short hostshort)
1174 {
1175     return win32_htons(hostshort);
1176 }
1177 
1178 u_long
1179 PerlSockNtohl(struct IPerlSock* piPerl, u_long netlong)
1180 {
1181     return win32_ntohl(netlong);
1182 }
1183 
1184 u_short
1185 PerlSockNtohs(struct IPerlSock* piPerl, u_short netshort)
1186 {
1187     return win32_ntohs(netshort);
1188 }
1189 
1190 SOCKET PerlSockAccept(struct IPerlSock* piPerl, SOCKET s, struct sockaddr* addr, int* addrlen)
1191 {
1192     return win32_accept(s, addr, addrlen);
1193 }
1194 
1195 int
1196 PerlSockBind(struct IPerlSock* piPerl, SOCKET s, const struct sockaddr* name, int namelen)
1197 {
1198     return win32_bind(s, name, namelen);
1199 }
1200 
1201 int
1202 PerlSockConnect(struct IPerlSock* piPerl, SOCKET s, const struct sockaddr* name, int namelen)
1203 {
1204     return win32_connect(s, name, namelen);
1205 }
1206 
1207 void
1208 PerlSockEndhostent(struct IPerlSock* piPerl)
1209 {
1210     win32_endhostent();
1211 }
1212 
1213 void
1214 PerlSockEndnetent(struct IPerlSock* piPerl)
1215 {
1216     win32_endnetent();
1217 }
1218 
1219 void
1220 PerlSockEndprotoent(struct IPerlSock* piPerl)
1221 {
1222     win32_endprotoent();
1223 }
1224 
1225 void
1226 PerlSockEndservent(struct IPerlSock* piPerl)
1227 {
1228     win32_endservent();
1229 }
1230 
1231 struct hostent*
1232 PerlSockGethostbyaddr(struct IPerlSock* piPerl, const char* addr, int len, int type)
1233 {
1234     return win32_gethostbyaddr(addr, len, type);
1235 }
1236 
1237 struct hostent*
1238 PerlSockGethostbyname(struct IPerlSock* piPerl, const char* name)
1239 {
1240     return win32_gethostbyname(name);
1241 }
1242 
1243 struct hostent*
1244 PerlSockGethostent(struct IPerlSock* piPerl)
1245 {
1246     dTHXo;
1247     Perl_croak(aTHX_ "gethostent not implemented!\n");
1248     return NULL;
1249 }
1250 
1251 int
1252 PerlSockGethostname(struct IPerlSock* piPerl, char* name, int namelen)
1253 {
1254     return win32_gethostname(name, namelen);
1255 }
1256 
1257 struct netent *
1258 PerlSockGetnetbyaddr(struct IPerlSock* piPerl, long net, int type)
1259 {
1260     return win32_getnetbyaddr(net, type);
1261 }
1262 
1263 struct netent *
1264 PerlSockGetnetbyname(struct IPerlSock* piPerl, const char *name)
1265 {
1266     return win32_getnetbyname((char*)name);
1267 }
1268 
1269 struct netent *
1270 PerlSockGetnetent(struct IPerlSock* piPerl)
1271 {
1272     return win32_getnetent();
1273 }
1274 
1275 int PerlSockGetpeername(struct IPerlSock* piPerl, SOCKET s, struct sockaddr* name, int* namelen)
1276 {
1277     return win32_getpeername(s, name, namelen);
1278 }
1279 
1280 struct protoent*
1281 PerlSockGetprotobyname(struct IPerlSock* piPerl, const char* name)
1282 {
1283     return win32_getprotobyname(name);
1284 }
1285 
1286 struct protoent*
1287 PerlSockGetprotobynumber(struct IPerlSock* piPerl, int number)
1288 {
1289     return win32_getprotobynumber(number);
1290 }
1291 
1292 struct protoent*
1293 PerlSockGetprotoent(struct IPerlSock* piPerl)
1294 {
1295     return win32_getprotoent();
1296 }
1297 
1298 struct servent*
1299 PerlSockGetservbyname(struct IPerlSock* piPerl, const char* name, const char* proto)
1300 {
1301     return win32_getservbyname(name, proto);
1302 }
1303 
1304 struct servent*
1305 PerlSockGetservbyport(struct IPerlSock* piPerl, int port, const char* proto)
1306 {
1307     return win32_getservbyport(port, proto);
1308 }
1309 
1310 struct servent*
1311 PerlSockGetservent(struct IPerlSock* piPerl)
1312 {
1313     return win32_getservent();
1314 }
1315 
1316 int
1317 PerlSockGetsockname(struct IPerlSock* piPerl, SOCKET s, struct sockaddr* name, int* namelen)
1318 {
1319     return win32_getsockname(s, name, namelen);
1320 }
1321 
1322 int
1323 PerlSockGetsockopt(struct IPerlSock* piPerl, SOCKET s, int level, int optname, char* optval, int* optlen)
1324 {
1325     return win32_getsockopt(s, level, optname, optval, optlen);
1326 }
1327 
1328 unsigned long
1329 PerlSockInetAddr(struct IPerlSock* piPerl, const char* cp)
1330 {
1331     return win32_inet_addr(cp);
1332 }
1333 
1334 char*
1335 PerlSockInetNtoa(struct IPerlSock* piPerl, struct in_addr in)
1336 {
1337     return win32_inet_ntoa(in);
1338 }
1339 
1340 int
1341 PerlSockListen(struct IPerlSock* piPerl, SOCKET s, int backlog)
1342 {
1343     return win32_listen(s, backlog);
1344 }
1345 
1346 int
1347 PerlSockRecv(struct IPerlSock* piPerl, SOCKET s, char* buffer, int len, int flags)
1348 {
1349     return win32_recv(s, buffer, len, flags);
1350 }
1351 
1352 int
1353 PerlSockRecvfrom(struct IPerlSock* piPerl, SOCKET s, char* buffer, int len, int flags, struct sockaddr* from, int* fromlen)
1354 {
1355     return win32_recvfrom(s, buffer, len, flags, from, fromlen);
1356 }
1357 
1358 int
1359 PerlSockSelect(struct IPerlSock* piPerl, int nfds, char* readfds, char* writefds, char* exceptfds, const struct timeval* timeout)
1360 {
1361     return win32_select(nfds, (Perl_fd_set*)readfds, (Perl_fd_set*)writefds, (Perl_fd_set*)exceptfds, timeout);
1362 }
1363 
1364 int
1365 PerlSockSend(struct IPerlSock* piPerl, SOCKET s, const char* buffer, int len, int flags)
1366 {
1367     return win32_send(s, buffer, len, flags);
1368 }
1369 
1370 int
1371 PerlSockSendto(struct IPerlSock* piPerl, SOCKET s, const char* buffer, int len, int flags, const struct sockaddr* to, int tolen)
1372 {
1373     return win32_sendto(s, buffer, len, flags, to, tolen);
1374 }
1375 
1376 void
1377 PerlSockSethostent(struct IPerlSock* piPerl, int stayopen)
1378 {
1379     win32_sethostent(stayopen);
1380 }
1381 
1382 void
1383 PerlSockSetnetent(struct IPerlSock* piPerl, int stayopen)
1384 {
1385     win32_setnetent(stayopen);
1386 }
1387 
1388 void
1389 PerlSockSetprotoent(struct IPerlSock* piPerl, int stayopen)
1390 {
1391     win32_setprotoent(stayopen);
1392 }
1393 
1394 void
1395 PerlSockSetservent(struct IPerlSock* piPerl, int stayopen)
1396 {
1397     win32_setservent(stayopen);
1398 }
1399 
1400 int
1401 PerlSockSetsockopt(struct IPerlSock* piPerl, SOCKET s, int level, int optname, const char* optval, int optlen)
1402 {
1403     return win32_setsockopt(s, level, optname, optval, optlen);
1404 }
1405 
1406 int
1407 PerlSockShutdown(struct IPerlSock* piPerl, SOCKET s, int how)
1408 {
1409     return win32_shutdown(s, how);
1410 }
1411 
1412 SOCKET
1413 PerlSockSocket(struct IPerlSock* piPerl, int af, int type, int protocol)
1414 {
1415     return win32_socket(af, type, protocol);
1416 }
1417 
1418 int
1419 PerlSockSocketpair(struct IPerlSock* piPerl, int domain, int type, int protocol, int* fds)
1420 {
1421     dTHXo;
1422     Perl_croak(aTHX_ "socketpair not implemented!\n");
1423     return 0;
1424 }
1425 
1426 int
1427 PerlSockClosesocket(struct IPerlSock* piPerl, SOCKET s)
1428 {
1429     return win32_closesocket(s);
1430 }
1431 
1432 int
1433 PerlSockIoctlsocket(struct IPerlSock* piPerl, SOCKET s, long cmd, u_long *argp)
1434 {
1435     return win32_ioctlsocket(s, cmd, argp);
1436 }
1437 
1438 struct IPerlSock perlSock =
1439 {
1440     PerlSockHtonl,
1441     PerlSockHtons,
1442     PerlSockNtohl,
1443     PerlSockNtohs,
1444     PerlSockAccept,
1445     PerlSockBind,
1446     PerlSockConnect,
1447     PerlSockEndhostent,
1448     PerlSockEndnetent,
1449     PerlSockEndprotoent,
1450     PerlSockEndservent,
1451     PerlSockGethostname,
1452     PerlSockGetpeername,
1453     PerlSockGethostbyaddr,
1454     PerlSockGethostbyname,
1455     PerlSockGethostent,
1456     PerlSockGetnetbyaddr,
1457     PerlSockGetnetbyname,
1458     PerlSockGetnetent,
1459     PerlSockGetprotobyname,
1460     PerlSockGetprotobynumber,
1461     PerlSockGetprotoent,
1462     PerlSockGetservbyname,
1463     PerlSockGetservbyport,
1464     PerlSockGetservent,
1465     PerlSockGetsockname,
1466     PerlSockGetsockopt,
1467     PerlSockInetAddr,
1468     PerlSockInetNtoa,
1469     PerlSockListen,
1470     PerlSockRecv,
1471     PerlSockRecvfrom,
1472     PerlSockSelect,
1473     PerlSockSend,
1474     PerlSockSendto,
1475     PerlSockSethostent,
1476     PerlSockSetnetent,
1477     PerlSockSetprotoent,
1478     PerlSockSetservent,
1479     PerlSockSetsockopt,
1480     PerlSockShutdown,
1481     PerlSockSocket,
1482     PerlSockSocketpair,
1483     PerlSockClosesocket,
1484 };
1485 
1486 
1487 /* IPerlProc */
1488 
1489 #define EXECF_EXEC 1
1490 #define EXECF_SPAWN 2
1491 
1492 void
1493 PerlProcAbort(struct IPerlProc* piPerl)
1494 {
1495     win32_abort();
1496 }
1497 
1498 char *
1499 PerlProcCrypt(struct IPerlProc* piPerl, const char* clear, const char* salt)
1500 {
1501     return win32_crypt(clear, salt);
1502 }
1503 
1504 void
1505 PerlProcExit(struct IPerlProc* piPerl, int status)
1506 {
1507     exit(status);
1508 }
1509 
1510 void
1511 PerlProc_Exit(struct IPerlProc* piPerl, int status)
1512 {
1513     _exit(status);
1514 }
1515 
1516 int
1517 PerlProcExecl(struct IPerlProc* piPerl, const char *cmdname, const char *arg0, const char *arg1, const char *arg2, const char *arg3)
1518 {
1519     return execl(cmdname, arg0, arg1, arg2, arg3);
1520 }
1521 
1522 int
1523 PerlProcExecv(struct IPerlProc* piPerl, const char *cmdname, const char *const *argv)
1524 {
1525     return win32_execvp(cmdname, argv);
1526 }
1527 
1528 int
1529 PerlProcExecvp(struct IPerlProc* piPerl, const char *cmdname, const char *const *argv)
1530 {
1531     return win32_execvp(cmdname, argv);
1532 }
1533 
1534 uid_t
1535 PerlProcGetuid(struct IPerlProc* piPerl)
1536 {
1537     return getuid();
1538 }
1539 
1540 uid_t
1541 PerlProcGeteuid(struct IPerlProc* piPerl)
1542 {
1543     return geteuid();
1544 }
1545 
1546 gid_t
1547 PerlProcGetgid(struct IPerlProc* piPerl)
1548 {
1549     return getgid();
1550 }
1551 
1552 gid_t
1553 PerlProcGetegid(struct IPerlProc* piPerl)
1554 {
1555     return getegid();
1556 }
1557 
1558 char *
1559 PerlProcGetlogin(struct IPerlProc* piPerl)
1560 {
1561     return g_getlogin();
1562 }
1563 
1564 int
1565 PerlProcKill(struct IPerlProc* piPerl, int pid, int sig)
1566 {
1567     return win32_kill(pid, sig);
1568 }
1569 
1570 int
1571 PerlProcKillpg(struct IPerlProc* piPerl, int pid, int sig)
1572 {
1573     dTHXo;
1574     Perl_croak(aTHX_ "killpg not implemented!\n");
1575     return 0;
1576 }
1577 
1578 int
1579 PerlProcPauseProc(struct IPerlProc* piPerl)
1580 {
1581     return win32_sleep((32767L << 16) + 32767);
1582 }
1583 
1584 PerlIO*
1585 PerlProcPopen(struct IPerlProc* piPerl, const char *command, const char *mode)
1586 {
1587     dTHXo;
1588     PERL_FLUSHALL_FOR_CHILD;
1589     return (PerlIO*)win32_popen(command, mode);
1590 }
1591 
1592 int
1593 PerlProcPclose(struct IPerlProc* piPerl, PerlIO *stream)
1594 {
1595     return win32_pclose((FILE*)stream);
1596 }
1597 
1598 int
1599 PerlProcPipe(struct IPerlProc* piPerl, int *phandles)
1600 {
1601     return win32_pipe(phandles, 512, O_BINARY);
1602 }
1603 
1604 int
1605 PerlProcSetuid(struct IPerlProc* piPerl, uid_t u)
1606 {
1607     return setuid(u);
1608 }
1609 
1610 int
1611 PerlProcSetgid(struct IPerlProc* piPerl, gid_t g)
1612 {
1613     return setgid(g);
1614 }
1615 
1616 int
1617 PerlProcSleep(struct IPerlProc* piPerl, unsigned int s)
1618 {
1619     return win32_sleep(s);
1620 }
1621 
1622 int
1623 PerlProcTimes(struct IPerlProc* piPerl, struct tms *timebuf)
1624 {
1625     return win32_times(timebuf);
1626 }
1627 
1628 int
1629 PerlProcWait(struct IPerlProc* piPerl, int *status)
1630 {
1631     return win32_wait(status);
1632 }
1633 
1634 int
1635 PerlProcWaitpid(struct IPerlProc* piPerl, int pid, int *status, int flags)
1636 {
1637     return win32_waitpid(pid, status, flags);
1638 }
1639 
1640 Sighandler_t
1641 PerlProcSignal(struct IPerlProc* piPerl, int sig, Sighandler_t subcode)
1642 {
1643     return signal(sig, subcode);
1644 }
1645 
1646 #ifdef USE_ITHREADS
1647 static THREAD_RET_TYPE
1648 win32_start_child(LPVOID arg)
1649 {
1650     PerlInterpreter *my_perl = (PerlInterpreter*)arg;
1651     GV *tmpgv;
1652     int status;
1653 #ifdef PERL_OBJECT
1654     CPerlObj *pPerl = (CPerlObj*)my_perl;
1655 #endif
1656 #ifdef PERL_SYNC_FORK
1657     static long sync_fork_id = 0;
1658     long id = ++sync_fork_id;
1659 #endif
1660 
1661 
1662     PERL_SET_THX(my_perl);
1663 
1664     /* set $$ to pseudo id */
1665 #ifdef PERL_SYNC_FORK
1666     w32_pseudo_id = id;
1667 #else
1668     w32_pseudo_id = GetCurrentThreadId();
1669     if (IsWin95()) {
1670 	int pid = (int)w32_pseudo_id;
1671 	if (pid < 0)
1672 	    w32_pseudo_id = -pid;
1673     }
1674 #endif
1675     if (tmpgv = gv_fetchpv("$", TRUE, SVt_PV))
1676 	sv_setiv(GvSV(tmpgv), -(IV)w32_pseudo_id);
1677     hv_clear(PL_pidstatus);
1678 
1679     /* push a zero on the stack (we are the child) */
1680     {
1681 	dSP;
1682 	dTARGET;
1683 	PUSHi(0);
1684 	PUTBACK;
1685     }
1686 
1687     /* continue from next op */
1688     PL_op = PL_op->op_next;
1689 
1690     {
1691 	dJMPENV;
1692 	volatile int oldscope = PL_scopestack_ix;
1693 
1694 restart:
1695 	JMPENV_PUSH(status);
1696 	switch (status) {
1697 	case 0:
1698 	    CALLRUNOPS(aTHX);
1699 	    status = 0;
1700 	    break;
1701 	case 2:
1702 	    while (PL_scopestack_ix > oldscope)
1703 		LEAVE;
1704 	    FREETMPS;
1705 	    PL_curstash = PL_defstash;
1706 	    if (PL_endav && !PL_minus_c)
1707 		call_list(oldscope, PL_endav);
1708 	    status = STATUS_NATIVE_EXPORT;
1709 	    break;
1710 	case 3:
1711 	    if (PL_restartop) {
1712 		POPSTACK_TO(PL_mainstack);
1713 		PL_op = PL_restartop;
1714 		PL_restartop = Nullop;
1715 		goto restart;
1716 	    }
1717 	    PerlIO_printf(Perl_error_log, "panic: restartop\n");
1718 	    FREETMPS;
1719 	    status = 1;
1720 	    break;
1721 	}
1722 	JMPENV_POP;
1723 
1724 	/* XXX hack to avoid perl_destruct() freeing optree */
1725 	PL_main_root = Nullop;
1726     }
1727 
1728     /* close the std handles to avoid fd leaks */
1729     {
1730 	do_close(gv_fetchpv("STDIN", TRUE, SVt_PVIO), FALSE);
1731 	do_close(gv_fetchpv("STDOUT", TRUE, SVt_PVIO), FALSE);
1732 	do_close(gv_fetchpv("STDERR", TRUE, SVt_PVIO), FALSE);
1733     }
1734 
1735     /* destroy everything (waits for any pseudo-forked children) */
1736     perl_destruct(my_perl);
1737     perl_free(my_perl);
1738 
1739 #ifdef PERL_SYNC_FORK
1740     return id;
1741 #else
1742     return (DWORD)status;
1743 #endif
1744 }
1745 #endif /* USE_ITHREADS */
1746 
1747 int
1748 PerlProcFork(struct IPerlProc* piPerl)
1749 {
1750     dTHXo;
1751 #ifdef USE_ITHREADS
1752     DWORD id;
1753     HANDLE handle;
1754     CPerlHost *h;
1755 
1756     if (w32_num_pseudo_children >= MAXIMUM_WAIT_OBJECTS) {
1757 	errno = EAGAIN;
1758 	return -1;
1759     }
1760     h = new CPerlHost(*(CPerlHost*)w32_internal_host);
1761     PerlInterpreter *new_perl = perl_clone_using((PerlInterpreter*)aTHXo, 1,
1762 						 h->m_pHostperlMem,
1763 						 h->m_pHostperlMemShared,
1764 						 h->m_pHostperlMemParse,
1765 						 h->m_pHostperlEnv,
1766 						 h->m_pHostperlStdIO,
1767 						 h->m_pHostperlLIO,
1768 						 h->m_pHostperlDir,
1769 						 h->m_pHostperlSock,
1770 						 h->m_pHostperlProc
1771 						 );
1772     new_perl->Isys_intern.internal_host = h;
1773 #  ifdef PERL_SYNC_FORK
1774     id = win32_start_child((LPVOID)new_perl);
1775     PERL_SET_THX(aTHXo);
1776 #  else
1777 #    ifdef USE_RTL_THREAD_API
1778     handle = (HANDLE)_beginthreadex((void*)NULL, 0, win32_start_child,
1779 				    (void*)new_perl, 0, (unsigned*)&id);
1780 #    else
1781     handle = CreateThread(NULL, 0, win32_start_child,
1782 			  (LPVOID)new_perl, 0, &id);
1783 #    endif
1784     PERL_SET_THX(aTHXo);	/* XXX perl_clone*() set TLS */
1785     if (!handle) {
1786 	errno = EAGAIN;
1787 	return -1;
1788     }
1789     if (IsWin95()) {
1790 	int pid = (int)id;
1791 	if (pid < 0)
1792 	    id = -pid;
1793     }
1794     w32_pseudo_child_handles[w32_num_pseudo_children] = handle;
1795     w32_pseudo_child_pids[w32_num_pseudo_children] = id;
1796     ++w32_num_pseudo_children;
1797 #  endif
1798     return -(int)id;
1799 #else
1800     Perl_croak(aTHX_ "fork() not implemented!\n");
1801     return -1;
1802 #endif /* USE_ITHREADS */
1803 }
1804 
1805 int
1806 PerlProcGetpid(struct IPerlProc* piPerl)
1807 {
1808     return win32_getpid();
1809 }
1810 
1811 void*
1812 PerlProcDynaLoader(struct IPerlProc* piPerl, const char* filename)
1813 {
1814     return win32_dynaload(filename);
1815 }
1816 
1817 void
1818 PerlProcGetOSError(struct IPerlProc* piPerl, SV* sv, DWORD dwErr)
1819 {
1820     win32_str_os_error(sv, dwErr);
1821 }
1822 
1823 BOOL
1824 PerlProcDoCmd(struct IPerlProc* piPerl, char *cmd)
1825 {
1826     do_spawn2(cmd, EXECF_EXEC);
1827     return FALSE;
1828 }
1829 
1830 int
1831 PerlProcSpawn(struct IPerlProc* piPerl, char* cmds)
1832 {
1833     return do_spawn2(cmds, EXECF_SPAWN);
1834 }
1835 
1836 int
1837 PerlProcSpawnvp(struct IPerlProc* piPerl, int mode, const char *cmdname, const char *const *argv)
1838 {
1839     return win32_spawnvp(mode, cmdname, argv);
1840 }
1841 
1842 int
1843 PerlProcASpawn(struct IPerlProc* piPerl, void *vreally, void **vmark, void **vsp)
1844 {
1845     return do_aspawn(vreally, vmark, vsp);
1846 }
1847 
1848 struct IPerlProc perlProc =
1849 {
1850     PerlProcAbort,
1851     PerlProcCrypt,
1852     PerlProcExit,
1853     PerlProc_Exit,
1854     PerlProcExecl,
1855     PerlProcExecv,
1856     PerlProcExecvp,
1857     PerlProcGetuid,
1858     PerlProcGeteuid,
1859     PerlProcGetgid,
1860     PerlProcGetegid,
1861     PerlProcGetlogin,
1862     PerlProcKill,
1863     PerlProcKillpg,
1864     PerlProcPauseProc,
1865     PerlProcPopen,
1866     PerlProcPclose,
1867     PerlProcPipe,
1868     PerlProcSetuid,
1869     PerlProcSetgid,
1870     PerlProcSleep,
1871     PerlProcTimes,
1872     PerlProcWait,
1873     PerlProcWaitpid,
1874     PerlProcSignal,
1875     PerlProcFork,
1876     PerlProcGetpid,
1877     PerlProcDynaLoader,
1878     PerlProcGetOSError,
1879     PerlProcDoCmd,
1880     PerlProcSpawn,
1881     PerlProcSpawnvp,
1882     PerlProcASpawn,
1883 };
1884 
1885 
1886 /*
1887  * CPerlHost
1888  */
1889 
1890 CPerlHost::CPerlHost(void)
1891 {
1892     m_pvDir = new VDir();
1893     m_pVMem = new VMem();
1894     m_pVMemShared = new VMem();
1895     m_pVMemParse =  new VMem();
1896 
1897     m_pvDir->Init(NULL, m_pVMem);
1898 
1899     m_dwEnvCount = 0;
1900     m_lppEnvList = NULL;
1901 
1902     CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
1903     CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
1904     CopyMemory(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse));
1905     CopyMemory(&m_hostperlEnv, &perlEnv, sizeof(perlEnv));
1906     CopyMemory(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO));
1907     CopyMemory(&m_hostperlLIO, &perlLIO, sizeof(perlLIO));
1908     CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir));
1909     CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock));
1910     CopyMemory(&m_hostperlProc, &perlProc, sizeof(perlProc));
1911 
1912     m_pHostperlMem	    = &m_hostperlMem;
1913     m_pHostperlMemShared    = &m_hostperlMemShared;
1914     m_pHostperlMemParse	    = &m_hostperlMemParse;
1915     m_pHostperlEnv	    = &m_hostperlEnv;
1916     m_pHostperlStdIO	    = &m_hostperlStdIO;
1917     m_pHostperlLIO	    = &m_hostperlLIO;
1918     m_pHostperlDir	    = &m_hostperlDir;
1919     m_pHostperlSock	    = &m_hostperlSock;
1920     m_pHostperlProc	    = &m_hostperlProc;
1921 }
1922 
1923 #define SETUPEXCHANGE(xptr, iptr, table) \
1924     STMT_START {				\
1925 	if (xptr) {				\
1926 	    iptr = *xptr;			\
1927 	    *xptr = &table;			\
1928 	}					\
1929 	else {					\
1930 	    iptr = &table;			\
1931 	}					\
1932     } STMT_END
1933 
1934 CPerlHost::CPerlHost(struct IPerlMem** ppMem, struct IPerlMem** ppMemShared,
1935 		 struct IPerlMem** ppMemParse, struct IPerlEnv** ppEnv,
1936 		 struct IPerlStdIO** ppStdIO, struct IPerlLIO** ppLIO,
1937 		 struct IPerlDir** ppDir, struct IPerlSock** ppSock,
1938 		 struct IPerlProc** ppProc)
1939 {
1940     m_pvDir = new VDir(0);
1941     m_pVMem = new VMem();
1942     m_pVMemShared = new VMem();
1943     m_pVMemParse =  new VMem();
1944 
1945     m_pvDir->Init(NULL, m_pVMem);
1946 
1947     m_dwEnvCount = 0;
1948     m_lppEnvList = NULL;
1949 
1950     CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
1951     CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
1952     CopyMemory(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse));
1953     CopyMemory(&m_hostperlEnv, &perlEnv, sizeof(perlEnv));
1954     CopyMemory(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO));
1955     CopyMemory(&m_hostperlLIO, &perlLIO, sizeof(perlLIO));
1956     CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir));
1957     CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock));
1958     CopyMemory(&m_hostperlProc, &perlProc, sizeof(perlProc));
1959 
1960     SETUPEXCHANGE(ppMem,	m_pHostperlMem,		m_hostperlMem);
1961     SETUPEXCHANGE(ppMemShared,	m_pHostperlMemShared,	m_hostperlMemShared);
1962     SETUPEXCHANGE(ppMemParse,	m_pHostperlMemParse,	m_hostperlMemParse);
1963     SETUPEXCHANGE(ppEnv,	m_pHostperlEnv,		m_hostperlEnv);
1964     SETUPEXCHANGE(ppStdIO,	m_pHostperlStdIO,	m_hostperlStdIO);
1965     SETUPEXCHANGE(ppLIO,	m_pHostperlLIO,		m_hostperlLIO);
1966     SETUPEXCHANGE(ppDir,	m_pHostperlDir,		m_hostperlDir);
1967     SETUPEXCHANGE(ppSock,	m_pHostperlSock,	m_hostperlSock);
1968     SETUPEXCHANGE(ppProc,	m_pHostperlProc,	m_hostperlProc);
1969 }
1970 #undef SETUPEXCHANGE
1971 
1972 CPerlHost::CPerlHost(CPerlHost& host)
1973 {
1974     m_pVMem = new VMem();
1975     m_pVMemShared = host.GetMemShared();
1976     m_pVMemParse =  host.GetMemParse();
1977 
1978     /* duplicate directory info */
1979     m_pvDir = new VDir(0);
1980     m_pvDir->Init(host.GetDir(), m_pVMem);
1981 
1982     CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
1983     CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
1984     CopyMemory(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse));
1985     CopyMemory(&m_hostperlEnv, &perlEnv, sizeof(perlEnv));
1986     CopyMemory(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO));
1987     CopyMemory(&m_hostperlLIO, &perlLIO, sizeof(perlLIO));
1988     CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir));
1989     CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock));
1990     CopyMemory(&m_hostperlProc, &perlProc, sizeof(perlProc));
1991     m_pHostperlMem	    = &m_hostperlMem;
1992     m_pHostperlMemShared    = &m_hostperlMemShared;
1993     m_pHostperlMemParse	    = &m_hostperlMemParse;
1994     m_pHostperlEnv	    = &m_hostperlEnv;
1995     m_pHostperlStdIO	    = &m_hostperlStdIO;
1996     m_pHostperlLIO	    = &m_hostperlLIO;
1997     m_pHostperlDir	    = &m_hostperlDir;
1998     m_pHostperlSock	    = &m_hostperlSock;
1999     m_pHostperlProc	    = &m_hostperlProc;
2000 
2001     m_dwEnvCount = 0;
2002     m_lppEnvList = NULL;
2003 
2004     /* duplicate environment info */
2005     LPSTR lpPtr;
2006     DWORD dwIndex = 0;
2007     while(lpPtr = host.GetIndex(dwIndex))
2008 	Add(lpPtr);
2009 }
2010 
2011 CPerlHost::~CPerlHost(void)
2012 {
2013 //  Reset();
2014     delete m_pvDir;
2015     m_pVMemParse->Release();
2016     m_pVMemShared->Release();
2017     m_pVMem->Release();
2018 }
2019 
2020 LPSTR
2021 CPerlHost::Find(LPCSTR lpStr)
2022 {
2023     LPSTR lpPtr;
2024     LPSTR* lppPtr = Lookup(lpStr);
2025     if(lppPtr != NULL) {
2026 	for(lpPtr = *lppPtr; *lpPtr != '\0' && *lpPtr != '='; ++lpPtr)
2027 	    ;
2028 
2029 	if(*lpPtr == '=')
2030 	    ++lpPtr;
2031 
2032 	return lpPtr;
2033     }
2034     return NULL;
2035 }
2036 
2037 int
2038 lookup(const void *arg1, const void *arg2)
2039 {   // Compare strings
2040     char*ptr1, *ptr2;
2041     char c1,c2;
2042 
2043     ptr1 = *(char**)arg1;
2044     ptr2 = *(char**)arg2;
2045     for(;;) {
2046 	c1 = *ptr1++;
2047 	c2 = *ptr2++;
2048 	if(c1 == '\0' || c1 == '=') {
2049 	    if(c2 == '\0' || c2 == '=')
2050 		break;
2051 
2052 	    return -1; // string 1 < string 2
2053 	}
2054 	else if(c2 == '\0' || c2 == '=')
2055 	    return 1; // string 1 > string 2
2056 	else if(c1 != c2) {
2057 	    c1 = toupper(c1);
2058 	    c2 = toupper(c2);
2059 	    if(c1 != c2) {
2060 		if(c1 < c2)
2061 		    return -1; // string 1 < string 2
2062 
2063 		return 1; // string 1 > string 2
2064 	    }
2065 	}
2066     }
2067     return 0;
2068 }
2069 
2070 LPSTR*
2071 CPerlHost::Lookup(LPCSTR lpStr)
2072 {
2073     return (LPSTR*)bsearch(&lpStr, m_lppEnvList, m_dwEnvCount, sizeof(LPSTR), lookup);
2074 }
2075 
2076 int
2077 compare(const void *arg1, const void *arg2)
2078 {   // Compare strings
2079     char*ptr1, *ptr2;
2080     char c1,c2;
2081 
2082     ptr1 = *(char**)arg1;
2083     ptr2 = *(char**)arg2;
2084     for(;;) {
2085 	c1 = *ptr1++;
2086 	c2 = *ptr2++;
2087 	if(c1 == '\0' || c1 == '=') {
2088 	    if(c1 == c2)
2089 		break;
2090 
2091 	    return -1; // string 1 < string 2
2092 	}
2093 	else if(c2 == '\0' || c2 == '=')
2094 	    return 1; // string 1 > string 2
2095 	else if(c1 != c2) {
2096 	    c1 = toupper(c1);
2097 	    c2 = toupper(c2);
2098 	    if(c1 != c2) {
2099 		if(c1 < c2)
2100 		    return -1; // string 1 < string 2
2101 
2102 		return 1; // string 1 > string 2
2103 	    }
2104 	}
2105     }
2106     return 0;
2107 }
2108 
2109 void
2110 CPerlHost::Add(LPCSTR lpStr)
2111 {
2112     dTHXo;
2113     char szBuffer[1024];
2114     LPSTR *lpPtr;
2115     int index, length = strlen(lpStr)+1;
2116 
2117     for(index = 0; lpStr[index] != '\0' && lpStr[index] != '='; ++index)
2118 	szBuffer[index] = lpStr[index];
2119 
2120     szBuffer[index] = '\0';
2121 
2122     // replacing ?
2123     lpPtr = Lookup(szBuffer);
2124     if(lpPtr != NULL) {
2125 	Renew(*lpPtr, length, char);
2126 	strcpy(*lpPtr, lpStr);
2127     }
2128     else {
2129 	++m_dwEnvCount;
2130 	Renew(m_lppEnvList, m_dwEnvCount, LPSTR);
2131 	New(1, m_lppEnvList[m_dwEnvCount-1], length, char);
2132 	if(m_lppEnvList[m_dwEnvCount-1] != NULL) {
2133 	    strcpy(m_lppEnvList[m_dwEnvCount-1], lpStr);
2134 	    qsort(m_lppEnvList, m_dwEnvCount, sizeof(LPSTR), compare);
2135 	}
2136 	else
2137 	    --m_dwEnvCount;
2138     }
2139 }
2140 
2141 DWORD
2142 CPerlHost::CalculateEnvironmentSpace(void)
2143 {
2144     DWORD index;
2145     DWORD dwSize = 0;
2146     for(index = 0; index < m_dwEnvCount; ++index)
2147 	dwSize += strlen(m_lppEnvList[index]) + 1;
2148 
2149     return dwSize;
2150 }
2151 
2152 void
2153 CPerlHost::FreeLocalEnvironmentStrings(LPSTR lpStr)
2154 {
2155     dTHXo;
2156     Safefree(lpStr);
2157 }
2158 
2159 char*
2160 CPerlHost::GetChildDir(void)
2161 {
2162     dTHXo;
2163     int length;
2164     char* ptr;
2165     New(0, ptr, MAX_PATH+1, char);
2166     if(ptr) {
2167 	m_pvDir->GetCurrentDirectoryA(MAX_PATH+1, ptr);
2168 	length = strlen(ptr);
2169 	if (length > 3) {
2170 	    if ((ptr[length-1] == '\\') || (ptr[length-1] == '/'))
2171 		ptr[length-1] = 0;
2172 	}
2173     }
2174     return ptr;
2175 }
2176 
2177 void
2178 CPerlHost::FreeChildDir(char* pStr)
2179 {
2180     dTHXo;
2181     Safefree(pStr);
2182 }
2183 
2184 LPSTR
2185 CPerlHost::CreateLocalEnvironmentStrings(VDir &vDir)
2186 {
2187     dTHXo;
2188     LPSTR lpStr, lpPtr, lpEnvPtr, lpTmp, lpLocalEnv, lpAllocPtr;
2189     DWORD dwSize, dwEnvIndex;
2190     int nLength, compVal;
2191 
2192     // get the process environment strings
2193     lpAllocPtr = lpTmp = (LPSTR)GetEnvironmentStrings();
2194 
2195     // step over current directory stuff
2196     while(*lpTmp == '=')
2197 	lpTmp += strlen(lpTmp) + 1;
2198 
2199     // save the start of the environment strings
2200     lpEnvPtr = lpTmp;
2201     for(dwSize = 1; *lpTmp != '\0'; lpTmp += strlen(lpTmp) + 1) {
2202 	// calculate the size of the environment strings
2203 	dwSize += strlen(lpTmp) + 1;
2204     }
2205 
2206     // add the size of current directories
2207     dwSize += vDir.CalculateEnvironmentSpace();
2208 
2209     // add the additional space used by changes made to the environment
2210     dwSize += CalculateEnvironmentSpace();
2211 
2212     New(1, lpStr, dwSize, char);
2213     lpPtr = lpStr;
2214     if(lpStr != NULL) {
2215 	// build the local environment
2216 	lpStr = vDir.BuildEnvironmentSpace(lpStr);
2217 
2218 	dwEnvIndex = 0;
2219 	lpLocalEnv = GetIndex(dwEnvIndex);
2220 	while(*lpEnvPtr != '\0') {
2221 	    if(!lpLocalEnv) {
2222 		// all environment overrides have been added
2223 		// so copy string into place
2224 		strcpy(lpStr, lpEnvPtr);
2225 		nLength = strlen(lpEnvPtr) + 1;
2226 		lpStr += nLength;
2227 		lpEnvPtr += nLength;
2228 	    }
2229 	    else {
2230 		// determine which string to copy next
2231 		compVal = compare(&lpEnvPtr, &lpLocalEnv);
2232 		if(compVal < 0) {
2233 		    strcpy(lpStr, lpEnvPtr);
2234 		    nLength = strlen(lpEnvPtr) + 1;
2235 		    lpStr += nLength;
2236 		    lpEnvPtr += nLength;
2237 		}
2238 		else {
2239 		    char *ptr = strchr(lpLocalEnv, '=');
2240 		    if(ptr && ptr[1]) {
2241 			strcpy(lpStr, lpLocalEnv);
2242 			lpStr += strlen(lpLocalEnv) + 1;
2243 		    }
2244 		    lpLocalEnv = GetIndex(dwEnvIndex);
2245 		    if(compVal == 0) {
2246 			// this string was replaced
2247 			lpEnvPtr += strlen(lpEnvPtr) + 1;
2248 		    }
2249 		}
2250 	    }
2251 	}
2252 
2253 	while(lpLocalEnv) {
2254 	    // still have environment overrides to add
2255 	    // so copy the strings into place
2256 	    strcpy(lpStr, lpLocalEnv);
2257 	    nLength = strlen(lpLocalEnv) + 1;
2258 	    lpStr += nLength;
2259 	    lpEnvPtr += nLength;
2260 	    lpLocalEnv = GetIndex(dwEnvIndex);
2261 	}
2262 
2263 	// add final NULL
2264 	*lpStr = '\0';
2265     }
2266 
2267     // release the process environment strings
2268     FreeEnvironmentStrings(lpAllocPtr);
2269 
2270     return lpPtr;
2271 }
2272 
2273 void
2274 CPerlHost::Reset(void)
2275 {
2276     dTHXo;
2277     if(m_lppEnvList != NULL) {
2278 	for(DWORD index = 0; index < m_dwEnvCount; ++index) {
2279 	    Safefree(m_lppEnvList[index]);
2280 	    m_lppEnvList[index] = NULL;
2281 	}
2282     }
2283     m_dwEnvCount = 0;
2284 }
2285 
2286 void
2287 CPerlHost::Clearenv(void)
2288 {
2289     char ch;
2290     LPSTR lpPtr, lpStr, lpEnvPtr;
2291     if(m_lppEnvList != NULL) {
2292 	/* set every entry to an empty string */
2293 	for(DWORD index = 0; index < m_dwEnvCount; ++index) {
2294 	    char* ptr = strchr(m_lppEnvList[index], '=');
2295 	    if(ptr) {
2296 		*++ptr = 0;
2297 	    }
2298 	}
2299     }
2300 
2301     /* get the process environment strings */
2302     lpStr = lpEnvPtr = (LPSTR)GetEnvironmentStrings();
2303 
2304     /* step over current directory stuff */
2305     while(*lpStr == '=')
2306 	lpStr += strlen(lpStr) + 1;
2307 
2308     while(*lpStr) {
2309 	lpPtr = strchr(lpStr, '=');
2310 	if(lpPtr) {
2311 	    ch = *++lpPtr;
2312 	    *lpPtr = 0;
2313 	    Add(lpStr);
2314 	    *lpPtr = ch;
2315 	}
2316 	lpStr += strlen(lpStr) + 1;
2317     }
2318 
2319     FreeEnvironmentStrings(lpEnvPtr);
2320 }
2321 
2322 
2323 char*
2324 CPerlHost::Getenv(const char *varname)
2325 {
2326     char* pEnv = Find(varname);
2327     if(pEnv == NULL) {
2328 	pEnv = win32_getenv(varname);
2329     }
2330     else {
2331 	if(!*pEnv)
2332 	    pEnv = 0;
2333     }
2334 
2335     return pEnv;
2336 }
2337 
2338 int
2339 CPerlHost::Putenv(const char *envstring)
2340 {
2341     Add(envstring);
2342     return 0;
2343 }
2344 
2345 int
2346 CPerlHost::Chdir(const char *dirname)
2347 {
2348     dTHXo;
2349     int ret;
2350     if (USING_WIDE()) {
2351 	WCHAR wBuffer[MAX_PATH];
2352 	A2WHELPER(dirname, wBuffer, sizeof(wBuffer));
2353 	ret = m_pvDir->SetCurrentDirectoryW(wBuffer);
2354     }
2355     else
2356 	ret = m_pvDir->SetCurrentDirectoryA((char*)dirname);
2357     if(ret < 0) {
2358 	errno = ENOENT;
2359     }
2360     return ret;
2361 }
2362 
2363 #endif /* ___PerlHost_H___ */
2364