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