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