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