In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/d5e473ac4b5315fec59f5f15df9cc949120d3967?hp=be8851fc38b39ec6167336f4fee669536e99e022>
- Log ----------------------------------------------------------------- commit d5e473ac4b5315fec59f5f15df9cc949120d3967 Author: Steve Hay <[email protected]> Date: Tue Aug 14 17:38:22 2012 +0100 Document new diagnostic message added by d903973c05 M pod/perldiag.pod commit 17ce47a8d9ab86a02e9b963d4f9bd487fe1cb049 Author: Steve Hay <[email protected]> Date: Tue Aug 14 17:33:50 2012 +0100 Tidy up comments and formatting in d903973c05 M win32/win32.c commit d903973c0527ee5c9f9f559e3e0e3f1aac2ab1cc Author: Daniel Dragan <[email protected]> Date: Tue Aug 14 13:50:25 2012 +0100 fix RT#88840, don't terminate a child fork psuedo process in DLL Loader Lock TerminateThread will terminate a thread but leaks all resources of that thread, and all locks will never be released, as documented in MSDN. There is no alternative to locks not being released that I see, but atleast -e "if ($pid=fork){kill(9,$pid)} else {sleep 5}" in fork.t won't deadlock with this patch since win32_start_child be reached before TerminateThread happens. The 5 ms timeout can be increased if problems arise in the future. The HWND of the child is delivered by win32_start_child very early, before any perl bytecode is executed, therefore the delay is keeping in spirit with a kill 9. In any case, if the child thread fails to schedule, (a DllMain in DLL_THREAD_ATTACH of some DLL in the process deadlocks or does very long (over 5 ms right now) sync IO), the parent interp will bail out. M win32/win32.c ----------------------------------------------------------------------- Summary of changes: pod/perldiag.pod | 6 ++ win32/win32.c | 139 ++++++++++++++++++++++++++++++++++------------------- 2 files changed, 95 insertions(+), 50 deletions(-) diff --git a/pod/perldiag.pod b/pod/perldiag.pod index 536764d..847afb2 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -3536,6 +3536,12 @@ an ACL related-function, but that function is not available on this platform. Earlier checks mean that it should not be possible to enter this branch on this platform. +=item panic: child pseudo-process was never scheduled + +(P) A child pseudo-process in the ithreads implementation on Windows +was not scheduled within the time period allowed and therefore was not +able to initialize properly. + =item panic: ck_grep, type=%u (P) Failed an internal consistency check trying to compile a grep. diff --git a/win32/win32.c b/win32/win32.c index 211ca6f..024a2a8 100644 --- a/win32/win32.c +++ b/win32/win32.c @@ -123,6 +123,7 @@ static LRESULT win32_process_message(HWND hwnd, UINT msg, #ifdef USE_ITHREADS static void remove_dead_pseudo_process(long child); static long find_pseudo_pid(int pid); +static HWND get_hwnd_delay(pTHX, long child, DWORD tries); #endif START_EXTERN_C @@ -1271,6 +1272,50 @@ my_kill(int pid, int sig) return retval; } +#ifdef USE_ITHREADS +/* Get a child pseudo-process HWND, with retrying and delaying/yielding. + * The "tries" parameter is the number of retries to make, with a Sleep(1) + * (waiting and yielding the time slot) between each try. Specifying 0 causes + * only Sleep(0) (no waiting and potentially no yielding) to be used, so is not + * recommended + * Returns an hwnd != INVALID_HANDLE_VALUE (so be aware that NULL can be + * returned) or croaks if the child pseudo-process doesn't schedule and deliver + * a HWND in the time period allowed. + */ +static HWND +get_hwnd_delay(pTHX, long child, DWORD tries) +{ + HWND hwnd = w32_pseudo_child_message_hwnds[child]; + if (hwnd != INVALID_HANDLE_VALUE) return hwnd; + + /* Pseudo-process has not yet properly initialized since hwnd isn't set. + * Fast sleep: On some NT kernels/systems, a Sleep(0) won't deschedule a + * thread 100% of the time since threads are attached to a CPU for NUMA and + * caching reasons, and the child thread was attached to a different CPU + * therefore there is no workload on that CPU and Sleep(0) returns control + * without yielding the time slot. + * https://rt.perl.org/rt3/Ticket/Display.html?id=88840 + */ + Sleep(0); + win32_async_check(aTHX); + hwnd = w32_pseudo_child_message_hwnds[child]; + if (hwnd != INVALID_HANDLE_VALUE) return hwnd; + + { + int count = 0; + /* No Sleep(1) if tries==0, just fail instead if we get this far. */ + while (count++ < tries) { + Sleep(1); + win32_async_check(aTHX); + hwnd = w32_pseudo_child_message_hwnds[child]; + if (hwnd != INVALID_HANDLE_VALUE) return hwnd; + } + } + + Perl_croak(aTHX_ "panic: child pseudo-process was never scheduled"); +} +#endif + DllExport int win32_kill(int pid, int sig) { @@ -1281,60 +1326,54 @@ win32_kill(int pid, int sig) /* it is a pseudo-forked child */ child = find_pseudo_pid(-pid); if (child >= 0) { - HWND hwnd = w32_pseudo_child_message_hwnds[child]; HANDLE hProcess = w32_pseudo_child_handles[child]; switch (sig) { - case 0: - /* "Does process exist?" use of kill */ - return 0; - - case 9: - /* kill -9 style un-graceful exit */ - if (TerminateThread(hProcess, sig)) { - /* Allow the scheduler to finish cleaning up the other thread. - * Otherwise, if we ExitProcess() before another context switch - * happens we will end up with a process exit code of "sig" instead - * of our own exit status. - * See also: https://rt.cpan.org/Ticket/Display.html?id=66016#txn-908976 - */ - Sleep(0); - remove_dead_pseudo_process(child); + case 0: + /* "Does process exist?" use of kill */ return 0; - } - break; - default: { - int count = 0; - /* pseudo-process has not yet properly initialized if hwnd isn't set */ - while (hwnd == INVALID_HANDLE_VALUE && count < 5) { - /* 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) { - /* We fake signals to pseudo-processes using Win32 - * message queue. In Win9X the pids are negative already. */ - if ((hwnd != NULL && PostMessage(hwnd, WM_USER_KILL, sig, 0)) || - PostThreadMessage(-pid, WM_USER_KILL, sig, 0)) - { - /* Don't wait for child process to terminate after we send a SIGTERM - * because the child may be blocked in a system call and never receive - * the signal. - */ - if (sig == SIGTERM) { - Sleep(0); - w32_pseudo_child_sigterm[child] = 1; - } - /* It might be us ... */ - PERL_ASYNC_CHECK(); - return 0; - } - } - break; - } - } /* switch */ + case 9: { + /* kill -9 style un-graceful exit */ + /* Do a wait to make sure child starts and isn't in DLL + * Loader Lock */ + HWND hwnd = get_hwnd_delay(aTHX, child, 5); + if (TerminateThread(hProcess, sig)) { + /* Allow the scheduler to finish cleaning up the other + * thread. + * Otherwise, if we ExitProcess() before another context + * switch happens we will end up with a process exit + * code of "sig" instead of our own exit status. + * https://rt.cpan.org/Ticket/Display.html?id=66016#txn-908976 + */ + Sleep(0); + remove_dead_pseudo_process(child); + return 0; + } + break; + } + + default: { + HWND hwnd = get_hwnd_delay(aTHX, child, 5); + /* We fake signals to pseudo-processes using Win32 + * message queue. */ + if ((hwnd != NULL && PostMessage(hwnd, WM_USER_KILL, sig, 0)) || + PostThreadMessage(-pid, WM_USER_KILL, sig, 0)) + { + /* Don't wait for child process to terminate after we send a + * SIGTERM because the child may be blocked in a system call + * and never receive the signal. + */ + if (sig == SIGTERM) { + Sleep(0); + w32_pseudo_child_sigterm[child] = 1; + } + /* It might be us ... */ + PERL_ASYNC_CHECK(); + return 0; + } + break; + } + } /* switch */ } } else -- Perl5 Master Repository
