# define HWND_MESSAGE ((HWND)-3)
#endif
#ifndef WC_NO_BEST_FIT_CHARS
-# define WC_NO_BEST_FIT_CHARS 0x00000400
+# define WC_NO_BEST_FIT_CHARS 0x00000400 /* requires Windows 2000 or later */
#endif
#include <winnt.h>
#include <tlhelp32.h>
#include "EXTERN.h"
#include "perl.h"
-/* GCC-2.95.2/Mingw32-1.1 forgot the WINAPI on CommandLineToArgvW() */
-#if defined(__MINGW32__) && (__MINGW32_MAJOR_VERSION==1)
-# include <shellapi.h>
-#else
-EXTERN_C LPWSTR* WINAPI CommandLineToArgvW(LPCWSTR lpCommandLine, int * pNumArgs);
-#endif
-
#define NO_XSLOCKS
#define PERL_NO_GET_CONTEXT
#include "XSUB.h"
}
#endif
-#if _MSC_VER >= 1400
+/* VS2005 (MSC version 14) provides a mechanism to set an invalid
+ * parameter handler. This functionality is not available in the
+ * 64-bit compiler from the Platform SDK, which unfortunately also
+ * believes itself to be MSC version 14.
+ *
+ * There is no #define related to _set_invalid_parameter_handler(),
+ * but we can check for one of the constants defined for
+ * _set_abort_behavior(), which was introduced into stdlib.h at
+ * the same time.
+ */
+
+#if _MSC_VER >= 1400 && defined(_WRITE_ABORT_MSG)
+# define SET_INVALID_PARAMETER_HANDLER
+#endif
+
+#ifdef SET_INVALID_PARAMETER_HANDLER
void my_invalid_parameter_handler(const wchar_t* expression,
const wchar_t* function,
const wchar_t* file,
return (g_osver.dwPlatformId == VER_PLATFORM_WIN32_NT);
}
-DllExport char *
-win32_ansipath(const WCHAR *widename);
+int
+IsWin2000(void)
+{
+ return (g_osver.dwMajorVersion > 4);
+}
EXTERN_C void
set_w32_module_name(void)
osver.dwOSVersionInfoSize = sizeof(osver);
GetVersionEx(&osver);
- if (osver.dwPlatformId == VER_PLATFORM_WIN32_NT) {
+ if (osver.dwMajorVersion > 4) {
WCHAR modulename[MAX_PATH];
WCHAR fullname[MAX_PATH];
char *ansi;
HKEY handle;
DWORD type;
const char *subkey = "Software\\Perl";
- char *str = Nullch;
+ char *str = NULL;
long retval;
retval = RegOpenKeyEx(hkey, subkey, 0, KEY_READ, &handle);
return SvPVX(*prev_pathp);
}
- return Nullch;
+ return NULL;
}
char *
dTHX;
char *stdlib = "lib";
char buffer[MAX_PATH+1];
- SV *sv = Nullsv;
+ SV *sv = NULL;
/* $stdlib = $HKCU{"lib-$]"} || $HKLM{"lib-$]"} || $HKCU{"lib"} || $HKLM{"lib"} || ""; */
sprintf(buffer, "%s-%s", stdlib, pl);
(void)get_regstr(stdlib, &sv);
/* $stdlib .= ";$EMD/../../lib" */
- return get_emd_part(&sv, stdlib, ARCHNAME, "bin", Nullch);
+ return get_emd_part(&sv, stdlib, ARCHNAME, "bin", NULL);
}
static char *
dTHX;
char regstr[40];
char pathstr[MAX_PATH+1];
- SV *sv1 = Nullsv;
- SV *sv2 = Nullsv;
+ SV *sv1 = NULL;
+ SV *sv2 = NULL;
/* $HKCU{"$xlib-$]"} || $HKLM{"$xlib-$]"} . ---; */
sprintf(regstr, "%s-%s", xlib, pl);
/* $xlib .=
* ";$EMD/" . ((-d $EMD/../../../$]) ? "../../.." : "../.."). "/$libname/$]/lib"; */
sprintf(pathstr, "%s/%s/lib", libname, pl);
- (void)get_emd_part(&sv1, pathstr, ARCHNAME, "bin", pl, Nullch);
+ (void)get_emd_part(&sv1, pathstr, ARCHNAME, "bin", pl, NULL);
/* $HKCU{$xlib} || $HKLM{$xlib} . ---; */
(void)get_regstr(xlib, &sv2);
/* $xlib .=
* ";$EMD/" . ((-d $EMD/../../../$]) ? "../../.." : "../.."). "/$libname/lib"; */
sprintf(pathstr, "%s/lib", libname);
- (void)get_emd_part(&sv2, pathstr, ARCHNAME, "bin", pl, Nullch);
+ (void)get_emd_part(&sv2, pathstr, ARCHNAME, "bin", pl, NULL);
if (!sv1 && !sv2)
- return Nullch;
+ return NULL;
if (!sv1)
return SvPVX(sv2);
if (!sv2)
static long
tokenize(const char *str, char **dest, char ***destv)
{
- char *retstart = Nullch;
+ char *retstart = NULL;
char **retvstart = 0;
int items = -1;
if (str) {
++items;
ret++;
}
- retvstart[items] = Nullch;
+ retvstart[items] = NULL;
*ret++ = '\0';
*ret = '\0';
}
if (*s)
*s++ = '\0';
}
- *a = Nullch;
+ *a = NULL;
if (argv[0]) {
switch (exectype) {
case EXECF_SPAWN:
while (++i < w32_perlshell_items)
argv[i] = w32_perlshell_vec[i];
argv[i++] = (char *)cmd;
- argv[i] = Nullch;
+ argv[i] = NULL;
switch (exectype) {
case EXECF_SPAWN:
status = win32_spawnvp(P_WAIT, argv[0],
scanname[len] = '\0';
/* do the FindFirstFile call */
- if (IsWinNT()) {
+ if (IsWin2000()) {
WCHAR wscanname[sizeof(scanname)];
MultiByteToWideChar(CP_ACP, 0, scanname, -1, wscanname, sizeof(wscanname)/sizeof(WCHAR));
dirp->handle = FindFirstFileW(PerlDir_mapW(wscanname), &wFindData);
/* finding the next file that matches the wildcard
* (which should be all of them in this directory!).
*/
- if (IsWinNT()) {
+ if (IsWin2000()) {
WIN32_FIND_DATAW wFindData;
res = FindNextFileW(dirp->handle, &wFindData);
if (res) {
int killed = 0;
process_handle = OpenProcess(PROCESS_TERMINATE, FALSE, pid);
- if (process_handle == INVALID_HANDLE_VALUE)
+ if (process_handle == NULL)
return 0;
killed += terminate_process(pid, process_handle, sig);
int killed = 0;
process_handle = OpenProcess(PROCESS_TERMINATE, FALSE, pid);
- if (process_handle == INVALID_HANDLE_VALUE)
+ if (process_handle == NULL)
return 0;
killed += terminate_process(pid, process_handle, sig);
return killpg(pid, -sig);
process_handle = OpenProcess(PROCESS_TERMINATE, FALSE, pid);
- if (process_handle != INVALID_HANDLE_VALUE) {
+ /* OpenProcess() returns NULL on error, *not* INVALID_HANDLE_VALUE */
+ if (process_handle != NULL) {
retval = terminate_process(pid, process_handle, sig);
CloseHandle(process_handle);
}
/* Yield and wait for the other thread to send us its message_hwnd */
Sleep(0);
win32_async_check(aTHX);
+ hwnd = w32_pseudo_child_message_hwnds[child];
++count;
}
if (hwnd != INVALID_HANDLE_VALUE) {
char *start = path;
char sep;
if (!path)
- return Nullch;
+ return NULL;
/* drive prefix */
if (isALPHA(path[0]) && path[1] == ':') {
else {
FindClose(fhand);
errno = ERANGE;
- return Nullch;
+ return NULL;
}
}
else {
/* failed a step, just return without side effects */
/*PerlIO_printf(Perl_debug_log, "Failed to find %s\n", path);*/
errno = EINVAL;
- return Nullch;
+ return NULL;
}
}
strcpy(path,tmpbuf);
{
dTHX;
DWORD needlen;
- SV *curitem = Nullsv;
+ SV *curitem = NULL;
needlen = GetEnvironmentVariableA(name,NULL,0);
if (needlen != 0) {
if (curitem && SvCUR(curitem))
return SvPVX(curitem);
- return Nullch;
+ return NULL;
}
DllExport int
timeout += ticks;
}
while (1) {
- DWORD result = MsgWaitForMultipleObjects(count,handles,FALSE,timeout-ticks, QS_ALLEVENTS);
+ DWORD result = MsgWaitForMultipleObjects(count,handles,FALSE,timeout-ticks, QS_POSTMESSAGE|QS_TIMER);
if (resultp)
*resultp = result;
if (result == WAIT_TIMEOUT) {
return des_fcrypt(txt, salt, w32_crypt_buffer);
#else
Perl_croak(aTHX_ "The crypt() function is unimplemented due to excessive paranoia.");
- return Nullch;
+ return NULL;
#endif
}
int retval = 0;
char szTmpName[MAX_PATH+1];
char dname[MAX_PATH+1];
- char *endname = Nullch;
+ char *endname = NULL;
STRLEN tmplen = 0;
DWORD from_attr, to_attr;
retval = rename(szOldName, szNewName);
/* if we created a temporary file before ... */
- if (endname != Nullch) {
+ if (endname != NULL) {
/* ...and rename succeeded, delete temporary file/directory */
if (retval == 0)
DeleteFile(szTmpName);
int has_slash = 0;
if (!cmd)
- return Nullch;
+ return NULL;
fullcmd = (char*)cmd;
while (*fullcmd) {
if (*fullcmd == '/' || *fullcmd == '\\')
}
Safefree(fullcmd);
- return Nullch;
+ return NULL;
}
/* The following are just place holders.
PROCESS_INFORMATION ProcessInformation;
DWORD create = 0;
char *cmd;
- char *fullcmd = Nullch;
+ char *fullcmd = NULL;
char *cname = (char *)cmdname;
STRLEN clen = 0;
XSRETURN(1);
}
-static void
-forward(pTHX_ const char *function)
-{
- dXSARGS;
- Perl_load_module(aTHX_ PERL_LOADMOD_NOIMPORT, newSVpvn("Win32",5), newSVnv(0.27));
- SPAGAIN;
- PUSHMARK(SP-items);
- call_pv(function, GIMME_V);
-}
-
-#define FORWARD(function) XS(w32_##function){ forward(aTHX_ "Win32::"#function); }
-FORWARD(GetCwd)
-FORWARD(SetCwd)
-FORWARD(GetNextAvailDrive)
-FORWARD(GetLastError)
-FORWARD(SetLastError)
-FORWARD(LoginName)
-FORWARD(NodeName)
-FORWARD(DomainName)
-FORWARD(FsType)
-FORWARD(GetOSVersion)
-FORWARD(IsWinNT)
-FORWARD(IsWin95)
-FORWARD(FormatMessage)
-FORWARD(Spawn)
-FORWARD(GetTickCount)
-FORWARD(GetShortPathName)
-FORWARD(GetFullPathName)
-FORWARD(GetLongPathName)
-FORWARD(CopyFile)
-FORWARD(Sleep)
-
-/* Don't forward Win32::SetChildShowWindow(). It accesses the internal variable
- * w32_showwindow in thread_intern and is therefore not implemented in Win32.xs.
- */
-/* FORWARD(SetChildShowWindow) */
-
-#undef FORWARD
-
void
Perl_init_os_extras(void)
{
dTHX;
char *file = __FILE__;
- dXSUB_SYS;
-
- /* these names are Activeware compatible */
- newXS("Win32::GetCwd", w32_GetCwd, file);
- newXS("Win32::SetCwd", w32_SetCwd, file);
- newXS("Win32::GetNextAvailDrive", w32_GetNextAvailDrive, file);
- newXS("Win32::GetLastError", w32_GetLastError, file);
- newXS("Win32::SetLastError", w32_SetLastError, file);
- newXS("Win32::LoginName", w32_LoginName, file);
- newXS("Win32::NodeName", w32_NodeName, file);
- newXS("Win32::DomainName", w32_DomainName, file);
- newXS("Win32::FsType", w32_FsType, file);
- newXS("Win32::GetOSVersion", w32_GetOSVersion, file);
- newXS("Win32::IsWinNT", w32_IsWinNT, file);
- newXS("Win32::IsWin95", w32_IsWin95, file);
- newXS("Win32::FormatMessage", w32_FormatMessage, file);
- newXS("Win32::Spawn", w32_Spawn, file);
- newXS("Win32::GetTickCount", w32_GetTickCount, file);
- newXS("Win32::GetShortPathName", w32_GetShortPathName, file);
- newXS("Win32::GetFullPathName", w32_GetFullPathName, file);
- newXS("Win32::GetLongPathName", w32_GetLongPathName, file);
- newXS("Win32::CopyFile", w32_CopyFile, file);
- newXS("Win32::Sleep", w32_Sleep, file);
+
+ /* Initialize Win32CORE if it has been statically linked. */
+ void (*pfn_init)(pTHX);
+#if defined(__BORLANDC__)
+ /* makedef.pl seems to have given up on fixing this issue in the .def file */
+ pfn_init = (void (*)(pTHX))GetProcAddress((HMODULE)w32_perldll_handle, "_init_Win32CORE");
+#else
+ pfn_init = (void (*)(pTHX))GetProcAddress((HMODULE)w32_perldll_handle, "init_Win32CORE");
+#endif
+ if (pfn_init)
+ pfn_init(aTHX);
+
newXS("Win32::SetChildShowWindow", w32_SetChildShowWindow, file);
}
}
-#if _MSC_VER >= 1400
+#ifdef SET_INVALID_PARAMETER_HANDLER
# include <crtdbg.h>
#endif
-void
-Perl_win32_init(int *argcp, char ***argvp)
-{
- HMODULE module;
-
-#if _MSC_VER >= 1400
- _invalid_parameter_handler oldHandler, newHandler;
- newHandler = my_invalid_parameter_handler;
- oldHandler = _set_invalid_parameter_handler(newHandler);
- _CrtSetReportMode(_CRT_ASSERT, 0);
-#endif
- /* Disable floating point errors, Perl will trap the ones we
- * care about. VC++ RTL defaults to switching these off
- * already, but the Borland RTL doesn't. Since we don't
- * want to be at the vendor's whim on the default, we set
- * it explicitly here.
- */
-#if !defined(_ALPHA_) && !defined(__GNUC__)
- _control87(MCW_EM, MCW_EM);
-#endif
- MALLOC_INIT;
-
- module = GetModuleHandle("ntdll.dll");
- if (module) {
- *(FARPROC*)&pfnZwQuerySystemInformation = GetProcAddress(module, "ZwQuerySystemInformation");
- }
-
- module = GetModuleHandle("kernel32.dll");
- if (module) {
- *(FARPROC*)&pfnCreateToolhelp32Snapshot = GetProcAddress(module, "CreateToolhelp32Snapshot");
- *(FARPROC*)&pfnProcess32First = GetProcAddress(module, "Process32First");
- *(FARPROC*)&pfnProcess32Next = GetProcAddress(module, "Process32Next");
- }
-}
-
-void
-Perl_win32_term(void)
-{
- dTHX;
- HINTS_REFCNT_TERM;
- OP_REFCNT_TERM;
- PERLIO_TERM;
- MALLOC_TERM;
-}
-
-void
-win32_get_child_IO(child_IO_table* ptbl)
-{
- ptbl->childStdIn = GetStdHandle(STD_INPUT_HANDLE);
- ptbl->childStdOut = GetStdHandle(STD_OUTPUT_HANDLE);
- ptbl->childStdErr = GetStdHandle(STD_ERROR_HANDLE);
-}
-
-Sighandler_t
-win32_signal(int sig, Sighandler_t subcode)
-{
- dTHX;
- if (sig < SIG_SIZE) {
- int save_errno = errno;
- Sighandler_t result = signal(sig, subcode);
- if (result == SIG_ERR) {
- result = w32_sighandler[sig];
- errno = save_errno;
- }
- w32_sighandler[sig] = subcode;
- return result;
- }
- else {
- errno = EINVAL;
- return SIG_ERR;
- }
-}
-
-
-#ifdef HAVE_INTERP_INTERN
-
static void
ansify_path(void)
{
- OSVERSIONINFO osver; /* g_osver may not yet be initialized */
size_t len;
char *ansi_path;
WCHAR *wide_path;
WCHAR *wide_dir;
- /* there is no Unicode environment on Windows 9X */
- osver.dwOSVersionInfoSize = sizeof(osver);
- GetVersionEx(&osver);
- if (osver.dwPlatformId == VER_PLATFORM_WIN32_WINDOWS)
+ /* win32_ansipath() requires Windows 2000 or later */
+ if (!IsWin2000())
return;
/* fetch Unicode version of PATH */
* will not call mg_set() if it initializes %ENV from `environ`.
*/
SetEnvironmentVariableA("PATH", ansi_path+5);
- win32_free(ansi_path);
+ /* We are intentionally leaking the ansi_path string here because
+ * the Borland runtime library puts it directly into the environ
+ * array. The Microsoft runtime library seems to make a copy,
+ * but will leak the copy should it be replaced again later.
+ * Since this code is only called once during PERL_SYS_INIT this
+ * shouldn't really matter.
+ */
}
win32_free(wide_path);
}
-static void
-win32_csighandler(int sig)
+void
+Perl_win32_init(int *argcp, char ***argvp)
{
-#if 0
- dTHXa(PERL_GET_SIG_CONTEXT);
- Perl_warn(aTHX_ "Got signal %d",sig);
+ HMODULE module;
+
+#ifdef SET_INVALID_PARAMETER_HANDLER
+ _invalid_parameter_handler oldHandler, newHandler;
+ newHandler = my_invalid_parameter_handler;
+ oldHandler = _set_invalid_parameter_handler(newHandler);
+ _CrtSetReportMode(_CRT_ASSERT, 0);
#endif
- /* Does nothing */
+ /* Disable floating point errors, Perl will trap the ones we
+ * care about. VC++ RTL defaults to switching these off
+ * already, but the Borland RTL doesn't. Since we don't
+ * want to be at the vendor's whim on the default, we set
+ * it explicitly here.
+ */
+#if !defined(_ALPHA_) && !defined(__GNUC__)
+ _control87(MCW_EM, MCW_EM);
+#endif
+ MALLOC_INIT;
+
+ module = GetModuleHandle("ntdll.dll");
+ if (module) {
+ *(FARPROC*)&pfnZwQuerySystemInformation = GetProcAddress(module, "ZwQuerySystemInformation");
+ }
+
+ module = GetModuleHandle("kernel32.dll");
+ if (module) {
+ *(FARPROC*)&pfnCreateToolhelp32Snapshot = GetProcAddress(module, "CreateToolhelp32Snapshot");
+ *(FARPROC*)&pfnProcess32First = GetProcAddress(module, "Process32First");
+ *(FARPROC*)&pfnProcess32Next = GetProcAddress(module, "Process32Next");
+ }
+
+ g_osver.dwOSVersionInfoSize = sizeof(g_osver);
+ GetVersionEx(&g_osver);
+
+ ansify_path();
+}
+
+void
+Perl_win32_term(void)
+{
+ dTHX;
+ HINTS_REFCNT_TERM;
+ OP_REFCNT_TERM;
+ PERLIO_TERM;
+ MALLOC_TERM;
+}
+
+void
+win32_get_child_IO(child_IO_table* ptbl)
+{
+ ptbl->childStdIn = GetStdHandle(STD_INPUT_HANDLE);
+ ptbl->childStdOut = GetStdHandle(STD_OUTPUT_HANDLE);
+ ptbl->childStdErr = GetStdHandle(STD_ERROR_HANDLE);
+}
+
+Sighandler_t
+win32_signal(int sig, Sighandler_t subcode)
+{
+ dTHX;
+ if (sig < SIG_SIZE) {
+ int save_errno = errno;
+ Sighandler_t result = signal(sig, subcode);
+ if (result == SIG_ERR) {
+ result = w32_sighandler[sig];
+ errno = save_errno;
+ }
+ w32_sighandler[sig] = subcode;
+ return result;
+ }
+ else {
+ errno = EINVAL;
+ return SIG_ERR;
+ }
}
HWND
* "right" place with DispatchMessage() anymore, as there is no WindowProc
* if there is no window handle.
*/
- if (g_osver.dwMajorVersion < 5)
+ if (!IsWin2000())
return NULL;
return CreateWindow("Static", "", 0, 0, 0, 0, 0, HWND_MESSAGE, 0, 0, NULL);
}
+#ifdef HAVE_INTERP_INTERN
+
+static void
+win32_csighandler(int sig)
+{
+#if 0
+ dTHXa(PERL_GET_SIG_CONTEXT);
+ Perl_warn(aTHX_ "Got signal %d",sig);
+#endif
+ /* Does nothing */
+}
+
#if defined(__MINGW32__) && defined(__cplusplus)
#define CAST_HWND__(x) (HWND__*)(x)
#else
{
int i;
- if (g_osver.dwOSVersionInfoSize == 0) {
- g_osver.dwOSVersionInfoSize = sizeof(g_osver);
- GetVersionEx(&g_osver);
- }
-
- w32_perlshell_tokens = Nullch;
+ w32_perlshell_tokens = NULL;
w32_perlshell_vec = (char**)NULL;
w32_perlshell_items = 0;
w32_fdpid = newAV();
for (i=0; i < SIG_SIZE; i++) {
w32_sighandler[i] = SIG_DFL;
}
-# ifdef MULTIPLICTY
+# ifdef MULTIPLICITY
if (my_perl == PL_curinterp) {
# else
{
/* Force C runtime signal stuff to set its console handler */
signal(SIGINT,win32_csighandler);
signal(SIGBREAK,win32_csighandler);
+
+ /* We spawn asynchronous processes with the CREATE_NEW_PROCESS_GROUP
+ * flag. This has the side-effect of disabling Ctrl-C events in all
+ * processes in this group. At least on Windows NT and later we
+ * can re-enable Ctrl-C handling by calling SetConsoleCtrlHandler()
+ * with a NULL handler. This is not valid on Windows 9X.
+ */
+ if (IsWinNT())
+ SetConsoleCtrlHandler(NULL,FALSE);
+
/* Push our handler on top */
SetConsoleCtrlHandler(win32_ctrlhandler,TRUE);
}
-
- ansify_path();
}
void
void
Perl_sys_intern_dup(pTHX_ struct interp_intern *src, struct interp_intern *dst)
{
- dst->perlshell_tokens = Nullch;
+ dst->perlshell_tokens = NULL;
dst->perlshell_vec = (char**)NULL;
dst->perlshell_items = 0;
dst->fdpid = newAV();
}
# endif /* USE_ITHREADS */
#endif /* HAVE_INTERP_INTERN */
-
-static void
-win32_free_argvw(pTHX_ void *ptr)
-{
- char** argv = (char**)ptr;
- while(*argv) {
- Safefree(*argv);
- *argv++ = Nullch;
- }
-}
-
-void
-win32_argv2utf8(int argc, char** argv)
-{
- dTHX;
- char* psz;
- int length, wargc;
- LPWSTR* lpwStr = CommandLineToArgvW(GetCommandLineW(), &wargc);
- if (lpwStr && argc) {
- while (argc--) {
- length = WideCharToMultiByte(CP_UTF8, 0, lpwStr[--wargc], -1, NULL, 0, NULL, NULL);
- Newxz(psz, length, char);
- WideCharToMultiByte(CP_UTF8, 0, lpwStr[wargc], -1, psz, length, NULL, NULL);
- argv[argc] = psz;
- }
- call_atexit(win32_free_argvw, argv);
- }
- GlobalFree((HGLOBAL)lpwStr);
-}
projects / p5sagit/p5-mst-13.2.git / blobdiff