# 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);
}
+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;
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);
}
win32_kill(int pid, int sig)
{
dTHX;
- HANDLE hProcess;
long child;
#ifdef USE_ITHREADS
if (pid < 0) {
child = find_pseudo_pid(-pid);
if (child >= 0) {
HWND hwnd = w32_pseudo_child_message_hwnds[child];
- hProcess = w32_pseudo_child_handles[child];
+ HANDLE hProcess = w32_pseudo_child_handles[child];
switch (sig) {
case 0:
/* "Does process exist?" use of kill */
/* 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) {
static void
out_of_memory()
{
- dTHX;
- /* Can't use PerlIO to write as it allocates memory */
- PerlLIO_write(PerlIO_fileno(Perl_error_log),
- PL_no_mem, strlen(PL_no_mem));
- my_exit(1);
+ if (PL_curinterp) {
+ dTHX;
+ /* Can't use PerlIO to write as it allocates memory */
+ PerlLIO_write(PerlIO_fileno(Perl_error_log),
+ PL_no_mem, strlen(PL_no_mem));
+ my_exit(1);
+ }
+ exit(1);
}
/* The win32_ansipath() function takes a Unicode filename and converts it
WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, widename, widelen,
name, len, NULL, &use_default);
if (use_default) {
- WCHAR *shortname;
DWORD shortlen = GetShortPathNameW(widename, NULL, 0);
- shortname = win32_malloc(shortlen*sizeof(WCHAR));
- if (!shortname)
- out_of_memory();
- shortlen = GetShortPathNameW(widename, shortname, shortlen)+1;
-
- len = WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, shortname, shortlen,
- NULL, 0, NULL, NULL);
- name = win32_realloc(name, len);
- if (!name)
- out_of_memory();
- WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, shortname, shortlen,
- name, len, NULL, NULL);
- win32_free(shortname);
+ if (shortlen) {
+ WCHAR *shortname = win32_malloc(shortlen*sizeof(WCHAR));
+ if (!shortname)
+ out_of_memory();
+ shortlen = GetShortPathNameW(widename, shortname, shortlen)+1;
+
+ len = WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, shortname, shortlen,
+ NULL, 0, NULL, NULL);
+ name = win32_realloc(name, len);
+ if (!name)
+ out_of_memory();
+ WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, shortname, shortlen,
+ name, len, NULL, NULL);
+ win32_free(shortname);
+ }
}
return name;
}
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) {
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__;
+ CV *cv;
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);
+ /* load Win32 CORE stubs, assuming Win32CORE was statically linked */
+ if ((cv = get_cv("Win32CORE::bootstrap", 0))) {
+ dSP;
+ PUSHMARK(SP);
+ (void)call_sv((SV *)cv, G_EVAL|G_DISCARD|G_VOID);
+ }
+
newXS("Win32::SetChildShowWindow", w32_SetChildShowWindow, file);
}
}
-#if _MSC_VER >= 1400
+#ifdef SET_INVALID_PARAMETER_HANDLER
# include <crtdbg.h>
#endif
+static void
+ansify_path(void)
+{
+ size_t len;
+ char *ansi_path;
+ WCHAR *wide_path;
+ WCHAR *wide_dir;
+
+ /* win32_ansipath() requires Windows 2000 or later */
+ if (!IsWin2000())
+ return;
+
+ /* fetch Unicode version of PATH */
+ len = 2000;
+ wide_path = win32_malloc(len*sizeof(WCHAR));
+ while (wide_path) {
+ size_t newlen = GetEnvironmentVariableW(L"PATH", wide_path, len);
+ if (newlen < len)
+ break;
+ len = newlen;
+ wide_path = win32_realloc(wide_path, len*sizeof(WCHAR));
+ }
+ if (!wide_path)
+ return;
+
+ /* convert to ANSI pathnames */
+ wide_dir = wide_path;
+ ansi_path = NULL;
+ while (wide_dir) {
+ WCHAR *sep = wcschr(wide_dir, ';');
+ char *ansi_dir;
+ size_t ansi_len;
+ size_t wide_len;
+
+ if (sep)
+ *sep++ = '\0';
+
+ /* remove quotes around pathname */
+ if (*wide_dir == '"')
+ ++wide_dir;
+ wide_len = wcslen(wide_dir);
+ if (wide_len && wide_dir[wide_len-1] == '"')
+ wide_dir[wide_len-1] = '\0';
+
+ /* append ansi_dir to ansi_path */
+ ansi_dir = win32_ansipath(wide_dir);
+ ansi_len = strlen(ansi_dir);
+ if (ansi_path) {
+ size_t newlen = len + 1 + ansi_len;
+ ansi_path = win32_realloc(ansi_path, newlen+1);
+ if (!ansi_path)
+ break;
+ ansi_path[len] = ';';
+ memcpy(ansi_path+len+1, ansi_dir, ansi_len+1);
+ len = newlen;
+ }
+ else {
+ len = ansi_len;
+ ansi_path = win32_malloc(5+len+1);
+ if (!ansi_path)
+ break;
+ memcpy(ansi_path, "PATH=", 5);
+ memcpy(ansi_path+5, ansi_dir, len+1);
+ len += 5;
+ }
+ win32_free(ansi_dir);
+ wide_dir = sep;
+ }
+
+ if (ansi_path) {
+ /* Update C RTL environ array. This will only have full effect if
+ * perl_parse() is later called with `environ` as the `env` argument.
+ * Otherwise S_init_postdump_symbols() will overwrite PATH again.
+ *
+ * We do have to ansify() the PATH before Perl has been fully
+ * initialized because S_find_script() uses the PATH when perl
+ * is being invoked with the -S option. This happens before %ENV
+ * is initialized in S_init_postdump_symbols().
+ *
+ * XXX Is this a bug? Should S_find_script() use the environment
+ * XXX passed in the `env` arg to parse_perl()?
+ */
+ putenv(ansi_path);
+ /* Keep system environment in sync because S_init_postdump_symbols()
+ * will not call mg_set() if it initializes %ENV from `environ`.
+ */
+ SetEnvironmentVariableA("PATH", ansi_path+5);
+ /* 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);
+}
+
void
Perl_win32_init(int *argcp, char ***argvp)
{
HMODULE module;
-#if _MSC_VER >= 1400
+#ifdef SET_INVALID_PARAMETER_HANDLER
_invalid_parameter_handler oldHandler, newHandler;
newHandler = my_invalid_parameter_handler;
oldHandler = _set_invalid_parameter_handler(newHandler);
*(FARPROC*)&pfnProcess32First = GetProcAddress(module, "Process32First");
*(FARPROC*)&pfnProcess32Next = GetProcAddress(module, "Process32Next");
}
+
+ g_osver.dwOSVersionInfoSize = sizeof(g_osver);
+ GetVersionEx(&g_osver);
+
+ ansify_path();
}
void
}
}
-
-#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 */
-}
-
HWND
win32_create_message_window()
{
* "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_vec = (char**)NULL;
w32_perlshell_items = 0;
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);
}
}
# 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