wince/wince.c

   1 /*  WINCE.C - stuff for Windows CE
   2  *
   3  *  Time-stamp: <26/10/01 15:25:20 keuchel@keuchelnt>
   4  *
   5  *  You may distribute under the terms of either the GNU General Public
   6  *  License or the Artistic License, as specified in the README file.
   7  */
   8
   9 #define WIN32_LEAN_AND_MEAN
  10 #define WIN32IO_IS_STDIO
  11 #include <windows.h>
  12 #include <signal.h>
  13
  14 #define PERLIO_NOT_STDIO 0
  15
  16 #if !defined(PERLIO_IS_STDIO) && !defined(USE_SFIO)
  17 #define PerlIO FILE
  18 #endif
  19
  20 #define wince_private
  21 #include "errno.h"
  22
  23 #include "EXTERN.h"
  24 #include "perl.h"
  25
  26 #define NO_XSLOCKS
  27 #define PERL_NO_GET_CONTEXT
  28 #include "XSUB.h"
  29
  30 #include "win32iop.h"
  31 #include <string.h>
  32 #include <stdarg.h>
  33 #include <float.h>
  34 #include <shellapi.h>
  35
  36 #define perl
  37 #include "celib_defs.h"
  38 #include "cewin32.h"
  39 #include "cecrt.h"
  40 #include "cewin32_defs.h"
  41 #include "cecrt_defs.h"
  42
  43 #ifdef PALM_SIZE
  44 #include "stdio-palmsize.h"
  45 #endif
  46
  47 #define EXECF_EXEC 1
  48 #define EXECF_SPAWN 2
  49 #define EXECF_SPAWN_NOWAIT 3
  50
  51 #if defined(PERL_IMPLICIT_SYS)
  52 #  undef win32_get_privlib
  53 #  define win32_get_privlib g_win32_get_privlib
  54 #  undef win32_get_sitelib
  55 #  define win32_get_sitelib g_win32_get_sitelib
  56 #  undef win32_get_vendorlib
  57 #  define win32_get_vendorlib g_win32_get_vendorlib
  58 #  undef do_spawn
  59 #  define do_spawn g_do_spawn
  60 #  undef getlogin
  61 #  define getlogin g_getlogin
  62 #endif
  63
  64 static long             filetime_to_clock(PFILETIME ft);
  65 static BOOL             filetime_from_time(PFILETIME ft, time_t t);
  66 static char *           get_emd_part(SV **leading, char *trailing, ...);
  67 static char *           win32_get_xlib(const char *pl, const char *xlib,
  68                                        const char *libname);
  69
  70 START_EXTERN_C
  71 HANDLE  w32_perldll_handle = INVALID_HANDLE_VALUE;
  72 char    w32_module_name[MAX_PATH+1];
  73 END_EXTERN_C
  74
  75 static DWORD    w32_platform = (DWORD)-1;
  76
  77 int
  78 IsWin95(void)
  79 {
  80   return (win32_os_id() == VER_PLATFORM_WIN32_WINDOWS);
  81 }
  82
  83 int
  84 IsWinNT(void)
  85 {
  86   return (win32_os_id() == VER_PLATFORM_WIN32_NT);
  87 }
  88
  89 int
  90 IsWinCE(void)
  91 {
  92   return (win32_os_id() == VER_PLATFORM_WIN32_CE);
  93 }
  94
  95 EXTERN_C void
  96 set_w32_module_name(void)
  97 {
  98   char* ptr;
  99   XCEGetModuleFileNameA((HMODULE)((w32_perldll_handle == INVALID_HANDLE_VALUE)
 100                                   ? XCEGetModuleHandleA(NULL)
 101                                   : w32_perldll_handle),
 102                         w32_module_name, sizeof(w32_module_name));
 103
 104   /* normalize to forward slashes */
 105   ptr = w32_module_name;
 106   while (*ptr) {
 107     if (*ptr == '\\')
 108       *ptr = '/';
 109     ++ptr;
 110   }
 111 }
 112
 113 /* *svp (if non-NULL) is expected to be POK (valid allocated SvPVX(*svp)) */
 114 static char*
 115 get_regstr_from(HKEY hkey, const char *valuename, SV **svp)
 116 {
 117     /* Retrieve a REG_SZ or REG_EXPAND_SZ from the registry */
 118     HKEY handle;
 119     DWORD type;
 120     const char *subkey = "Software\\Perl";
 121     char *str = Nullch;
 122     long retval;
 123
 124     retval = XCERegOpenKeyExA(hkey, subkey, 0, KEY_READ, &handle);
 125     if (retval == ERROR_SUCCESS) {
 126         DWORD datalen;
 127         retval = XCERegQueryValueExA(handle, valuename, 0, &type, NULL, &datalen);
 128         if (retval == ERROR_SUCCESS && type == REG_SZ) {
 129             dTHX;
 130             if (!*svp)
 131                 *svp = sv_2mortal(newSVpvn("",0));
 132             SvGROW(*svp, datalen);
 133             retval = XCERegQueryValueExA(handle, valuename, 0, NULL,
 134                                      (PBYTE)SvPVX(*svp), &datalen);
 135             if (retval == ERROR_SUCCESS) {
 136                 str = SvPVX(*svp);
 137                 SvCUR_set(*svp,datalen-1);
 138             }
 139         }
 140         RegCloseKey(handle);
 141     }
 142     return str;
 143 }
 144
 145 /* *svp (if non-NULL) is expected to be POK (valid allocated SvPVX(*svp)) */
 146 static char*
 147 get_regstr(const char *valuename, SV **svp)
 148 {
 149     char *str = get_regstr_from(HKEY_CURRENT_USER, valuename, svp);
 150     if (!str)
 151         str = get_regstr_from(HKEY_LOCAL_MACHINE, valuename, svp);
 152     return str;
 153 }
 154
 155 /* *prev_pathp (if non-NULL) is expected to be POK (valid allocated SvPVX(sv)) */
 156 static char *
 157 get_emd_part(SV **prev_pathp, char *trailing_path, ...)
 158 {
 159     char base[10];
 160     va_list ap;
 161     char mod_name[MAX_PATH+1];
 162     char *ptr;
 163     char *optr;
 164     char *strip;
 165     int oldsize, newsize;
 166     STRLEN baselen;
 167
 168     va_start(ap, trailing_path);
 169     strip = va_arg(ap, char *);
 170
 171     sprintf(base, "%d.%d", (int)PERL_REVISION, (int)PERL_VERSION);
 172     baselen = strlen(base);
 173
 174     if (!*w32_module_name) {
 175         set_w32_module_name();
 176     }
 177     strcpy(mod_name, w32_module_name);
 178     ptr = strrchr(mod_name, '/');
 179     while (ptr && strip) {
 180         /* look for directories to skip back */
 181         optr = ptr;
 182         *ptr = '\0';
 183         ptr = strrchr(mod_name, '/');
 184         /* avoid stripping component if there is no slash,
 185          * or it doesn't match ... */
 186         if (!ptr || stricmp(ptr+1, strip) != 0) {
 187             /* ... but not if component matches m|5\.$patchlevel.*| */
 188             if (!ptr || !(*strip == '5' && *(ptr+1) == '5'
 189                           && strncmp(strip, base, baselen) == 0
 190                           && strncmp(ptr+1, base, baselen) == 0))
 191             {
 192                 *optr = '/';
 193                 ptr = optr;
 194             }
 195         }
 196         strip = va_arg(ap, char *);
 197     }
 198     if (!ptr) {
 199         ptr = mod_name;
 200         *ptr++ = '.';
 201         *ptr = '/';
 202     }
 203     va_end(ap);
 204     strcpy(++ptr, trailing_path);
 205
 206     /* only add directory if it exists */
 207     if (XCEGetFileAttributesA(mod_name) != (DWORD) -1) {
 208         /* directory exists */
 209         dTHX;
 210         if (!*prev_pathp)
 211             *prev_pathp = sv_2mortal(newSVpvn("",0));
 212         sv_catpvn(*prev_pathp, ";", 1);
 213         sv_catpv(*prev_pathp, mod_name);
 214         return SvPVX(*prev_pathp);
 215     }
 216
 217     return Nullch;
 218 }
 219
 220 char *
 221 win32_get_privlib(const char *pl)
 222 {
 223     dTHX;
 224     char *stdlib = "lib";
 225     char buffer[MAX_PATH+1];
 226     SV *sv = Nullsv;
 227
 228     /* $stdlib = $HKCU{"lib-$]"} || $HKLM{"lib-$]"} || $HKCU{"lib"} || $HKLM{"lib"} || "";  */
 229     sprintf(buffer, "%s-%s", stdlib, pl);
 230     if (!get_regstr(buffer, &sv))
 231         (void)get_regstr(stdlib, &sv);
 232
 233     /* $stdlib .= ";$EMD/../../lib" */
 234     return get_emd_part(&sv, stdlib, ARCHNAME, "bin", Nullch);
 235 }
 236
 237 static char *
 238 win32_get_xlib(const char *pl, const char *xlib, const char *libname)
 239 {
 240     dTHX;
 241     char regstr[40];
 242     char pathstr[MAX_PATH+1];
 243     DWORD datalen;
 244     int len, newsize;
 245     SV *sv1 = Nullsv;
 246     SV *sv2 = Nullsv;
 247
 248     /* $HKCU{"$xlib-$]"} || $HKLM{"$xlib-$]"} . ---; */
 249     sprintf(regstr, "%s-%s", xlib, pl);
 250     (void)get_regstr(regstr, &sv1);
 251
 252     /* $xlib .=
 253      * ";$EMD/" . ((-d $EMD/../../../$]) ? "../../.." : "../.."). "/$libname/$]/lib";  */
 254     sprintf(pathstr, "%s/%s/lib", libname, pl);
 255     (void)get_emd_part(&sv1, pathstr, ARCHNAME, "bin", pl, Nullch);
 256
 257     /* $HKCU{$xlib} || $HKLM{$xlib} . ---; */
 258     (void)get_regstr(xlib, &sv2);
 259
 260     /* $xlib .=
 261      * ";$EMD/" . ((-d $EMD/../../../$]) ? "../../.." : "../.."). "/$libname/lib";  */
 262     sprintf(pathstr, "%s/lib", libname);
 263     (void)get_emd_part(&sv2, pathstr, ARCHNAME, "bin", pl, Nullch);
 264
 265     if (!sv1 && !sv2)
 266         return Nullch;
 267     if (!sv1)
 268         return SvPVX(sv2);
 269     if (!sv2)
 270         return SvPVX(sv1);
 271
 272     sv_catpvn(sv1, ";", 1);
 273     sv_catsv(sv1, sv2);
 274
 275     return SvPVX(sv1);
 276 }
 277
 278 char *
 279 win32_get_sitelib(const char *pl)
 280 {
 281     return win32_get_xlib(pl, "sitelib", "site");
 282 }
 283
 284 #ifndef PERL_VENDORLIB_NAME
 285 #  define PERL_VENDORLIB_NAME   "vendor"
 286 #endif
 287
 288 char *
 289 win32_get_vendorlib(const char *pl)
 290 {
 291     return win32_get_xlib(pl, "vendorlib", PERL_VENDORLIB_NAME);
 292 }
 293
 294 #if !defined(PERL_IMPLICIT_SYS)
 295 /* since the current process environment is being updated in util.c
 296  * the library functions will get the correct environment
 297  */
 298 PerlIO *
 299 Perl_my_popen(pTHX_ char *cmd, char *mode)
 300 {
 301   printf("popen(%s)\n", cmd);
 302
 303   Perl_croak(aTHX_ PL_no_func, "popen");
 304   return NULL;
 305 }
 306
 307 long
 308 Perl_my_pclose(pTHX_ PerlIO *fp)
 309 {
 310   Perl_croak(aTHX_ PL_no_func, "pclose");
 311   return -1;
 312 }
 313 #endif
 314
 315 DllExport unsigned long
 316 win32_os_id(void)
 317 {
 318     static OSVERSIONINFOA osver;
 319
 320     if (osver.dwPlatformId != w32_platform) {
 321         memset(&osver, 0, sizeof(OSVERSIONINFOA));
 322         osver.dwOSVersionInfoSize = sizeof(OSVERSIONINFOA);
 323         XCEGetVersionExA(&osver);
 324         w32_platform = osver.dwPlatformId;
 325     }
 326     return (unsigned long)w32_platform;
 327 }
 328
 329 DllExport int
 330 win32_getpid(void)
 331 {
 332   return xcegetpid();
 333 }
 334
 335 bool
 336 Perl_do_exec(pTHX_ char *cmd)
 337 {
 338   Perl_croak_nocontext("exec() unimplemented on this platform");
 339   return FALSE;
 340 }
 341
 342 DllExport int
 343 win32_pipe(int *pfd, unsigned int size, int mode)
 344 {
 345   dTHX;
 346   Perl_croak(aTHX_ PL_no_func, "pipe");
 347   return -1;
 348 }
 349
 350 DllExport int
 351 win32_times(struct tms *timebuf)
 352 {
 353   dTHX;
 354   Perl_croak(aTHX_ PL_no_func, "times");
 355   return -1;
 356 }
 357
 358 /* TODO */
 359 Sighandler_t
 360 win32_signal(int sig, Sighandler_t subcode)
 361 {
 362   dTHX;
 363   Perl_croak_nocontext("signal() TBD on this platform");
 364   return FALSE;
 365 }
 366
 367
 368 DllExport char ***
 369 win32_environ(void)
 370 {
 371   return (&(environ));
 372 }
 373
 374 DllExport DIR *
 375 win32_opendir(char *filename)
 376 {
 377   return opendir(filename);
 378 }
 379
 380 DllExport struct direct *
 381 win32_readdir(DIR *dirp)
 382 {
 383   return readdir(dirp);
 384 }
 385
 386 DllExport long
 387 win32_telldir(DIR *dirp)
 388 {
 389   dTHX;
 390   Perl_croak(aTHX_ PL_no_func, "telldir");
 391   return -1;
 392 }
 393
 394 DllExport void
 395 win32_seekdir(DIR *dirp, long loc)
 396 {
 397   dTHX;
 398   Perl_croak(aTHX_ PL_no_func, "seekdir");
 399 }
 400
 401 DllExport void
 402 win32_rewinddir(DIR *dirp)
 403 {
 404   dTHX;
 405   Perl_croak(aTHX_ PL_no_func, "rewinddir");
 406 }
 407
 408 DllExport int
 409 win32_closedir(DIR *dirp)
 410 {
 411   closedir(dirp);
 412   return 0;
 413 }
 414
 415 DllExport int
 416 win32_kill(int pid, int sig)
 417 {
 418   dTHX;
 419   Perl_croak(aTHX_ PL_no_func, "kill");
 420   return -1;
 421 }
 422
 423 DllExport unsigned int
 424 win32_sleep(unsigned int t)
 425 {
 426   return xcesleep(t);
 427 }
 428
 429 DllExport int
 430 win32_stat(const char *path, struct stat *sbuf)
 431 {
 432   return xcestat(path, sbuf);
 433 }
 434
 435 DllExport char *
 436 win32_longpath(char *path)
 437 {
 438   return path;
 439 }
 440
 441 #ifndef USE_WIN32_RTL_ENV
 442
 443 DllExport char *
 444 win32_getenv(const char *name)
 445 {
 446   return xcegetenv(name);
 447 }
 448
 449 DllExport int
 450 win32_putenv(const char *name)
 451 {
 452   return xceputenv(name);
 453 }
 454
 455 #endif
 456
 457 static long
 458 filetime_to_clock(PFILETIME ft)
 459 {
 460     __int64 qw = ft->dwHighDateTime;
 461     qw <<= 32;
 462     qw |= ft->dwLowDateTime;
 463     qw /= 10000;  /* File time ticks at 0.1uS, clock at 1mS */
 464     return (long) qw;
 465 }
 466
 467 /* fix utime() so it works on directories in NT */
 468 static BOOL
 469 filetime_from_time(PFILETIME pFileTime, time_t Time)
 470 {
 471     struct tm *pTM = localtime(&Time);
 472     SYSTEMTIME SystemTime;
 473     FILETIME LocalTime;
 474
 475     if (pTM == NULL)
 476         return FALSE;
 477
 478     SystemTime.wYear   = pTM->tm_year + 1900;
 479     SystemTime.wMonth  = pTM->tm_mon + 1;
 480     SystemTime.wDay    = pTM->tm_mday;
 481     SystemTime.wHour   = pTM->tm_hour;
 482     SystemTime.wMinute = pTM->tm_min;
 483     SystemTime.wSecond = pTM->tm_sec;
 484     SystemTime.wMilliseconds = 0;
 485
 486     return SystemTimeToFileTime(&SystemTime, &LocalTime) &&
 487            LocalFileTimeToFileTime(&LocalTime, pFileTime);
 488 }
 489
 490 DllExport int
 491 win32_unlink(const char *filename)
 492 {
 493   return xceunlink(filename);
 494 }
 495
 496 DllExport int
 497 win32_utime(const char *filename, struct utimbuf *times)
 498 {
 499   return xceutime(filename, (struct _utimbuf *) times);
 500 }
 501
 502 DllExport int
 503 win32_gettimeofday(struct timeval *tp, void *not_used)
 504 {
 505     return xcegettimeofday(tp,not_used);
 506 }
 507
 508 DllExport int
 509 win32_uname(struct utsname *name)
 510 {
 511     struct hostent *hep;
 512     STRLEN nodemax = sizeof(name->nodename)-1;
 513     OSVERSIONINFOA osver;
 514
 515     memset(&osver, 0, sizeof(OSVERSIONINFOA));
 516     osver.dwOSVersionInfoSize = sizeof(OSVERSIONINFOA);
 517     if (XCEGetVersionExA(&osver)) {
 518         /* sysname */
 519         switch (osver.dwPlatformId) {
 520         case VER_PLATFORM_WIN32_CE:
 521             strcpy(name->sysname, "Windows CE");
 522             break;
 523         case VER_PLATFORM_WIN32_WINDOWS:
 524             strcpy(name->sysname, "Windows");
 525             break;
 526         case VER_PLATFORM_WIN32_NT:
 527             strcpy(name->sysname, "Windows NT");
 528             break;
 529         case VER_PLATFORM_WIN32s:
 530             strcpy(name->sysname, "Win32s");
 531             break;
 532         default:
 533             strcpy(name->sysname, "Win32 Unknown");
 534             break;
 535         }
 536
 537         /* release */
 538         sprintf(name->release, "%d.%d",
 539                 osver.dwMajorVersion, osver.dwMinorVersion);
 540
 541         /* version */
 542         sprintf(name->version, "Build %d",
 543                 osver.dwPlatformId == VER_PLATFORM_WIN32_NT
 544                 ? osver.dwBuildNumber : (osver.dwBuildNumber & 0xffff));
 545         if (osver.szCSDVersion[0]) {
 546             char *buf = name->version + strlen(name->version);
 547             sprintf(buf, " (%s)", osver.szCSDVersion);
 548         }
 549     }
 550     else {
 551         *name->sysname = '\0';
 552         *name->version = '\0';
 553         *name->release = '\0';
 554     }
 555
 556     /* nodename */
 557     hep = win32_gethostbyname("localhost");
 558     if (hep) {
 559         STRLEN len = strlen(hep->h_name);
 560         if (len <= nodemax) {
 561             strcpy(name->nodename, hep->h_name);
 562         }
 563         else {
 564             strncpy(name->nodename, hep->h_name, nodemax);
 565             name->nodename[nodemax] = '\0';
 566         }
 567     }
 568     else {
 569         DWORD sz = nodemax;
 570         if (!XCEGetComputerNameA(name->nodename, &sz))
 571             *name->nodename = '\0';
 572     }
 573
 574     /* machine (architecture) */
 575     {
 576         SYSTEM_INFO info;
 577         char *arch;
 578         GetSystemInfo(&info);
 579
 580         switch (info.wProcessorArchitecture) {
 581         case PROCESSOR_ARCHITECTURE_INTEL:
 582             arch = "x86"; break;
 583         case PROCESSOR_ARCHITECTURE_MIPS:
 584             arch = "mips"; break;
 585         case PROCESSOR_ARCHITECTURE_ALPHA:
 586             arch = "alpha"; break;
 587         case PROCESSOR_ARCHITECTURE_PPC:
 588             arch = "ppc"; break;
 589         case PROCESSOR_ARCHITECTURE_ARM:
 590             arch = "arm"; break;
 591         case PROCESSOR_HITACHI_SH3:
 592             arch = "sh3"; break;
 593         case PROCESSOR_SHx_SH3:
 594             arch = "sh3"; break;
 595
 596         default:
 597             arch = "unknown"; break;
 598         }
 599         strcpy(name->machine, arch);
 600     }
 601     return 0;
 602 }
 603
 604 void
 605 sig_terminate(pTHX_ int sig)
 606 {
 607     Perl_warn(aTHX_ "Terminating on signal SIG%s(%d)\n",PL_sig_name[sig], sig);
 608     /* exit() seems to be safe, my_exit() or die() is a problem in ^C
 609        thread
 610      */
 611     exit(sig);
 612 }
 613
 614 DllExport int
 615 win32_async_check(pTHX)
 616 {
 617     MSG msg;
 618     int ours = 1;
 619     /* Passing PeekMessage -1 as HWND (2nd arg) only get PostThreadMessage() messages
 620      * and ignores window messages - should co-exist better with windows apps e.g. Tk
 621      */
 622     while (PeekMessage(&msg, (HWND)-1, 0, 0, PM_REMOVE|PM_NOYIELD)) {
 623         int sig;
 624         switch(msg.message) {
 625
 626 #if 0
 627     /* Perhaps some other messages could map to signals ? ... */
 628         case WM_CLOSE:
 629         case WM_QUIT:
 630             /* Treat WM_QUIT like SIGHUP?  */
 631             sig = SIGHUP;
 632             goto Raise;
 633             break;
 634 #endif
 635
 636         /* We use WM_USER to fake kill() with other signals */
 637         case WM_USER: {
 638             sig = msg.wParam;
 639         Raise:
 640             if (do_raise(aTHX_ sig)) {
 641                    sig_terminate(aTHX_ sig);
 642             }
 643             break;
 644         }
 645
 646         case WM_TIMER: {
 647             /* alarm() is a one-shot but SetTimer() repeats so kill it */
 648             if (w32_timerid) {
 649                 KillTimer(NULL,w32_timerid);
 650                 w32_timerid=0;
 651             }
 652             /* Now fake a call to signal handler */
 653             if (do_raise(aTHX_ 14)) {
 654                 sig_terminate(aTHX_ 14);
 655             }
 656             break;
 657         }
 658
 659         /* Otherwise do normal Win32 thing - in case it is useful */
 660         default:
 661             TranslateMessage(&msg);
 662             DispatchMessage(&msg);
 663             ours = 0;
 664             break;
 665         }
 666     }
 667     w32_poll_count = 0;
 668
 669     /* Above or other stuff may have set a signal flag */
 670     if (PL_sig_pending) {
 671         despatch_signals();
 672     }
 673     return ours;
 674 }
 675
 676 /* This function will not return until the timeout has elapsed, or until
 677  * one of the handles is ready. */
 678 DllExport DWORD
 679 win32_msgwait(pTHX_ DWORD count, LPHANDLE handles, DWORD timeout, LPDWORD resultp)
 680 {
 681     /* We may need several goes at this - so compute when we stop */
 682     DWORD ticks = 0;
 683     if (timeout != INFINITE) {
 684         ticks = GetTickCount();
 685         timeout += ticks;
 686     }
 687     while (1) {
 688         DWORD result = MsgWaitForMultipleObjects(count,handles,FALSE,timeout-ticks, QS_ALLEVENTS);
 689         if (resultp)
 690            *resultp = result;
 691         if (result == WAIT_TIMEOUT) {
 692             /* Ran out of time - explicit return of zero to avoid -ve if we
 693                have scheduling issues
 694              */
 695             return 0;
 696         }
 697         if (timeout != INFINITE) {
 698             ticks = GetTickCount();
 699         }
 700         if (result == WAIT_OBJECT_0 + count) {
 701             /* Message has arrived - check it */
 702             (void)win32_async_check(aTHX);
 703         }
 704         else {
 705            /* Not timeout or message - one of handles is ready */
 706            break;
 707         }
 708     }
 709     /* compute time left to wait */
 710     ticks = timeout - ticks;
 711     /* If we are past the end say zero */
 712     return (ticks > 0) ? ticks : 0;
 713 }
 714
 715 /* Timing related stuff */
 716
 717 int
 718 do_raise(pTHX_ int sig)
 719 {
 720     if (sig < SIG_SIZE) {
 721         Sighandler_t handler = w32_sighandler[sig];
 722         if (handler == SIG_IGN) {
 723             return 0;
 724         }
 725         else if (handler != SIG_DFL) {
 726             (*handler)(sig);
 727             return 0;
 728         }
 729         else {
 730             /* Choose correct default behaviour */
 731             switch (sig) {
 732 #ifdef SIGCLD
 733                 case SIGCLD:
 734 #endif
 735 #ifdef SIGCHLD
 736                 case SIGCHLD:
 737 #endif
 738                 case 0:
 739                     return 0;
 740                 case SIGTERM:
 741                 default:
 742                     break;
 743             }
 744         }
 745     }
 746     /* Tell caller to exit thread/process as approriate */
 747     return 1;
 748 }
 749
 750 static UINT timerid = 0;
 751
 752 static VOID CALLBACK TimerProc(HWND win, UINT msg, UINT id, DWORD time)
 753 {
 754     dTHX;
 755     KillTimer(NULL,timerid);
 756     timerid=0;
 757     sighandler(14);
 758 }
 759
 760 DllExport unsigned int
 761 win32_alarm(unsigned int sec)
 762 {
 763     /*
 764      * the 'obvious' implentation is SetTimer() with a callback
 765      * which does whatever receiving SIGALRM would do
 766      * we cannot use SIGALRM even via raise() as it is not
 767      * one of the supported codes in <signal.h>
 768      *
 769      * Snag is unless something is looking at the message queue
 770      * nothing happens :-(
 771      */
 772     dTHX;
 773     if (sec)
 774      {
 775       timerid = SetTimer(NULL,timerid,sec*1000,(TIMERPROC)TimerProc);
 776       if (!timerid)
 777        Perl_croak_nocontext("Cannot set timer");
 778      }
 779     else
 780      {
 781       if (timerid)
 782        {
 783         KillTimer(NULL,timerid);
 784         timerid=0;
 785        }
 786      }
 787     return 0;
 788 }
 789
 790 #ifdef HAVE_DES_FCRYPT
 791 extern char *   des_fcrypt(const char *txt, const char *salt, char *cbuf);
 792 #endif
 793
 794 DllExport char *
 795 win32_crypt(const char *txt, const char *salt)
 796 {
 797     dTHX;
 798 #ifdef HAVE_DES_FCRYPT
 799     dTHR;
 800     return des_fcrypt(txt, salt, w32_crypt_buffer);
 801 #else
 802     Perl_croak(aTHX_ "The crypt() function is unimplemented due to excessive paranoia.");
 803     return Nullch;
 804 #endif
 805 }
 806
 807 /* C doesn't like repeat struct definitions */
 808
 809 #if defined(USE_FIXED_OSFHANDLE) || defined(PERL_MSVCRT_READFIX)
 810
 811 #ifndef _CRTIMP
 812 #define _CRTIMP __declspec(dllimport)
 813 #endif
 814
 815 /*
 816  * Control structure for lowio file handles
 817  */
 818 typedef struct {
 819     long osfhnd;    /* underlying OS file HANDLE */
 820     char osfile;    /* attributes of file (e.g., open in text mode?) */
 821     char pipech;    /* one char buffer for handles opened on pipes */
 822     int lockinitflag;
 823     CRITICAL_SECTION lock;
 824 } ioinfo;
 825
 826
 827 /*
 828  * Array of arrays of control structures for lowio files.
 829  */
 830 EXTERN_C _CRTIMP ioinfo* __pioinfo[];
 831
 832 /*
 833  * Definition of IOINFO_L2E, the log base 2 of the number of elements in each
 834  * array of ioinfo structs.
 835  */
 836 #define IOINFO_L2E          5
 837
 838 /*
 839  * Definition of IOINFO_ARRAY_ELTS, the number of elements in ioinfo array
 840  */
 841 #define IOINFO_ARRAY_ELTS   (1 << IOINFO_L2E)
 842
 843 /*
 844  * Access macros for getting at an ioinfo struct and its fields from a
 845  * file handle
 846  */
 847 #define _pioinfo(i) (__pioinfo[(i) >> IOINFO_L2E] + ((i) & (IOINFO_ARRAY_ELTS - 1)))
 848 #define _osfhnd(i)  (_pioinfo(i)->osfhnd)
 849 #define _osfile(i)  (_pioinfo(i)->osfile)
 850 #define _pipech(i)  (_pioinfo(i)->pipech)
 851
 852 #endif
 853
 854 /*
 855  *  redirected io subsystem for all XS modules
 856  *
 857  */
 858
 859 DllExport int *
 860 win32_errno(void)
 861 {
 862     return (&errno);
 863 }
 864
 865 /* the rest are the remapped stdio routines */
 866 DllExport FILE *
 867 win32_stderr(void)
 868 {
 869     return (stderr);
 870 }
 871
 872 char *g_getlogin() {
 873     return "no-getlogin";
 874 }
 875
 876 DllExport FILE *
 877 win32_stdin(void)
 878 {
 879     return (stdin);
 880 }
 881
 882 DllExport FILE *
 883 win32_stdout()
 884 {
 885     return (stdout);
 886 }
 887
 888 DllExport int
 889 win32_ferror(FILE *fp)
 890 {
 891     return (ferror(fp));
 892 }
 893
 894
 895 DllExport int
 896 win32_feof(FILE *fp)
 897 {
 898     return (feof(fp));
 899 }
 900
 901 /*
 902  * Since the errors returned by the socket error function
 903  * WSAGetLastError() are not known by the library routine strerror
 904  * we have to roll our own.
 905  */
 906
 907 DllExport char *
 908 win32_strerror(int e)
 909 {
 910   return xcestrerror(e);
 911 }
 912
 913 DllExport void
 914 win32_str_os_error(void *sv, DWORD dwErr)
 915 {
 916   dTHX;
 917
 918   sv_setpvn((SV*)sv, "Error", 5);
 919 }
 920
 921
 922 DllExport int
 923 win32_fprintf(FILE *fp, const char *format, ...)
 924 {
 925     va_list marker;
 926     va_start(marker, format);     /* Initialize variable arguments. */
 927
 928     return (vfprintf(fp, format, marker));
 929 }
 930
 931 DllExport int
 932 win32_printf(const char *format, ...)
 933 {
 934     va_list marker;
 935     va_start(marker, format);     /* Initialize variable arguments. */
 936
 937     return (vprintf(format, marker));
 938 }
 939
 940 DllExport int
 941 win32_vfprintf(FILE *fp, const char *format, va_list args)
 942 {
 943     return (vfprintf(fp, format, args));
 944 }
 945
 946 DllExport int
 947 win32_vprintf(const char *format, va_list args)
 948 {
 949     return (vprintf(format, args));
 950 }
 951
 952 DllExport size_t
 953 win32_fread(void *buf, size_t size, size_t count, FILE *fp)
 954 {
 955   return fread(buf, size, count, fp);
 956 }
 957
 958 DllExport size_t
 959 win32_fwrite(const void *buf, size_t size, size_t count, FILE *fp)
 960 {
 961   return fwrite(buf, size, count, fp);
 962 }
 963
 964 DllExport FILE *
 965 win32_fopen(const char *filename, const char *mode)
 966 {
 967   return xcefopen(filename, mode);
 968 }
 969
 970 DllExport FILE *
 971 win32_fdopen(int handle, const char *mode)
 972 {
 973   return palm_fdopen(handle, mode);
 974 }
 975
 976 DllExport FILE *
 977 win32_freopen(const char *path, const char *mode, FILE *stream)
 978 {
 979   return xcefreopen(path, mode, stream);
 980 }
 981
 982 DllExport int
 983 win32_fclose(FILE *pf)
 984 {
 985   return xcefclose(pf);
 986 }
 987
 988 DllExport int
 989 win32_fputs(const char *s,FILE *pf)
 990 {
 991   return fputs(s, pf);
 992 }
 993
 994 DllExport int
 995 win32_fputc(int c,FILE *pf)
 996 {
 997   return fputc(c,pf);
 998 }
 999
