Change 14155 by jhi@alpha on 2002/01/09 19:09:15
Integrate perlio; (Re-)implement alarm() for Win32.
Affected files ...
.... //depot/perl/win32/config.vc#124 integrate
.... //depot/perl/win32/config_H.vc#112 integrate
.... //depot/perl/win32/win32.c#181 integrate
.... //depot/perl/win32/win32.h#96 integrate
.... //depot/perl/win32/win32iop.h#35 integrate
Differences ...
==== //depot/perl/win32/config.vc#124 (text) ====
Index: perl/win32/config.vc
--- perl/win32/config.vc.~1~ Wed Jan 9 12:15:05 2002
+++ perl/win32/config.vc Wed Jan 9 12:15:05 2002
@@ -86,7 +86,7 @@
d__fwalk='undef'
d_access='define'
d_accessx='undef'
-d_alarm='undef'
+d_alarm='define'
d_archlib='define'
d_atolf='undef'
d_atoll='undef'
==== //depot/perl/win32/config_H.vc#112 (text+w) ====
Index: perl/win32/config_H.vc
--- perl/win32/config_H.vc.~1~ Wed Jan 9 12:15:05 2002
+++ perl/win32/config_H.vc Wed Jan 9 12:15:05 2002
@@ -13,7 +13,7 @@
/*
* Package name : perl5
* Source directory :
- * Configuration time: Sat Dec 29 19:19:05 2001
+ * Configuration time: Tue Jan 8 21:51:07 2002
* Configured by : nick
* Target system :
*/
@@ -30,7 +30,7 @@
* This symbol, if defined, indicates that the alarm routine is
* available.
*/
-/*#define HAS_ALARM /**/
+#define HAS_ALARM /**/
/* HASATTRIBUTE:
* This symbol indicates the C compiler can check for function attributes,
==== //depot/perl/win32/win32.c#181 (text) ====
Index: perl/win32/win32.c
--- perl/win32/win32.c.~1~ Wed Jan 9 12:15:05 2002
+++ perl/win32/win32.c Wed Jan 9 12:15:05 2002
@@ -1124,17 +1124,6 @@
return -1;
}
-/*
- * File system stuff
- */
-
-DllExport unsigned int
-win32_sleep(unsigned int t)
-{
- Sleep(t*1000);
- return 0;
-}
-
DllExport int
win32_stat(const char *path, struct stat *sbuf)
{
@@ -1689,6 +1678,85 @@
return 0;
}
+/* Timing related stuff */
+
+DllExport int
+win32_async_check(pTHX)
+{
+ MSG msg;
+ int ours = 1;
+ while (PeekMessage(&msg, NULL, 0, 0, PM_REMOVE)) {
+ switch(msg.message) {
+
+ /* plan to use WM_USER to fake kill() with other signals */
+ case WM_USER: {
+ break;
+ }
+
+ case WM_TIMER: {
+ /* alarm() is a one-shot but SetTimer() repeats so kill it */
+ KillTimer(NULL,w32_timerid);
+ w32_timerid=0;
+ /* Now fake a call to signal handler */
+ CALL_FPTR(PL_sighandlerp)(14);
+ break;
+ }
+
+ /* Otherwise do normal Win32 thing - in case it is useful */
+ default:
+ TranslateMessage(&msg);
+ DispatchMessage(&msg);
+ ours = 0;
+ break;
+ }
+ }
+
+ if (PL_sig_pending) {
+ despatch_signals();
+ }
+ return ours;
+}
+
+DllExport DWORD
+win32_msgwait(pTHX_ DWORD count, LPHANDLE handles, DWORD timeout, LPDWORD resultp)
+{
+ /* We may need several goes at this - so compute when we stop */
+ DWORD ticks = 0;
+ if (timeout != INFINITE) {
+ ticks = GetTickCount();
+ timeout += ticks;
+ }
+ while (1) {
+ DWORD result = MsgWaitForMultipleObjects(count,handles,FALSE,timeout-ticks,
+QS_ALLEVENTS);
+ if (resultp)
+ *resultp = result;
+ if (result == WAIT_TIMEOUT) {
+ /* Ran out of time - explicit return of zero to avoid -ve if we
+ have scheduling issues
+ */
+ return 0;
+ }
+ if (timeout != INFINITE) {
+ ticks = GetTickCount();
+ }
+ if (result == WAIT_OBJECT_0 + count) {
+ /* Message has arrived - check it */
+ if (win32_async_check(aTHX)) {
+ /* was one of ours */
+ break;
+ }
+ }
+ else {
+ /* Not timeout or message - one of handles is ready */
+ break;
+ }
+ }
+ /* compute time left to wait */
+ ticks = timeout - ticks;
+ /* If we are past the end say zero */
+ return (ticks > 0) ? ticks : 0;
+}
+
int
win32_internal_wait(int *status, DWORD timeout)
{
@@ -1701,10 +1769,8 @@
#ifdef USE_ITHREADS
if (w32_num_pseudo_children) {
- waitcode = WaitForMultipleObjects(w32_num_pseudo_children,
- w32_pseudo_child_handles,
- FALSE,
- timeout);
+ win32_msgwait(aTHX_ w32_num_pseudo_children, w32_pseudo_child_handles,
+ timeout, &waitcode);
/* Time out here if there are no other children to wait for. */
if (waitcode == WAIT_TIMEOUT) {
if (!w32_num_children) {
@@ -1733,10 +1799,7 @@
}
/* if a child exists, wait for it to die */
- waitcode = WaitForMultipleObjects(w32_num_children,
- w32_child_handles,
- FALSE,
- timeout);
+ win32_msgwait(aTHX_ w32_num_children, w32_child_handles, timeout, &waitcode);
if (waitcode == WAIT_TIMEOUT) {
return 0;
}
@@ -1773,11 +1836,12 @@
child = find_pseudo_pid(-pid);
if (child >= 0) {
HANDLE hThread = w32_pseudo_child_handles[child];
- DWORD waitcode = WaitForSingleObject(hThread, timeout);
+ DWORD waitcode;
+ win32_msgwait(aTHX_ 1, &hThread, timeout, &waitcode);
if (waitcode == WAIT_TIMEOUT) {
return 0;
}
- else if (waitcode != WAIT_FAILED) {
+ else if (waitcode == WAIT_OBJECT_0) {
if (GetExitCodeThread(hThread, &waitcode)) {
*status = (int)((waitcode & 0xff) << 8);
retval = (int)w32_pseudo_child_pids[child];
@@ -1800,11 +1864,11 @@
child = find_pid(pid);
if (child >= 0) {
hProcess = w32_child_handles[child];
- waitcode = WaitForSingleObject(hProcess, timeout);
+ win32_msgwait(aTHX_ 1, &hProcess, timeout, &waitcode);
if (waitcode == WAIT_TIMEOUT) {
return 0;
}
- else if (waitcode != WAIT_FAILED) {
+ else if (waitcode == WAIT_OBJECT_0) {
if (GetExitCodeProcess(hProcess, &waitcode)) {
*status = (int)((waitcode & 0xff) << 8);
retval = (int)w32_child_pids[child];
@@ -1820,11 +1884,11 @@
hProcess = OpenProcess(PROCESS_ALL_ACCESS, TRUE,
(IsWin95() ? -pid : pid));
if (hProcess) {
- waitcode = WaitForSingleObject(hProcess, timeout);
+ win32_msgwait(aTHX_ 1, &hProcess, timeout, &waitcode);
if (waitcode == WAIT_TIMEOUT) {
return 0;
}
- else if (waitcode != WAIT_FAILED) {
+ else if (waitcode == WAIT_OBJECT_0) {
if (GetExitCodeProcess(hProcess, &waitcode)) {
*status = (int)((waitcode & 0xff) << 8);
CloseHandle(hProcess);
@@ -1846,49 +1910,33 @@
return win32_internal_wait(status, INFINITE);
}
-#ifndef PERL_IMPLICIT_CONTEXT
-
-static UINT timerid = 0;
-
-static VOID CALLBACK TimerProc(HWND win, UINT msg, UINT id, DWORD time)
+DllExport unsigned int
+win32_sleep(unsigned int t)
{
dTHX;
- KillTimer(NULL,timerid);
- timerid=0;
- CALL_FPTR(PL_sighandlerp)(14);
+ /* Win32 times are in ms so *1000 in and /1000 out */
+ return win32_msgwait(aTHX_ 0, NULL, t*1000, NULL)/1000;
}
-#endif /* !PERL_IMPLICIT_CONTEXT */
-
DllExport unsigned int
win32_alarm(unsigned int sec)
{
-#ifndef PERL_IMPLICIT_CONTEXT
/*
* the 'obvious' implentation is SetTimer() with a callback
* which does whatever receiving SIGALRM would do
* we cannot use SIGALRM even via raise() as it is not
* one of the supported codes in <signal.h>
- *
- * Snag is unless something is looking at the message queue
- * nothing happens :-(
*/
dTHX;
- if (sec)
- {
- timerid = SetTimer(NULL,timerid,sec*1000,(TIMERPROC)TimerProc);
- if (!timerid)
- Perl_croak_nocontext("Cannot set timer");
- }
- else
- {
- if (timerid)
- {
- KillTimer(NULL,timerid);
- timerid=0;
- }
- }
-#endif /* !PERL_IMPLICIT_CONTEXT */
+ if (sec) {
+ w32_timerid = SetTimer(NULL,w32_timerid,sec*1000,NULL);
+ }
+ else {
+ if (w32_timerid) {
+ KillTimer(NULL,w32_timerid);
+ w32_timerid=0;
+ }
+ }
return 0;
}
@@ -3562,7 +3610,7 @@
}
else {
DWORD status;
- WaitForSingleObject(ProcessInformation.hProcess, INFINITE);
+ win32_msgwait(aTHX_ 1, &ProcessInformation.hProcess, INFINITE, NULL);
GetExitCodeProcess(ProcessInformation.hProcess, &status);
ret = (int)status;
CloseHandle(ProcessInformation.hProcess);
@@ -4443,3 +4491,6 @@
GlobalFree((HGLOBAL)lpwStr);
}
+
+
+
==== //depot/perl/win32/win32.h#96 (text) ====
Index: perl/win32/win32.h
--- perl/win32/win32.h.~1~ Wed Jan 9 12:15:05 2002
+++ perl/win32/win32.h Wed Jan 9 12:15:05 2002
@@ -382,8 +382,13 @@
#ifndef USE_5005THREADS
struct thread_intern thr_intern;
#endif
+ UINT timerid;
+ HANDLE msg_event;
};
+DllExport int win32_async_check(pTHX);
+
+#define PERL_ASYNC_CHECK() if (w32_do_async || PL_sig_pending) win32_async_check(aTHX)
#define w32_perlshell_tokens (PL_sys_intern.perlshell_tokens)
#define w32_perlshell_vec (PL_sys_intern.perlshell_vec)
@@ -399,6 +404,8 @@
#define w32_pseudo_child_pids (w32_pseudo_children->pids)
#define w32_pseudo_child_handles (w32_pseudo_children->handles)
#define w32_internal_host (PL_sys_intern.internal_host)
+#define w32_timerid (PL_sys_intern.timerid)
+#define w32_do_async (w32_timerid != 0)
#ifdef USE_5005THREADS
# define w32_strerror_buffer (thr->i.Wstrerror_buffer)
# define w32_getlogin_buffer (thr->i.Wgetlogin_buffer)
@@ -518,3 +525,4 @@
#endif /* _INC_WIN32_PERL5 */
+
==== //depot/perl/win32/win32iop.h#35 (text) ====
Index: perl/win32/win32iop.h
--- perl/win32/win32iop.h.~1~ Wed Jan 9 12:15:05 2002
+++ perl/win32/win32iop.h Wed Jan 9 12:15:05 2002
@@ -153,6 +153,9 @@
END_EXTERN_C
+#undef alarm
+#define alarm win32_alarm
+
/*
* the following six(6) is #define in stdio.h
*/
@@ -169,7 +172,6 @@
#undef pause
#undef sleep
#undef times
-#undef alarm
#undef ioctl
#undef unlink
#undef utime
@@ -283,7 +285,6 @@
#define pause() win32_sleep((32767L << 16) + 32767)
#define sleep win32_sleep
#define times win32_times
-#define alarm win32_alarm
#define ioctl win32_ioctl
#define link win32_link
#define unlink win32_unlink
End of Patch.
