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);
}
* 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,
dTHX;
HANDLE hProcess;
long child;
+ int retval;
#ifdef USE_ITHREADS
if (pid < 0) {
/* it is a pseudo-forked child */
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)) {
}
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;
/* 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';
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);
/* Otherwise do normal Win32 thing - in case it is useful */
default:
+ FallThrough:
TranslateMessage(&msg);
DispatchMessage(&msg);
ours = 0;
if (hProcess) {
win32_msgwait(aTHX_ 1, &hProcess, timeout, &waitcode);
if (waitcode == WAIT_TIMEOUT) {
+ CloseHandle(hProcess);
return 0;
}
else if (waitcode == WAIT_OBJECT_0) {
win32_ftell(FILE *pf)
{
#if defined(WIN64) || defined(USE_LARGE_FILES)
+#if defined(__BORLAND__) /* 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
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:
return -1;
}
return fsetpos(pf, &offset);
+#endif
#else
return fseek(pf, 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
do {
count = extend >= sizeof(b) ? sizeof(b) : (size_t)extend;
count = win32_write(fd, b, count);
- if (count < 0) {
+ if ((int)count < 0) {
retval = -1;
break;
}
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, offset, origin);
#endif
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
|| (IsWinNT() && stricmp(&cname[clen-4], ".cmd") == 0)))
{
bat_file = TRUE;
- len += 3;
+ if (!IsWin95())
+ len += 3;
}
else {
char *exe = strrchr(cname, '/');
New(1310, cmd, len, char);
ptr = cmd;
- if (bat_file) {
+ if (bat_file && !IsWin95()) {
*ptr++ = '"';
extra_quotes = TRUE;
}
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]) {
/* 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" */
+ New(0, fullcmd, (pathstr ? strlen(pathstr) : 0) + cmdlen + 6, char);
curfullcmd = fullcmd;
while (1) {
if (*pathstr == '"') { /* foo;"baz;etc";bar */
pathstr++; /* skip initial '"' */
while (*pathstr && *pathstr != '"') {
- if ((STRLEN)(curfullcmd-fullcmd) < MAX_PATH-cmdlen-5)
- *curfullcmd++ = *pathstr;
- pathstr++;
+ *curfullcmd++ = *pathstr++;
}
if (*pathstr)
pathstr++; /* skip trailing '"' */
}
else {
- if ((STRLEN)(curfullcmd-fullcmd) < MAX_PATH-cmdlen-5)
- *curfullcmd++ = *pathstr;
- pathstr++;
+ *curfullcmd++ = *pathstr++;
}
}
if (*pathstr)
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(ptrdiff_t 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)
{
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;
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;
}
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)));
}
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;
}
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;
New(1313, 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++) {
Newz(1313, dst->children, 1, child_tab);
dst->pseudo_id = 0;
Newz(1313, dst->pseudo_children, 1, child_tab);
- dst->thr_intern.Winit_socktype = 0;
dst->timerid = 0;
dst->poll_count = 0;
Copy(src->sigtable,dst->sigtable,SIG_SIZE,Sighandler_t);
https://perl5.git.perl.org / perl5.git / blobdiff