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);
}
# 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)
+ if (IsWin95())
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);
}
+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");
+ }
+
+ 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;
+ }
+}
+
+
+#ifdef HAVE_INTERP_INTERN
+
static void
win32_csighandler(int sig)
{
{
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
{
/* Push our handler on top */
SetConsoleCtrlHandler(win32_ctrlhandler,TRUE);
}
-
- ansify_path();
}
void
https://perl5.git.perl.org / perl5.git / blobdiff