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     /* destroy everything (waits for any pseudo-forked children) */
1723     perl_destruct(my_perl);
1724     perl_free(my_perl);
1725
1726 #ifdef PERL_SYNC_FORK
1727     return id;
1728 #else
1729     return (DWORD)status;
1730 #endif
1731 }
1732 #endif /* USE_ITHREADS */
1733
1734 int
1735 PerlProcFork(struct IPerlProc* piPerl)
1736 {
1737     dTHXo;
1738 #ifdef USE_ITHREADS
1739     DWORD id;
1740     HANDLE handle;
1741     CPerlHost *h = new CPerlHost(*(CPerlHost*)w32_internal_host);
1742     PerlInterpreter *new_perl = perl_clone_using((PerlInterpreter*)aTHXo, 1,
1743                                                  h->m_pHostperlMem,
1744                                                  h->m_pHostperlMemShared,
1745                                                  h->m_pHostperlMemParse,
1746                                                  h->m_pHostperlEnv,
1747                                                  h->m_pHostperlStdIO,
1748                                                  h->m_pHostperlLIO,
1749                                                  h->m_pHostperlDir,
1750                                                  h->m_pHostperlSock,
1751                                                  h->m_pHostperlProc
1752                                                  );
1753     new_perl->Isys_intern.internal_host = h;
1754 #  ifdef PERL_SYNC_FORK
1755     id = win32_start_child((LPVOID)new_perl);
1756     PERL_SET_THX(aTHXo);
1757 #  else
1758 #    ifdef USE_RTL_THREAD_API
1759     handle = (HANDLE)_beginthreadex((void*)NULL, 0, win32_start_child,
1760                                     (void*)new_perl, 0, (unsigned*)&id);
1761 #    else
1762     handle = CreateThread(NULL, 0, win32_start_child,
1763                           (LPVOID)new_perl, 0, &id);
1764 #    endif
1765     PERL_SET_THX(aTHXo);        /* XXX perl_clone*() set TLS */
1766     if (!handle)
1767         Perl_croak(aTHX_ "panic: pseudo fork() failed");
1768     w32_pseudo_child_handles[w32_num_pseudo_children] = handle;
1769     w32_pseudo_child_pids[w32_num_pseudo_children] = id;
1770     ++w32_num_pseudo_children;
1771 #  endif
1772     return -(int)id;
1773 #else
1774     Perl_croak(aTHX_ "fork() not implemented!\n");
1775     return -1;
1776 #endif /* USE_ITHREADS */
1777 }
1778
1779 int
1780 PerlProcGetpid(struct IPerlProc* piPerl)
1781 {
1782     return win32_getpid();
1783 }
1784
1785 void*
1786 PerlProcDynaLoader(struct IPerlProc* piPerl, const char* filename)
1787 {
1788     return win32_dynaload(filename);
1789 }
1790
1791 void
1792 PerlProcGetOSError(struct IPerlProc* piPerl, SV* sv, DWORD dwErr)
1793 {
1794     win32_str_os_error(sv, dwErr);
1795 }
1796
1797 BOOL
1798 PerlProcDoCmd(struct IPerlProc* piPerl, char *cmd)
1799 {
1800     do_spawn2(cmd, EXECF_EXEC);
1801     return FALSE;
1802 }
1803
1804 int
1805 PerlProcSpawn(struct IPerlProc* piPerl, char* cmds)
1806 {
1807     return do_spawn2(cmds, EXECF_SPAWN);
1808 }
1809
1810 int
1811 PerlProcSpawnvp(struct IPerlProc* piPerl, int mode, const char *cmdname, const char *const *argv)
1812 {
1813     return win32_spawnvp(mode, cmdname, argv);
1814 }
1815
1816 int
1817 PerlProcASpawn(struct IPerlProc* piPerl, void *vreally, void **vmark, void **vsp)
1818 {
1819     return do_aspawn(vreally, vmark, vsp);
1820 }
1821
1822 struct IPerlProc perlProc =
1823 {
1824     PerlProcAbort,
1825     PerlProcCrypt,
1826     PerlProcExit,
1827     PerlProc_Exit,
1828     PerlProcExecl,
1829     PerlProcExecv,
1830     PerlProcExecvp,
1831     PerlProcGetuid,
1832     PerlProcGeteuid,
1833     PerlProcGetgid,
1834     PerlProcGetegid,
1835     PerlProcGetlogin,
1836     PerlProcKill,
1837     PerlProcKillpg,
1838     PerlProcPauseProc,
1839     PerlProcPopen,
1840     PerlProcPclose,
1841     PerlProcPipe,
1842     PerlProcSetuid,
1843     PerlProcSetgid,
1844     PerlProcSleep,
1845     PerlProcTimes,
1846     PerlProcWait,
1847     PerlProcWaitpid,
1848     PerlProcSignal,
1849     PerlProcFork,
1850     PerlProcGetpid,
1851     PerlProcDynaLoader,
1852     PerlProcGetOSError,
1853     PerlProcDoCmd,
1854     PerlProcSpawn,
1855     PerlProcSpawnvp,
1856     PerlProcASpawn,
1857 };
1858
1859
1860 /*
1861  * CPerlHost
1862  */
1863
1864 CPerlHost::CPerlHost(void)
1865 {
1866     m_pvDir = new VDir();
1867     m_pVMem = new VMem();
1868     m_pVMemShared = new VMem();
1869     m_pVMemParse =  new VMem();
1870
1871     m_pvDir->Init(NULL, m_pVMem);
1872
1873     m_dwEnvCount = 0;
1874     m_lppEnvList = NULL;
1875
1876     CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
1877     CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
1878     CopyMemory(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse));
1879     CopyMemory(&m_hostperlEnv, &perlEnv, sizeof(perlEnv));
1880     CopyMemory(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO));
1881     CopyMemory(&m_hostperlLIO, &perlLIO, sizeof(perlLIO));
1882     CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir));
1883     CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock));
1884     CopyMemory(&m_hostperlProc, &perlProc, sizeof(perlProc));
1885
1886     m_pHostperlMem          = &m_hostperlMem;
1887     m_pHostperlMemShared    = &m_hostperlMemShared;
1888     m_pHostperlMemParse     = &m_hostperlMemParse;
1889     m_pHostperlEnv          = &m_hostperlEnv;
1890     m_pHostperlStdIO        = &m_hostperlStdIO;
1891     m_pHostperlLIO          = &m_hostperlLIO;
1892     m_pHostperlDir          = &m_hostperlDir;
1893     m_pHostperlSock         = &m_hostperlSock;
1894     m_pHostperlProc         = &m_hostperlProc;
1895 }
1896
1897 #define SETUPEXCHANGE(xptr, iptr, table) \
1898     STMT_START {                                \
1899         if (xptr) {                             \
1900             iptr = *xptr;                       \
1901             *xptr = &table;                     \
1902         }                                       \
1903         else {                                  \
1904             iptr = &table;                      \
1905         }                                       \
1906     } STMT_END
1907
1908 CPerlHost::CPerlHost(struct IPerlMem** ppMem, struct IPerlMem** ppMemShared,
1909                  struct IPerlMem** ppMemParse, struct IPerlEnv** ppEnv,
1910                  struct IPerlStdIO** ppStdIO, struct IPerlLIO** ppLIO,
1911                  struct IPerlDir** ppDir, struct IPerlSock** ppSock,
1912                  struct IPerlProc** ppProc)
1913 {
1914     m_pvDir = new VDir(0);
1915     m_pVMem = new VMem();
1916     m_pVMemShared = new VMem();
1917     m_pVMemParse =  new VMem();
1918
1919     m_pvDir->Init(NULL, m_pVMem);
1920
1921     m_dwEnvCount = 0;
1922     m_lppEnvList = NULL;
1923
1924     CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
1925     CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
1926     CopyMemory(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse));
1927     CopyMemory(&m_hostperlEnv, &perlEnv, sizeof(perlEnv));
1928     CopyMemory(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO));
1929     CopyMemory(&m_hostperlLIO, &perlLIO, sizeof(perlLIO));
1930     CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir));
1931     CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock));
1932     CopyMemory(&m_hostperlProc, &perlProc, sizeof(perlProc));
1933
1934     SETUPEXCHANGE(ppMem,        m_pHostperlMem,         m_hostperlMem);
1935     SETUPEXCHANGE(ppMemShared,  m_pHostperlMemShared,   m_hostperlMemShared);
1936     SETUPEXCHANGE(ppMemParse,   m_pHostperlMemParse,    m_hostperlMemParse);
1937     SETUPEXCHANGE(ppEnv,        m_pHostperlEnv,         m_hostperlEnv);
1938     SETUPEXCHANGE(ppStdIO,      m_pHostperlStdIO,       m_hostperlStdIO);
1939     SETUPEXCHANGE(ppLIO,        m_pHostperlLIO,         m_hostperlLIO);
1940     SETUPEXCHANGE(ppDir,        m_pHostperlDir,         m_hostperlDir);
1941     SETUPEXCHANGE(ppSock,       m_pHostperlSock,        m_hostperlSock);
1942     SETUPEXCHANGE(ppProc,       m_pHostperlProc,        m_hostperlProc);
1943 }
1944 #undef SETUPEXCHANGE
1945
1946 CPerlHost::CPerlHost(CPerlHost& host)
1947 {
1948     m_pVMem = new VMem();
1949     m_pVMemShared = host.GetMemShared();
1950     m_pVMemParse =  host.GetMemParse();
1951
1952     /* duplicate directory info */
1953     m_pvDir = new VDir(0);
1954     m_pvDir->Init(host.GetDir(), m_pVMem);
1955
1956     CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
1957     CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
1958     CopyMemory(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse));
1959     CopyMemory(&m_hostperlEnv, &perlEnv, sizeof(perlEnv));
1960     CopyMemory(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO));
1961     CopyMemory(&m_hostperlLIO, &perlLIO, sizeof(perlLIO));
1962     CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir));
1963     CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock));
1964     CopyMemory(&m_hostperlProc, &perlProc, sizeof(perlProc));
1965     m_pHostperlMem          = &m_hostperlMem;
1966     m_pHostperlMemShared    = &m_hostperlMemShared;
1967     m_pHostperlMemParse     = &m_hostperlMemParse;
1968     m_pHostperlEnv          = &m_hostperlEnv;
1969     m_pHostperlStdIO        = &m_hostperlStdIO;
1970     m_pHostperlLIO          = &m_hostperlLIO;
1971     m_pHostperlDir          = &m_hostperlDir;
1972     m_pHostperlSock         = &m_hostperlSock;
1973     m_pHostperlProc         = &m_hostperlProc;
1974
1975     m_dwEnvCount = 0;
1976     m_lppEnvList = NULL;
1977
1978     /* duplicate environment info */
1979     LPSTR lpPtr;
1980     DWORD dwIndex = 0;
1981     while(lpPtr = host.GetIndex(dwIndex))
1982         Add(lpPtr);
1983 }
1984
1985 CPerlHost::~CPerlHost(void)
1986 {
1987 //  Reset();
1988     delete m_pvDir;
1989     m_pVMemParse->Release();
1990     m_pVMemShared->Release();
1991     m_pVMem->Release();
1992 }
1993
1994 LPSTR
1995 CPerlHost::Find(LPCSTR lpStr)
1996 {
1997     LPSTR lpPtr;
1998     LPSTR* lppPtr = Lookup(lpStr);
1999     if(lppPtr != NULL) {
2000         for(lpPtr = *lppPtr; *lpPtr != '\0' && *lpPtr != '='; ++lpPtr)
2001             ;
2002
2003         if(*lpPtr == '=')
2004             ++lpPtr;
2005
2006         return lpPtr;
2007     }
2008     return NULL;
2009 }
2010
2011 int
2012 lookup(const void *arg1, const void *arg2)
2013 {   // Compare strings
2014     char*ptr1, *ptr2;
2015     char c1,c2;
2016
2017     ptr1 = *(char**)arg1;
2018     ptr2 = *(char**)arg2;
2019     for(;;) {
2020         c1 = *ptr1++;
2021         c2 = *ptr2++;
2022         if(c1 == '\0' || c1 == '=') {
2023             if(c2 == '\0' || c2 == '=')
2024                 break;
2025
2026             return -1; // string 1 < string 2
2027         }
2028         else if(c2 == '\0' || c2 == '=')
2029             return 1; // string 1 > string 2
2030         else if(c1 != c2) {
2031             c1 = toupper(c1);
2032             c2 = toupper(c2);
2033             if(c1 != c2) {
2034                 if(c1 < c2)
2035                     return -1; // string 1 < string 2
2036
2037                 return 1; // string 1 > string 2
2038             }
2039         }
2040     }
2041     return 0;
2042 }
2043
2044 LPSTR*
2045 CPerlHost::Lookup(LPCSTR lpStr)
2046 {
2047     return (LPSTR*)bsearch(&lpStr, m_lppEnvList, m_dwEnvCount, sizeof(LPSTR), lookup);
2048 }
2049
2050 int
2051 compare(const void *arg1, const void *arg2)
2052 {   // Compare strings
2053     char*ptr1, *ptr2;
2054     char c1,c2;
2055
2056     ptr1 = *(char**)arg1;
2057     ptr2 = *(char**)arg2;
2058     for(;;) {
2059         c1 = *ptr1++;
2060         c2 = *ptr2++;
2061         if(c1 == '\0' || c1 == '=') {
2062             if(c1 == c2)
2063                 break;
2064
2065             return -1; // string 1 < string 2
2066         }
2067         else if(c2 == '\0' || c2 == '=')
2068             return 1; // string 1 > string 2
2069         else if(c1 != c2) {
2070             c1 = toupper(c1);
2071             c2 = toupper(c2);
2072             if(c1 != c2) {
2073                 if(c1 < c2)
2074                     return -1; // string 1 < string 2
2075
2076                 return 1; // string 1 > string 2
2077             }
2078         }
2079     }
2080     return 0;
2081 }
2082
2083 void
2084 CPerlHost::Add(LPCSTR lpStr)
2085 {
2086     dTHXo;
2087     char szBuffer[1024];
2088     LPSTR *lpPtr;
2089     int index, length = strlen(lpStr)+1;
2090
2091     for(index = 0; lpStr[index] != '\0' && lpStr[index] != '='; ++index)
2092         szBuffer[index] = lpStr[index];
2093
2094     szBuffer[index] = '\0';
2095
2096     // replacing ?
2097     lpPtr = Lookup(szBuffer);
2098     if(lpPtr != NULL) {
2099         Renew(*lpPtr, length, char);
2100         strcpy(*lpPtr, lpStr);
2101     }
2102     else {
2103         ++m_dwEnvCount;
2104         Renew(m_lppEnvList, m_dwEnvCount, LPSTR);
2105         New(1, m_lppEnvList[m_dwEnvCount-1], length, char);
2106         if(m_lppEnvList[m_dwEnvCount-1] != NULL) {
2107             strcpy(m_lppEnvList[m_dwEnvCount-1], lpStr);
2108             qsort(m_lppEnvList, m_dwEnvCount, sizeof(LPSTR), compare);
2109         }
2110         else
2111             --m_dwEnvCount;
2112     }
2113 }
2114
2115 DWORD
2116 CPerlHost::CalculateEnvironmentSpace(void)
2117 {
2118     DWORD index;
2119     DWORD dwSize = 0;
2120     for(index = 0; index < m_dwEnvCount; ++index)
2121         dwSize += strlen(m_lppEnvList[index]) + 1;
2122
2123     return dwSize;
2124 }
2125
2126 void
2127 CPerlHost::FreeLocalEnvironmentStrings(LPSTR lpStr)
2128 {
2129     dTHXo;
2130     Safefree(lpStr);
2131 }
2132
2133 char*
2134 CPerlHost::GetChildDir(void)
2135 {
2136     dTHXo;
2137     int length;
2138     char* ptr;
2139     New(0, ptr, MAX_PATH+1, char);
2140     if(ptr) {
2141         m_pvDir->GetCurrentDirectoryA(MAX_PATH+1, ptr);
2142         length = strlen(ptr)-1;
2143         if(length > 0) {
2144             if((ptr[length] == '\\') || (ptr[length] == '/'))
2145                 ptr[length] = 0;
2146         }
2147     }
2148     return ptr;
2149 }
2150
2151 void
2152 CPerlHost::FreeChildDir(char* pStr)
2153 {
2154     dTHXo;
2155     Safefree(pStr);
2156 }
2157
2158 LPSTR
2159 CPerlHost::CreateLocalEnvironmentStrings(VDir &vDir)
2160 {
2161     dTHXo;
2162     LPSTR lpStr, lpPtr, lpEnvPtr, lpTmp, lpLocalEnv, lpAllocPtr;
2163     DWORD dwSize, dwEnvIndex;
2164     int nLength, compVal;
2165
2166     // get the process environment strings
2167     lpAllocPtr = lpTmp = (LPSTR)GetEnvironmentStrings();
2168
2169     // step over current directory stuff
2170     while(*lpTmp == '=')
2171         lpTmp += strlen(lpTmp) + 1;
2172
2173     // save the start of the environment strings
2174     lpEnvPtr = lpTmp;
2175     for(dwSize = 1; *lpTmp != '\0'; lpTmp += strlen(lpTmp) + 1) {
2176         // calculate the size of the environment strings
2177         dwSize += strlen(lpTmp) + 1;
2178     }
2179
2180     // add the size of current directories
2181     dwSize += vDir.CalculateEnvironmentSpace();
2182
2183     // add the additional space used by changes made to the environment
2184     dwSize += CalculateEnvironmentSpace();
2185
2186     New(1, lpStr, dwSize, char);
2187     lpPtr = lpStr;
2188     if(lpStr != NULL) {
2189         // build the local environment
2190         lpStr = vDir.BuildEnvironmentSpace(lpStr);
2191
2192         dwEnvIndex = 0;
2193         lpLocalEnv = GetIndex(dwEnvIndex);
2194         while(*lpEnvPtr != '\0') {
2195             if(lpLocalEnv == NULL) {
2196                 // all environment overrides have been added
2197                 // so copy string into place
2198                 strcpy(lpStr, lpEnvPtr);
2199                 nLength = strlen(lpEnvPtr) + 1;
2200                 lpStr += nLength;
2201                 lpEnvPtr += nLength;
2202             }
2203             else {
2204                 // determine which string to copy next
2205                 compVal = compare(&lpEnvPtr, &lpLocalEnv);
2206                 if(compVal < 0) {
2207                     strcpy(lpStr, lpEnvPtr);
2208                     nLength = strlen(lpEnvPtr) + 1;
2209                     lpStr += nLength;
2210                     lpEnvPtr += nLength;
2211                 }
2212                 else {
2213                     char *ptr = strchr(lpLocalEnv, '=');
2214                     if(ptr && ptr[1]) {
2215                         strcpy(lpStr, lpLocalEnv);
2216                         lpStr += strlen(lpLocalEnv) + 1;
2217                     }
2218                     lpLocalEnv = GetIndex(dwEnvIndex);
2219                     if(compVal == 0) {
2220                         // this string was replaced
2221                         lpEnvPtr += strlen(lpEnvPtr) + 1;
2222                     }
2223                 }
2224             }
2225         }
2226
2227         // add final NULL
2228         *lpStr = '\0';
2229     }
2230
2231     // release the process environment strings
2232     FreeEnvironmentStrings(lpAllocPtr);
2233
2234     return lpPtr;
2235 }
2236
2237 void
2238 CPerlHost::Reset(void)
2239 {
2240     dTHXo;
2241     if(m_lppEnvList != NULL) {
2242         for(DWORD index = 0; index < m_dwEnvCount; ++index) {
2243             Safefree(m_lppEnvList[index]);
2244             m_lppEnvList[index] = NULL;
2245         }
2246     }
2247     m_dwEnvCount = 0;
2248 }
2249
2250 void
2251 CPerlHost::Clearenv(void)
2252 {
2253     char ch;
2254     LPSTR lpPtr, lpStr, lpEnvPtr;
2255     if(m_lppEnvList != NULL) {
2256         /* set every entry to an empty string */
2257         for(DWORD index = 0; index < m_dwEnvCount; ++index) {
2258             char* ptr = strchr(m_lppEnvList[index], '=');
2259             if(ptr) {
2260                 *++ptr = 0;
2261             }
2262         }
2263     }
2264
2265     /* get the process environment strings */
2266     lpStr = lpEnvPtr = (LPSTR)GetEnvironmentStrings();
2267
2268     /* step over current directory stuff */
2269     while(*lpStr == '=')
2270         lpStr += strlen(lpStr) + 1;
2271
2272     while(*lpStr) {
2273         lpPtr = strchr(lpStr, '=');
2274         if(lpPtr) {
2275             ch = *++lpPtr;
2276             *lpPtr = 0;
2277             Add(lpStr);
2278             *lpPtr = ch;
2279         }
2280         lpStr += strlen(lpStr) + 1;
2281     }
2282
2283     FreeEnvironmentStrings(lpEnvPtr);
2284 }
2285
2286
2287 char*
2288 CPerlHost::Getenv(const char *varname)
2289 {
2290     char* pEnv = Find(varname);
2291     if(pEnv == NULL) {
2292         pEnv = win32_getenv(varname);
2293     }
2294     else {
2295         if(!*pEnv)
2296             pEnv = 0;
2297     }
2298
2299     return pEnv;
2300 }
2301
2302 int
2303 CPerlHost::Putenv(const char *envstring)
2304 {
2305     Add(envstring);
2306     return 0;
2307 }
2308
2309 int
2310 CPerlHost::Chdir(const char *dirname)
2311 {
2312     dTHXo;
2313     int ret;
2314     if (USING_WIDE()) {
2315         WCHAR wBuffer[MAX_PATH];
2316         A2WHELPER(dirname, wBuffer, sizeof(wBuffer));
2317         ret = m_pvDir->SetCurrentDirectoryW(wBuffer);
2318     }
2319     else
2320         ret = m_pvDir->SetCurrentDirectoryA((char*)dirname);
2321     if(ret < 0) {
2322         errno = ENOENT;
2323     }
2324     return ret;
2325 }
2326
2327 #endif /* ___PerlHost_H___ */