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