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     dTHX;
1440     Perl_croak(aTHX_ "socketpair not implemented!\n");
1441     return 0;
1442 }
1443
1444 int
1445 PerlSockClosesocket(struct IPerlSock* piPerl, SOCKET s)
1446 {
1447     return win32_closesocket(s);
1448 }
1449
1450 int
1451 PerlSockIoctlsocket(struct IPerlSock* piPerl, SOCKET s, long cmd, u_long *argp)
1452 {
1453     return win32_ioctlsocket(s, cmd, argp);
1454 }
1455
1456 struct IPerlSock perlSock =
1457 {
1458     PerlSockHtonl,
1459     PerlSockHtons,
1460     PerlSockNtohl,
1461     PerlSockNtohs,
1462     PerlSockAccept,
1463     PerlSockBind,
1464     PerlSockConnect,
1465     PerlSockEndhostent,
1466     PerlSockEndnetent,
1467     PerlSockEndprotoent,
1468     PerlSockEndservent,
1469     PerlSockGethostname,
1470     PerlSockGetpeername,
1471     PerlSockGethostbyaddr,
1472     PerlSockGethostbyname,
1473     PerlSockGethostent,
1474     PerlSockGetnetbyaddr,
1475     PerlSockGetnetbyname,
1476     PerlSockGetnetent,
1477     PerlSockGetprotobyname,
1478     PerlSockGetprotobynumber,
1479     PerlSockGetprotoent,
1480     PerlSockGetservbyname,
1481     PerlSockGetservbyport,
1482     PerlSockGetservent,
1483     PerlSockGetsockname,
1484     PerlSockGetsockopt,
1485     PerlSockInetAddr,
1486     PerlSockInetNtoa,
1487     PerlSockListen,
1488     PerlSockRecv,
1489     PerlSockRecvfrom,
1490     PerlSockSelect,
1491     PerlSockSend,
1492     PerlSockSendto,
1493     PerlSockSethostent,
1494     PerlSockSetnetent,
1495     PerlSockSetprotoent,
1496     PerlSockSetservent,
1497     PerlSockSetsockopt,
1498     PerlSockShutdown,
1499     PerlSockSocket,
1500     PerlSockSocketpair,
1501     PerlSockClosesocket,
1502 };
1503
1504
1505 /* IPerlProc */
1506
1507 #define EXECF_EXEC 1
1508 #define EXECF_SPAWN 2
1509
1510 void
1511 PerlProcAbort(struct IPerlProc* piPerl)
1512 {
1513     win32_abort();
1514 }
1515
1516 char *
1517 PerlProcCrypt(struct IPerlProc* piPerl, const char* clear, const char* salt)
1518 {
1519     return win32_crypt(clear, salt);
1520 }
1521
1522 void
1523 PerlProcExit(struct IPerlProc* piPerl, int status)
1524 {
1525     exit(status);
1526 }
1527
1528 void
1529 PerlProc_Exit(struct IPerlProc* piPerl, int status)
1530 {
1531     _exit(status);
1532 }
1533
1534 int
1535 PerlProcExecl(struct IPerlProc* piPerl, const char *cmdname, const char *arg0, const char *arg1, const char *arg2, const char *arg3)
1536 {
1537     return execl(cmdname, arg0, arg1, arg2, arg3);
1538 }
1539
1540 int
1541 PerlProcExecv(struct IPerlProc* piPerl, const char *cmdname, const char *const *argv)
1542 {
1543     return win32_execvp(cmdname, argv);
1544 }
1545
1546 int
1547 PerlProcExecvp(struct IPerlProc* piPerl, const char *cmdname, const char *const *argv)
1548 {
1549     return win32_execvp(cmdname, argv);
1550 }
1551
1552 uid_t
1553 PerlProcGetuid(struct IPerlProc* piPerl)
1554 {
1555     return getuid();
1556 }
1557
1558 uid_t
1559 PerlProcGeteuid(struct IPerlProc* piPerl)
1560 {
1561     return geteuid();
1562 }
1563
1564 gid_t
1565 PerlProcGetgid(struct IPerlProc* piPerl)
1566 {
1567     return getgid();
1568 }
1569
1570 gid_t
1571 PerlProcGetegid(struct IPerlProc* piPerl)
1572 {
1573     return getegid();
1574 }
1575
1576 char *
1577 PerlProcGetlogin(struct IPerlProc* piPerl)
1578 {
1579     return g_getlogin();
1580 }
1581
1582 int
1583 PerlProcKill(struct IPerlProc* piPerl, int pid, int sig)
1584 {
1585     return win32_kill(pid, sig);
1586 }
1587
1588 int
1589 PerlProcKillpg(struct IPerlProc* piPerl, int pid, int sig)
1590 {
1591     dTHX;
1592     Perl_croak(aTHX_ "killpg not implemented!\n");
1593     return 0;
1594 }
1595
1596 int
1597 PerlProcPauseProc(struct IPerlProc* piPerl)
1598 {
1599     return win32_sleep((32767L << 16) + 32767);
1600 }
1601
1602 PerlIO*
1603 PerlProcPopen(struct IPerlProc* piPerl, const char *command, const char *mode)
1604 {
1605     dTHX;
1606     PERL_FLUSHALL_FOR_CHILD;
1607     return win32_popen(command, mode);
1608 }
1609
1610 PerlIO*
1611 PerlProcPopenList(struct IPerlProc* piPerl, const char *mode, IV narg, SV **args)
1612 {
1613     dTHX;
1614     PERL_FLUSHALL_FOR_CHILD;
1615     return win32_popenlist(mode, narg, args);
1616 }
1617
1618 int
1619 PerlProcPclose(struct IPerlProc* piPerl, PerlIO *stream)
1620 {
1621     return win32_pclose(stream);
1622 }
1623
1624 int
1625 PerlProcPipe(struct IPerlProc* piPerl, int *phandles)
1626 {
1627     return win32_pipe(phandles, 512, O_BINARY);
1628 }
1629
1630 int
1631 PerlProcSetuid(struct IPerlProc* piPerl, uid_t u)
1632 {
1633     return setuid(u);
1634 }
1635
1636 int
1637 PerlProcSetgid(struct IPerlProc* piPerl, gid_t g)
1638 {
1639     return setgid(g);
1640 }
1641
1642 int
1643 PerlProcSleep(struct IPerlProc* piPerl, unsigned int s)
1644 {
1645     return win32_sleep(s);
1646 }
1647
1648 int
1649 PerlProcTimes(struct IPerlProc* piPerl, struct tms *timebuf)
1650 {
1651     return win32_times(timebuf);
1652 }
1653
1654 int
1655 PerlProcWait(struct IPerlProc* piPerl, int *status)
1656 {
1657     return win32_wait(status);
1658 }
1659
1660 int
1661 PerlProcWaitpid(struct IPerlProc* piPerl, int pid, int *status, int flags)
1662 {
1663     return win32_waitpid(pid, status, flags);
1664 }
1665
1666 Sighandler_t
1667 PerlProcSignal(struct IPerlProc* piPerl, int sig, Sighandler_t subcode)
1668 {
1669     return signal(sig, subcode);
1670 }
1671
1672 #ifdef USE_ITHREADS
1673 static THREAD_RET_TYPE
1674 win32_start_child(LPVOID arg)
1675 {
1676     PerlInterpreter *my_perl = (PerlInterpreter*)arg;
1677     GV *tmpgv;
1678     int status;
1679 #ifdef PERL_SYNC_FORK
1680     static long sync_fork_id = 0;
1681     long id = ++sync_fork_id;
1682 #endif
1683
1684
1685     PERL_SET_THX(my_perl);
1686
1687     /* set $$ to pseudo id */
1688 #ifdef PERL_SYNC_FORK
1689     w32_pseudo_id = id;
1690 #else
1691     w32_pseudo_id = GetCurrentThreadId();
1692     if (IsWin95()) {
1693         int pid = (int)w32_pseudo_id;
1694         if (pid < 0)
1695             w32_pseudo_id = -pid;
1696     }
1697 #endif
1698     if (tmpgv = gv_fetchpv("$", TRUE, SVt_PV))
1699         sv_setiv(GvSV(tmpgv), -(IV)w32_pseudo_id);
1700     hv_clear(PL_pidstatus);
1701
1702     /* push a zero on the stack (we are the child) */
1703     {
1704         dSP;
1705         dTARGET;
1706         PUSHi(0);
1707         PUTBACK;
1708     }
1709
1710     /* continue from next op */
1711     PL_op = PL_op->op_next;
1712
1713     {
1714         dJMPENV;
1715         volatile int oldscope = PL_scopestack_ix;
1716
1717 restart:
1718         JMPENV_PUSH(status);
1719         switch (status) {
1720         case 0:
1721             CALLRUNOPS(aTHX);
1722             status = 0;
1723             break;
1724         case 2:
1725             while (PL_scopestack_ix > oldscope)
1726                 LEAVE;
1727             FREETMPS;
1728             PL_curstash = PL_defstash;
1729             if (PL_endav && !PL_minus_c)
1730                 call_list(oldscope, PL_endav);
1731             status = STATUS_NATIVE_EXPORT;
1732             break;
1733         case 3:
1734             if (PL_restartop) {
1735                 POPSTACK_TO(PL_mainstack);
1736                 PL_op = PL_restartop;
1737                 PL_restartop = Nullop;
1738                 goto restart;
1739             }
1740             PerlIO_printf(Perl_error_log, "panic: restartop\n");
1741             FREETMPS;
1742             status = 1;
1743             break;
1744         }
1745         JMPENV_POP;
1746
1747         /* XXX hack to avoid perl_destruct() freeing optree */
1748         PL_main_root = Nullop;
1749     }
1750
1751     /* close the std handles to avoid fd leaks */
1752     {
1753         do_close(gv_fetchpv("STDIN", TRUE, SVt_PVIO), FALSE);
1754         do_close(gv_fetchpv("STDOUT", TRUE, SVt_PVIO), FALSE);
1755         do_close(gv_fetchpv("STDERR", TRUE, SVt_PVIO), FALSE);
1756     }
1757
1758     /* destroy everything (waits for any pseudo-forked children) */
1759     perl_destruct(my_perl);
1760     perl_free(my_perl);
1761
1762 #ifdef PERL_SYNC_FORK
1763     return id;
1764 #else
1765     return (DWORD)status;
1766 #endif
1767 }
1768 #endif /* USE_ITHREADS */
1769
1770 int
1771 PerlProcFork(struct IPerlProc* piPerl)
1772 {
1773     dTHX;
1774 #ifdef USE_ITHREADS
1775     DWORD id;
1776     HANDLE handle;
1777     CPerlHost *h;
1778
1779     if (w32_num_pseudo_children >= MAXIMUM_WAIT_OBJECTS) {
1780         errno = EAGAIN;
1781         return -1;
1782     }
1783     h = new CPerlHost(*(CPerlHost*)w32_internal_host);
1784     PerlInterpreter *new_perl = perl_clone_using((PerlInterpreter*)aTHX, 1,
1785                                                  h->m_pHostperlMem,
1786                                                  h->m_pHostperlMemShared,
1787                                                  h->m_pHostperlMemParse,
1788                                                  h->m_pHostperlEnv,
1789                                                  h->m_pHostperlStdIO,
1790                                                  h->m_pHostperlLIO,
1791                                                  h->m_pHostperlDir,
1792                                                  h->m_pHostperlSock,
1793                                                  h->m_pHostperlProc
1794                                                  );
1795     new_perl->Isys_intern.internal_host = h;
1796 #  ifdef PERL_SYNC_FORK
1797     id = win32_start_child((LPVOID)new_perl);
1798     PERL_SET_THX(aTHX);
1799 #  else
1800 #    ifdef USE_RTL_THREAD_API
1801     handle = (HANDLE)_beginthreadex((void*)NULL, 0, win32_start_child,
1802                                     (void*)new_perl, 0, (unsigned*)&id);
1803 #    else
1804     handle = CreateThread(NULL, 0, win32_start_child,
1805                           (LPVOID)new_perl, 0, &id);
1806 #    endif
1807     PERL_SET_THX(aTHX); /* XXX perl_clone*() set TLS */
1808     if (!handle) {
1809         errno = EAGAIN;
1810         return -1;
1811     }
1812     if (IsWin95()) {
1813         int pid = (int)id;
1814         if (pid < 0)
1815             id = -pid;
1816     }
1817     w32_pseudo_child_handles[w32_num_pseudo_children] = handle;
1818     w32_pseudo_child_pids[w32_num_pseudo_children] = id;
1819     ++w32_num_pseudo_children;
1820 #  endif
1821     return -(int)id;
1822 #else
1823     Perl_croak(aTHX_ "fork() not implemented!\n");
1824     return -1;
1825 #endif /* USE_ITHREADS */
1826 }
1827
1828 int
1829 PerlProcGetpid(struct IPerlProc* piPerl)
1830 {
1831     return win32_getpid();
1832 }
1833
1834 void*
1835 PerlProcDynaLoader(struct IPerlProc* piPerl, const char* filename)
1836 {
1837     return win32_dynaload(filename);
1838 }
1839
1840 void
1841 PerlProcGetOSError(struct IPerlProc* piPerl, SV* sv, DWORD dwErr)
1842 {
1843     win32_str_os_error(sv, dwErr);
1844 }
1845
1846 BOOL
1847 PerlProcDoCmd(struct IPerlProc* piPerl, char *cmd)
1848 {
1849     do_spawn2(cmd, EXECF_EXEC);
1850     return FALSE;
1851 }
1852
1853 int
1854 PerlProcSpawn(struct IPerlProc* piPerl, char* cmds)
1855 {
1856     return do_spawn2(cmds, EXECF_SPAWN);
1857 }
1858
1859 int
1860 PerlProcSpawnvp(struct IPerlProc* piPerl, int mode, const char *cmdname, const char *const *argv)
1861 {
1862     return win32_spawnvp(mode, cmdname, argv);
1863 }
1864
1865 int
1866 PerlProcASpawn(struct IPerlProc* piPerl, void *vreally, void **vmark, void **vsp)
1867 {
1868     return do_aspawn(vreally, vmark, vsp);
1869 }
1870
1871 int
1872 PerlProcLastHost(struct IPerlProc* piPerl)
1873 {
1874  dTHX;
1875  CPerlHost *h = (CPerlHost*)w32_internal_host;
1876  return h->LastHost();
1877 }
1878
1879 struct IPerlProc perlProc =
1880 {
1881     PerlProcAbort,
1882     PerlProcCrypt,
1883     PerlProcExit,
1884     PerlProc_Exit,
1885     PerlProcExecl,
1886     PerlProcExecv,
1887     PerlProcExecvp,
1888     PerlProcGetuid,
1889     PerlProcGeteuid,
1890     PerlProcGetgid,
1891     PerlProcGetegid,
1892     PerlProcGetlogin,
1893     PerlProcKill,
1894     PerlProcKillpg,
1895     PerlProcPauseProc,
1896     PerlProcPopen,
1897     PerlProcPclose,
1898     PerlProcPipe,
1899     PerlProcSetuid,
1900     PerlProcSetgid,
1901     PerlProcSleep,
1902     PerlProcTimes,
1903     PerlProcWait,
1904     PerlProcWaitpid,
1905     PerlProcSignal,
1906     PerlProcFork,
1907     PerlProcGetpid,
1908     PerlProcDynaLoader,
1909     PerlProcGetOSError,
1910     PerlProcDoCmd,
1911     PerlProcSpawn,
1912     PerlProcSpawnvp,
1913     PerlProcASpawn,
1914     PerlProcLastHost,
1915     PerlProcPopenList
1916 };
1917
1918
1919 /*
1920  * CPerlHost
1921  */
1922
1923 CPerlHost::CPerlHost(void)
1924 {
1925     /* Construct a host from scratch */
1926     InterlockedIncrement(&num_hosts);
1927     m_pvDir = new VDir();
1928     m_pVMem = new VMem();
1929     m_pVMemShared = new VMem();
1930     m_pVMemParse =  new VMem();
1931
1932     m_pvDir->Init(NULL, m_pVMem);
1933
1934     m_dwEnvCount = 0;
1935     m_lppEnvList = NULL;
1936     m_bTopLevel = TRUE;
1937
1938     CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
1939     CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
1940     CopyMemory(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse));
1941     CopyMemory(&m_hostperlEnv, &perlEnv, sizeof(perlEnv));
1942     CopyMemory(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO));
1943     CopyMemory(&m_hostperlLIO, &perlLIO, sizeof(perlLIO));
1944     CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir));
1945     CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock));
1946     CopyMemory(&m_hostperlProc, &perlProc, sizeof(perlProc));
1947
1948     m_pHostperlMem          = &m_hostperlMem;
1949     m_pHostperlMemShared    = &m_hostperlMemShared;
1950     m_pHostperlMemParse     = &m_hostperlMemParse;
1951     m_pHostperlEnv          = &m_hostperlEnv;
1952     m_pHostperlStdIO        = &m_hostperlStdIO;
1953     m_pHostperlLIO          = &m_hostperlLIO;
1954     m_pHostperlDir          = &m_hostperlDir;
1955     m_pHostperlSock         = &m_hostperlSock;
1956     m_pHostperlProc         = &m_hostperlProc;
1957 }
1958
1959 #define SETUPEXCHANGE(xptr, iptr, table) \
1960     STMT_START {                                \
1961         if (xptr) {                             \
1962             iptr = *xptr;                       \
1963             *xptr = &table;                     \
1964         }                                       \
1965         else {                                  \
1966             iptr = &table;                      \
1967         }                                       \
1968     } STMT_END
1969
1970 CPerlHost::CPerlHost(struct IPerlMem** ppMem, struct IPerlMem** ppMemShared,
1971                  struct IPerlMem** ppMemParse, struct IPerlEnv** ppEnv,
1972                  struct IPerlStdIO** ppStdIO, struct IPerlLIO** ppLIO,
1973                  struct IPerlDir** ppDir, struct IPerlSock** ppSock,
1974                  struct IPerlProc** ppProc)
1975 {
1976     InterlockedIncrement(&num_hosts);
1977     m_pvDir = new VDir(0);
1978     m_pVMem = new VMem();
1979     m_pVMemShared = new VMem();
1980     m_pVMemParse =  new VMem();
1981
1982     m_pvDir->Init(NULL, m_pVMem);
1983
1984     m_dwEnvCount = 0;
1985     m_lppEnvList = NULL;
1986     m_bTopLevel = FALSE;
1987
1988     CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
1989     CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
1990     CopyMemory(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse));
1991     CopyMemory(&m_hostperlEnv, &perlEnv, sizeof(perlEnv));
1992     CopyMemory(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO));
1993     CopyMemory(&m_hostperlLIO, &perlLIO, sizeof(perlLIO));
1994     CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir));
1995     CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock));
1996     CopyMemory(&m_hostperlProc, &perlProc, sizeof(perlProc));
1997
1998     SETUPEXCHANGE(ppMem,        m_pHostperlMem,         m_hostperlMem);
1999     SETUPEXCHANGE(ppMemShared,  m_pHostperlMemShared,   m_hostperlMemShared);
2000     SETUPEXCHANGE(ppMemParse,   m_pHostperlMemParse,    m_hostperlMemParse);
2001     SETUPEXCHANGE(ppEnv,        m_pHostperlEnv,         m_hostperlEnv);
2002     SETUPEXCHANGE(ppStdIO,      m_pHostperlStdIO,       m_hostperlStdIO);
2003     SETUPEXCHANGE(ppLIO,        m_pHostperlLIO,         m_hostperlLIO);
2004     SETUPEXCHANGE(ppDir,        m_pHostperlDir,         m_hostperlDir);
2005     SETUPEXCHANGE(ppSock,       m_pHostperlSock,        m_hostperlSock);
2006     SETUPEXCHANGE(ppProc,       m_pHostperlProc,        m_hostperlProc);
2007 }
2008 #undef SETUPEXCHANGE
2009
2010 CPerlHost::CPerlHost(CPerlHost& host)
2011 {
2012     /* Construct a host from another host */
2013     InterlockedIncrement(&num_hosts);
2014     m_pVMem = new VMem();
2015     m_pVMemShared = host.GetMemShared();
2016     m_pVMemParse =  host.GetMemParse();
2017
2018     /* duplicate directory info */
2019     m_pvDir = new VDir(0);
2020     m_pvDir->Init(host.GetDir(), m_pVMem);
2021
2022     CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
2023     CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
2024     CopyMemory(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse));
2025     CopyMemory(&m_hostperlEnv, &perlEnv, sizeof(perlEnv));
2026     CopyMemory(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO));
2027     CopyMemory(&m_hostperlLIO, &perlLIO, sizeof(perlLIO));
2028     CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir));
2029     CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock));
2030     CopyMemory(&m_hostperlProc, &perlProc, sizeof(perlProc));
2031     m_pHostperlMem          = &m_hostperlMem;
2032     m_pHostperlMemShared    = &m_hostperlMemShared;
2033     m_pHostperlMemParse     = &m_hostperlMemParse;
2034     m_pHostperlEnv          = &m_hostperlEnv;
2035     m_pHostperlStdIO        = &m_hostperlStdIO;
2036     m_pHostperlLIO          = &m_hostperlLIO;
2037     m_pHostperlDir          = &m_hostperlDir;
2038     m_pHostperlSock         = &m_hostperlSock;
2039     m_pHostperlProc         = &m_hostperlProc;
2040
2041     m_dwEnvCount = 0;
2042     m_lppEnvList = NULL;
2043     m_bTopLevel = FALSE;
2044
2045     /* duplicate environment info */
2046     LPSTR lpPtr;
2047     DWORD dwIndex = 0;
2048     while(lpPtr = host.GetIndex(dwIndex))
2049         Add(lpPtr);
2050 }
2051
2052 CPerlHost::~CPerlHost(void)
2053 {
2054 //  Reset();
2055     InterlockedDecrement(&num_hosts);
2056     delete m_pvDir;
2057     m_pVMemParse->Release();
2058     m_pVMemShared->Release();
2059     m_pVMem->Release();
2060 }
2061
2062 LPSTR
2063 CPerlHost::Find(LPCSTR lpStr)
2064 {
2065     LPSTR lpPtr;
2066     LPSTR* lppPtr = Lookup(lpStr);
2067     if(lppPtr != NULL) {
2068         for(lpPtr = *lppPtr; *lpPtr != '\0' && *lpPtr != '='; ++lpPtr)
2069             ;
2070
2071         if(*lpPtr == '=')
2072             ++lpPtr;
2073
2074         return lpPtr;
2075     }
2076     return NULL;
2077 }
2078
2079 int
2080 lookup(const void *arg1, const void *arg2)
2081 {   // Compare strings
2082     char*ptr1, *ptr2;
2083     char c1,c2;
2084
2085     ptr1 = *(char**)arg1;
2086     ptr2 = *(char**)arg2;
2087     for(;;) {
2088         c1 = *ptr1++;
2089         c2 = *ptr2++;
2090         if(c1 == '\0' || c1 == '=') {
2091             if(c2 == '\0' || c2 == '=')
2092                 break;
2093
2094             return -1; // string 1 < string 2
2095         }
2096         else if(c2 == '\0' || c2 == '=')
2097             return 1; // string 1 > string 2
2098         else if(c1 != c2) {
2099             c1 = toupper(c1);
2100             c2 = toupper(c2);
2101             if(c1 != c2) {
2102                 if(c1 < c2)
2103                     return -1; // string 1 < string 2
2104
2105                 return 1; // string 1 > string 2
2106             }
2107         }
2108     }
2109     return 0;
2110 }
2111
2112 LPSTR*
2113 CPerlHost::Lookup(LPCSTR lpStr)
2114 {
2115     return (LPSTR*)bsearch(&lpStr, m_lppEnvList, m_dwEnvCount, sizeof(LPSTR), lookup);
2116 }
2117
2118 int
2119 compare(const void *arg1, const void *arg2)
2120 {   // Compare strings
2121     char*ptr1, *ptr2;
2122     char c1,c2;
2123
2124     ptr1 = *(char**)arg1;
2125     ptr2 = *(char**)arg2;
2126     for(;;) {
2127         c1 = *ptr1++;
2128         c2 = *ptr2++;
2129         if(c1 == '\0' || c1 == '=') {
2130             if(c1 == c2)
2131                 break;
2132
2133             return -1; // string 1 < string 2
2134         }
2135         else if(c2 == '\0' || c2 == '=')
2136             return 1; // string 1 > string 2
2137         else if(c1 != c2) {
2138             c1 = toupper(c1);
2139             c2 = toupper(c2);
2140             if(c1 != c2) {
2141                 if(c1 < c2)
2142                     return -1; // string 1 < string 2
2143
2144                 return 1; // string 1 > string 2
2145             }
2146         }
2147     }
2148     return 0;
2149 }
2150
2151 void
2152 CPerlHost::Add(LPCSTR lpStr)
2153 {
2154     dTHX;
2155     char szBuffer[1024];
2156     LPSTR *lpPtr;
2157     int index, length = strlen(lpStr)+1;
2158
2159     for(index = 0; lpStr[index] != '\0' && lpStr[index] != '='; ++index)
2160         szBuffer[index] = lpStr[index];
2161
2162     szBuffer[index] = '\0';
2163
2164     // replacing ?
2165     lpPtr = Lookup(szBuffer);
2166     if(lpPtr != NULL) {
2167         Renew(*lpPtr, length, char);
2168         strcpy(*lpPtr, lpStr);
2169     }
2170     else {
2171         ++m_dwEnvCount;
2172         Renew(m_lppEnvList, m_dwEnvCount, LPSTR);
2173         New(1, m_lppEnvList[m_dwEnvCount-1], length, char);
2174         if(m_lppEnvList[m_dwEnvCount-1] != NULL) {
2175             strcpy(m_lppEnvList[m_dwEnvCount-1], lpStr);
2176             qsort(m_lppEnvList, m_dwEnvCount, sizeof(LPSTR), compare);
2177         }
2178         else
2179             --m_dwEnvCount;
2180     }
2181 }
2182
2183 DWORD
2184 CPerlHost::CalculateEnvironmentSpace(void)
2185 {
2186     DWORD index;
2187     DWORD dwSize = 0;
2188     for(index = 0; index < m_dwEnvCount; ++index)
2189         dwSize += strlen(m_lppEnvList[index]) + 1;
2190
2191     return dwSize;
2192 }
2193
2194 void
2195 CPerlHost::FreeLocalEnvironmentStrings(LPSTR lpStr)
2196 {
2197     dTHX;
2198     Safefree(lpStr);
2199 }
2200
2201 char*
2202 CPerlHost::GetChildDir(void)
2203 {
2204     dTHX;
2205     int length;
2206     char* ptr;
2207     New(0, ptr, MAX_PATH+1, char);
2208     if(ptr) {
2209         m_pvDir->GetCurrentDirectoryA(MAX_PATH+1, ptr);
2210         length = strlen(ptr);
2211         if (length > 3) {
2212             if ((ptr[length-1] == '\\') || (ptr[length-1] == '/'))
2213                 ptr[length-1] = 0;
2214         }
2215     }
2216     return ptr;
2217 }
2218
2219 void
2220 CPerlHost::FreeChildDir(char* pStr)
2221 {
2222     dTHX;
2223     Safefree(pStr);
2224 }
2225
2226 LPSTR
2227 CPerlHost::CreateLocalEnvironmentStrings(VDir &vDir)
2228 {
2229     dTHX;
2230     LPSTR lpStr, lpPtr, lpEnvPtr, lpTmp, lpLocalEnv, lpAllocPtr;
2231     DWORD dwSize, dwEnvIndex;
2232     int nLength, compVal;
2233
2234     // get the process environment strings
2235     lpAllocPtr = lpTmp = (LPSTR)GetEnvironmentStrings();
2236
2237     // step over current directory stuff
2238     while(*lpTmp == '=')
2239         lpTmp += strlen(lpTmp) + 1;
2240
2241     // save the start of the environment strings
2242     lpEnvPtr = lpTmp;
2243     for(dwSize = 1; *lpTmp != '\0'; lpTmp += strlen(lpTmp) + 1) {
2244         // calculate the size of the environment strings
2245         dwSize += strlen(lpTmp) + 1;
2246     }
2247
2248     // add the size of current directories
2249     dwSize += vDir.CalculateEnvironmentSpace();
2250
2251     // add the additional space used by changes made to the environment
2252     dwSize += CalculateEnvironmentSpace();
2253
2254     New(1, lpStr, dwSize, char);
2255     lpPtr = lpStr;
2256     if(lpStr != NULL) {
2257         // build the local environment
2258         lpStr = vDir.BuildEnvironmentSpace(lpStr);
2259
2260         dwEnvIndex = 0;
2261         lpLocalEnv = GetIndex(dwEnvIndex);
2262         while(*lpEnvPtr != '\0') {
2263             if(!lpLocalEnv) {
2264                 // all environment overrides have been added
2265                 // so copy string into place
2266                 strcpy(lpStr, lpEnvPtr);
2267                 nLength = strlen(lpEnvPtr) + 1;
2268                 lpStr += nLength;
2269                 lpEnvPtr += nLength;
2270             }
2271             else {
2272                 // determine which string to copy next
2273                 compVal = compare(&lpEnvPtr, &lpLocalEnv);
2274                 if(compVal < 0) {
2275                     strcpy(lpStr, lpEnvPtr);
2276                     nLength = strlen(lpEnvPtr) + 1;
2277                     lpStr += nLength;
2278                     lpEnvPtr += nLength;
2279                 }
2280                 else {
2281                     char *ptr = strchr(lpLocalEnv, '=');
2282                     if(ptr && ptr[1]) {
2283                         strcpy(lpStr, lpLocalEnv);
2284                         lpStr += strlen(lpLocalEnv) + 1;
2285                     }
2286                     lpLocalEnv = GetIndex(dwEnvIndex);
2287                     if(compVal == 0) {
2288                         // this string was replaced
2289                         lpEnvPtr += strlen(lpEnvPtr) + 1;
2290                     }
2291                 }
2292             }
2293         }
2294
2295         while(lpLocalEnv) {
2296             // still have environment overrides to add
2297             // so copy the strings into place if not an override
2298             char *ptr = strchr(lpLocalEnv, '=');
2299             if(ptr && ptr[1]) {
2300                 strcpy(lpStr, lpLocalEnv);
2301                 lpStr += strlen(lpLocalEnv) + 1;
2302             }
2303             lpLocalEnv = GetIndex(dwEnvIndex);
2304         }
2305
2306         // add final NULL
2307         *lpStr = '\0';
2308     }
2309
2310     // release the process environment strings
2311     FreeEnvironmentStrings(lpAllocPtr);
2312
2313     return lpPtr;
2314 }
2315
2316 void
2317 CPerlHost::Reset(void)
2318 {
2319     dTHX;
2320     if(m_lppEnvList != NULL) {
2321         for(DWORD index = 0; index < m_dwEnvCount; ++index) {
2322             Safefree(m_lppEnvList[index]);
2323             m_lppEnvList[index] = NULL;
2324         }
2325     }
2326     m_dwEnvCount = 0;
2327 }
2328
2329 void
2330 CPerlHost::Clearenv(void)
2331 {
2332     dTHX;
2333     char ch;
2334     LPSTR lpPtr, lpStr, lpEnvPtr;
2335     if (m_lppEnvList != NULL) {
2336         /* set every entry to an empty string */
2337         for(DWORD index = 0; index < m_dwEnvCount; ++index) {
2338             char* ptr = strchr(m_lppEnvList[index], '=');
2339             if(ptr) {
2340                 *++ptr = 0;
2341             }
2342         }
2343     }
2344
2345     /* get the process environment strings */
2346     lpStr = lpEnvPtr = (LPSTR)GetEnvironmentStrings();
2347
2348     /* step over current directory stuff */
2349     while(*lpStr == '=')
2350         lpStr += strlen(lpStr) + 1;
2351
2352     while(*lpStr) {
2353         lpPtr = strchr(lpStr, '=');
2354         if(lpPtr) {
2355             ch = *++lpPtr;
2356             *lpPtr = 0;
2357             Add(lpStr);
2358             if (m_bTopLevel)
2359                 (void)win32_putenv(lpStr);
2360             *lpPtr = ch;
2361         }
2362         lpStr += strlen(lpStr) + 1;
2363     }
2364
2365     FreeEnvironmentStrings(lpEnvPtr);
2366 }
2367
2368
2369 char*
2370 CPerlHost::Getenv(const char *varname)
2371 {
2372     dTHX;
2373     if (!m_bTopLevel) {
2374         char *pEnv = Find(varname);
2375         if (pEnv && *pEnv)
2376             return pEnv;
2377     }
2378     return win32_getenv(varname);
2379 }
2380
2381 int
2382 CPerlHost::Putenv(const char *envstring)
2383 {
2384     dTHX;
2385     Add(envstring);
2386     if (m_bTopLevel)
2387         return win32_putenv(envstring);
2388
2389     return 0;
2390 }
2391
2392 int
2393 CPerlHost::Chdir(const char *dirname)
2394 {
2395     dTHX;
2396     int ret;
2397     if (!dirname) {
2398         errno = ENOENT;
2399         return -1;
2400     }
2401     if (USING_WIDE()) {
2402         WCHAR wBuffer[MAX_PATH];
2403         A2WHELPER(dirname, wBuffer, sizeof(wBuffer));
2404         ret = m_pvDir->SetCurrentDirectoryW(wBuffer);
2405     }
2406     else
2407         ret = m_pvDir->SetCurrentDirectoryA((char*)dirname);
2408     if(ret < 0) {
2409         errno = ENOENT;
2410     }
2411     return ret;
2412 }
2413
2414 #endif /* ___PerlHost_H___ */