1000 DllExport int
1001 win32_ungetc(int c,FILE *pf)
1002 {
1003   return ungetc(c,pf);
1004 }
1005
1006 DllExport int
1007 win32_getc(FILE *pf)
1008 {
1009   return getc(pf);
1010 }
1011
1012 DllExport int
1013 win32_fileno(FILE *pf)
1014 {
1015   return palm_fileno(pf);
1016 }
1017
1018 DllExport void
1019 win32_clearerr(FILE *pf)
1020 {
1021   clearerr(pf);
1022   return;
1023 }
1024
1025 DllExport int
1026 win32_fflush(FILE *pf)
1027 {
1028   return fflush(pf);
1029 }
1030
1031 DllExport long
1032 win32_ftell(FILE *pf)
1033 {
1034   return ftell(pf);
1035 }
1036
1037 DllExport int
1038 win32_fseek(FILE *pf,long offset,int origin)
1039 {
1040   return fseek(pf, offset, origin);
1041 }
1042
1043 /* fpos_t seems to be int64 on hpc pro! Really stupid. */
1044 /* But maybe someday there will be such large disks in a hpc... */
1045 DllExport int
1046 win32_fgetpos(FILE *pf, fpos_t *p)
1047 {
1048   return fgetpos(pf, p);
1049 }
1050
1051 DllExport int
1052 win32_fsetpos(FILE *pf, const fpos_t *p)
1053 {
1054   return fsetpos(pf, p);
1055 }
1056
1057 DllExport void
1058 win32_rewind(FILE *pf)
1059 {
1060   fseek(pf, 0, SEEK_SET);
1061   return;
1062 }
1063
1064 DllExport int
1065 win32_tmpfd(void)
1066 {
1067     dTHX;
1068     char prefix[MAX_PATH+1];
1069     char filename[MAX_PATH+1];
1070     DWORD len = GetTempPath(MAX_PATH, prefix);
1071     if (len && len < MAX_PATH) {
1072         if (GetTempFileName(prefix, "plx", 0, filename)) {
1073             HANDLE fh = CreateFile(filename,
1074                                    DELETE | GENERIC_READ | GENERIC_WRITE,
1075                                    0,
1076                                    NULL,
1077                                    CREATE_ALWAYS,
1078                                    FILE_ATTRIBUTE_NORMAL
1079                                    | FILE_FLAG_DELETE_ON_CLOSE,
1080                                    NULL);
1081             if (fh != INVALID_HANDLE_VALUE) {
1082                 int fd = win32_open_osfhandle((intptr_t)fh, 0);
1083                 if (fd >= 0) {
1084 #if defined(__BORLANDC__)
1085                     setmode(fd,O_BINARY);
1086 #endif
1087                     DEBUG_p(PerlIO_printf(Perl_debug_log,
1088                                           "Created tmpfile=%s\n",filename));
1089                     return fd;
1090                 }
1091             }
1092         }
1093     }
1094     return -1;
1095 }
1096
1097 DllExport FILE*
1098 win32_tmpfile(void)
1099 {
1100     int fd = win32_tmpfd();
1101     if (fd >= 0)
1102         return win32_fdopen(fd, "w+b");
1103     return NULL;
1104 }
1105
1106 DllExport void
1107 win32_abort(void)
1108 {
1109   xceabort();
1110
1111   return;
1112 }
1113
1114 DllExport int
1115 win32_fstat(int fd, struct stat *sbufptr)
1116 {
1117   return xcefstat(fd, sbufptr);
1118 }
1119
1120 DllExport int
1121 win32_link(const char *oldname, const char *newname)
1122 {
1123   dTHX;
1124   Perl_croak(aTHX_ PL_no_func, "link");
1125
1126   return -1;
1127 }
1128
1129 DllExport int
1130 win32_rename(const char *oname, const char *newname)
1131 {
1132   return xcerename(oname, newname);
1133 }
1134
1135 DllExport int
1136 win32_setmode(int fd, int mode)
1137 {
1138     /* currently 'celib' seem to have this function in src, but not
1139      * exported. When it will be, we'll uncomment following line.
1140      */
1141     /* return xcesetmode(fd, mode); */
1142     return 0;
1143 }
1144
1145 DllExport int
1146 win32_chsize(int fd, Off_t size)
1147 {
1148     return chsize(fd, size);
1149 }
1150
1151 DllExport long
1152 win32_lseek(int fd, long offset, int origin)
1153 {
1154   return xcelseek(fd, offset, origin);
1155 }
1156
1157 DllExport long
1158 win32_tell(int fd)
1159 {
1160   return xcelseek(fd, 0, SEEK_CUR);
1161 }
1162
1163 DllExport int
1164 win32_open(const char *path, int flag, ...)
1165 {
1166   int pmode;
1167   va_list ap;
1168
1169   va_start(ap, flag);
1170   pmode = va_arg(ap, int);
1171   va_end(ap);
1172
1173   return xceopen(path, flag, pmode);
1174 }
1175
1176 DllExport int
1177 win32_close(int fd)
1178 {
1179   return xceclose(fd);
1180 }
1181
1182 DllExport int
1183 win32_eof(int fd)
1184 {
1185   dTHX;
1186   Perl_croak(aTHX_ PL_no_func, "eof");
1187   return -1;
1188 }
1189
1190 DllExport int
1191 win32_dup(int fd)
1192 {
1193   return xcedup(fd); /* from celib/ceio.c; requires some more work on it */
1194 }
1195
1196 DllExport int
1197 win32_dup2(int fd1,int fd2)
1198 {
1199   return xcedup2(fd1,fd2);
1200 }
1201
1202 DllExport int
1203 win32_read(int fd, void *buf, unsigned int cnt)
1204 {
1205   return xceread(fd, buf, cnt);
1206 }
1207
1208 DllExport int
1209 win32_write(int fd, const void *buf, unsigned int cnt)
1210 {
1211   return xcewrite(fd, (void *) buf, cnt);
1212 }
1213
1214 DllExport int
1215 win32_mkdir(const char *dir, int mode)
1216 {
1217   return xcemkdir(dir);
1218 }
1219
1220 DllExport int
1221 win32_rmdir(const char *dir)
1222 {
1223   return xcermdir(dir);
1224 }
1225
1226 DllExport int
1227 win32_chdir(const char *dir)
1228 {
1229   return xcechdir(dir);
1230 }
1231
1232 DllExport  int
1233 win32_access(const char *path, int mode)
1234 {
1235   return xceaccess(path, mode);
1236 }
1237
1238 DllExport  int
1239 win32_chmod(const char *path, int mode)
1240 {
1241   return xcechmod(path, mode);
1242 }
1243
1244 DllExport void
1245 win32_perror(const char *str)
1246 {
1247   xceperror(str);
1248 }
1249
1250 DllExport void
1251 win32_setbuf(FILE *pf, char *buf)
1252 {
1253   dTHX;
1254   Perl_croak(aTHX_ PL_no_func, "setbuf");
1255 }
1256
1257 DllExport int
1258 win32_setvbuf(FILE *pf, char *buf, int type, size_t size)
1259 {
1260   return setvbuf(pf, buf, type, size);
1261 }
1262
1263 DllExport int
1264 win32_flushall(void)
1265 {
1266   return flushall();
1267 }
1268
1269 DllExport int
1270 win32_fcloseall(void)
1271 {
1272   return fcloseall();
1273 }
1274
1275 DllExport char*
1276 win32_fgets(char *s, int n, FILE *pf)
1277 {
1278   return fgets(s, n, pf);
1279 }
1280
1281 DllExport char*
1282 win32_gets(char *s)
1283 {
1284   return gets(s);
1285 }
1286
1287 DllExport int
1288 win32_fgetc(FILE *pf)
1289 {
1290   return fgetc(pf);
1291 }
1292
1293 DllExport int
1294 win32_putc(int c, FILE *pf)
1295 {
1296   return putc(c,pf);
1297 }
1298
1299 DllExport int
1300 win32_puts(const char *s)
1301 {
1302   return puts(s);
1303 }
1304
1305 DllExport int
1306 win32_getchar(void)
1307 {
1308   return getchar();
1309 }
1310
1311 DllExport int
1312 win32_putchar(int c)
1313 {
1314   return putchar(c);
1315 }
1316
1317 #ifdef MYMALLOC
1318
1319 #ifndef USE_PERL_SBRK
1320
1321 static char *committed = NULL;
1322 static char *base      = NULL;
1323 static char *reserved  = NULL;
1324 static char *brk       = NULL;
1325 static DWORD pagesize  = 0;
1326 static DWORD allocsize = 0;
1327
1328 void *
1329 sbrk(int need)
1330 {
1331  void *result;
1332  if (!pagesize)
1333   {SYSTEM_INFO info;
1334    GetSystemInfo(&info);
1335    /* Pretend page size is larger so we don't perpetually
1336     * call the OS to commit just one page ...
1337     */
1338    pagesize = info.dwPageSize << 3;
1339    allocsize = info.dwAllocationGranularity;
1340   }
1341  /* This scheme fails eventually if request for contiguous
1342   * block is denied so reserve big blocks - this is only
1343   * address space not memory ...
1344   */
1345  if (brk+need >= reserved)
1346   {
1347    DWORD size = 64*1024*1024;
1348    char *addr;
1349    if (committed && reserved && committed < reserved)
1350     {
1351      /* Commit last of previous chunk cannot span allocations */
1352      addr = (char *) VirtualAlloc(committed,reserved-committed,MEM_COMMIT,PAGE_READWRITE);
1353      if (addr)
1354       committed = reserved;
1355     }
1356    /* Reserve some (more) space
1357     * Note this is a little sneaky, 1st call passes NULL as reserved
1358     * so lets system choose where we start, subsequent calls pass
1359     * the old end address so ask for a contiguous block
1360     */
1361    addr  = (char *) VirtualAlloc(reserved,size,MEM_RESERVE,PAGE_NOACCESS);
1362    if (addr)
1363     {
1364      reserved = addr+size;
1365      if (!base)
1366       base = addr;
1367      if (!committed)
1368       committed = base;
1369      if (!brk)
1370       brk = committed;
1371     }
1372    else
1373     {
1374      return (void *) -1;
1375     }
1376   }
1377  result = brk;
1378  brk += need;
1379  if (brk > committed)
1380   {
1381    DWORD size = ((brk-committed + pagesize -1)/pagesize) * pagesize;
1382    char *addr = (char *) VirtualAlloc(committed,size,MEM_COMMIT,PAGE_READWRITE);
1383    if (addr)
1384     {
1385      committed += size;
1386     }
1387    else
1388     return (void *) -1;
1389   }
1390  return result;
1391 }
1392
1393 #endif
1394 #endif
1395
1396 DllExport void*
1397 win32_malloc(size_t size)
1398 {
1399     return malloc(size);
1400 }
1401
1402 DllExport void*
1403 win32_calloc(size_t numitems, size_t size)
1404 {
1405     return calloc(numitems,size);
1406 }
1407
1408 DllExport void*
1409 win32_realloc(void *block, size_t size)
1410 {
1411     return realloc(block,size);
1412 }
1413
1414 DllExport void
1415 win32_free(void *block)
1416 {
1417     free(block);
1418 }
1419
1420 /* returns pointer to the next unquoted space or the end of the string */
1421 static char*
1422 find_next_space(const char *s)
1423 {
1424     bool in_quotes = FALSE;
1425     while (*s) {
1426         /* ignore doubled backslashes, or backslash+quote */
1427         if (*s == '\\' && (s[1] == '\\' || s[1] == '"')) {
1428             s += 2;
1429         }
1430         /* keep track of when we're within quotes */
1431         else if (*s == '"') {
1432             s++;
1433             in_quotes = !in_quotes;
1434         }
1435         /* break it up only at spaces that aren't in quotes */
1436         else if (!in_quotes && isSPACE(*s))
1437             return (char*)s;
1438         else
1439             s++;
1440     }
1441     return (char*)s;
1442 }
1443
1444 static char *
1445 create_command_line(char *cname, STRLEN clen, const char * const *args)
1446 {
1447     dTHX;
1448     int index, argc;
1449     char *cmd, *ptr;
1450     const char *arg;
1451     STRLEN len = 0;
1452     bool bat_file = FALSE;
1453     bool cmd_shell = FALSE;
1454     bool dumb_shell = FALSE;
1455     bool extra_quotes = FALSE;
1456     bool quote_next = FALSE;
1457
1458     if (!cname)
1459         cname = (char*)args[0];
1460
1461     /* The NT cmd.exe shell has the following peculiarity that needs to be
1462      * worked around.  It strips a leading and trailing dquote when any
1463      * of the following is true:
1464      *    1. the /S switch was used
1465      *    2. there are more than two dquotes
1466      *    3. there is a special character from this set: &<>()@^|
1467      *    4. no whitespace characters within the two dquotes
1468      *    5. string between two dquotes isn't an executable file
1469      * To work around this, we always add a leading and trailing dquote
1470      * to the string, if the first argument is either "cmd.exe" or "cmd",
1471      * and there were at least two or more arguments passed to cmd.exe
1472      * (not including switches).
1473      * XXX the above rules (from "cmd /?") don't seem to be applied
1474      * always, making for the convolutions below :-(
1475      */
1476     if (cname) {
1477         if (!clen)
1478             clen = strlen(cname);
1479
1480         if (clen > 4
1481             && (stricmp(&cname[clen-4], ".bat") == 0
1482                 || (IsWinNT() && stricmp(&cname[clen-4], ".cmd") == 0)))
1483         {
1484             bat_file = TRUE;
1485             len += 3;
1486         }
1487         else {
1488             char *exe = strrchr(cname, '/');
1489             char *exe2 = strrchr(cname, '\\');
1490             if (exe2 > exe)
1491                 exe = exe2;
1492             if (exe)
1493                 ++exe;
1494             else
1495                 exe = cname;
1496             if (stricmp(exe, "cmd.exe") == 0 || stricmp(exe, "cmd") == 0) {
1497                 cmd_shell = TRUE;
1498                 len += 3;
1499             }
1500             else if (stricmp(exe, "command.com") == 0
1501                      || stricmp(exe, "command") == 0)
1502             {
1503                 dumb_shell = TRUE;
1504             }
1505         }
1506     }
1507
1508     DEBUG_p(PerlIO_printf(Perl_debug_log, "Args "));
1509     for (index = 0; (arg = (char*)args[index]) != NULL; ++index) {
1510         STRLEN curlen = strlen(arg);
1511         if (!(arg[0] == '"' && arg[curlen-1] == '"'))
1512             len += 2;   /* assume quoting needed (worst case) */
1513         len += curlen + 1;
1514         DEBUG_p(PerlIO_printf(Perl_debug_log, "[%s]",arg));
1515     }
1516     DEBUG_p(PerlIO_printf(Perl_debug_log, "\n"));
1517
1518     argc = index;
1519     New(1310, cmd, len, char);
1520     ptr = cmd;
1521
1522     if (bat_file) {
1523         *ptr++ = '"';
1524         extra_quotes = TRUE;
1525     }
1526
1527     for (index = 0; (arg = (char*)args[index]) != NULL; ++index) {
1528         bool do_quote = 0;
1529         STRLEN curlen = strlen(arg);
1530
1531         /* we want to protect empty arguments and ones with spaces with
1532          * dquotes, but only if they aren't already there */
1533         if (!dumb_shell) {
1534             if (!curlen) {
1535                 do_quote = 1;
1536             }
1537             else if (quote_next) {
1538                 /* see if it really is multiple arguments pretending to
1539                  * be one and force a set of quotes around it */
1540                 if (*find_next_space(arg))
1541                     do_quote = 1;
1542             }
1543             else if (!(arg[0] == '"' && curlen > 1 && arg[curlen-1] == '"')) {
1544                 STRLEN i = 0;
1545                 while (i < curlen) {
1546                     if (isSPACE(arg[i])) {
1547                         do_quote = 1;
1548                     }
1549                     else if (arg[i] == '"') {
1550                         do_quote = 0;
1551                         break;
1552                     }
1553                     i++;
1554                 }
1555             }
1556         }
1557
1558         if (do_quote)
1559             *ptr++ = '"';
1560
1561         strcpy(ptr, arg);
1562         ptr += curlen;
1563
1564         if (do_quote)
1565             *ptr++ = '"';
1566
1567         if (args[index+1])
1568             *ptr++ = ' ';
1569
1570         if (!extra_quotes
1571             && cmd_shell
1572             && curlen >= 2
1573             && *arg  == '/'     /* see if arg is "/c", "/x/c", "/x/d/c" etc. */
1574             && stricmp(arg+curlen-2, "/c") == 0)
1575         {
1576             /* is there a next argument? */
1577             if (args[index+1]) {
1578                 /* are there two or more next arguments? */
1579                 if (args[index+2]) {
1580                     *ptr++ = '"';
1581                     extra_quotes = TRUE;
1582                 }
1583                 else {
1584                     /* single argument, force quoting if it has spaces */
1585                     quote_next = TRUE;
1586                 }
1587             }
1588         }
1589     }
1590
1591     if (extra_quotes)
1592         *ptr++ = '"';
1593
1594     *ptr = '\0';
1595
1596     return cmd;
1597 }
1598
1599 static char *
1600 qualified_path(const char *cmd)
1601 {
1602     dTHX;
1603     char *pathstr;
1604     char *fullcmd, *curfullcmd;
1605     STRLEN cmdlen = 0;
1606     int has_slash = 0;
1607
1608     if (!cmd)
1609         return Nullch;
1610     fullcmd = (char*)cmd;
1611     while (*fullcmd) {
1612         if (*fullcmd == '/' || *fullcmd == '\\')
1613             has_slash++;
1614         fullcmd++;
1615         cmdlen++;
1616     }
1617
1618     /* look in PATH */
1619     pathstr = PerlEnv_getenv("PATH");
1620     New(0, fullcmd, MAX_PATH+1, char);
1621     curfullcmd = fullcmd;
1622
1623     while (1) {
1624         DWORD res;
1625
1626         /* start by appending the name to the current prefix */
1627         strcpy(curfullcmd, cmd);
1628         curfullcmd += cmdlen;
1629
1630         /* if it doesn't end with '.', or has no extension, try adding
1631          * a trailing .exe first */
1632         if (cmd[cmdlen-1] != '.'
1633             && (cmdlen < 4 || cmd[cmdlen-4] != '.'))
1634         {
1635             strcpy(curfullcmd, ".exe");
1636             res = GetFileAttributes(fullcmd);
1637             if (res != 0xFFFFFFFF && !(res & FILE_ATTRIBUTE_DIRECTORY))
1638                 return fullcmd;
1639             *curfullcmd = '\0';
1640         }
1641
1642         /* that failed, try the bare name */
1643         res = GetFileAttributes(fullcmd);
1644         if (res != 0xFFFFFFFF && !(res & FILE_ATTRIBUTE_DIRECTORY))
1645             return fullcmd;
1646
1647         /* quit if no other path exists, or if cmd already has path */
1648         if (!pathstr || !*pathstr || has_slash)
1649             break;
1650
1651         /* skip leading semis */
1652         while (*pathstr == ';')
1653             pathstr++;
1654
1655         /* build a new prefix from scratch */
1656         curfullcmd = fullcmd;
1657         while (*pathstr && *pathstr != ';') {
1658             if (*pathstr == '"') {      /* foo;"baz;etc";bar */
1659                 pathstr++;              /* skip initial '"' */
1660                 while (*pathstr && *pathstr != '"') {
1661                     if ((STRLEN)(curfullcmd-fullcmd) < MAX_PATH-cmdlen-5)
1662                         *curfullcmd++ = *pathstr;
1663                     pathstr++;
1664                 }
1665                 if (*pathstr)
1666                     pathstr++;          /* skip trailing '"' */
1667             }
1668             else {
1669                 if ((STRLEN)(curfullcmd-fullcmd) < MAX_PATH-cmdlen-5)
1670                     *curfullcmd++ = *pathstr;
1671                 pathstr++;
1672             }
1673         }
1674         if (*pathstr)
1675             pathstr++;                  /* skip trailing semi */
1676         if (curfullcmd > fullcmd        /* append a dir separator */
1677             && curfullcmd[-1] != '/' && curfullcmd[-1] != '\\')
1678         {
1679             *curfullcmd++ = '\\';
1680         }
1681     }
1682
1683     Safefree(fullcmd);
1684     return Nullch;
1685 }
1686
1687 /* The following are just place holders.
1688  * Some hosts may provide and environment that the OS is
1689  * not tracking, therefore, these host must provide that
1690  * environment and the current directory to CreateProcess
1691  */
1692
1693 DllExport void*
1694 win32_get_childenv(void)
1695 {
1696     return NULL;
1697 }
1698
1699 DllExport void
1700 win32_free_childenv(void* d)
1701 {
1702 }
1703
1704 DllExport void
1705 win32_clearenv(void)
1706 {
1707     char *envv = GetEnvironmentStrings();
1708     char *cur = envv;
1709     STRLEN len;
1710     while (*cur) {
1711         char *end = strchr(cur,'=');
1712         if (end && end != cur) {
1713             *end = '\0';
1714             xcesetenv(cur, "", 0);
1715             *end = '=';
1716             cur = end + strlen(end+1)+2;
1717         }
1718         else if ((len = strlen(cur)))
1719             cur += len+1;
1720     }
1721     FreeEnvironmentStrings(envv);
1722 }
1723
1724 DllExport char*
1725 win32_get_childdir(void)
1726 {
1727     dTHX;
1728     char* ptr;
1729     char szfilename[(MAX_PATH+1)*2];
1730     if (USING_WIDE()) {
1731         WCHAR wfilename[MAX_PATH+1];
1732         GetCurrentDirectoryW(MAX_PATH+1, wfilename);
1733         W2AHELPER(wfilename, szfilename, sizeof(szfilename));
1734     }
1735     else {
1736         GetCurrentDirectoryA(MAX_PATH+1, szfilename);
1737     }
1738
1739     New(0, ptr, strlen(szfilename)+1, char);
1740     strcpy(ptr, szfilename);
1741     return ptr;
1742 }
1743
1744 DllExport void
1745 win32_free_childdir(char* d)
1746 {
1747     dTHX;
1748     Safefree(d);
1749 }
1750
1751 /* XXX this needs to be made more compatible with the spawnvp()
1752  * provided by the various RTLs.  In particular, searching for
1753  * *.{com,bat,cmd} files (as done by the RTLs) is unimplemented.
1754  * This doesn't significantly affect perl itself, because we
1755  * always invoke things using PERL5SHELL if a direct attempt to
1756  * spawn the executable fails.
1757  *
1758  * XXX splitting and rejoining the commandline between do_aspawn()
1759  * and win32_spawnvp() could also be avoided.
1760  */
1761
1762 #define P_WAIT         0
1763 #define P_NOWAIT       1
1764 DllExport int
1765 win32_spawnvp(int mode, const char *cmdname, const char *const *argv)
1766 {
1767 #ifdef USE_RTL_SPAWNVP
1768     return spawnvp(mode, cmdname, (char * const *)argv);
1769 #else
1770     dTHX;
1771     int ret;
1772     void* env;
1773     char* dir;
1774     child_IO_table tbl;
1775     STARTUPINFO StartupInfo;
1776     PROCESS_INFORMATION ProcessInformation;
1777     DWORD create = 0;
1778     char *cmd;
1779     char *fullcmd = Nullch;
1780     char *cname = (char *)cmdname;
1781     STRLEN clen = 0;
1782
1783     if (cname) {
1784         clen = strlen(cname);
1785         /* if command name contains dquotes, must remove them */
1786         if (strchr(cname, '"')) {
1787             cmd = cname;
1788             New(0,cname,clen+1,char);
1789             clen = 0;
1790             while (*cmd) {
1791                 if (*cmd != '"') {
1792                     cname[clen] = *cmd;
1793                     ++clen;
1794                 }
1795                 ++cmd;
1796             }
1797             cname[clen] = '\0';
1798         }
1799     }
1800
1801     cmd = create_command_line(cname, clen, argv);
1802
1803     env = PerlEnv_get_childenv();
1804     dir = PerlEnv_get_childdir();
1805
1806     switch(mode) {
1807     case P_NOWAIT:      /* asynch + remember result */
1808         if (w32_num_children >= MAXIMUM_WAIT_OBJECTS) {
1809             errno = EAGAIN;
1810             ret = -1;
1811             goto RETVAL;
1812         }
1813         /* Create a new process group so we can use GenerateConsoleCtrlEvent()
1814          * in win32_kill()
1815          */
1816         /* not supported on CE create |= CREATE_NEW_PROCESS_GROUP; */
1817         /* FALL THROUGH */
1818
1819     case P_WAIT:        /* synchronous execution */
1820         break;
1821     default:            /* invalid mode */
1822         errno = EINVAL;
1823         ret = -1;
1824         goto RETVAL;
1825     }
1826     memset(&StartupInfo,0,sizeof(StartupInfo));
1827     StartupInfo.cb = sizeof(StartupInfo);
1828     memset(&tbl,0,sizeof(tbl));
1829     PerlEnv_get_child_IO(&tbl);
1830     StartupInfo.dwFlags         = tbl.dwFlags;
1831     StartupInfo.dwX             = tbl.dwX;
1832     StartupInfo.dwY             = tbl.dwY;
1833     StartupInfo.dwXSize         = tbl.dwXSize;
1834     StartupInfo.dwYSize         = tbl.dwYSize;
1835     StartupInfo.dwXCountChars   = tbl.dwXCountChars;
1836     StartupInfo.dwYCountChars   = tbl.dwYCountChars;
1837     StartupInfo.dwFillAttribute = tbl.dwFillAttribute;
1838     StartupInfo.wShowWindow     = tbl.wShowWindow;
1839     StartupInfo.hStdInput       = tbl.childStdIn;
1840     StartupInfo.hStdOutput      = tbl.childStdOut;
1841     StartupInfo.hStdError       = tbl.childStdErr;
1842     if (StartupInfo.hStdInput == INVALID_HANDLE_VALUE &&
1843         StartupInfo.hStdOutput == INVALID_HANDLE_VALUE &&
1844         StartupInfo.hStdError == INVALID_HANDLE_VALUE)
1845     {
1846         create |= CREATE_NEW_CONSOLE;
1847     }
1848     else {
1849         StartupInfo.dwFlags |= STARTF_USESTDHANDLES;
1850     }
1851     if (w32_use_showwindow) {
1852         StartupInfo.dwFlags |= STARTF_USESHOWWINDOW;
1853         StartupInfo.wShowWindow = w32_showwindow;
1854     }
1855
1856     DEBUG_p(PerlIO_printf(Perl_debug_log, "Spawning [%s] with [%s]\n",
1857                           cname,cmd));
1858 RETRY:
1859     if (!CreateProcess(cname,           /* search PATH to find executable */
1860                        cmd,             /* executable, and its arguments */
1861                        NULL,            /* process attributes */
1862                        NULL,            /* thread attributes */
1863                        TRUE,            /* inherit handles */
1864                        create,          /* creation flags */
1865                        (LPVOID)env,     /* inherit environment */
1866                        dir,             /* inherit cwd */
1867                        &StartupInfo,
1868                        &ProcessInformation))
1869     {
1870         /* initial NULL argument to CreateProcess() does a PATH
1871          * search, but it always first looks in the directory
1872          * where the current process was started, which behavior
1873          * is undesirable for backward compatibility.  So we
1874          * jump through our own hoops by picking out the path
1875          * we really want it to use. */
1876         if (!fullcmd) {
1877             fullcmd = qualified_path(cname);
1878             if (fullcmd) {
1879                 if (cname != cmdname)
1880                     Safefree(cname);
1881                 cname = fullcmd;
1882                 DEBUG_p(PerlIO_printf(Perl_debug_log,
1883                                       "Retrying [%s] with same args\n",
1884                                       cname));
1885                 goto RETRY;
1886             }
1887         }
1888         errno = ENOENT;
1889         ret = -1;
1890         goto RETVAL;
1891     }
1892
1893     if (mode == P_NOWAIT) {
1894         /* asynchronous spawn -- store handle, return PID */
1895         ret = (int)ProcessInformation.dwProcessId;
1896         if (IsWin95() && ret < 0)
1897             ret = -ret;
1898
1899         w32_child_handles[w32_num_children] = ProcessInformation.hProcess;
1900         w32_child_pids[w32_num_children] = (DWORD)ret;
1901         ++w32_num_children;
1902     }
1903     else  {
1904         DWORD status;
1905         win32_msgwait(aTHX_ 1, &ProcessInformation.hProcess, INFINITE, NULL);
1906         /* FIXME: if msgwait returned due to message perhaps forward the
1907            "signal" to the process
1908          */
1909         GetExitCodeProcess(ProcessInformation.hProcess, &status);
1910         ret = (int)status;
1911         CloseHandle(ProcessInformation.hProcess);
1912     }
1913
1914     CloseHandle(ProcessInformation.hThread);
1915
1916 RETVAL:
1917     PerlEnv_free_childenv(env);
1918     PerlEnv_free_childdir(dir);
1919     Safefree(cmd);
1920     if (cname != cmdname)
1921         Safefree(cname);
1922     return ret;
1923 #endif
1924 }
1925
1926 DllExport int
1927 win32_execv(const char *cmdname, const char *const *argv)
1928 {
1929   dTHX;
1930   Perl_croak(aTHX_ PL_no_func, "execv");
1931   return -1;
1932 }
1933
1934 DllExport int
1935 win32_execvp(const char *cmdname, const char *const *argv)
1936 {
1937   dTHX;
1938   Perl_croak(aTHX_ PL_no_func, "execvp");
1939   return -1;
1940 }
1941
1942 DllExport void*
1943 win32_dynaload(const char* filename)
1944 {
1945     dTHX;
1946     HMODULE hModule;
1947
1948     hModule = XCELoadLibraryA(filename);
1949
1950     return hModule;
1951 }
1952
1953 /* this is needed by Cwd.pm... */
1954
1955 static
1956 XS(w32_GetCwd)
1957 {
1958   dXSARGS;
1959   char buf[MAX_PATH];
1960   SV *sv = sv_newmortal();
1961
1962   xcegetcwd(buf, sizeof(buf));
1963
1964   sv_setpv(sv, xcestrdup(buf));
1965   EXTEND(SP,1);
1966   SvPOK_on(sv);
1967   ST(0) = sv;
1968 #ifndef INCOMPLETE_TAINTS
1969   SvTAINTED_on(ST(0));
1970 #endif
1971   XSRETURN(1);
1972 }
1973
1974 static
1975 XS(w32_SetCwd)
1976 {
1977   dXSARGS;
1978
1979   if (items != 1)
1980     Perl_croak(aTHX_ "usage: Win32::SetCwd($cwd)");
1981
1982   if (!xcechdir(SvPV_nolen(ST(0))))
1983     XSRETURN_YES;
1984
1985   XSRETURN_NO;
1986 }
1987
1988 static
1989 XS(w32_GetTickCount)
1990 {
1991     dXSARGS;
1992     DWORD msec = GetTickCount();
1993     EXTEND(SP,1);
1994     if ((IV)msec > 0)
1995         XSRETURN_IV(msec);
1996     XSRETURN_NV(msec);
1997 }
1998
1999 static
2000 XS(w32_GetOSVersion)
2001 {
2002     dXSARGS;
2003     OSVERSIONINFOA osver;
2004
2005     osver.dwOSVersionInfoSize = sizeof(OSVERSIONINFOA);
2006     if (!XCEGetVersionExA(&osver)) {
2007       XSRETURN_EMPTY;
2008     }
2009     XPUSHs(newSVpvn(osver.szCSDVersion, strlen(osver.szCSDVersion)));
2010     XPUSHs(newSViv(osver.dwMajorVersion));
2011     XPUSHs(newSViv(osver.dwMinorVersion));
2012     XPUSHs(newSViv(osver.dwBuildNumber));
2013     /* WINCE = 3 */
2014     XPUSHs(newSViv(osver.dwPlatformId));
2015     PUTBACK;
2016 }
2017
2018 static
2019 XS(w32_IsWinNT)
2020 {
2021     dXSARGS;
2022     EXTEND(SP,1);
2023     XSRETURN_IV(IsWinNT());
2024 }
2025
2026 static
2027 XS(w32_IsWin95)
2028 {
2029     dXSARGS;
2030     EXTEND(SP,1);
2031     XSRETURN_IV(IsWin95());
2032 }
2033
2034 static
2035 XS(w32_IsWinCE)
2036 {
2037     dXSARGS;
2038     EXTEND(SP,1);
2039     XSRETURN_IV(IsWinCE());
2040 }
2041
2042 static
2043 XS(w32_GetOemInfo)
2044 {
2045   dXSARGS;
2046   wchar_t wbuf[126];
2047   char buf[126];
2048
2049   if(SystemParametersInfoW(SPI_GETOEMINFO, sizeof(wbuf), wbuf, FALSE))
2050     WideCharToMultiByte(CP_ACP, 0, wbuf, -1, buf, sizeof(buf), 0, 0);
2051   else
2052     sprintf(buf, "SystemParametersInfo failed: %d", GetLastError());
2053
2054   EXTEND(SP,1);
2055   XSRETURN_PV(buf);
2056 }
2057
2058 static
2059 XS(w32_Sleep)
2060 {
2061     dXSARGS;
2062     if (items != 1)
2063         Perl_croak(aTHX_ "usage: Win32::Sleep($milliseconds)");
2064     Sleep(SvIV(ST(0)));
2065     XSRETURN_YES;
2066 }
2067
2068 static
2069 XS(w32_CopyFile)
2070 {
2071     dXSARGS;
2072     BOOL bResult;
2073     if (items != 3)
2074         Perl_croak(aTHX_ "usage: Win32::CopyFile($from, $to, $overwrite)");
2075
2076     {
2077       char szSourceFile[MAX_PATH+1];
2078       strcpy(szSourceFile, PerlDir_mapA(SvPV_nolen(ST(0))));
2079       bResult = XCECopyFileA(szSourceFile, SvPV_nolen(ST(1)),
2080                              !SvTRUE(ST(2)));
2081     }
2082
2083     if (bResult)
2084         XSRETURN_YES;
2085
2086     XSRETURN_NO;
2087 }
2088
2089 static
2090 XS(w32_MessageBox)
2091 {
2092     dXSARGS;
2093
2094     char *txt;
2095     unsigned int res;
2096     unsigned int flags = MB_OK;
2097
2098     txt = SvPV_nolen(ST(0));
2099
2100     if (items < 1 || items > 2)
2101         Perl_croak(aTHX_ "usage: Win32::MessageBox($txt, [$flags])");
2102
2103     if(items == 2)
2104       flags = SvIV(ST(1));
2105
2106     res = XCEMessageBoxA(NULL, txt, "Perl", flags);
2107
2108     XSRETURN_IV(res);
2109 }
2110
2111 static
2112 XS(w32_GetPowerStatus)
2113 {
2114   dXSARGS;
2115
2116   SYSTEM_POWER_STATUS_EX sps;
2117
2118   if(GetSystemPowerStatusEx(&sps, TRUE) == FALSE)
2119     {
2120       XSRETURN_EMPTY;
2121     }
2122
2123   XPUSHs(newSViv(sps.ACLineStatus));
2124   XPUSHs(newSViv(sps.BatteryFlag));
2125   XPUSHs(newSViv(sps.BatteryLifePercent));
2126   XPUSHs(newSViv(sps.BatteryLifeTime));
2127   XPUSHs(newSViv(sps.BatteryFullLifeTime));
2128   XPUSHs(newSViv(sps.BackupBatteryFlag));
2129   XPUSHs(newSViv(sps.BackupBatteryLifePercent));
2130   XPUSHs(newSViv(sps.BackupBatteryLifeTime));
2131   XPUSHs(newSViv(sps.BackupBatteryFullLifeTime));
2132
2133   PUTBACK;
2134 }
2135
2136 #if UNDER_CE > 200
2137 static
2138 XS(w32_ShellEx)
2139 {
2140   dXSARGS;
2141
2142   char buf[126];
2143   SHELLEXECUTEINFO si;
2144   char *file, *verb;
2145   wchar_t wfile[MAX_PATH];
2146   wchar_t wverb[20];
2147
2148   if (items != 2)
2149     Perl_croak(aTHX_ "usage: Win32::ShellEx($file, $verb)");
2150
2151   file = SvPV_nolen(ST(0));
2152   verb = SvPV_nolen(ST(1));
2153
2154   memset(&si, 0, sizeof(si));
2155   si.cbSize = sizeof(si);
2156   si.fMask = SEE_MASK_FLAG_NO_UI;
2157
2158   MultiByteToWideChar(CP_ACP, 0, verb, -1,
2159                       wverb, sizeof(wverb)/2);
2160   si.lpVerb = (TCHAR *)wverb;
2161
2162   MultiByteToWideChar(CP_ACP, 0, file, -1,
2163                       wfile, sizeof(wfile)/2);
2164   si.lpFile = (TCHAR *)wfile;
2165
2166   if(ShellExecuteEx(&si) == FALSE)
2167     {
2168       XSRETURN_NO;
2169     }
2170   XSRETURN_YES;
2171 }
2172 #endif
2173
2174 void
2175 Perl_init_os_extras(void)
2176 {
2177     dTHX;
2178     char *file = __FILE__;
2179     dXSUB_SYS;
2180
2181     w32_perlshell_tokens = Nullch;
2182     w32_perlshell_items = -1;
2183     w32_fdpid = newAV(); /* XX needs to be in Perl_win32_init()? */
2184     New(1313, w32_children, 1, child_tab);
2185     w32_num_children = 0;
2186
2187     newXS("Win32::GetCwd", w32_GetCwd, file);
2188     newXS("Win32::SetCwd", w32_SetCwd, file);
2189     newXS("Win32::GetTickCount", w32_GetTickCount, file);
2190     newXS("Win32::GetOSVersion", w32_GetOSVersion, file);
2191 #if UNDER_CE > 200
2192     newXS("Win32::ShellEx", w32_ShellEx, file);
2193 #endif
2194     newXS("Win32::IsWinNT", w32_IsWinNT, file);
2195     newXS("Win32::IsWin95", w32_IsWin95, file);
2196     newXS("Win32::IsWinCE", w32_IsWinCE, file);
2197     newXS("Win32::CopyFile", w32_CopyFile, file);
2198     newXS("Win32::Sleep", w32_Sleep, file);
2199     newXS("Win32::MessageBox", w32_MessageBox, file);
2200     newXS("Win32::GetPowerStatus", w32_GetPowerStatus, file);
2201     newXS("Win32::GetOemInfo", w32_GetOemInfo, file);
2202 }
2203
2204 void
2205 myexit(void)
2206 {
2207   char buf[126];
2208
2209   puts("Hit return");
2210   fgets(buf, sizeof(buf), stdin);
2211 }
2212
2213 void
2214 Perl_win32_init(int *argcp, char ***argvp)
2215 {
2216 #ifdef UNDER_CE
2217   char *p;
2218
2219   if((p = xcegetenv("PERLDEBUG")) && (p[0] == 'y' || p[0] == 'Y'))
2220     atexit(myexit);
2221 #endif
2222
2223   MALLOC_INIT;
2224 }
2225
2226 DllExport void
2227 Perl_win32_term(void)
2228 {
2229     OP_REFCNT_TERM;
2230     MALLOC_TERM;
2231 }
2232
2233 void
2234 win32_get_child_IO(child_IO_table* ptbl)
2235 {
2236     ptbl->childStdIn    = GetStdHandle(STD_INPUT_HANDLE);
2237     ptbl->childStdOut   = GetStdHandle(STD_OUTPUT_HANDLE);
2238     ptbl->childStdErr   = GetStdHandle(STD_ERROR_HANDLE);
2239 }
2240
2241 win32_flock(int fd, int oper)
2242 {
2243   dTHX;
2244   Perl_croak(aTHX_ PL_no_func, "flock");
2245   return -1;
2246 }
2247
2248 DllExport int
2249 win32_waitpid(int pid, int *status, int flags)
2250 {
2251   dTHX;
2252   Perl_croak(aTHX_ PL_no_func, "waitpid");
2253   return -1;
2254 }
2255
2256 DllExport int
2257 win32_wait(int *status)
2258 {
2259   dTHX;
2260   Perl_croak(aTHX_ PL_no_func, "wait");
2261   return -1;
2262 }
2263
2264 int
2265 Perl_do_spawn(pTHX_ char *cmd)
2266 {
2267     return do_spawn(aTHX_ cmd);
2268 }
2269
2270 int
2271 Perl_do_aspawn(pTHX_ SV *really, SV **mark, SV **sp)
2272 {
2273   Perl_croak(aTHX_ PL_no_func, "aspawn");
2274   return -1;
2275 }
2276
2277 int
2278 wce_reopen_stdout(char *fname)
2279 {
2280   if(xcefreopen(fname, "w", stdout) == NULL)
2281     return -1;
2282
2283   return 0;
2284 }
2285
2286 void
2287 wce_hitreturn()
2288 {
2289   char buf[126];
2290
2291   printf("Hit RETURN");
2292   fflush(stdout);
2293   fgets(buf, sizeof(buf), stdin);
2294   return;
2295 }
2296
2297 /* //////////////////////////////////////////////////////////////////// */
2298
2299 #undef getcwd
2300
2301 char *
2302 getcwd(char *buf, size_t size)
2303 {
2304   return xcegetcwd(buf, size);
2305 }
2306
2307 int
2308 isnan(double d)
2309 {
2310   return _isnan(d);
2311 }
2312
2313 int
2314 win32_open_osfhandle(intptr_t osfhandle, int flags)
2315 {
2316     int fh;
2317     char fileflags=0;           /* _osfile flags */
2318
2319     Perl_croak_nocontext("win32_open_osfhandle() TBD on this platform");
2320     return 0;
2321 }
2322
2323 int
2324 win32_get_osfhandle(int fd)
2325 {
2326     int fh;
2327     char fileflags=0;           /* _osfile flags */
2328
2329     Perl_croak_nocontext("win32_get_osfhandle() TBD on this platform");
2330     return 0;
2331 }
2332
2333 /*
2334  * a popen() clone that respects PERL5SHELL
2335  *
2336  * changed to return PerlIO* rather than FILE * by BKS, 11-11-2000
2337  */
2338
2339 DllExport PerlIO*
2340 win32_popen(const char *command, const char *mode)
2341 {
2342     Perl_croak_nocontext("win32_popen() TBD on this platform");
2343 }
2344
2345 DllExport PerlIO*
2346 win32_popenlist(const char *mode, IV narg, SV **args)
2347 {
2348  dTHX;
2349  Perl_croak(aTHX_ "List form of pipe open not implemented");
2350  return NULL;
2351 }
2352
2353 /*
2354  * pclose() clone
2355  */
2356
2357 DllExport int
2358 win32_pclose(PerlIO *pf)
2359 {
2360 #ifdef USE_RTL_POPEN
2361     return _pclose(pf);
2362 #else
2363     dTHX;
2364     int childpid, status;
2365     SV *sv;
2366
2367     LOCK_FDPID_MUTEX;
2368     sv = *av_fetch(w32_fdpid, PerlIO_fileno(pf), TRUE);
2369
2370     if (SvIOK(sv))
2371         childpid = SvIVX(sv);
2372     else
2373         childpid = 0;
2374
2375     if (!childpid) {
2376         errno = EBADF;
2377         return -1;
2378     }
2379
2380 #ifdef USE_PERLIO
2381     PerlIO_close(pf);
2382 #else
2383     fclose(pf);
2384 #endif
2385     SvIVX(sv) = 0;
2386     UNLOCK_FDPID_MUTEX;
2387
2388     if (win32_waitpid(childpid, &status, 0) == -1)
2389         return -1;
2390
2391     return status;
2392
2393 #endif /* USE_RTL_POPEN */
2394 }
2395
2396 FILE *
2397 win32_fdupopen(FILE *pf)
2398 {
2399     FILE* pfdup;
2400     fpos_t pos;
2401     char mode[3];
2402     int fileno = win32_dup(win32_fileno(pf));
2403
2404     XCEMessageBoxA(NULL, "NEED TO IMPLEMENT a place in .../wince/wince.c(win32_fdupopen)", "Perl(developer)", 0);
2405     Perl_croak_nocontext("win32_fdupopen() TBD on this platform");
2406
2407 #if 0
2408     /* open the file in the same mode */
2409     if((pf)->_flag & _IOREAD) {
2410         mode[0] = 'r';
2411         mode[1] = 0;
2412     }
2413     else if((pf)->_flag & _IOWRT) {
2414         mode[0] = 'a';
2415         mode[1] = 0;
2416     }
2417     else if((pf)->_flag & _IORW) {
2418         mode[0] = 'r';
2419         mode[1] = '+';
2420         mode[2] = 0;
2421     }
2422
2423     /* it appears that the binmode is attached to the
2424      * file descriptor so binmode files will be handled
2425      * correctly
2426      */
2427     pfdup = win32_fdopen(fileno, mode);
2428
2429     /* move the file pointer to the same position */
2430     if (!fgetpos(pf, &pos)) {
2431         fsetpos(pfdup, &pos);
2432     }
2433 #endif
2434     return pfdup;
2435 }
2436
2437 #ifdef HAVE_INTERP_INTERN
2438
2439
2440 static void
2441 win32_csighandler(int sig)
2442 {
2443 #if 0
2444     dTHXa(PERL_GET_SIG_CONTEXT);
2445     Perl_warn(aTHX_ "Got signal %d",sig);
2446 #endif
2447     /* Does nothing */
2448 }
2449
2450 void
2451 Perl_sys_intern_init(pTHX)
2452 {
2453     int i;
2454     w32_perlshell_tokens        = Nullch;
2455     w32_perlshell_vec           = (char**)NULL;
2456     w32_perlshell_items         = 0;
2457     w32_fdpid                   = newAV();
2458     New(1313, w32_children, 1, child_tab);
2459     w32_num_children            = 0;
2460 #  ifdef USE_ITHREADS
2461     w32_pseudo_id               = 0;
2462     New(1313, w32_pseudo_children, 1, child_tab);
2463     w32_num_pseudo_children     = 0;
2464 #  endif
2465     w32_init_socktype           = 0;
2466     w32_timerid                 = 0;
2467     w32_poll_count              = 0;
2468 }
2469
2470 void
2471 Perl_sys_intern_clear(pTHX)
2472 {
2473     Safefree(w32_perlshell_tokens);
2474     Safefree(w32_perlshell_vec);
2475     /* NOTE: w32_fdpid is freed by sv_clean_all() */
2476     Safefree(w32_children);
2477     if (w32_timerid) {
2478         KillTimer(NULL,w32_timerid);
2479         w32_timerid=0;
2480     }
2481 #  ifdef USE_ITHREADS
2482     Safefree(w32_pseudo_children);
2483 #  endif
2484 }
2485
2486 #  ifdef USE_ITHREADS
2487
2488 void
2489 Perl_sys_intern_dup(pTHX_ struct interp_intern *src, struct interp_intern *dst)
2490 {
2491     dst->perlshell_tokens       = Nullch;
2492     dst->perlshell_vec          = (char**)NULL;
2493     dst->perlshell_items        = 0;
2494     dst->fdpid                  = newAV();
2495     Newz(1313, dst->children, 1, child_tab);
2496     dst->pseudo_id              = 0;
2497     Newz(1313, dst->pseudo_children, 1, child_tab);
2498     dst->thr_intern.Winit_socktype = 0;
2499     dst->timerid                 = 0;
2500     dst->poll_count              = 0;
2501     Copy(src->sigtable,dst->sigtable,SIG_SIZE,Sighandler_t);
2502 }
2503 #  endif /* USE_ITHREADS */
2504 #endif /* HAVE_INTERP_INTERN */
2505
2506 static void
2507 win32_free_argvw(pTHX_ void *ptr)
2508 {
2509     char** argv = (char**)ptr;
2510     while(*argv) {
2511         Safefree(*argv);
2512         *argv++ = Nullch;
2513     }
2514 }
2515
2516 void
2517 win32_argv2utf8(int argc, char** argv)
2518 {
2519   /* do nothing, since we're not aware of command line arguments
2520    * currently ...
2521    */
2522 }
2523
2524 #if 0
2525 void
2526 Perl_sys_intern_clear(pTHX)
2527 {
2528     Safefree(w32_perlshell_tokens);
2529     Safefree(w32_perlshell_vec);
2530     /* NOTE: w32_fdpid is freed by sv_clean_all() */
2531     Safefree(w32_children);
2532 #  ifdef USE_ITHREADS
2533     Safefree(w32_pseudo_children);
2534 #  endif
2535 }
2536
2537 #endif
2538 // added to remove undefied symbol error in CodeWarrior compilation
2539 int
2540 Perl_Ireentrant_buffer_ptr(aTHX)
2541 {
2542         return 0;
2543 }