X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=win32%2Fwin32.c;h=3740e7054d86c6eed1a87af895f4d80eb2c3690a;hb=25ca88e0cbd385e70d7ea2ee4f8a34a9ff7bcc17;hp=517a5765fe06a9b7a716f7abb5061183a7fb2462;hpb=fb6be3502484a63390e9ec69dde969648a503399;p=p5sagit%2Fp5-mst-13.2.git diff --git a/win32/win32.c b/win32/win32.c index 517a576..3740e70 100644 --- a/win32/win32.c +++ b/win32/win32.c @@ -15,7 +15,8 @@ #define Win32_Winsock #endif #include -#ifndef __MINGW32__ /* GCC/Mingw32-2.95.2 forgot the WINAPI on CommandLineToArgvW() */ +/* GCC-2.95.2/Mingw32-1.1 forgot the WINAPI on CommandLineToArgvW() */ +#if defined(__MINGW32__) && (__MINGW32_MAJOR_VERSION==1) # include #else LPWSTR* WINAPI CommandLineToArgvW(LPCWSTR lpCommandLine, int * pNumArgs); @@ -60,8 +61,8 @@ int _CRT_glob = 0; #endif -#if defined(__MINGW32__) -/* Mingw32 is missing some prototypes */ +#if defined(__MINGW32__) && (__MINGW32_MAJOR_VERSION==1) +/* Mingw32-1.1 is missing some prototypes */ FILE * _wfopen(LPCWSTR wszFileName, LPCWSTR wszMode); FILE * _wfdopen(int nFd, LPCWSTR wszMode); FILE * _freopen(LPCWSTR wszFileName, LPCWSTR wszMode, FILE * pOldStream); @@ -85,16 +86,14 @@ int _fcloseall(); # define win32_get_sitelib g_win32_get_sitelib # undef win32_get_vendorlib # define win32_get_vendorlib g_win32_get_vendorlib -# undef do_spawn -# define do_spawn g_do_spawn # undef getlogin # define getlogin g_getlogin #endif static void get_shell(void); static long tokenize(const char *str, char **dest, char ***destv); - int do_spawn2(char *cmd, int exectype); -static BOOL has_shell_metachars(char *ptr); +static int do_spawn2(pTHX_ const char *cmd, int exectype); +static BOOL has_shell_metachars(const char *ptr); static long filetime_to_clock(PFILETIME ft); static BOOL filetime_from_time(PFILETIME ft, time_t t); static char * get_emd_part(SV **leading, char *trailing, ...); @@ -118,6 +117,16 @@ static DWORD w32_platform = (DWORD)-1; #define ONE_K_BUFSIZE 1024 +#ifdef __BORLANDC__ +/* Silence STDERR grumblings from Borland's math library. */ +DllExport int +_matherr(struct _exception *a) +{ + PERL_UNUSED_VAR(a); + return 1; +} +#endif + int IsWin95(void) { @@ -139,6 +148,10 @@ set_w32_module_name(void) : w32_perldll_handle), w32_module_name, sizeof(w32_module_name)); + /* remove \\?\ prefix */ + if (memcmp(w32_module_name, "\\\\?\\", 4) == 0) + memmove(w32_module_name, w32_module_name+4, strlen(w32_module_name+4)+1); + /* try to get full path to binary (which may be mangled when perl is * run from a 16-bit app) */ /*PerlIO_printf(Perl_debug_log, "Before %s\n", w32_module_name);*/ @@ -208,7 +221,6 @@ get_emd_part(SV **prev_pathp, char *trailing_path, ...) char *ptr; char *optr; char *strip; - int oldsize, newsize; STRLEN baselen; va_start(ap, trailing_path); @@ -255,7 +267,8 @@ get_emd_part(SV **prev_pathp, char *trailing_path, ...) dTHX; if (!*prev_pathp) *prev_pathp = sv_2mortal(newSVpvn("",0)); - sv_catpvn(*prev_pathp, ";", 1); + else if (SvPVX(*prev_pathp)) + sv_catpvn(*prev_pathp, ";", 1); sv_catpv(*prev_pathp, mod_name); return SvPVX(*prev_pathp); } @@ -286,8 +299,6 @@ win32_get_xlib(const char *pl, const char *xlib, const char *libname) dTHX; char regstr[40]; char pathstr[MAX_PATH+1]; - DWORD datalen; - int len, newsize; SV *sv1 = Nullsv; SV *sv2 = Nullsv; @@ -338,7 +349,7 @@ win32_get_vendorlib(const char *pl) } static BOOL -has_shell_metachars(char *ptr) +has_shell_metachars(const char *ptr) { int inquote = 0; char quote = '\0'; @@ -383,7 +394,7 @@ has_shell_metachars(char *ptr) * the library functions will get the correct environment */ PerlIO * -Perl_my_popen(pTHX_ char *cmd, char *mode) +Perl_my_popen(pTHX_ const char *cmd, const char *mode) { #ifdef FIXCMD #define fixcmd(x) { \ @@ -461,8 +472,8 @@ tokenize(const char *str, char **dest, char ***destv) int slen = strlen(str); register char *ret; register char **retv; - New(1307, ret, slen+2, char); - New(1308, retv, (slen+3)/2, char*); + Newx(ret, slen+2, char); + Newx(retv, (slen+3)/2, char*); retstart = ret; retvstart = retv; @@ -510,7 +521,7 @@ get_shell(void) * for). */ const char* defaultshell = (IsWinNT() - ? "cmd.exe /x/c" : "command.com /c"); + ? "cmd.exe /x/d/c" : "command.com /c"); const char *usershell = PerlEnv_getenv("PERL5SHELL"); w32_perlshell_items = tokenize(usershell ? usershell : defaultshell, &w32_perlshell_tokens, @@ -519,12 +530,8 @@ get_shell(void) } int -do_aspawn(void *vreally, void **vmark, void **vsp) +Perl_do_aspawn(pTHX_ SV *really, SV **mark, SV **sp) { - dTHX; - SV *really = (SV*)vreally; - SV **mark = (SV**)vmark; - SV **sp = (SV**)vsp; char **argv; char *str; int status; @@ -535,7 +542,7 @@ do_aspawn(void *vreally, void **vmark, void **vsp) return -1; get_shell(); - New(1306, argv, (sp - mark) + w32_perlshell_items + 2, char*); + Newx(argv, (sp - mark) + w32_perlshell_items + 2, char*); if (SvNIOKp(*(mark+1)) && !SvPOKp(*(mark+1))) { ++mark; @@ -575,7 +582,7 @@ do_aspawn(void *vreally, void **vmark, void **vsp) else { if (status < 0) { if (ckWARN(WARN_EXEC)) - Perl_warner(aTHX_ WARN_EXEC, "Can't spawn \"%s\": %s", argv[0], strerror(errno)); + Perl_warner(aTHX_ packWARN(WARN_EXEC), "Can't spawn \"%s\": %s", argv[0], strerror(errno)); status = 255 * 256; } else @@ -610,10 +617,9 @@ find_next_space(const char *s) return (char*)s; } -int -do_spawn2(char *cmd, int exectype) +static int +do_spawn2(pTHX_ const char *cmd, int exectype) { - dTHX; char **a; char *s; char **argv; @@ -624,8 +630,8 @@ do_spawn2(char *cmd, int exectype) /* Save an extra exec if possible. See if there are shell * metacharacters in it */ if (!has_shell_metachars(cmd)) { - New(1301,argv, strlen(cmd) / 2 + 2, char*); - New(1302,cmd2, strlen(cmd) + 1, char); + Newx(argv, strlen(cmd) / 2 + 2, char*); + Newx(cmd2, strlen(cmd) + 1, char); strcpy(cmd2, cmd); a = argv; for (s = cmd2; *s;) { @@ -662,10 +668,10 @@ do_spawn2(char *cmd, int exectype) char **argv; int i = -1; get_shell(); - New(1306, argv, w32_perlshell_items + 2, char*); + Newx(argv, w32_perlshell_items + 2, char*); while (++i < w32_perlshell_items) argv[i] = w32_perlshell_vec[i]; - argv[i++] = cmd; + argv[i++] = (char *)cmd; argv[i] = Nullch; switch (exectype) { case EXECF_SPAWN: @@ -690,7 +696,7 @@ do_spawn2(char *cmd, int exectype) else { if (status < 0) { if (ckWARN(WARN_EXEC)) - Perl_warner(aTHX_ WARN_EXEC, "Can't %s \"%s\": %s", + Perl_warner(aTHX_ packWARN(WARN_EXEC), "Can't %s \"%s\": %s", (exectype == EXECF_EXEC ? "exec" : "spawn"), cmd, strerror(errno)); status = 255 * 256; @@ -703,21 +709,21 @@ do_spawn2(char *cmd, int exectype) } int -do_spawn(char *cmd) +Perl_do_spawn(pTHX_ char *cmd) { - return do_spawn2(cmd, EXECF_SPAWN); + return do_spawn2(aTHX_ cmd, EXECF_SPAWN); } int -do_spawn_nowait(char *cmd) +Perl_do_spawn_nowait(pTHX_ char *cmd) { - return do_spawn2(cmd, EXECF_SPAWN_NOWAIT); + return do_spawn2(aTHX_ cmd, EXECF_SPAWN_NOWAIT); } bool -Perl_do_exec(pTHX_ char *cmd) +Perl_do_exec(pTHX_ const char *cmd) { - do_spawn2(cmd, EXECF_EXEC); + do_spawn2(aTHX_ cmd, EXECF_EXEC); return FALSE; } @@ -726,14 +732,14 @@ Perl_do_exec(pTHX_ char *cmd) * return the pointer to the current file name. */ DllExport DIR * -win32_opendir(char *filename) +win32_opendir(const char *filename) { dTHX; DIR *dirp; long len; long idx; char scanname[MAX_PATH+3]; - struct stat sbuf; + Stat_t sbuf; WIN32_FIND_DATAA aFindData; WIN32_FIND_DATAW wFindData; HANDLE fh; @@ -750,7 +756,7 @@ win32_opendir(char *filename) return NULL; /* Get us a DIR structure */ - Newz(1303, dirp, 1, DIR); + Newxz(dirp, 1, DIR); /* Create the search pattern */ strcpy(scanname, filename); @@ -811,7 +817,7 @@ win32_opendir(char *filename) dirp->size = 128; else dirp->size = idx; - New(1304, dirp->start, dirp->size, char); + Newx(dirp->start, dirp->size, char); strcpy(dirp->start, ptr); dirp->nfiles++; dirp->end = dirp->curr = dirp->start; @@ -1022,7 +1028,7 @@ find_pid(int pid) dTHX; long child = w32_num_children; while (--child >= 0) { - if (w32_child_pids[child] == pid) + if ((int)w32_child_pids[child] == pid) return child; } return -1; @@ -1049,7 +1055,7 @@ find_pseudo_pid(int pid) dTHX; long child = w32_num_pseudo_children; while (--child >= 0) { - if (w32_pseudo_child_pids[child] == pid) + if ((int)w32_pseudo_child_pids[child] == pid) return child; } return -1; @@ -1076,6 +1082,7 @@ win32_kill(int pid, int sig) dTHX; HANDLE hProcess; long child; + int retval; #ifdef USE_ITHREADS if (pid < 0) { /* it is a pseudo-forked child */ @@ -1123,6 +1130,11 @@ win32_kill(int pid, int sig) if (GenerateConsoleCtrlEvent(CTRL_C_EVENT,pid)) return 0; break; + case SIGBREAK: + case SIGTERM: + if (GenerateConsoleCtrlEvent(CTRL_BREAK_EVENT,pid)) + return 0; + break; default: /* For now be backwards compatible with perl5.6 */ case 9: if (TerminateProcess(hProcess, sig)) { @@ -1134,25 +1146,34 @@ win32_kill(int pid, int sig) } else { alien_process: + retval = -1; hProcess = OpenProcess(PROCESS_ALL_ACCESS, TRUE, (IsWin95() ? -pid : pid)); if (hProcess) { switch(sig) { case 0: /* "Does process exist?" use of kill */ - return 0; + retval = 0; + break; case 2: if (GenerateConsoleCtrlEvent(CTRL_C_EVENT,pid)) - return 0; + retval = 0; break; + case SIGBREAK: + case SIGTERM: + if (GenerateConsoleCtrlEvent(CTRL_BREAK_EVENT,pid)) + retval = 0; + break; default: /* For now be backwards compatible with perl5.6 */ case 9: - if (TerminateProcess(hProcess, sig)) { - CloseHandle(hProcess); - return 0; - } + if (TerminateProcess(hProcess, sig)) + retval = 0; + break; } } + CloseHandle(hProcess); + if (retval == 0) + return 0; } } errno = EINVAL; @@ -1160,7 +1181,7 @@ alien_process: } DllExport int -win32_stat(const char *path, struct stat *sbuf) +win32_stat(const char *path, Stat_t *sbuf) { dTHX; char buffer[MAX_PATH+1]; @@ -1176,6 +1197,10 @@ win32_stat(const char *path, struct stat *sbuf) /* FindFirstFile() and stat() are buggy with a trailing * backslash, so change it to a forward slash :-( */ case '\\': + if (l >= sizeof(buffer)) { + errno = ENAMETOOLONG; + return -1; + } strncpy(buffer, path, l-1); buffer[l - 1] = '/'; buffer[l] = '\0'; @@ -1217,10 +1242,18 @@ win32_stat(const char *path, struct stat *sbuf) /* pwbuffer or path will be mapped correctly above */ if (USING_WIDE()) { - res = _wstat(pwbuffer, (struct _stat *)sbuf); +#if defined(WIN64) || defined(USE_LARGE_FILES) + res = _wstati64(pwbuffer, sbuf); +#else + res = _wstat(pwbuffer, (struct _stat*)sbuf); +#endif } else { +#if defined(WIN64) || defined(USE_LARGE_FILES) + res = _stati64(path, sbuf); +#else res = stat(path, sbuf); +#endif } sbuf->st_nlink = nlink; @@ -1238,7 +1271,7 @@ win32_stat(const char *path, struct stat *sbuf) } if (r != 0xffffffff && (r & FILE_ATTRIBUTE_DIRECTORY)) { /* sbuf may still contain old garbage since stat() failed */ - Zero(sbuf, 1, struct stat); + Zero(sbuf, 1, Stat_t); sbuf->st_mode = S_IFDIR | S_IREAD; errno = 0; if (!(r & FILE_ATTRIBUTE_READONLY)) @@ -1284,6 +1317,18 @@ win32_stat(const char *path, struct stat *sbuf) return res; } +#define isSLASH(c) ((c) == '/' || (c) == '\\') +#define SKIP_SLASHES(s) \ + STMT_START { \ + while (*(s) && isSLASH(*(s))) \ + ++(s); \ + } STMT_END +#define COPY_NONSLASHES(d,s) \ + STMT_START { \ + while (*(s) && !isSLASH(*(s))) \ + *(d)++ = *(s)++; \ + } STMT_END + /* Find the longname of a given path. path is destructively modified. * It should have space for at least MAX_PATH characters. */ DllExport char * @@ -1299,61 +1344,74 @@ win32_longpath(char *path) return Nullch; /* drive prefix */ - if (isALPHA(path[0]) && path[1] == ':' && - (path[2] == '/' || path[2] == '\\')) - { + if (isALPHA(path[0]) && path[1] == ':') { start = path + 2; *tmpstart++ = path[0]; *tmpstart++ = ':'; } /* UNC prefix */ - else if ((path[0] == '/' || path[0] == '\\') && - (path[1] == '/' || path[1] == '\\')) - { + else if (isSLASH(path[0]) && isSLASH(path[1])) { start = path + 2; *tmpstart++ = path[0]; *tmpstart++ = path[1]; - /* copy machine name */ - while (*start && *start != '/' && *start != '\\') - *tmpstart++ = *start++; + SKIP_SLASHES(start); + COPY_NONSLASHES(tmpstart,start); /* copy machine name */ if (*start) { - *tmpstart++ = *start; - start++; - /* copy share name */ - while (*start && *start != '/' && *start != '\\') - *tmpstart++ = *start++; + *tmpstart++ = *start++; + SKIP_SLASHES(start); + COPY_NONSLASHES(tmpstart,start); /* copy share name */ } } - sep = *start++; - if (sep == '/' || sep == '\\') - *tmpstart++ = sep; *tmpstart = '\0'; - while (sep) { - /* walk up to slash */ - while (*start && *start != '/' && *start != '\\') - ++start; + while (*start) { + /* copy initial slash, if any */ + if (isSLASH(*start)) { + *tmpstart++ = *start++; + *tmpstart = '\0'; + SKIP_SLASHES(start); + } - /* discard doubled slashes */ - while (*start && (start[1] == '/' || start[1] == '\\')) + /* FindFirstFile() expands "." and "..", so we need to pass + * those through unmolested */ + if (*start == '.' + && (!start[1] || isSLASH(start[1]) + || (start[1] == '.' && (!start[2] || isSLASH(start[2]))))) + { + COPY_NONSLASHES(tmpstart,start); /* copy "." or ".." */ + *tmpstart = '\0'; + continue; + } + + /* if this is the end, bust outta here */ + if (!*start) + break; + + /* now we're at a non-slash; walk up to next slash */ + while (*start && !isSLASH(*start)) ++start; - sep = *start; /* stop and find full name of component */ + sep = *start; *start = '\0'; fhand = FindFirstFile(path,&fdata); + *start = sep; if (fhand != INVALID_HANDLE_VALUE) { - strcpy(tmpstart, fdata.cFileName); - tmpstart += strlen(fdata.cFileName); - if (sep) - *tmpstart++ = sep; - *tmpstart = '\0'; - *start++ = sep; - FindClose(fhand); + STRLEN len = strlen(fdata.cFileName); + if ((STRLEN)(tmpbuf + sizeof(tmpbuf) - tmpstart) > len) { + strcpy(tmpstart, fdata.cFileName); + tmpstart += len; + FindClose(fhand); + } + else { + FindClose(fhand); + errno = ERANGE; + return Nullch; + } } else { /* failed a step, just return without side effects */ /*PerlIO_printf(Perl_debug_log, "Failed to find %s\n", path);*/ - *start = sep; + errno = EINVAL; return Nullch; } } @@ -1423,7 +1481,7 @@ win32_putenv(const char *name) if (name) { if (USING_WIDE()) { length = strlen(name)+1; - New(1309,wCuritem,length,WCHAR); + Newx(wCuritem,length,WCHAR); A2WHELPER(name, wCuritem, length*sizeof(WCHAR)); wVal = wcschr(wCuritem, '='); if (wVal) { @@ -1434,7 +1492,7 @@ win32_putenv(const char *name) Safefree(wCuritem); } else { - New(1309,curitem,strlen(name)+1,char); + Newx(curitem,strlen(name)+1,char); strcpy(curitem, name); val = strchr(curitem, '='); if (val) { @@ -1478,22 +1536,21 @@ win32_times(struct tms *timebuf) FILETIME user; FILETIME kernel; FILETIME dummy; + clock_t process_time_so_far = clock(); if (GetProcessTimes(GetCurrentProcess(), &dummy, &dummy, &kernel,&user)) { timebuf->tms_utime = filetime_to_clock(&user); timebuf->tms_stime = filetime_to_clock(&kernel); timebuf->tms_cutime = 0; timebuf->tms_cstime = 0; - } else { /* That failed - e.g. Win95 fallback to clock() */ - clock_t t = clock(); - timebuf->tms_utime = t; + timebuf->tms_utime = process_time_so_far; timebuf->tms_stime = 0; timebuf->tms_cutime = 0; timebuf->tms_cstime = 0; } - return 0; + return process_time_so_far; } /* fix utime() so it works on directories in NT */ @@ -1622,6 +1679,38 @@ win32_utime(const char *filename, struct utimbuf *times) return rc; } +typedef union { + unsigned __int64 ft_i64; + FILETIME ft_val; +} FT_t; + +#ifdef __GNUC__ +#define Const64(x) x##LL +#else +#define Const64(x) x##i64 +#endif +/* Number of 100 nanosecond units from 1/1/1601 to 1/1/1970 */ +#define EPOCH_BIAS Const64(116444736000000000) + +/* NOTE: This does not compute the timezone info (doing so can be expensive, + * and appears to be unsupported even by glibc) */ +DllExport int +win32_gettimeofday(struct timeval *tp, void *not_used) +{ + FT_t ft; + + /* this returns time in 100-nanosecond units (i.e. tens of usecs) */ + GetSystemTimeAsFileTime(&ft.ft_val); + + /* seconds since epoch */ + tp->tv_sec = (long)((ft.ft_i64 - EPOCH_BIAS) / Const64(10000000)); + + /* microseconds remaining */ + tp->tv_usec = (long)((ft.ft_i64 / Const64(10)) % Const64(1000000)); + + return 0; +} + DllExport int win32_uname(struct utsname *name) { @@ -1688,15 +1777,17 @@ win32_uname(struct utsname *name) /* machine (architecture) */ { SYSTEM_INFO info; + DWORD procarch; char *arch; GetSystemInfo(&info); #if (defined(__BORLANDC__)&&(__BORLANDC__<=0x520)) \ || (defined(__MINGW32__) && !defined(_ANONYMOUS_UNION)) - switch (info.u.s.wProcessorArchitecture) { + procarch = info.u.s.wProcessorArchitecture; #else - switch (info.wProcessorArchitecture) { + procarch = info.wProcessorArchitecture; #endif + switch (procarch) { case PROCESSOR_ARCHITECTURE_INTEL: arch = "x86"; break; case PROCESSOR_ARCHITECTURE_MIPS: @@ -1705,10 +1796,45 @@ win32_uname(struct utsname *name) arch = "alpha"; break; case PROCESSOR_ARCHITECTURE_PPC: arch = "ppc"; break; - default: +#ifdef PROCESSOR_ARCHITECTURE_SHX + case PROCESSOR_ARCHITECTURE_SHX: + arch = "shx"; break; +#endif +#ifdef PROCESSOR_ARCHITECTURE_ARM + case PROCESSOR_ARCHITECTURE_ARM: + arch = "arm"; break; +#endif +#ifdef PROCESSOR_ARCHITECTURE_IA64 + case PROCESSOR_ARCHITECTURE_IA64: + arch = "ia64"; break; +#endif +#ifdef PROCESSOR_ARCHITECTURE_ALPHA64 + case PROCESSOR_ARCHITECTURE_ALPHA64: + arch = "alpha64"; break; +#endif +#ifdef PROCESSOR_ARCHITECTURE_MSIL + case PROCESSOR_ARCHITECTURE_MSIL: + arch = "msil"; break; +#endif +#ifdef PROCESSOR_ARCHITECTURE_AMD64 + case PROCESSOR_ARCHITECTURE_AMD64: + arch = "amd64"; break; +#endif +#ifdef PROCESSOR_ARCHITECTURE_IA32_ON_WIN64 + case PROCESSOR_ARCHITECTURE_IA32_ON_WIN64: + arch = "ia32-64"; break; +#endif +#ifdef PROCESSOR_ARCHITECTURE_UNKNOWN + case PROCESSOR_ARCHITECTURE_UNKNOWN: arch = "unknown"; break; +#endif + default: + sprintf(name->machine, "unknown(0x%x)", procarch); + arch = name->machine; + break; } - strcpy(name->machine, arch); + if (name->machine != arch) + strcpy(name->machine, arch); } return 0; } @@ -1792,10 +1918,12 @@ win32_async_check(pTHX) case WM_TIMER: { /* alarm() is a one-shot but SetTimer() repeats so kill it */ - if (w32_timerid) { + if (w32_timerid && w32_timerid==msg.wParam) { KillTimer(NULL,w32_timerid); w32_timerid=0; } + else + goto FallThrough; /* Now fake a call to signal handler */ if (do_raise(aTHX_ 14)) { sig_terminate(aTHX_ 14); @@ -1805,6 +1933,7 @@ win32_async_check(pTHX) /* Otherwise do normal Win32 thing - in case it is useful */ default: + FallThrough: TranslateMessage(&msg); DispatchMessage(&msg); ours = 0; @@ -1820,6 +1949,8 @@ win32_async_check(pTHX) return ours; } +/* This function will not return until the timeout has elapsed, or until + * one of the handles is ready. */ DllExport DWORD win32_msgwait(pTHX_ DWORD count, LPHANDLE handles, DWORD timeout, LPDWORD resultp) { @@ -1844,10 +1975,7 @@ win32_msgwait(pTHX_ DWORD count, LPHANDLE handles, DWORD timeout, LPDWORD result } if (result == WAIT_OBJECT_0 + count) { /* Message has arrived - check it */ - if (win32_async_check(aTHX)) { - /* was one of ours */ - break; - } + (void)win32_async_check(aTHX); } else { /* Not timeout or message - one of handles is ready */ @@ -1920,7 +2048,6 @@ win32_internal_wait(int *status, DWORD timeout) } } -FAILED: errno = GetLastError(); return -1; } @@ -1989,6 +2116,7 @@ alien_process: if (hProcess) { win32_msgwait(aTHX_ 1, &hProcess, timeout, &waitcode); if (waitcode == WAIT_TIMEOUT) { + CloseHandle(hProcess); return 0; } else if (waitcode == WAIT_OBJECT_0) { @@ -2068,7 +2196,7 @@ win32_crypt(const char *txt, const char *salt) #define FTEXT 0x80 /* file handle is in text mode */ /*** -*int my_open_osfhandle(long osfhandle, int flags) - open C Runtime file handle +*int my_open_osfhandle(intptr_t osfhandle, int flags) - open C Runtime file handle * *Purpose: * This function allocates a free C Runtime file handle and associates @@ -2079,7 +2207,7 @@ win32_crypt(const char *txt, const char *salt) * This works with MSVC++ 4.0+ or GCC/Mingw32 * *Entry: -* long osfhandle - Win32 HANDLE to associate with C Runtime file handle. +* intptr_t osfhandle - Win32 HANDLE to associate with C Runtime file handle. * int flags - flags to associate with C Runtime file handle. * *Exit: @@ -2103,7 +2231,7 @@ static int _alloc_osfhnd(void) { HANDLE hF = CreateFile("NUL", 0, 0, NULL, OPEN_ALWAYS, 0, NULL); - int fh = _open_osfhandle((long)hF, 0); + int fh = _open_osfhandle((intptr_t)hF, 0); CloseHandle(hF); if (fh == -1) return fh; @@ -2112,7 +2240,7 @@ _alloc_osfhnd(void) } static int -my_open_osfhandle(long osfhandle, int flags) +my_open_osfhandle(intptr_t osfhandle, int flags) { int fh; char fileflags; /* _osfile flags */ @@ -2465,28 +2593,81 @@ win32_fflush(FILE *pf) return fflush(pf); } -DllExport long +DllExport Off_t win32_ftell(FILE *pf) { +#if defined(WIN64) || defined(USE_LARGE_FILES) +#if defined(__BORLANDC__) /* buk */ + return win32_tell( fileno( pf ) ); +#else + fpos_t pos; + if (fgetpos(pf, &pos)) + return -1; + return (Off_t)pos; +#endif +#else return ftell(pf); +#endif } DllExport int -win32_fseek(FILE *pf,long offset,int origin) -{ - return fseek(pf, offset, origin); +win32_fseek(FILE *pf, Off_t offset,int origin) +{ +#if defined(WIN64) || defined(USE_LARGE_FILES) +#if defined(__BORLANDC__) /* buk */ + return win32_lseek( + fileno(pf), + offset, + origin + ); +#else + fpos_t pos; + switch (origin) { + case SEEK_CUR: + if (fgetpos(pf, &pos)) + return -1; + offset += pos; + break; + case SEEK_END: + fseek(pf, 0, SEEK_END); + pos = _telli64(fileno(pf)); + offset += pos; + break; + case SEEK_SET: + break; + default: + errno = EINVAL; + return -1; + } + return fsetpos(pf, &offset); +#endif +#else + return fseek(pf, (long)offset, origin); +#endif } DllExport int win32_fgetpos(FILE *pf,fpos_t *p) { +#if defined(__BORLANDC__) && defined(USE_LARGE_FILES) /* buk */ + if( win32_tell(fileno(pf)) == -1L ) { + errno = EBADF; + return -1; + } + return 0; +#else return fgetpos(pf, p); +#endif } DllExport int win32_fsetpos(FILE *pf,const fpos_t *p) { +#if defined(__BORLANDC__) && defined(USE_LARGE_FILES) /* buk */ + return win32_lseek(fileno(pf), *p, SEEK_CUR); +#else return fsetpos(pf, p); +#endif } DllExport void @@ -2496,8 +2677,8 @@ win32_rewind(FILE *pf) return; } -DllExport FILE* -win32_tmpfile(void) +DllExport int +win32_tmpfd(void) { dTHX; char prefix[MAX_PATH+1]; @@ -2514,15 +2695,27 @@ win32_tmpfile(void) | FILE_FLAG_DELETE_ON_CLOSE, NULL); if (fh != INVALID_HANDLE_VALUE) { - int fd = win32_open_osfhandle((long)fh, 0); + int fd = win32_open_osfhandle((intptr_t)fh, 0); if (fd >= 0) { +#if defined(__BORLANDC__) + setmode(fd,O_BINARY); +#endif DEBUG_p(PerlIO_printf(Perl_debug_log, "Created tmpfile=%s\n",filename)); - return fdopen(fd, "w+b"); + return fd; } } } } + return -1; +} + +DllExport FILE* +win32_tmpfile(void) +{ + int fd = win32_tmpfd(); + if (fd >= 0) + return win32_fdopen(fd, "w+b"); return NULL; } @@ -2534,7 +2727,7 @@ win32_abort(void) } DllExport int -win32_fstat(int fd,struct stat *sbufptr) +win32_fstat(int fd, Stat_t *sbufptr) { #ifdef __BORLANDC__ /* A file designated by filehandle is not shown as accessible @@ -2583,22 +2776,28 @@ win32_popen(const char *command, const char *mode) #ifdef USE_RTL_POPEN return _popen(command, mode); #else + dTHX; int p[2]; int parent, child; int stdfd, oldfd; int ourmode; int childpid; + DWORD nhandle; + HANDLE old_h; + int lock_held = 0; /* establish which ends read and write */ if (strchr(mode,'w')) { stdfd = 0; /* stdin */ parent = 1; child = 0; + nhandle = STD_INPUT_HANDLE; } else if (strchr(mode,'r')) { stdfd = 1; /* stdout */ parent = 0; child = 1; + nhandle = STD_OUTPUT_HANDLE; } else return NULL; @@ -2614,13 +2813,19 @@ win32_popen(const char *command, const char *mode) /* the child doesn't inherit handles */ ourmode |= O_NOINHERIT; - if (win32_pipe( p, 512, ourmode) == -1) + if (win32_pipe(p, 512, ourmode) == -1) return NULL; /* save current stdfd */ if ((oldfd = win32_dup(stdfd)) == -1) goto cleanup; + /* save the old std handle (this needs to happen before the + * dup2(), since that might call SetStdHandle() too) */ + OP_REFCNT_LOCK; + lock_held = 1; + old_h = GetStdHandle(nhandle); + /* make stdfd go to child end of pipe (implicitly closes stdfd) */ /* stdfd will be inherited by the child */ if (win32_dup2(p[child], stdfd) == -1) @@ -2629,6 +2834,9 @@ win32_popen(const char *command, const char *mode) /* close the child end in parent */ win32_close(p[child]); + /* set the new std handle (in case dup2() above didn't) */ + SetStdHandle(nhandle, (HANDLE)_get_osfhandle(stdfd)); + /* start the child */ { dTHX; @@ -2639,6 +2847,14 @@ win32_popen(const char *command, const char *mode) if (win32_dup2(oldfd, stdfd) == -1) goto cleanup; + /* restore the old std handle (this needs to happen after the + * dup2(), since that might call SetStdHandle() too */ + if (lock_held) { + SetStdHandle(nhandle, old_h); + OP_REFCNT_UNLOCK; + lock_held = 0; + } + /* close saved handle */ win32_close(oldfd); @@ -2657,6 +2873,11 @@ cleanup: /* we don't need to check for errors here */ win32_close(p[0]); win32_close(p[1]); + if (lock_held) { + SetStdHandle(nhandle, old_h); + OP_REFCNT_UNLOCK; + lock_held = 0; + } if (oldfd != -1) { win32_dup2(oldfd, stdfd); win32_close(oldfd); @@ -2926,16 +3147,106 @@ win32_setmode(int fd, int mode) return setmode(fd, mode); } -DllExport long -win32_lseek(int fd, long offset, int origin) +DllExport int +win32_chsize(int fd, Off_t size) { - return lseek(fd, offset, origin); +#if defined(WIN64) || defined(USE_LARGE_FILES) + int retval = 0; + Off_t cur, end, extend; + + cur = win32_tell(fd); + if (cur < 0) + return -1; + end = win32_lseek(fd, 0, SEEK_END); + if (end < 0) + return -1; + extend = size - end; + if (extend == 0) { + /* do nothing */ + } + else if (extend > 0) { + /* must grow the file, padding with nulls */ + char b[4096]; + int oldmode = win32_setmode(fd, O_BINARY); + size_t count; + memset(b, '\0', sizeof(b)); + do { + count = extend >= sizeof(b) ? sizeof(b) : (size_t)extend; + count = win32_write(fd, b, count); + if ((int)count < 0) { + retval = -1; + break; + } + } while ((extend -= count) > 0); + win32_setmode(fd, oldmode); + } + else { + /* shrink the file */ + win32_lseek(fd, size, SEEK_SET); + if (!SetEndOfFile((HANDLE)_get_osfhandle(fd))) { + errno = EACCES; + retval = -1; + } + } +finish: + win32_lseek(fd, cur, SEEK_SET); + return retval; +#else + return chsize(fd, (long)size); +#endif } -DllExport long +DllExport Off_t +win32_lseek(int fd, Off_t offset, int origin) +{ +#if defined(WIN64) || defined(USE_LARGE_FILES) +#if defined(__BORLANDC__) /* buk */ + LARGE_INTEGER pos; + pos.QuadPart = offset; + pos.LowPart = SetFilePointer( + (HANDLE)_get_osfhandle(fd), + pos.LowPart, + &pos.HighPart, + origin + ); + if (pos.LowPart == INVALID_SET_FILE_POINTER && GetLastError() != NO_ERROR) { + pos.QuadPart = -1; + } + + return pos.QuadPart; +#else + return _lseeki64(fd, offset, origin); +#endif +#else + return lseek(fd, (long)offset, origin); +#endif +} + +DllExport Off_t win32_tell(int fd) { +#if defined(WIN64) || defined(USE_LARGE_FILES) +#if defined(__BORLANDC__) /* buk */ + LARGE_INTEGER pos; + pos.QuadPart = 0; + pos.LowPart = SetFilePointer( + (HANDLE)_get_osfhandle(fd), + pos.LowPart, + &pos.HighPart, + FILE_CURRENT + ); + if (pos.LowPart == INVALID_SET_FILE_POINTER && GetLastError() != NO_ERROR) { + pos.QuadPart = -1; + } + + return pos.QuadPart; + /* return tell(fd); */ +#else + return _telli64(fd); +#endif +#else return tell(fd); +#endif } DllExport int @@ -3305,7 +3616,8 @@ create_command_line(char *cname, STRLEN clen, const char * const *args) || (IsWinNT() && stricmp(&cname[clen-4], ".cmd") == 0))) { bat_file = TRUE; - len += 3; + if (!IsWin95()) + len += 3; } else { char *exe = strrchr(cname, '/'); @@ -3339,10 +3651,10 @@ create_command_line(char *cname, STRLEN clen, const char * const *args) DEBUG_p(PerlIO_printf(Perl_debug_log, "\n")); argc = index; - New(1310, cmd, len, char); + Newx(cmd, len, char); ptr = cmd; - if (bat_file) { + if (bat_file && !IsWin95()) { *ptr++ = '"'; extra_quotes = TRUE; } @@ -3392,7 +3704,9 @@ create_command_line(char *cname, STRLEN clen, const char * const *args) if (!extra_quotes && cmd_shell - && (stricmp(arg, "/x/c") == 0 || stricmp(arg, "/c") == 0)) + && curlen >= 2 + && *arg == '/' /* see if arg is "/c", "/x/c", "/x/d/c" etc. */ + && stricmp(arg+curlen-2, "/c") == 0) { /* is there a next argument? */ if (args[index+1]) { @@ -3438,7 +3752,10 @@ qualified_path(const char *cmd) /* look in PATH */ pathstr = PerlEnv_getenv("PATH"); - New(0, fullcmd, MAX_PATH+1, char); + + /* worst case: PATH is a single directory; we need additional space + * to append "/", ".exe" and trailing "\0" */ + Newx(fullcmd, (pathstr ? strlen(pathstr) : 0) + cmdlen + 6, char); curfullcmd = fullcmd; while (1) { @@ -3479,17 +3796,13 @@ qualified_path(const char *cmd) if (*pathstr == '"') { /* foo;"baz;etc";bar */ pathstr++; /* skip initial '"' */ while (*pathstr && *pathstr != '"') { - if (curfullcmd-fullcmd < MAX_PATH-cmdlen-5) - *curfullcmd++ = *pathstr; - pathstr++; + *curfullcmd++ = *pathstr++; } if (*pathstr) pathstr++; /* skip trailing '"' */ } else { - if (curfullcmd-fullcmd < MAX_PATH-cmdlen-5) - *curfullcmd++ = *pathstr; - pathstr++; + *curfullcmd++ = *pathstr++; } } if (*pathstr) @@ -3500,7 +3813,7 @@ qualified_path(const char *cmd) *curfullcmd++ = '\\'; } } -GIVE_UP: + Safefree(fullcmd); return Nullch; } @@ -3557,7 +3870,7 @@ win32_get_childdir(void) GetCurrentDirectoryA(MAX_PATH+1, szfilename); } - New(0, ptr, strlen(szfilename)+1, char); + Newx(ptr, strlen(szfilename)+1, char); strcpy(ptr, szfilename); return ptr; } @@ -3605,7 +3918,7 @@ win32_spawnvp(int mode, const char *cmdname, const char *const *argv) /* if command name contains dquotes, must remove them */ if (strchr(cname, '"')) { cmd = cname; - New(0,cname,clen+1,char); + Newx(cname,clen+1,char); clen = 0; while (*cmd) { if (*cmd != '"') { @@ -3659,14 +3972,14 @@ win32_spawnvp(int mode, const char *cmdname, const char *const *argv) StartupInfo.hStdInput = tbl.childStdIn; StartupInfo.hStdOutput = tbl.childStdOut; StartupInfo.hStdError = tbl.childStdErr; - if (StartupInfo.hStdInput != INVALID_HANDLE_VALUE && - StartupInfo.hStdOutput != INVALID_HANDLE_VALUE && - StartupInfo.hStdError != INVALID_HANDLE_VALUE) + if (StartupInfo.hStdInput == INVALID_HANDLE_VALUE && + StartupInfo.hStdOutput == INVALID_HANDLE_VALUE && + StartupInfo.hStdError == INVALID_HANDLE_VALUE) { - StartupInfo.dwFlags |= STARTF_USESTDHANDLES; + create |= CREATE_NEW_CONSOLE; } else { - create |= CREATE_NEW_CONSOLE; + StartupInfo.dwFlags |= STARTF_USESTDHANDLES; } if (w32_use_showwindow) { StartupInfo.dwFlags |= STARTF_USESHOWWINDOW; @@ -3751,9 +4064,17 @@ win32_execv(const char *cmdname, const char *const *argv) /* if this is a pseudo-forked child, we just want to spawn * the new program, and return */ if (w32_pseudo_id) +# ifdef __BORLANDC__ return spawnv(P_WAIT, cmdname, (char *const *)argv); +# else + return spawnv(P_WAIT, cmdname, argv); +# endif #endif +#ifdef __BORLANDC__ return execv(cmdname, (char *const *)argv); +#else + return execv(cmdname, argv); +#endif } DllExport int @@ -3764,7 +4085,7 @@ win32_execvp(const char *cmdname, const char *const *argv) /* if this is a pseudo-forked child, we just want to spawn * the new program, and return */ if (w32_pseudo_id) { - int status = win32_spawnvp(P_WAIT, cmdname, (char *const *)argv); + int status = win32_spawnvp(P_WAIT, cmdname, (const char *const *)argv); if (status != -1) { my_exit(status); return 0; @@ -3773,7 +4094,11 @@ win32_execvp(const char *cmdname, const char *const *argv) return status; } #endif +#ifdef __BORLANDC__ return execvp(cmdname, (char *const *)argv); +#else + return execvp(cmdname, argv); +#endif } DllExport void @@ -3857,10 +4182,9 @@ static char *base = NULL; /* XXX threadead */ static char *reserved = NULL; /* XXX threadead */ static char *brk = NULL; /* XXX threadead */ static DWORD pagesize = 0; /* XXX threadead */ -static DWORD allocsize = 0; /* XXX threadead */ void * -sbrk(int need) +sbrk(ptrdiff_t need) { void *result; if (!pagesize) @@ -3870,28 +4194,34 @@ sbrk(int need) * call the OS to commit just one page ... */ pagesize = info.dwPageSize << 3; - allocsize = info.dwAllocationGranularity; } - /* This scheme fails eventually if request for contiguous - * block is denied so reserve big blocks - this is only - * address space not memory ... - */ if (brk+need >= reserved) { - DWORD size = 64*1024*1024; + DWORD size = brk+need-reserved; char *addr; + char *prev_committed = NULL; if (committed && reserved && committed < reserved) { /* Commit last of previous chunk cannot span allocations */ addr = (char *) VirtualAlloc(committed,reserved-committed,MEM_COMMIT,PAGE_READWRITE); if (addr) + { + /* Remember where we committed from in case we want to decommit later */ + prev_committed = committed; committed = reserved; + } } /* Reserve some (more) space + * Contiguous blocks give us greater efficiency, so reserve big blocks - + * this is only address space not memory... * Note this is a little sneaky, 1st call passes NULL as reserved * so lets system choose where we start, subsequent calls pass * the old end address so ask for a contiguous block */ +sbrk_reserve: + if (size < 64*1024*1024) + size = 64*1024*1024; + size = ((size + pagesize - 1) / pagesize) * pagesize; addr = (char *) VirtualAlloc(reserved,size,MEM_RESERVE,PAGE_NOACCESS); if (addr) { @@ -3903,6 +4233,19 @@ sbrk(int need) if (!brk) brk = committed; } + else if (reserved) + { + /* The existing block could not be extended far enough, so decommit + * anything that was just committed above and start anew */ + if (prev_committed) + { + if (!VirtualFree(prev_committed,reserved-prev_committed,MEM_DECOMMIT)) + return (void *) -1; + } + reserved = base = committed = brk = NULL; + size = need; + goto sbrk_reserve; + } else { return (void *) -1; @@ -3913,11 +4256,12 @@ sbrk(int need) if (brk > committed) { DWORD size = ((brk-committed + pagesize -1)/pagesize) * pagesize; - char *addr = (char *) VirtualAlloc(committed,size,MEM_COMMIT,PAGE_READWRITE); + char *addr; + if (committed+size > reserved) + size = reserved-committed; + addr = (char *) VirtualAlloc(committed,size,MEM_COMMIT,PAGE_READWRITE); if (addr) - { - committed += size; - } + committed += size; else return (void *) -1; } @@ -3952,8 +4296,8 @@ win32_free(void *block) } -int -win32_open_osfhandle(long handle, int flags) +DllExport int +win32_open_osfhandle(intptr_t handle, int flags) { #ifdef USE_FIXED_OSFHANDLE if (IsWin95()) @@ -3962,10 +4306,62 @@ win32_open_osfhandle(long handle, int flags) return _open_osfhandle(handle, flags); } -long +DllExport intptr_t win32_get_osfhandle(int fd) { - return _get_osfhandle(fd); + return (intptr_t)_get_osfhandle(fd); +} + +DllExport FILE * +win32_fdupopen(FILE *pf) +{ + FILE* pfdup; + fpos_t pos; + char mode[3]; + int fileno = win32_dup(win32_fileno(pf)); + + /* open the file in the same mode */ +#ifdef __BORLANDC__ + if((pf)->flags & _F_READ) { + mode[0] = 'r'; + mode[1] = 0; + } + else if((pf)->flags & _F_WRIT) { + mode[0] = 'a'; + mode[1] = 0; + } + else if((pf)->flags & _F_RDWR) { + mode[0] = 'r'; + mode[1] = '+'; + mode[2] = 0; + } +#else + if((pf)->_flag & _IOREAD) { + mode[0] = 'r'; + mode[1] = 0; + } + else if((pf)->_flag & _IOWRT) { + mode[0] = 'a'; + mode[1] = 0; + } + else if((pf)->_flag & _IORW) { + mode[0] = 'r'; + mode[1] = '+'; + mode[2] = 0; + } +#endif + + /* it appears that the binmode is attached to the + * file descriptor so binmode files will be handled + * correctly + */ + pfdup = win32_fdopen(fileno, mode); + + /* move the file pointer to the same position */ + if (!fgetpos(pf, &pos)) { + fsetpos(pfdup, &pos); + } + return pfdup; } DllExport void* @@ -4170,11 +4566,11 @@ XS(w32_DomainName) /* NERR_Success *is* 0*/ if (0 == pfnNetWkstaGetInfo(NULL, 100, &pwi)) { if (pwi->wki100_langroup && *(pwi->wki100_langroup)) { - WideCharToMultiByte(CP_ACP, NULL, pwi->wki100_langroup, + WideCharToMultiByte(CP_ACP, 0, pwi->wki100_langroup, -1, (LPSTR)dname, dnamelen, NULL, NULL); } else { - WideCharToMultiByte(CP_ACP, NULL, pwi->wki100_computername, + WideCharToMultiByte(CP_ACP, 0, pwi->wki100_computername, -1, (LPSTR)dname, dnamelen, NULL, NULL); } pfnNetApiBufferFree(pwi); @@ -4229,26 +4625,74 @@ static XS(w32_GetOSVersion) { dXSARGS; - OSVERSIONINFOA osver; + /* Use explicit struct definition because wSuiteMask and + * wProductType are not defined in the VC++ 6.0 headers. + * WORD type has been replaced by unsigned short because + * WORD is already used by Perl itself. + */ + struct { + DWORD dwOSVersionInfoSize; + DWORD dwMajorVersion; + DWORD dwMinorVersion; + DWORD dwBuildNumber; + DWORD dwPlatformId; + CHAR szCSDVersion[128]; + unsigned short wServicePackMajor; + unsigned short wServicePackMinor; + unsigned short wSuiteMask; + BYTE wProductType; + BYTE wReserved; + } osver; + BOOL bEx = TRUE; if (USING_WIDE()) { - OSVERSIONINFOW osverw; + struct { + DWORD dwOSVersionInfoSize; + DWORD dwMajorVersion; + DWORD dwMinorVersion; + DWORD dwBuildNumber; + DWORD dwPlatformId; + WCHAR szCSDVersion[128]; + unsigned short wServicePackMajor; + unsigned short wServicePackMinor; + unsigned short wSuiteMask; + BYTE wProductType; + BYTE wReserved; + } osverw; char szCSDVersion[sizeof(osverw.szCSDVersion)]; - osverw.dwOSVersionInfoSize = sizeof(OSVERSIONINFOW); - if (!GetVersionExW(&osverw)) { - XSRETURN_EMPTY; + osverw.dwOSVersionInfoSize = sizeof(osverw); + if (!GetVersionExW((OSVERSIONINFOW*)&osverw)) { + bEx = FALSE; + osverw.dwOSVersionInfoSize = sizeof(OSVERSIONINFOW); + if (!GetVersionExW((OSVERSIONINFOW*)&osverw)) { + XSRETURN_EMPTY; + } + } + if (GIMME_V == G_SCALAR) { + XSRETURN_IV(osverw.dwPlatformId); } W2AHELPER(osverw.szCSDVersion, szCSDVersion, sizeof(szCSDVersion)); XPUSHs(newSVpvn(szCSDVersion, strlen(szCSDVersion))); - osver.dwMajorVersion = osverw.dwMajorVersion; - osver.dwMinorVersion = osverw.dwMinorVersion; - osver.dwBuildNumber = osverw.dwBuildNumber; - osver.dwPlatformId = osverw.dwPlatformId; + osver.dwMajorVersion = osverw.dwMajorVersion; + osver.dwMinorVersion = osverw.dwMinorVersion; + osver.dwBuildNumber = osverw.dwBuildNumber; + osver.dwPlatformId = osverw.dwPlatformId; + osver.wServicePackMajor = osverw.wServicePackMajor; + osver.wServicePackMinor = osverw.wServicePackMinor; + osver.wSuiteMask = osverw.wSuiteMask; + osver.wProductType = osverw.wProductType; } else { - osver.dwOSVersionInfoSize = sizeof(OSVERSIONINFOA); - if (!GetVersionExA(&osver)) { - XSRETURN_EMPTY; + osver.dwOSVersionInfoSize = sizeof(osver); + if (!GetVersionExA((OSVERSIONINFOA*)&osver)) { + bEx = FALSE; + osver.dwOSVersionInfoSize = sizeof(OSVERSIONINFOA); + if (!GetVersionExA((OSVERSIONINFOA*)&osver)) { + XSRETURN_EMPTY; + } + } + if (GIMME_V == G_SCALAR) { + XSRETURN_IV(osver.dwPlatformId); } XPUSHs(newSVpvn(osver.szCSDVersion, strlen(osver.szCSDVersion))); } @@ -4256,6 +4700,12 @@ XS(w32_GetOSVersion) XPUSHs(newSViv(osver.dwMinorVersion)); XPUSHs(newSViv(osver.dwBuildNumber)); XPUSHs(newSViv(osver.dwPlatformId)); + if (bEx) { + XPUSHs(newSViv(osver.wServicePackMajor)); + XPUSHs(newSViv(osver.wServicePackMinor)); + XPUSHs(newSViv(osver.wSuiteMask)); + XPUSHs(newSViv(osver.wProductType)); + } PUTBACK; } @@ -4388,6 +4838,7 @@ XS(w32_GetShortPathName) } while (len >= SvLEN(shortpath) && sv_grow(shortpath,len+1)); if (len) { SvCUR_set(shortpath,len); + *SvEND(shortpath) = '\0'; ST(0) = shortpath; XSRETURN(1); } @@ -4402,13 +4853,15 @@ XS(w32_GetFullPathName) SV *fullpath; char *filepart; DWORD len; + STRLEN filename_len; + char *filename_p; if (items != 1) Perl_croak(aTHX_ "usage: Win32::GetFullPathName($filename)"); filename = ST(0); - fullpath = sv_mortalcopy(filename); - SvUPGRADE(fullpath, SVt_PV); + filename_p = SvPV(filename, filename_len); + fullpath = sv_2mortal(newSVpvn(filename_p, filename_len)); if (!SvPVX(fullpath) || !SvLEN(fullpath)) XSRETURN_UNDEF; @@ -4421,11 +4874,17 @@ XS(w32_GetFullPathName) if (len) { if (GIMME_V == G_ARRAY) { EXTEND(SP,1); - XST_mPV(1,filepart); - len = filepart - SvPVX(fullpath); + if (filepart) { + XST_mPV(1,filepart); + len = filepart - SvPVX(fullpath); + } + else { + XST_mPVN(1,"",0); + } items = 2; } SvCUR_set(fullpath,len); + *SvEND(fullpath) = '\0'; ST(0) = fullpath; XSRETURN(items); } @@ -4533,24 +4992,31 @@ Perl_init_os_extras(void) */ } -PerlInterpreter * +void * win32_signal_context(void) { dTHX; +#ifdef MULTIPLICITY if (!my_perl) { my_perl = PL_curinterp; PERL_SET_THX(my_perl); } return my_perl; +#else + return PL_curinterp; +#endif } + BOOL WINAPI win32_ctrlhandler(DWORD dwCtrlType) { +#ifdef MULTIPLICITY dTHXa(PERL_GET_SIG_CONTEXT); if (!my_perl) return FALSE; +#endif switch(dwCtrlType) { case CTRL_CLOSE_EVENT: @@ -4611,6 +5077,13 @@ Perl_win32_init(int *argcp, char ***argvp) } void +Perl_win32_term(void) +{ + OP_REFCNT_TERM; + MALLOC_TERM; +} + +void win32_get_child_IO(child_IO_table* ptbl) { ptbl->childStdIn = GetStdHandle(STD_INPUT_HANDLE); @@ -4660,23 +5133,26 @@ Perl_sys_intern_init(pTHX) w32_perlshell_vec = (char**)NULL; w32_perlshell_items = 0; w32_fdpid = newAV(); - New(1313, w32_children, 1, child_tab); + Newx(w32_children, 1, child_tab); w32_num_children = 0; # ifdef USE_ITHREADS w32_pseudo_id = 0; - New(1313, w32_pseudo_children, 1, child_tab); + Newx(w32_pseudo_children, 1, child_tab); w32_num_pseudo_children = 0; # endif - w32_init_socktype = 0; w32_timerid = 0; w32_poll_count = 0; for (i=0; i < SIG_SIZE; i++) { w32_sighandler[i] = SIG_DFL; } +# ifdef MULTIPLICTY if (my_perl == PL_curinterp) { +# else + { +# endif /* Force C runtime signal stuff to set its console handler */ - signal(SIGINT,&win32_csighandler); - signal(SIGBREAK,&win32_csighandler); + signal(SIGINT,win32_csighandler); + signal(SIGBREAK,win32_csighandler); /* Push our handler on top */ SetConsoleCtrlHandler(win32_ctrlhandler,TRUE); } @@ -4693,7 +5169,11 @@ Perl_sys_intern_clear(pTHX) KillTimer(NULL,w32_timerid); w32_timerid=0; } +# ifdef MULTIPLICITY if (my_perl == PL_curinterp) { +# else + { +# endif SetConsoleCtrlHandler(win32_ctrlhandler,FALSE); } # ifdef USE_ITHREADS @@ -4710,10 +5190,9 @@ Perl_sys_intern_dup(pTHX_ struct interp_intern *src, struct interp_intern *dst) dst->perlshell_vec = (char**)NULL; dst->perlshell_items = 0; dst->fdpid = newAV(); - Newz(1313, dst->children, 1, child_tab); + Newxz(dst->children, 1, child_tab); dst->pseudo_id = 0; - Newz(1313, dst->pseudo_children, 1, child_tab); - dst->thr_intern.Winit_socktype = 0; + Newxz(dst->pseudo_children, 1, child_tab); dst->timerid = 0; dst->poll_count = 0; Copy(src->sigtable,dst->sigtable,SIG_SIZE,Sighandler_t); @@ -4741,7 +5220,7 @@ win32_argv2utf8(int argc, char** argv) if (lpwStr && argc) { while (argc--) { length = WideCharToMultiByte(CP_UTF8, 0, lpwStr[--wargc], -1, NULL, 0, NULL, NULL); - Newz(0, psz, length, char); + Newxz(psz, length, char); WideCharToMultiByte(CP_UTF8, 0, lpwStr[wargc], -1, psz, length, NULL, NULL); argv[argc] = psz; }