use guile-snarf for subr definition
[bpt/emacs.git] / src / w32proc.c
1 /* Process support for GNU Emacs on the Microsoft Windows API.
2
3 Copyright (C) 1992, 1995, 1999-2014 Free Software Foundation, Inc.
4
5 This file is part of GNU Emacs.
6
7 GNU Emacs is free software: you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation, either version 3 of the License, or
10 (at your option) any later version.
11
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
16
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
19
20 /*
21 Drew Bliss Oct 14, 1993
22 Adapted from alarm.c by Tim Fleehart
23 */
24
25 #include <mingw_time.h>
26 #include <stdio.h>
27 #include <stdlib.h>
28 #include <errno.h>
29 #include <ctype.h>
30 #include <io.h>
31 #include <fcntl.h>
32 #include <signal.h>
33 #include <sys/file.h>
34 #include <mbstring.h>
35
36 /* must include CRT headers *before* config.h */
37 #include <config.h>
38
39 #undef signal
40 #undef wait
41 #undef spawnve
42 #undef select
43 #undef kill
44
45 #include <windows.h>
46 #if defined(__GNUC__) && !defined(__MINGW64__)
47 /* This definition is missing from mingw.org headers, but not MinGW64
48 headers. */
49 extern BOOL WINAPI IsValidLocale (LCID, DWORD);
50 #endif
51
52 #ifdef HAVE_LANGINFO_CODESET
53 #include <nl_types.h>
54 #include <langinfo.h>
55 #endif
56
57 #include "lisp.h"
58 #include "w32.h"
59 #include "w32common.h"
60 #include "w32heap.h"
61 #include "systime.h"
62 #include "syswait.h"
63 #include "process.h"
64 #include "syssignal.h"
65 #include "w32term.h"
66 #include "dispextern.h" /* for xstrcasecmp */
67 #include "coding.h"
68
69 #define RVA_TO_PTR(var,section,filedata) \
70 ((void *)((section)->PointerToRawData \
71 + ((DWORD_PTR)(var) - (section)->VirtualAddress) \
72 + (filedata).file_base))
73
74 Lisp_Object Qhigh, Qlow;
75
76 /* Signal handlers...SIG_DFL == 0 so this is initialized correctly. */
77 static signal_handler sig_handlers[NSIG];
78
79 static sigset_t sig_mask;
80
81 static CRITICAL_SECTION crit_sig;
82
83 /* Improve on the CRT 'signal' implementation so that we could record
84 the SIGCHLD handler and fake interval timers. */
85 signal_handler
86 sys_signal (int sig, signal_handler handler)
87 {
88 signal_handler old;
89
90 /* SIGCHLD is needed for supporting subprocesses, see sys_kill
91 below. SIGALRM and SIGPROF are used by setitimer. All the
92 others are the only ones supported by the MS runtime. */
93 if (!(sig == SIGCHLD || sig == SIGSEGV || sig == SIGILL
94 || sig == SIGFPE || sig == SIGABRT || sig == SIGTERM
95 || sig == SIGALRM || sig == SIGPROF))
96 {
97 errno = EINVAL;
98 return SIG_ERR;
99 }
100 old = sig_handlers[sig];
101 /* SIGABRT is treated specially because w32.c installs term_ntproc
102 as its handler, so we don't want to override that afterwards.
103 Aborting Emacs works specially anyway: either by calling
104 emacs_abort directly or through terminate_due_to_signal, which
105 calls emacs_abort through emacs_raise. */
106 if (!(sig == SIGABRT && old == term_ntproc))
107 {
108 sig_handlers[sig] = handler;
109 if (!(sig == SIGCHLD || sig == SIGALRM || sig == SIGPROF))
110 signal (sig, handler);
111 }
112 return old;
113 }
114
115 /* Emulate sigaction. */
116 int
117 sigaction (int sig, const struct sigaction *act, struct sigaction *oact)
118 {
119 signal_handler old = SIG_DFL;
120 int retval = 0;
121
122 if (act)
123 old = sys_signal (sig, act->sa_handler);
124 else if (oact)
125 old = sig_handlers[sig];
126
127 if (old == SIG_ERR)
128 {
129 errno = EINVAL;
130 retval = -1;
131 }
132 if (oact)
133 {
134 oact->sa_handler = old;
135 oact->sa_flags = 0;
136 oact->sa_mask = empty_mask;
137 }
138 return retval;
139 }
140
141 /* Emulate signal sets and blocking of signals used by timers. */
142
143 int
144 sigemptyset (sigset_t *set)
145 {
146 *set = 0;
147 return 0;
148 }
149
150 int
151 sigaddset (sigset_t *set, int signo)
152 {
153 if (!set)
154 {
155 errno = EINVAL;
156 return -1;
157 }
158 if (signo < 0 || signo >= NSIG)
159 {
160 errno = EINVAL;
161 return -1;
162 }
163
164 *set |= (1U << signo);
165
166 return 0;
167 }
168
169 int
170 sigfillset (sigset_t *set)
171 {
172 if (!set)
173 {
174 errno = EINVAL;
175 return -1;
176 }
177
178 *set = 0xFFFFFFFF;
179 return 0;
180 }
181
182 int
183 sigprocmask (int how, const sigset_t *set, sigset_t *oset)
184 {
185 if (!(how == SIG_BLOCK || how == SIG_UNBLOCK || how == SIG_SETMASK))
186 {
187 errno = EINVAL;
188 return -1;
189 }
190
191 if (oset)
192 *oset = sig_mask;
193
194 if (!set)
195 return 0;
196
197 switch (how)
198 {
199 case SIG_BLOCK:
200 sig_mask |= *set;
201 break;
202 case SIG_SETMASK:
203 sig_mask = *set;
204 break;
205 case SIG_UNBLOCK:
206 /* FIXME: Catch signals that are blocked and reissue them when
207 they are unblocked. Important for SIGALRM and SIGPROF only. */
208 sig_mask &= ~(*set);
209 break;
210 }
211
212 return 0;
213 }
214
215 int
216 pthread_sigmask (int how, const sigset_t *set, sigset_t *oset)
217 {
218 if (sigprocmask (how, set, oset) == -1)
219 return EINVAL;
220 return 0;
221 }
222
223 int
224 sigismember (const sigset_t *set, int signo)
225 {
226 if (signo < 0 || signo >= NSIG)
227 {
228 errno = EINVAL;
229 return -1;
230 }
231 if (signo > sizeof (*set) * BITS_PER_CHAR)
232 emacs_abort ();
233
234 return (*set & (1U << signo)) != 0;
235 }
236
237 pid_t
238 getpgrp (void)
239 {
240 return getpid ();
241 }
242
243 pid_t
244 tcgetpgrp (int fd)
245 {
246 return getpid ();
247 }
248
249 int
250 setpgid (pid_t pid, pid_t pgid)
251 {
252 return 0;
253 }
254
255 pid_t
256 setsid (void)
257 {
258 return getpid ();
259 }
260
261 /* Emulations of interval timers.
262
263 Limitations: only ITIMER_REAL and ITIMER_PROF are supported.
264
265 Implementation: a separate thread is started for each timer type,
266 the thread calls the appropriate signal handler when the timer
267 expires, after stopping the thread which installed the timer. */
268
269 struct itimer_data {
270 volatile ULONGLONG expire;
271 volatile ULONGLONG reload;
272 volatile int terminate;
273 int type;
274 HANDLE caller_thread;
275 HANDLE timer_thread;
276 };
277
278 static ULONGLONG ticks_now;
279 static struct itimer_data real_itimer, prof_itimer;
280 static ULONGLONG clocks_min;
281 /* If non-zero, itimers are disabled. Used during shutdown, when we
282 delete the critical sections used by the timer threads. */
283 static int disable_itimers;
284
285 static CRITICAL_SECTION crit_real, crit_prof;
286
287 /* GetThreadTimes is not available on Windows 9X and possibly also on 2K. */
288 typedef BOOL (WINAPI *GetThreadTimes_Proc) (
289 HANDLE hThread,
290 LPFILETIME lpCreationTime,
291 LPFILETIME lpExitTime,
292 LPFILETIME lpKernelTime,
293 LPFILETIME lpUserTime);
294
295 static GetThreadTimes_Proc s_pfn_Get_Thread_Times;
296
297 #define MAX_SINGLE_SLEEP 30
298 #define TIMER_TICKS_PER_SEC 1000
299
300 /* Return a suitable time value, in 1-ms units, for THREAD, a handle
301 to a thread. If THREAD is NULL or an invalid handle, return the
302 current wall-clock time since January 1, 1601 (UTC). Otherwise,
303 return the sum of kernel and user times used by THREAD since it was
304 created, plus its creation time. */
305 static ULONGLONG
306 w32_get_timer_time (HANDLE thread)
307 {
308 ULONGLONG retval;
309 int use_system_time = 1;
310 /* The functions below return times in 100-ns units. */
311 const int tscale = 10 * TIMER_TICKS_PER_SEC;
312
313 if (thread && thread != INVALID_HANDLE_VALUE
314 && s_pfn_Get_Thread_Times != NULL)
315 {
316 FILETIME creation_ftime, exit_ftime, kernel_ftime, user_ftime;
317 ULARGE_INTEGER temp_creation, temp_kernel, temp_user;
318
319 if (s_pfn_Get_Thread_Times (thread, &creation_ftime, &exit_ftime,
320 &kernel_ftime, &user_ftime))
321 {
322 use_system_time = 0;
323 temp_creation.LowPart = creation_ftime.dwLowDateTime;
324 temp_creation.HighPart = creation_ftime.dwHighDateTime;
325 temp_kernel.LowPart = kernel_ftime.dwLowDateTime;
326 temp_kernel.HighPart = kernel_ftime.dwHighDateTime;
327 temp_user.LowPart = user_ftime.dwLowDateTime;
328 temp_user.HighPart = user_ftime.dwHighDateTime;
329 retval =
330 temp_creation.QuadPart / tscale + temp_kernel.QuadPart / tscale
331 + temp_user.QuadPart / tscale;
332 }
333 else
334 DebPrint (("GetThreadTimes failed with error code %lu\n",
335 GetLastError ()));
336 }
337
338 if (use_system_time)
339 {
340 FILETIME current_ftime;
341 ULARGE_INTEGER temp;
342
343 GetSystemTimeAsFileTime (&current_ftime);
344
345 temp.LowPart = current_ftime.dwLowDateTime;
346 temp.HighPart = current_ftime.dwHighDateTime;
347
348 retval = temp.QuadPart / tscale;
349 }
350
351 return retval;
352 }
353
354 /* Thread function for a timer thread. */
355 static DWORD WINAPI
356 timer_loop (LPVOID arg)
357 {
358 struct itimer_data *itimer = (struct itimer_data *)arg;
359 int which = itimer->type;
360 int sig = (which == ITIMER_REAL) ? SIGALRM : SIGPROF;
361 CRITICAL_SECTION *crit = (which == ITIMER_REAL) ? &crit_real : &crit_prof;
362 const DWORD max_sleep = MAX_SINGLE_SLEEP * 1000 / TIMER_TICKS_PER_SEC;
363 HANDLE hth = (which == ITIMER_REAL) ? NULL : itimer->caller_thread;
364
365 while (1)
366 {
367 DWORD sleep_time;
368 signal_handler handler;
369 ULONGLONG now, expire, reload;
370
371 /* Load new values if requested by setitimer. */
372 EnterCriticalSection (crit);
373 expire = itimer->expire;
374 reload = itimer->reload;
375 LeaveCriticalSection (crit);
376 if (itimer->terminate)
377 return 0;
378
379 if (expire == 0)
380 {
381 /* We are idle. */
382 Sleep (max_sleep);
383 continue;
384 }
385
386 if (expire > (now = w32_get_timer_time (hth)))
387 sleep_time = expire - now;
388 else
389 sleep_time = 0;
390 /* Don't sleep too long at a time, to be able to see the
391 termination flag without too long a delay. */
392 while (sleep_time > max_sleep)
393 {
394 if (itimer->terminate)
395 return 0;
396 Sleep (max_sleep);
397 EnterCriticalSection (crit);
398 expire = itimer->expire;
399 LeaveCriticalSection (crit);
400 sleep_time =
401 (expire > (now = w32_get_timer_time (hth))) ? expire - now : 0;
402 }
403 if (itimer->terminate)
404 return 0;
405 if (sleep_time > 0)
406 {
407 Sleep (sleep_time * 1000 / TIMER_TICKS_PER_SEC);
408 /* Always sleep past the expiration time, to make sure we
409 never call the handler _before_ the expiration time,
410 always slightly after it. Sleep(5) makes sure we don't
411 hog the CPU by calling 'w32_get_timer_time' with high
412 frequency, and also let other threads work. */
413 while (w32_get_timer_time (hth) < expire)
414 Sleep (5);
415 }
416
417 EnterCriticalSection (crit);
418 expire = itimer->expire;
419 LeaveCriticalSection (crit);
420 if (expire == 0)
421 continue;
422
423 /* Time's up. */
424 handler = sig_handlers[sig];
425 if (!(handler == SIG_DFL || handler == SIG_IGN || handler == SIG_ERR)
426 /* FIXME: Don't ignore masked signals. Instead, record that
427 they happened and reissue them when the signal is
428 unblocked. */
429 && !sigismember (&sig_mask, sig)
430 /* Simulate masking of SIGALRM and SIGPROF when processing
431 fatal signals. */
432 && !fatal_error_in_progress
433 && itimer->caller_thread)
434 {
435 /* Simulate a signal delivered to the thread which installed
436 the timer, by suspending that thread while the handler
437 runs. */
438 HANDLE th = itimer->caller_thread;
439 DWORD result = SuspendThread (th);
440
441 if (result == (DWORD)-1)
442 return 2;
443
444 handler (sig);
445 ResumeThread (th);
446 }
447
448 /* Update expiration time and loop. */
449 EnterCriticalSection (crit);
450 expire = itimer->expire;
451 if (expire == 0)
452 {
453 LeaveCriticalSection (crit);
454 continue;
455 }
456 reload = itimer->reload;
457 if (reload > 0)
458 {
459 now = w32_get_timer_time (hth);
460 if (expire <= now)
461 {
462 ULONGLONG lag = now - expire;
463
464 /* If we missed some opportunities (presumably while
465 sleeping or while the signal handler ran), skip
466 them. */
467 if (lag > reload)
468 expire = now - (lag % reload);
469
470 expire += reload;
471 }
472 }
473 else
474 expire = 0; /* become idle */
475 itimer->expire = expire;
476 LeaveCriticalSection (crit);
477 }
478 return 0;
479 }
480
481 static void
482 stop_timer_thread (int which)
483 {
484 struct itimer_data *itimer =
485 (which == ITIMER_REAL) ? &real_itimer : &prof_itimer;
486 int i;
487 DWORD err, exit_code = 255;
488 BOOL status;
489
490 /* Signal the thread that it should terminate. */
491 itimer->terminate = 1;
492
493 if (itimer->timer_thread == NULL)
494 return;
495
496 /* Wait for the timer thread to terminate voluntarily, then kill it
497 if it doesn't. This loop waits twice more than the maximum
498 amount of time a timer thread sleeps, see above. */
499 for (i = 0; i < MAX_SINGLE_SLEEP / 5; i++)
500 {
501 if (!((status = GetExitCodeThread (itimer->timer_thread, &exit_code))
502 && exit_code == STILL_ACTIVE))
503 break;
504 Sleep (10);
505 }
506 if ((status == FALSE && (err = GetLastError ()) == ERROR_INVALID_HANDLE)
507 || exit_code == STILL_ACTIVE)
508 {
509 if (!(status == FALSE && err == ERROR_INVALID_HANDLE))
510 TerminateThread (itimer->timer_thread, 0);
511 }
512
513 /* Clean up. */
514 CloseHandle (itimer->timer_thread);
515 itimer->timer_thread = NULL;
516 if (itimer->caller_thread)
517 {
518 CloseHandle (itimer->caller_thread);
519 itimer->caller_thread = NULL;
520 }
521 }
522
523 /* This is called at shutdown time from term_ntproc. */
524 void
525 term_timers (void)
526 {
527 if (real_itimer.timer_thread)
528 stop_timer_thread (ITIMER_REAL);
529 if (prof_itimer.timer_thread)
530 stop_timer_thread (ITIMER_PROF);
531
532 /* We are going to delete the critical sections, so timers cannot
533 work after this. */
534 disable_itimers = 1;
535
536 DeleteCriticalSection (&crit_real);
537 DeleteCriticalSection (&crit_prof);
538 DeleteCriticalSection (&crit_sig);
539 }
540
541 /* This is called at initialization time from init_ntproc. */
542 void
543 init_timers (void)
544 {
545 /* GetThreadTimes is not available on all versions of Windows, so
546 need to probe for its availability dynamically, and call it
547 through a pointer. */
548 s_pfn_Get_Thread_Times = NULL; /* in case dumped Emacs comes with a value */
549 if (os_subtype != OS_9X)
550 s_pfn_Get_Thread_Times =
551 (GetThreadTimes_Proc)GetProcAddress (GetModuleHandle ("kernel32.dll"),
552 "GetThreadTimes");
553
554 /* Make sure we start with zeroed out itimer structures, since
555 dumping may have left there traces of threads long dead. */
556 memset (&real_itimer, 0, sizeof real_itimer);
557 memset (&prof_itimer, 0, sizeof prof_itimer);
558
559 InitializeCriticalSection (&crit_real);
560 InitializeCriticalSection (&crit_prof);
561 InitializeCriticalSection (&crit_sig);
562
563 disable_itimers = 0;
564 }
565
566 static int
567 start_timer_thread (int which)
568 {
569 DWORD exit_code, tid;
570 HANDLE th;
571 struct itimer_data *itimer =
572 (which == ITIMER_REAL) ? &real_itimer : &prof_itimer;
573
574 if (itimer->timer_thread
575 && GetExitCodeThread (itimer->timer_thread, &exit_code)
576 && exit_code == STILL_ACTIVE)
577 return 0;
578
579 /* Clean up after possibly exited thread. */
580 if (itimer->timer_thread)
581 {
582 CloseHandle (itimer->timer_thread);
583 itimer->timer_thread = NULL;
584 }
585 if (itimer->caller_thread)
586 {
587 CloseHandle (itimer->caller_thread);
588 itimer->caller_thread = NULL;
589 }
590
591 /* Start a new thread. */
592 if (!DuplicateHandle (GetCurrentProcess (), GetCurrentThread (),
593 GetCurrentProcess (), &th, 0, FALSE,
594 DUPLICATE_SAME_ACCESS))
595 {
596 errno = ESRCH;
597 return -1;
598 }
599 itimer->terminate = 0;
600 itimer->type = which;
601 itimer->caller_thread = th;
602 /* Request that no more than 64KB of stack be reserved for this
603 thread, to avoid reserving too much memory, which would get in
604 the way of threads we start to wait for subprocesses. See also
605 new_child below. */
606 itimer->timer_thread = CreateThread (NULL, 64 * 1024, timer_loop,
607 (void *)itimer, 0x00010000, &tid);
608
609 if (!itimer->timer_thread)
610 {
611 CloseHandle (itimer->caller_thread);
612 itimer->caller_thread = NULL;
613 errno = EAGAIN;
614 return -1;
615 }
616
617 /* This is needed to make sure that the timer thread running for
618 profiling gets CPU as soon as the Sleep call terminates. */
619 if (which == ITIMER_PROF)
620 SetThreadPriority (itimer->timer_thread, THREAD_PRIORITY_TIME_CRITICAL);
621
622 return 0;
623 }
624
625 /* Most of the code of getitimer and setitimer (but not of their
626 subroutines) was shamelessly stolen from itimer.c in the DJGPP
627 library, see www.delorie.com/djgpp. */
628 int
629 getitimer (int which, struct itimerval *value)
630 {
631 volatile ULONGLONG *t_expire;
632 volatile ULONGLONG *t_reload;
633 ULONGLONG expire, reload;
634 __int64 usecs;
635 CRITICAL_SECTION *crit;
636 struct itimer_data *itimer;
637
638 if (disable_itimers)
639 return -1;
640
641 if (!value)
642 {
643 errno = EFAULT;
644 return -1;
645 }
646
647 if (which != ITIMER_REAL && which != ITIMER_PROF)
648 {
649 errno = EINVAL;
650 return -1;
651 }
652
653 itimer = (which == ITIMER_REAL) ? &real_itimer : &prof_itimer;
654
655 ticks_now = w32_get_timer_time ((which == ITIMER_REAL)
656 ? NULL
657 : GetCurrentThread ());
658
659 t_expire = &itimer->expire;
660 t_reload = &itimer->reload;
661 crit = (which == ITIMER_REAL) ? &crit_real : &crit_prof;
662
663 EnterCriticalSection (crit);
664 reload = *t_reload;
665 expire = *t_expire;
666 LeaveCriticalSection (crit);
667
668 if (expire)
669 expire -= ticks_now;
670
671 value->it_value.tv_sec = expire / TIMER_TICKS_PER_SEC;
672 usecs =
673 (expire % TIMER_TICKS_PER_SEC) * (__int64)1000000 / TIMER_TICKS_PER_SEC;
674 value->it_value.tv_usec = usecs;
675 value->it_interval.tv_sec = reload / TIMER_TICKS_PER_SEC;
676 usecs =
677 (reload % TIMER_TICKS_PER_SEC) * (__int64)1000000 / TIMER_TICKS_PER_SEC;
678 value->it_interval.tv_usec= usecs;
679
680 return 0;
681 }
682
683 int
684 setitimer(int which, struct itimerval *value, struct itimerval *ovalue)
685 {
686 volatile ULONGLONG *t_expire, *t_reload;
687 ULONGLONG expire, reload, expire_old, reload_old;
688 __int64 usecs;
689 CRITICAL_SECTION *crit;
690 struct itimerval tem, *ptem;
691
692 if (disable_itimers)
693 return -1;
694
695 /* Posix systems expect timer values smaller than the resolution of
696 the system clock be rounded up to the clock resolution. First
697 time we are called, measure the clock tick resolution. */
698 if (!clocks_min)
699 {
700 ULONGLONG t1, t2;
701
702 for (t1 = w32_get_timer_time (NULL);
703 (t2 = w32_get_timer_time (NULL)) == t1; )
704 ;
705 clocks_min = t2 - t1;
706 }
707
708 if (ovalue)
709 ptem = ovalue;
710 else
711 ptem = &tem;
712
713 if (getitimer (which, ptem)) /* also sets ticks_now */
714 return -1; /* errno already set */
715
716 t_expire =
717 (which == ITIMER_REAL) ? &real_itimer.expire : &prof_itimer.expire;
718 t_reload =
719 (which == ITIMER_REAL) ? &real_itimer.reload : &prof_itimer.reload;
720
721 crit = (which == ITIMER_REAL) ? &crit_real : &crit_prof;
722
723 if (!value
724 || (value->it_value.tv_sec == 0 && value->it_value.tv_usec == 0))
725 {
726 EnterCriticalSection (crit);
727 /* Disable the timer. */
728 *t_expire = 0;
729 *t_reload = 0;
730 LeaveCriticalSection (crit);
731 return 0;
732 }
733
734 reload = value->it_interval.tv_sec * TIMER_TICKS_PER_SEC;
735
736 usecs = value->it_interval.tv_usec;
737 if (value->it_interval.tv_sec == 0
738 && usecs && usecs * TIMER_TICKS_PER_SEC < clocks_min * 1000000)
739 reload = clocks_min;
740 else
741 {
742 usecs *= TIMER_TICKS_PER_SEC;
743 reload += usecs / 1000000;
744 }
745
746 expire = value->it_value.tv_sec * TIMER_TICKS_PER_SEC;
747 usecs = value->it_value.tv_usec;
748 if (value->it_value.tv_sec == 0
749 && usecs * TIMER_TICKS_PER_SEC < clocks_min * 1000000)
750 expire = clocks_min;
751 else
752 {
753 usecs *= TIMER_TICKS_PER_SEC;
754 expire += usecs / 1000000;
755 }
756
757 expire += ticks_now;
758
759 EnterCriticalSection (crit);
760 expire_old = *t_expire;
761 reload_old = *t_reload;
762 if (!(expire == expire_old && reload == reload_old))
763 {
764 *t_reload = reload;
765 *t_expire = expire;
766 }
767 LeaveCriticalSection (crit);
768
769 return start_timer_thread (which);
770 }
771
772 int
773 alarm (int seconds)
774 {
775 #ifdef HAVE_SETITIMER
776 struct itimerval new_values, old_values;
777
778 new_values.it_value.tv_sec = seconds;
779 new_values.it_value.tv_usec = 0;
780 new_values.it_interval.tv_sec = new_values.it_interval.tv_usec = 0;
781
782 if (setitimer (ITIMER_REAL, &new_values, &old_values) < 0)
783 return 0;
784 return old_values.it_value.tv_sec;
785 #else
786 return seconds;
787 #endif
788 }
789
790 /* Defined in <process.h> which conflicts with the local copy */
791 #define _P_NOWAIT 1
792
793 /* Child process management list. */
794 int child_proc_count = 0;
795 child_process child_procs[ MAX_CHILDREN ];
796
797 static DWORD WINAPI reader_thread (void *arg);
798
799 /* Find an unused process slot. */
800 child_process *
801 new_child (void)
802 {
803 child_process *cp;
804 DWORD id;
805
806 for (cp = child_procs + (child_proc_count-1); cp >= child_procs; cp--)
807 if (!CHILD_ACTIVE (cp) && cp->procinfo.hProcess == NULL)
808 goto Initialize;
809 if (child_proc_count == MAX_CHILDREN)
810 {
811 int i = 0;
812 child_process *dead_cp = NULL;
813
814 DebPrint (("new_child: No vacant slots, looking for dead processes\n"));
815 for (cp = child_procs + (child_proc_count-1); cp >= child_procs; cp--)
816 if (!CHILD_ACTIVE (cp) && cp->procinfo.hProcess)
817 {
818 DWORD status = 0;
819
820 if (!GetExitCodeProcess (cp->procinfo.hProcess, &status))
821 {
822 DebPrint (("new_child.GetExitCodeProcess: error %lu for PID %lu\n",
823 GetLastError (), cp->procinfo.dwProcessId));
824 status = STILL_ACTIVE;
825 }
826 if (status != STILL_ACTIVE
827 || WaitForSingleObject (cp->procinfo.hProcess, 0) == WAIT_OBJECT_0)
828 {
829 DebPrint (("new_child: Freeing slot of dead process %d, fd %d\n",
830 cp->procinfo.dwProcessId, cp->fd));
831 CloseHandle (cp->procinfo.hProcess);
832 cp->procinfo.hProcess = NULL;
833 CloseHandle (cp->procinfo.hThread);
834 cp->procinfo.hThread = NULL;
835 /* Free up to 2 dead slots at a time, so that if we
836 have a lot of them, they will eventually all be
837 freed when the tornado ends. */
838 if (i == 0)
839 dead_cp = cp;
840 else
841 break;
842 i++;
843 }
844 }
845 if (dead_cp)
846 {
847 cp = dead_cp;
848 goto Initialize;
849 }
850 }
851 if (child_proc_count == MAX_CHILDREN)
852 return NULL;
853 cp = &child_procs[child_proc_count++];
854
855 Initialize:
856 /* Last opportunity to avoid leaking handles before we forget them
857 for good. */
858 if (cp->procinfo.hProcess)
859 CloseHandle (cp->procinfo.hProcess);
860 if (cp->procinfo.hThread)
861 CloseHandle (cp->procinfo.hThread);
862 memset (cp, 0, sizeof (*cp));
863 cp->fd = -1;
864 cp->pid = -1;
865 cp->procinfo.hProcess = NULL;
866 cp->status = STATUS_READ_ERROR;
867
868 /* use manual reset event so that select() will function properly */
869 cp->char_avail = CreateEvent (NULL, TRUE, FALSE, NULL);
870 if (cp->char_avail)
871 {
872 cp->char_consumed = CreateEvent (NULL, FALSE, FALSE, NULL);
873 if (cp->char_consumed)
874 {
875 /* The 0x00010000 flag is STACK_SIZE_PARAM_IS_A_RESERVATION.
876 It means that the 64K stack we are requesting in the 2nd
877 argument is how much memory should be reserved for the
878 stack. If we don't use this flag, the memory requested
879 by the 2nd argument is the amount actually _committed_,
880 but Windows reserves 8MB of memory for each thread's
881 stack. (The 8MB figure comes from the -stack
882 command-line argument we pass to the linker when building
883 Emacs, but that's because we need a large stack for
884 Emacs's main thread.) Since we request 2GB of reserved
885 memory at startup (see w32heap.c), which is close to the
886 maximum memory available for a 32-bit process on Windows,
887 the 8MB reservation for each thread causes failures in
888 starting subprocesses, because we create a thread running
889 reader_thread for each subprocess. As 8MB of stack is
890 way too much for reader_thread, forcing Windows to
891 reserve less wins the day. */
892 cp->thrd = CreateThread (NULL, 64 * 1024, reader_thread, cp,
893 0x00010000, &id);
894 if (cp->thrd)
895 return cp;
896 }
897 }
898 delete_child (cp);
899 return NULL;
900 }
901
902 void
903 delete_child (child_process *cp)
904 {
905 int i;
906
907 /* Should not be deleting a child that is still needed. */
908 for (i = 0; i < MAXDESC; i++)
909 if (fd_info[i].cp == cp)
910 emacs_abort ();
911
912 if (!CHILD_ACTIVE (cp) && cp->procinfo.hProcess == NULL)
913 return;
914
915 /* reap thread if necessary */
916 if (cp->thrd)
917 {
918 DWORD rc;
919
920 if (GetExitCodeThread (cp->thrd, &rc) && rc == STILL_ACTIVE)
921 {
922 /* let the thread exit cleanly if possible */
923 cp->status = STATUS_READ_ERROR;
924 SetEvent (cp->char_consumed);
925 #if 0
926 /* We used to forcibly terminate the thread here, but it
927 is normally unnecessary, and in abnormal cases, the worst that
928 will happen is we have an extra idle thread hanging around
929 waiting for the zombie process. */
930 if (WaitForSingleObject (cp->thrd, 1000) != WAIT_OBJECT_0)
931 {
932 DebPrint (("delete_child.WaitForSingleObject (thread) failed "
933 "with %lu for fd %ld\n", GetLastError (), cp->fd));
934 TerminateThread (cp->thrd, 0);
935 }
936 #endif
937 }
938 CloseHandle (cp->thrd);
939 cp->thrd = NULL;
940 }
941 if (cp->char_avail)
942 {
943 CloseHandle (cp->char_avail);
944 cp->char_avail = NULL;
945 }
946 if (cp->char_consumed)
947 {
948 CloseHandle (cp->char_consumed);
949 cp->char_consumed = NULL;
950 }
951
952 /* update child_proc_count (highest numbered slot in use plus one) */
953 if (cp == child_procs + child_proc_count - 1)
954 {
955 for (i = child_proc_count-1; i >= 0; i--)
956 if (CHILD_ACTIVE (&child_procs[i])
957 || child_procs[i].procinfo.hProcess != NULL)
958 {
959 child_proc_count = i + 1;
960 break;
961 }
962 }
963 if (i < 0)
964 child_proc_count = 0;
965 }
966
967 /* Find a child by pid. */
968 static child_process *
969 find_child_pid (DWORD pid)
970 {
971 child_process *cp;
972
973 for (cp = child_procs + (child_proc_count-1); cp >= child_procs; cp--)
974 if ((CHILD_ACTIVE (cp) || cp->procinfo.hProcess != NULL)
975 && pid == cp->pid)
976 return cp;
977 return NULL;
978 }
979
980 void
981 release_listen_threads (void)
982 {
983 int i;
984
985 for (i = child_proc_count - 1; i >= 0; i--)
986 {
987 if (CHILD_ACTIVE (&child_procs[i])
988 && (fd_info[child_procs[i].fd].flags & FILE_LISTEN))
989 child_procs[i].status = STATUS_READ_ERROR;
990 }
991 }
992
993 /* Thread proc for child process and socket reader threads. Each thread
994 is normally blocked until woken by select() to check for input by
995 reading one char. When the read completes, char_avail is signaled
996 to wake up the select emulator and the thread blocks itself again. */
997 static DWORD WINAPI
998 reader_thread (void *arg)
999 {
1000 child_process *cp;
1001
1002 /* Our identity */
1003 cp = (child_process *)arg;
1004
1005 /* We have to wait for the go-ahead before we can start */
1006 if (cp == NULL
1007 || WaitForSingleObject (cp->char_consumed, INFINITE) != WAIT_OBJECT_0
1008 || cp->fd < 0)
1009 return 1;
1010
1011 for (;;)
1012 {
1013 int rc;
1014
1015 if (cp->fd >= 0 && fd_info[cp->fd].flags & FILE_LISTEN)
1016 rc = _sys_wait_accept (cp->fd);
1017 else
1018 rc = _sys_read_ahead (cp->fd);
1019
1020 /* Don't bother waiting for the event if we already have been
1021 told to exit by delete_child. */
1022 if (cp->status == STATUS_READ_ERROR || !cp->char_avail)
1023 break;
1024
1025 /* The name char_avail is a misnomer - it really just means the
1026 read-ahead has completed, whether successfully or not. */
1027 if (!SetEvent (cp->char_avail))
1028 {
1029 DebPrint (("reader_thread.SetEvent(0x%x) failed with %lu for fd %ld (PID %d)\n",
1030 (DWORD_PTR)cp->char_avail, GetLastError (),
1031 cp->fd, cp->pid));
1032 return 1;
1033 }
1034
1035 if (rc == STATUS_READ_ERROR)
1036 return 1;
1037
1038 /* If the read died, the child has died so let the thread die */
1039 if (rc == STATUS_READ_FAILED)
1040 break;
1041
1042 /* Don't bother waiting for the acknowledge if we already have
1043 been told to exit by delete_child. */
1044 if (cp->status == STATUS_READ_ERROR || !cp->char_consumed)
1045 break;
1046
1047 /* Wait until our input is acknowledged before reading again */
1048 if (WaitForSingleObject (cp->char_consumed, INFINITE) != WAIT_OBJECT_0)
1049 {
1050 DebPrint (("reader_thread.WaitForSingleObject failed with "
1051 "%lu for fd %ld\n", GetLastError (), cp->fd));
1052 break;
1053 }
1054 /* delete_child sets status to STATUS_READ_ERROR when it wants
1055 us to exit. */
1056 if (cp->status == STATUS_READ_ERROR)
1057 break;
1058 }
1059 return 0;
1060 }
1061
1062 /* To avoid Emacs changing directory, we just record here the
1063 directory the new process should start in. This is set just before
1064 calling sys_spawnve, and is not generally valid at any other time.
1065 Note that this directory's name is UTF-8 encoded. */
1066 static char * process_dir;
1067
1068 static BOOL
1069 create_child (char *exe, char *cmdline, char *env, int is_gui_app,
1070 pid_t * pPid, child_process *cp)
1071 {
1072 STARTUPINFO start;
1073 SECURITY_ATTRIBUTES sec_attrs;
1074 #if 0
1075 SECURITY_DESCRIPTOR sec_desc;
1076 #endif
1077 DWORD flags;
1078 char dir[ MAX_PATH ];
1079 char *p;
1080
1081 if (cp == NULL) emacs_abort ();
1082
1083 memset (&start, 0, sizeof (start));
1084 start.cb = sizeof (start);
1085
1086 #ifdef HAVE_NTGUI
1087 if (NILP (Vw32_start_process_show_window) && !is_gui_app)
1088 start.dwFlags = STARTF_USESTDHANDLES | STARTF_USESHOWWINDOW;
1089 else
1090 start.dwFlags = STARTF_USESTDHANDLES;
1091 start.wShowWindow = SW_HIDE;
1092
1093 start.hStdInput = GetStdHandle (STD_INPUT_HANDLE);
1094 start.hStdOutput = GetStdHandle (STD_OUTPUT_HANDLE);
1095 start.hStdError = GetStdHandle (STD_ERROR_HANDLE);
1096 #endif /* HAVE_NTGUI */
1097
1098 #if 0
1099 /* Explicitly specify no security */
1100 if (!InitializeSecurityDescriptor (&sec_desc, SECURITY_DESCRIPTOR_REVISION))
1101 goto EH_Fail;
1102 if (!SetSecurityDescriptorDacl (&sec_desc, TRUE, NULL, FALSE))
1103 goto EH_Fail;
1104 #endif
1105 sec_attrs.nLength = sizeof (sec_attrs);
1106 sec_attrs.lpSecurityDescriptor = NULL /* &sec_desc */;
1107 sec_attrs.bInheritHandle = FALSE;
1108
1109 filename_to_ansi (process_dir, dir);
1110 /* Can't use unixtodos_filename here, since that needs its file name
1111 argument encoded in UTF-8. OTOH, process_dir, which _is_ in
1112 UTF-8, points, to the directory computed by our caller, and we
1113 don't want to modify that, either. */
1114 for (p = dir; *p; p = CharNextA (p))
1115 if (*p == '/')
1116 *p = '\\';
1117
1118 flags = (!NILP (Vw32_start_process_share_console)
1119 ? CREATE_NEW_PROCESS_GROUP
1120 : CREATE_NEW_CONSOLE);
1121 if (NILP (Vw32_start_process_inherit_error_mode))
1122 flags |= CREATE_DEFAULT_ERROR_MODE;
1123 if (!CreateProcessA (exe, cmdline, &sec_attrs, NULL, TRUE,
1124 flags, env, dir, &start, &cp->procinfo))
1125 goto EH_Fail;
1126
1127 cp->pid = (int) cp->procinfo.dwProcessId;
1128
1129 /* Hack for Windows 95, which assigns large (ie negative) pids */
1130 if (cp->pid < 0)
1131 cp->pid = -cp->pid;
1132
1133 *pPid = cp->pid;
1134
1135 return TRUE;
1136
1137 EH_Fail:
1138 DebPrint (("create_child.CreateProcess failed: %ld\n", GetLastError ()););
1139 return FALSE;
1140 }
1141
1142 /* create_child doesn't know what emacs's file handle will be for waiting
1143 on output from the child, so we need to make this additional call
1144 to register the handle with the process
1145 This way the select emulator knows how to match file handles with
1146 entries in child_procs. */
1147 void
1148 register_child (pid_t pid, int fd)
1149 {
1150 child_process *cp;
1151
1152 cp = find_child_pid ((DWORD)pid);
1153 if (cp == NULL)
1154 {
1155 DebPrint (("register_child unable to find pid %lu\n", pid));
1156 return;
1157 }
1158
1159 #ifdef FULL_DEBUG
1160 DebPrint (("register_child registered fd %d with pid %lu\n", fd, pid));
1161 #endif
1162
1163 cp->fd = fd;
1164
1165 /* thread is initially blocked until select is called; set status so
1166 that select will release thread */
1167 cp->status = STATUS_READ_ACKNOWLEDGED;
1168
1169 /* attach child_process to fd_info */
1170 if (fd_info[fd].cp != NULL)
1171 {
1172 DebPrint (("register_child: fd_info[%d] apparently in use!\n", fd));
1173 emacs_abort ();
1174 }
1175
1176 fd_info[fd].cp = cp;
1177 }
1178
1179 /* Called from waitpid when a process exits. */
1180 static void
1181 reap_subprocess (child_process *cp)
1182 {
1183 if (cp->procinfo.hProcess)
1184 {
1185 /* Reap the process */
1186 #ifdef FULL_DEBUG
1187 /* Process should have already died before we are called. */
1188 if (WaitForSingleObject (cp->procinfo.hProcess, 0) != WAIT_OBJECT_0)
1189 DebPrint (("reap_subprocess: child for fd %d has not died yet!", cp->fd));
1190 #endif
1191 CloseHandle (cp->procinfo.hProcess);
1192 cp->procinfo.hProcess = NULL;
1193 CloseHandle (cp->procinfo.hThread);
1194 cp->procinfo.hThread = NULL;
1195 }
1196
1197 /* If cp->fd was not closed yet, we might be still reading the
1198 process output, so don't free its resources just yet. The call
1199 to delete_child on behalf of this subprocess will be made by
1200 sys_read when the subprocess output is fully read. */
1201 if (cp->fd < 0)
1202 delete_child (cp);
1203 }
1204
1205 /* Wait for a child process specified by PID, or for any of our
1206 existing child processes (if PID is nonpositive) to die. When it
1207 does, close its handle. Return the pid of the process that died
1208 and fill in STATUS if non-NULL. */
1209
1210 pid_t
1211 waitpid (pid_t pid, int *status, int options)
1212 {
1213 DWORD active, retval;
1214 int nh;
1215 child_process *cp, *cps[MAX_CHILDREN];
1216 HANDLE wait_hnd[MAX_CHILDREN];
1217 DWORD timeout_ms;
1218 int dont_wait = (options & WNOHANG) != 0;
1219
1220 nh = 0;
1221 /* According to Posix:
1222
1223 PID = -1 means status is requested for any child process.
1224
1225 PID > 0 means status is requested for a single child process
1226 whose pid is PID.
1227
1228 PID = 0 means status is requested for any child process whose
1229 process group ID is equal to that of the calling process. But
1230 since Windows has only a limited support for process groups (only
1231 for console processes and only for the purposes of passing
1232 Ctrl-BREAK signal to them), and since we have no documented way
1233 of determining whether a given process belongs to our group, we
1234 treat 0 as -1.
1235
1236 PID < -1 means status is requested for any child process whose
1237 process group ID is equal to the absolute value of PID. Again,
1238 since we don't support process groups, we treat that as -1. */
1239 if (pid > 0)
1240 {
1241 int our_child = 0;
1242
1243 /* We are requested to wait for a specific child. */
1244 for (cp = child_procs + (child_proc_count-1); cp >= child_procs; cp--)
1245 {
1246 /* Some child_procs might be sockets; ignore them. Also
1247 ignore subprocesses whose output is not yet completely
1248 read. */
1249 if (CHILD_ACTIVE (cp)
1250 && cp->procinfo.hProcess
1251 && cp->pid == pid)
1252 {
1253 our_child = 1;
1254 break;
1255 }
1256 }
1257 if (our_child)
1258 {
1259 if (cp->fd < 0 || (fd_info[cp->fd].flags & FILE_AT_EOF) != 0)
1260 {
1261 wait_hnd[nh] = cp->procinfo.hProcess;
1262 cps[nh] = cp;
1263 nh++;
1264 }
1265 else if (dont_wait)
1266 {
1267 /* PID specifies our subprocess, but its status is not
1268 yet available. */
1269 return 0;
1270 }
1271 }
1272 if (nh == 0)
1273 {
1274 /* No such child process, or nothing to wait for, so fail. */
1275 errno = ECHILD;
1276 return -1;
1277 }
1278 }
1279 else
1280 {
1281 for (cp = child_procs + (child_proc_count-1); cp >= child_procs; cp--)
1282 {
1283 if (CHILD_ACTIVE (cp)
1284 && cp->procinfo.hProcess
1285 && (cp->fd < 0 || (fd_info[cp->fd].flags & FILE_AT_EOF) != 0))
1286 {
1287 wait_hnd[nh] = cp->procinfo.hProcess;
1288 cps[nh] = cp;
1289 nh++;
1290 }
1291 }
1292 if (nh == 0)
1293 {
1294 /* Nothing to wait on, so fail. */
1295 errno = ECHILD;
1296 return -1;
1297 }
1298 }
1299
1300 if (dont_wait)
1301 timeout_ms = 0;
1302 else
1303 timeout_ms = 1000; /* check for quit about once a second. */
1304
1305 do
1306 {
1307 QUIT;
1308 active = WaitForMultipleObjects (nh, wait_hnd, FALSE, timeout_ms);
1309 } while (active == WAIT_TIMEOUT && !dont_wait);
1310
1311 if (active == WAIT_FAILED)
1312 {
1313 errno = EBADF;
1314 return -1;
1315 }
1316 else if (active == WAIT_TIMEOUT && dont_wait)
1317 {
1318 /* PID specifies our subprocess, but it didn't exit yet, so its
1319 status is not yet available. */
1320 #ifdef FULL_DEBUG
1321 DebPrint (("Wait: PID %d not reap yet\n", cp->pid));
1322 #endif
1323 return 0;
1324 }
1325 else if (active >= WAIT_OBJECT_0
1326 && active < WAIT_OBJECT_0+MAXIMUM_WAIT_OBJECTS)
1327 {
1328 active -= WAIT_OBJECT_0;
1329 }
1330 else if (active >= WAIT_ABANDONED_0
1331 && active < WAIT_ABANDONED_0+MAXIMUM_WAIT_OBJECTS)
1332 {
1333 active -= WAIT_ABANDONED_0;
1334 }
1335 else
1336 emacs_abort ();
1337
1338 if (!GetExitCodeProcess (wait_hnd[active], &retval))
1339 {
1340 DebPrint (("Wait.GetExitCodeProcess failed with %lu\n",
1341 GetLastError ()));
1342 retval = 1;
1343 }
1344 if (retval == STILL_ACTIVE)
1345 {
1346 /* Should never happen. */
1347 DebPrint (("Wait.WaitForMultipleObjects returned an active process\n"));
1348 if (pid > 0 && dont_wait)
1349 return 0;
1350 errno = EINVAL;
1351 return -1;
1352 }
1353
1354 /* Massage the exit code from the process to match the format expected
1355 by the WIFSTOPPED et al macros in syswait.h. Only WIFSIGNALED and
1356 WIFEXITED are supported; WIFSTOPPED doesn't make sense under NT. */
1357
1358 if (retval == STATUS_CONTROL_C_EXIT)
1359 retval = SIGINT;
1360 else
1361 retval <<= 8;
1362
1363 if (pid > 0 && active != 0)
1364 emacs_abort ();
1365 cp = cps[active];
1366 pid = cp->pid;
1367 #ifdef FULL_DEBUG
1368 DebPrint (("Wait signaled with process pid %d\n", cp->pid));
1369 #endif
1370
1371 if (status)
1372 *status = retval;
1373 reap_subprocess (cp);
1374
1375 return pid;
1376 }
1377
1378 /* Old versions of w32api headers don't have separate 32-bit and
1379 64-bit defines, but the one they have matches the 32-bit variety. */
1380 #ifndef IMAGE_NT_OPTIONAL_HDR32_MAGIC
1381 # define IMAGE_NT_OPTIONAL_HDR32_MAGIC IMAGE_NT_OPTIONAL_HDR_MAGIC
1382 # define IMAGE_OPTIONAL_HEADER32 IMAGE_OPTIONAL_HEADER
1383 #endif
1384
1385 /* Implementation note: This function works with file names encoded in
1386 the current ANSI codepage. */
1387 static void
1388 w32_executable_type (char * filename,
1389 int * is_dos_app,
1390 int * is_cygnus_app,
1391 int * is_gui_app)
1392 {
1393 file_data executable;
1394 char * p;
1395
1396 /* Default values in case we can't tell for sure. */
1397 *is_dos_app = FALSE;
1398 *is_cygnus_app = FALSE;
1399 *is_gui_app = FALSE;
1400
1401 if (!open_input_file (&executable, filename))
1402 return;
1403
1404 p = strrchr (filename, '.');
1405
1406 /* We can only identify DOS .com programs from the extension. */
1407 if (p && xstrcasecmp (p, ".com") == 0)
1408 *is_dos_app = TRUE;
1409 else if (p && (xstrcasecmp (p, ".bat") == 0
1410 || xstrcasecmp (p, ".cmd") == 0))
1411 {
1412 /* A DOS shell script - it appears that CreateProcess is happy to
1413 accept this (somewhat surprisingly); presumably it looks at
1414 COMSPEC to determine what executable to actually invoke.
1415 Therefore, we have to do the same here as well. */
1416 /* Actually, I think it uses the program association for that
1417 extension, which is defined in the registry. */
1418 p = egetenv ("COMSPEC");
1419 if (p)
1420 w32_executable_type (p, is_dos_app, is_cygnus_app, is_gui_app);
1421 }
1422 else
1423 {
1424 /* Look for DOS .exe signature - if found, we must also check that
1425 it isn't really a 16- or 32-bit Windows exe, since both formats
1426 start with a DOS program stub. Note that 16-bit Windows
1427 executables use the OS/2 1.x format. */
1428
1429 IMAGE_DOS_HEADER * dos_header;
1430 IMAGE_NT_HEADERS * nt_header;
1431
1432 dos_header = (PIMAGE_DOS_HEADER) executable.file_base;
1433 if (dos_header->e_magic != IMAGE_DOS_SIGNATURE)
1434 goto unwind;
1435
1436 nt_header = (PIMAGE_NT_HEADERS) ((unsigned char *) dos_header + dos_header->e_lfanew);
1437
1438 if ((char *) nt_header > (char *) dos_header + executable.size)
1439 {
1440 /* Some dos headers (pkunzip) have bogus e_lfanew fields. */
1441 *is_dos_app = TRUE;
1442 }
1443 else if (nt_header->Signature != IMAGE_NT_SIGNATURE
1444 && LOWORD (nt_header->Signature) != IMAGE_OS2_SIGNATURE)
1445 {
1446 *is_dos_app = TRUE;
1447 }
1448 else if (nt_header->Signature == IMAGE_NT_SIGNATURE)
1449 {
1450 IMAGE_DATA_DIRECTORY *data_dir = NULL;
1451 if (nt_header->OptionalHeader.Magic == IMAGE_NT_OPTIONAL_HDR32_MAGIC)
1452 {
1453 /* Ensure we are using the 32 bit structure. */
1454 IMAGE_OPTIONAL_HEADER32 *opt
1455 = (IMAGE_OPTIONAL_HEADER32*) &(nt_header->OptionalHeader);
1456 data_dir = opt->DataDirectory;
1457 *is_gui_app = (opt->Subsystem == IMAGE_SUBSYSTEM_WINDOWS_GUI);
1458 }
1459 /* MingW 3.12 has the required 64 bit structs, but in case older
1460 versions don't, only check 64 bit exes if we know how. */
1461 #ifdef IMAGE_NT_OPTIONAL_HDR64_MAGIC
1462 else if (nt_header->OptionalHeader.Magic
1463 == IMAGE_NT_OPTIONAL_HDR64_MAGIC)
1464 {
1465 IMAGE_OPTIONAL_HEADER64 *opt
1466 = (IMAGE_OPTIONAL_HEADER64*) &(nt_header->OptionalHeader);
1467 data_dir = opt->DataDirectory;
1468 *is_gui_app = (opt->Subsystem == IMAGE_SUBSYSTEM_WINDOWS_GUI);
1469 }
1470 #endif
1471 if (data_dir)
1472 {
1473 /* Look for cygwin.dll in DLL import list. */
1474 IMAGE_DATA_DIRECTORY import_dir =
1475 data_dir[IMAGE_DIRECTORY_ENTRY_IMPORT];
1476 IMAGE_IMPORT_DESCRIPTOR * imports;
1477 IMAGE_SECTION_HEADER * section;
1478
1479 section = rva_to_section (import_dir.VirtualAddress, nt_header);
1480 imports = RVA_TO_PTR (import_dir.VirtualAddress, section,
1481 executable);
1482
1483 for ( ; imports->Name; imports++)
1484 {
1485 char * dllname = RVA_TO_PTR (imports->Name, section,
1486 executable);
1487
1488 /* The exact name of the cygwin dll has changed with
1489 various releases, but hopefully this will be reasonably
1490 future proof. */
1491 if (strncmp (dllname, "cygwin", 6) == 0)
1492 {
1493 *is_cygnus_app = TRUE;
1494 break;
1495 }
1496 }
1497 }
1498 }
1499 }
1500
1501 unwind:
1502 close_file_data (&executable);
1503 }
1504
1505 static int
1506 compare_env (const void *strp1, const void *strp2)
1507 {
1508 const char *str1 = *(const char **)strp1, *str2 = *(const char **)strp2;
1509
1510 while (*str1 && *str2 && *str1 != '=' && *str2 != '=')
1511 {
1512 /* Sort order in command.com/cmd.exe is based on uppercasing
1513 names, so do the same here. */
1514 if (toupper (*str1) > toupper (*str2))
1515 return 1;
1516 else if (toupper (*str1) < toupper (*str2))
1517 return -1;
1518 str1++, str2++;
1519 }
1520
1521 if (*str1 == '=' && *str2 == '=')
1522 return 0;
1523 else if (*str1 == '=')
1524 return -1;
1525 else
1526 return 1;
1527 }
1528
1529 static void
1530 merge_and_sort_env (char **envp1, char **envp2, char **new_envp)
1531 {
1532 char **optr, **nptr;
1533 int num;
1534
1535 nptr = new_envp;
1536 optr = envp1;
1537 while (*optr)
1538 *nptr++ = *optr++;
1539 num = optr - envp1;
1540
1541 optr = envp2;
1542 while (*optr)
1543 *nptr++ = *optr++;
1544 num += optr - envp2;
1545
1546 qsort (new_envp, num, sizeof (char *), compare_env);
1547
1548 *nptr = NULL;
1549 }
1550
1551 /* When a new child process is created we need to register it in our list,
1552 so intercept spawn requests. */
1553 int
1554 sys_spawnve (int mode, char *cmdname, char **argv, char **envp)
1555 {
1556 Lisp_Object program, full;
1557 char *cmdline, *env, *parg, **targ;
1558 int arglen, numenv;
1559 pid_t pid;
1560 child_process *cp;
1561 int is_dos_app, is_cygnus_app, is_gui_app;
1562 int do_quoting = 0;
1563 /* We pass our process ID to our children by setting up an environment
1564 variable in their environment. */
1565 char ppid_env_var_buffer[64];
1566 char *extra_env[] = {ppid_env_var_buffer, NULL};
1567 /* These are the characters that cause an argument to need quoting.
1568 Arguments with whitespace characters need quoting to prevent the
1569 argument being split into two or more. Arguments with wildcards
1570 are also quoted, for consistency with posix platforms, where wildcards
1571 are not expanded if we run the program directly without a shell.
1572 Some extra whitespace characters need quoting in Cygwin programs,
1573 so this list is conditionally modified below. */
1574 char *sepchars = " \t*?";
1575 /* This is for native w32 apps; modified below for Cygwin apps. */
1576 char escape_char = '\\';
1577 char cmdname_a[MAX_PATH];
1578
1579 /* We don't care about the other modes */
1580 if (mode != _P_NOWAIT)
1581 {
1582 errno = EINVAL;
1583 return -1;
1584 }
1585
1586 /* Handle executable names without an executable suffix. The caller
1587 already searched exec-path and verified the file is executable,
1588 but start-process doesn't do that for file names that are already
1589 absolute. So we double-check this here, just in case. */
1590 if (faccessat (AT_FDCWD, cmdname, X_OK, AT_EACCESS) != 0)
1591 {
1592 struct gcpro gcpro1;
1593
1594 program = build_string (cmdname);
1595 full = Qnil;
1596 GCPRO1 (program);
1597 openp (Vexec_path, program, Vexec_suffixes, &full, make_number (X_OK), 0);
1598 UNGCPRO;
1599 if (NILP (full))
1600 {
1601 errno = EINVAL;
1602 return -1;
1603 }
1604 program = ENCODE_FILE (full);
1605 cmdname = SDATA (program);
1606 }
1607
1608 /* make sure argv[0] and cmdname are both in DOS format */
1609 unixtodos_filename (cmdname);
1610 /* argv[0] was encoded by caller using ENCODE_FILE, so it is in
1611 UTF-8. All the other arguments are encoded by ENCODE_SYSTEM or
1612 some such, and are in some ANSI codepage. We need to have
1613 argv[0] encoded in ANSI codepage. */
1614 filename_to_ansi (cmdname, cmdname_a);
1615 /* We explicitly require that the command's file name be encodable
1616 in the current ANSI codepage, because we will be invoking it via
1617 the ANSI APIs. */
1618 if (_mbspbrk (cmdname_a, "?"))
1619 {
1620 errno = ENOENT;
1621 return -1;
1622 }
1623 /* From here on, CMDNAME is an ANSI-encoded string. */
1624 cmdname = cmdname_a;
1625 argv[0] = cmdname;
1626
1627 /* Determine whether program is a 16-bit DOS executable, or a 32-bit Windows
1628 executable that is implicitly linked to the Cygnus dll (implying it
1629 was compiled with the Cygnus GNU toolchain and hence relies on
1630 cygwin.dll to parse the command line - we use this to decide how to
1631 escape quote chars in command line args that must be quoted).
1632
1633 Also determine whether it is a GUI app, so that we don't hide its
1634 initial window unless specifically requested. */
1635 w32_executable_type (cmdname, &is_dos_app, &is_cygnus_app, &is_gui_app);
1636
1637 /* On Windows 95, if cmdname is a DOS app, we invoke a helper
1638 application to start it by specifying the helper app as cmdname,
1639 while leaving the real app name as argv[0]. */
1640 if (is_dos_app)
1641 {
1642 char *p;
1643
1644 cmdname = alloca (MAX_PATH);
1645 if (egetenv ("CMDPROXY"))
1646 strcpy (cmdname, egetenv ("CMDPROXY"));
1647 else
1648 {
1649 strcpy (cmdname, SDATA (Vinvocation_directory));
1650 strcat (cmdname, "cmdproxy.exe");
1651 }
1652
1653 /* Can't use unixtodos_filename here, since that needs its file
1654 name argument encoded in UTF-8. */
1655 for (p = cmdname; *p; p = CharNextA (p))
1656 if (*p == '/')
1657 *p = '\\';
1658 }
1659
1660 /* we have to do some conjuring here to put argv and envp into the
1661 form CreateProcess wants... argv needs to be a space separated/null
1662 terminated list of parameters, and envp is a null
1663 separated/double-null terminated list of parameters.
1664
1665 Additionally, zero-length args and args containing whitespace or
1666 quote chars need to be wrapped in double quotes - for this to work,
1667 embedded quotes need to be escaped as well. The aim is to ensure
1668 the child process reconstructs the argv array we start with
1669 exactly, so we treat quotes at the beginning and end of arguments
1670 as embedded quotes.
1671
1672 The w32 GNU-based library from Cygnus doubles quotes to escape
1673 them, while MSVC uses backslash for escaping. (Actually the MSVC
1674 startup code does attempt to recognize doubled quotes and accept
1675 them, but gets it wrong and ends up requiring three quotes to get a
1676 single embedded quote!) So by default we decide whether to use
1677 quote or backslash as the escape character based on whether the
1678 binary is apparently a Cygnus compiled app.
1679
1680 Note that using backslash to escape embedded quotes requires
1681 additional special handling if an embedded quote is already
1682 preceded by backslash, or if an arg requiring quoting ends with
1683 backslash. In such cases, the run of escape characters needs to be
1684 doubled. For consistency, we apply this special handling as long
1685 as the escape character is not quote.
1686
1687 Since we have no idea how large argv and envp are likely to be we
1688 figure out list lengths on the fly and allocate them. */
1689
1690 if (!NILP (Vw32_quote_process_args))
1691 {
1692 do_quoting = 1;
1693 /* Override escape char by binding w32-quote-process-args to
1694 desired character, or use t for auto-selection. */
1695 if (INTEGERP (Vw32_quote_process_args))
1696 escape_char = XINT (Vw32_quote_process_args);
1697 else
1698 escape_char = is_cygnus_app ? '"' : '\\';
1699 }
1700
1701 /* Cygwin apps needs quoting a bit more often. */
1702 if (escape_char == '"')
1703 sepchars = "\r\n\t\f '";
1704
1705 /* do argv... */
1706 arglen = 0;
1707 targ = argv;
1708 while (*targ)
1709 {
1710 char * p = *targ;
1711 int need_quotes = 0;
1712 int escape_char_run = 0;
1713
1714 if (*p == 0)
1715 need_quotes = 1;
1716 for ( ; *p; p++)
1717 {
1718 if (escape_char == '"' && *p == '\\')
1719 /* If it's a Cygwin app, \ needs to be escaped. */
1720 arglen++;
1721 else if (*p == '"')
1722 {
1723 /* allow for embedded quotes to be escaped */
1724 arglen++;
1725 need_quotes = 1;
1726 /* handle the case where the embedded quote is already escaped */
1727 if (escape_char_run > 0)
1728 {
1729 /* To preserve the arg exactly, we need to double the
1730 preceding escape characters (plus adding one to
1731 escape the quote character itself). */
1732 arglen += escape_char_run;
1733 }
1734 }
1735 else if (strchr (sepchars, *p) != NULL)
1736 {
1737 need_quotes = 1;
1738 }
1739
1740 if (*p == escape_char && escape_char != '"')
1741 escape_char_run++;
1742 else
1743 escape_char_run = 0;
1744 }
1745 if (need_quotes)
1746 {
1747 arglen += 2;
1748 /* handle the case where the arg ends with an escape char - we
1749 must not let the enclosing quote be escaped. */
1750 if (escape_char_run > 0)
1751 arglen += escape_char_run;
1752 }
1753 arglen += strlen (*targ++) + 1;
1754 }
1755 cmdline = alloca (arglen);
1756 targ = argv;
1757 parg = cmdline;
1758 while (*targ)
1759 {
1760 char * p = *targ;
1761 int need_quotes = 0;
1762
1763 if (*p == 0)
1764 need_quotes = 1;
1765
1766 if (do_quoting)
1767 {
1768 for ( ; *p; p++)
1769 if ((strchr (sepchars, *p) != NULL) || *p == '"')
1770 need_quotes = 1;
1771 }
1772 if (need_quotes)
1773 {
1774 int escape_char_run = 0;
1775 /* char * first; */
1776 /* char * last; */
1777
1778 p = *targ;
1779 /* first = p; */
1780 /* last = p + strlen (p) - 1; */
1781 *parg++ = '"';
1782 #if 0
1783 /* This version does not escape quotes if they occur at the
1784 beginning or end of the arg - this could lead to incorrect
1785 behavior when the arg itself represents a command line
1786 containing quoted args. I believe this was originally done
1787 as a hack to make some things work, before
1788 `w32-quote-process-args' was added. */
1789 while (*p)
1790 {
1791 if (*p == '"' && p > first && p < last)
1792 *parg++ = escape_char; /* escape embedded quotes */
1793 *parg++ = *p++;
1794 }
1795 #else
1796 for ( ; *p; p++)
1797 {
1798 if (*p == '"')
1799 {
1800 /* double preceding escape chars if any */
1801 while (escape_char_run > 0)
1802 {
1803 *parg++ = escape_char;
1804 escape_char_run--;
1805 }
1806 /* escape all quote chars, even at beginning or end */
1807 *parg++ = escape_char;
1808 }
1809 else if (escape_char == '"' && *p == '\\')
1810 *parg++ = '\\';
1811 *parg++ = *p;
1812
1813 if (*p == escape_char && escape_char != '"')
1814 escape_char_run++;
1815 else
1816 escape_char_run = 0;
1817 }
1818 /* double escape chars before enclosing quote */
1819 while (escape_char_run > 0)
1820 {
1821 *parg++ = escape_char;
1822 escape_char_run--;
1823 }
1824 #endif
1825 *parg++ = '"';
1826 }
1827 else
1828 {
1829 strcpy (parg, *targ);
1830 parg += strlen (*targ);
1831 }
1832 *parg++ = ' ';
1833 targ++;
1834 }
1835 *--parg = '\0';
1836
1837 /* and envp... */
1838 arglen = 1;
1839 targ = envp;
1840 numenv = 1; /* for end null */
1841 while (*targ)
1842 {
1843 arglen += strlen (*targ++) + 1;
1844 numenv++;
1845 }
1846 /* extra env vars... */
1847 sprintf (ppid_env_var_buffer, "EM_PARENT_PROCESS_ID=%lu",
1848 GetCurrentProcessId ());
1849 arglen += strlen (ppid_env_var_buffer) + 1;
1850 numenv++;
1851
1852 /* merge env passed in and extra env into one, and sort it. */
1853 targ = (char **) alloca (numenv * sizeof (char *));
1854 merge_and_sort_env (envp, extra_env, targ);
1855
1856 /* concatenate env entries. */
1857 env = alloca (arglen);
1858 parg = env;
1859 while (*targ)
1860 {
1861 strcpy (parg, *targ);
1862 parg += strlen (*targ++);
1863 *parg++ = '\0';
1864 }
1865 *parg++ = '\0';
1866 *parg = '\0';
1867
1868 cp = new_child ();
1869 if (cp == NULL)
1870 {
1871 errno = EAGAIN;
1872 return -1;
1873 }
1874
1875 /* Now create the process. */
1876 if (!create_child (cmdname, cmdline, env, is_gui_app, &pid, cp))
1877 {
1878 delete_child (cp);
1879 errno = ENOEXEC;
1880 return -1;
1881 }
1882
1883 return pid;
1884 }
1885
1886 /* Emulate the select call
1887 Wait for available input on any of the given rfds, or timeout if
1888 a timeout is given and no input is detected
1889 wfds and efds are not supported and must be NULL.
1890
1891 For simplicity, we detect the death of child processes here and
1892 synchronously call the SIGCHLD handler. Since it is possible for
1893 children to be created without a corresponding pipe handle from which
1894 to read output, we wait separately on the process handles as well as
1895 the char_avail events for each process pipe. We only call
1896 wait/reap_process when the process actually terminates.
1897
1898 To reduce the number of places in which Emacs can be hung such that
1899 C-g is not able to interrupt it, we always wait on interrupt_handle
1900 (which is signaled by the input thread when C-g is detected). If we
1901 detect that we were woken up by C-g, we return -1 with errno set to
1902 EINTR as on Unix. */
1903
1904 /* From w32console.c */
1905 extern HANDLE keyboard_handle;
1906
1907 /* From w32xfns.c */
1908 extern HANDLE interrupt_handle;
1909
1910 /* From process.c */
1911 extern int proc_buffered_char[];
1912
1913 int
1914 sys_select (int nfds, SELECT_TYPE *rfds, SELECT_TYPE *wfds, SELECT_TYPE *efds,
1915 struct timespec *timeout, void *ignored)
1916 {
1917 SELECT_TYPE orfds;
1918 DWORD timeout_ms, start_time;
1919 int i, nh, nc, nr;
1920 DWORD active;
1921 child_process *cp, *cps[MAX_CHILDREN];
1922 HANDLE wait_hnd[MAXDESC + MAX_CHILDREN];
1923 int fdindex[MAXDESC]; /* mapping from wait handles back to descriptors */
1924
1925 timeout_ms =
1926 timeout ? (timeout->tv_sec * 1000 + timeout->tv_nsec / 1000000) : INFINITE;
1927
1928 /* If the descriptor sets are NULL but timeout isn't, then just Sleep. */
1929 if (rfds == NULL && wfds == NULL && efds == NULL && timeout != NULL)
1930 {
1931 Sleep (timeout_ms);
1932 return 0;
1933 }
1934
1935 /* Otherwise, we only handle rfds, so fail otherwise. */
1936 if (rfds == NULL || wfds != NULL || efds != NULL)
1937 {
1938 errno = EINVAL;
1939 return -1;
1940 }
1941
1942 orfds = *rfds;
1943 FD_ZERO (rfds);
1944 nr = 0;
1945
1946 /* If interrupt_handle is available and valid, always wait on it, to
1947 detect C-g (quit). */
1948 nh = 0;
1949 if (interrupt_handle && interrupt_handle != INVALID_HANDLE_VALUE)
1950 {
1951 wait_hnd[0] = interrupt_handle;
1952 fdindex[0] = -1;
1953 nh++;
1954 }
1955
1956 /* Build a list of pipe handles to wait on. */
1957 for (i = 0; i < nfds; i++)
1958 if (FD_ISSET (i, &orfds))
1959 {
1960 if (i == 0)
1961 {
1962 if (keyboard_handle)
1963 {
1964 /* Handle stdin specially */
1965 wait_hnd[nh] = keyboard_handle;
1966 fdindex[nh] = i;
1967 nh++;
1968 }
1969
1970 /* Check for any emacs-generated input in the queue since
1971 it won't be detected in the wait */
1972 if (detect_input_pending ())
1973 {
1974 FD_SET (i, rfds);
1975 return 1;
1976 }
1977 else if (noninteractive)
1978 {
1979 if (handle_file_notifications (NULL))
1980 return 1;
1981 }
1982 }
1983 else
1984 {
1985 /* Child process and socket/comm port input. */
1986 cp = fd_info[i].cp;
1987 if (cp)
1988 {
1989 int current_status = cp->status;
1990
1991 if (current_status == STATUS_READ_ACKNOWLEDGED)
1992 {
1993 /* Tell reader thread which file handle to use. */
1994 cp->fd = i;
1995 /* Wake up the reader thread for this process */
1996 cp->status = STATUS_READ_READY;
1997 if (!SetEvent (cp->char_consumed))
1998 DebPrint (("sys_select.SetEvent failed with "
1999 "%lu for fd %ld\n", GetLastError (), i));
2000 }
2001
2002 #ifdef CHECK_INTERLOCK
2003 /* slightly crude cross-checking of interlock between threads */
2004
2005 current_status = cp->status;
2006 if (WaitForSingleObject (cp->char_avail, 0) == WAIT_OBJECT_0)
2007 {
2008 /* char_avail has been signaled, so status (which may
2009 have changed) should indicate read has completed
2010 but has not been acknowledged. */
2011 current_status = cp->status;
2012 if (current_status != STATUS_READ_SUCCEEDED
2013 && current_status != STATUS_READ_FAILED)
2014 DebPrint (("char_avail set, but read not completed: status %d\n",
2015 current_status));
2016 }
2017 else
2018 {
2019 /* char_avail has not been signaled, so status should
2020 indicate that read is in progress; small possibility
2021 that read has completed but event wasn't yet signaled
2022 when we tested it (because a context switch occurred
2023 or if running on separate CPUs). */
2024 if (current_status != STATUS_READ_READY
2025 && current_status != STATUS_READ_IN_PROGRESS
2026 && current_status != STATUS_READ_SUCCEEDED
2027 && current_status != STATUS_READ_FAILED)
2028 DebPrint (("char_avail reset, but read status is bad: %d\n",
2029 current_status));
2030 }
2031 #endif
2032 wait_hnd[nh] = cp->char_avail;
2033 fdindex[nh] = i;
2034 if (!wait_hnd[nh]) emacs_abort ();
2035 nh++;
2036 #ifdef FULL_DEBUG
2037 DebPrint (("select waiting on child %d fd %d\n",
2038 cp-child_procs, i));
2039 #endif
2040 }
2041 else
2042 {
2043 /* Unable to find something to wait on for this fd, skip */
2044
2045 /* Note that this is not a fatal error, and can in fact
2046 happen in unusual circumstances. Specifically, if
2047 sys_spawnve fails, eg. because the program doesn't
2048 exist, and debug-on-error is t so Fsignal invokes a
2049 nested input loop, then the process output pipe is
2050 still included in input_wait_mask with no child_proc
2051 associated with it. (It is removed when the debugger
2052 exits the nested input loop and the error is thrown.) */
2053
2054 DebPrint (("sys_select: fd %ld is invalid! ignoring\n", i));
2055 }
2056 }
2057 }
2058
2059 count_children:
2060 /* Add handles of child processes. */
2061 nc = 0;
2062 for (cp = child_procs + (child_proc_count-1); cp >= child_procs; cp--)
2063 /* Some child_procs might be sockets; ignore them. Also some
2064 children may have died already, but we haven't finished reading
2065 the process output; ignore them too. */
2066 if ((CHILD_ACTIVE (cp) && cp->procinfo.hProcess)
2067 && (cp->fd < 0
2068 || (fd_info[cp->fd].flags & FILE_SEND_SIGCHLD) == 0
2069 || (fd_info[cp->fd].flags & FILE_AT_EOF) != 0)
2070 )
2071 {
2072 wait_hnd[nh + nc] = cp->procinfo.hProcess;
2073 cps[nc] = cp;
2074 nc++;
2075 }
2076
2077 /* Nothing to look for, so we didn't find anything */
2078 if (nh + nc == 0)
2079 {
2080 if (timeout)
2081 Sleep (timeout_ms);
2082 if (noninteractive)
2083 {
2084 if (handle_file_notifications (NULL))
2085 return 1;
2086 }
2087 return 0;
2088 }
2089
2090 start_time = GetTickCount ();
2091
2092 /* Wait for input or child death to be signaled. If user input is
2093 allowed, then also accept window messages. */
2094 if (FD_ISSET (0, &orfds))
2095 active = MsgWaitForMultipleObjects (nh + nc, wait_hnd, FALSE, timeout_ms,
2096 QS_ALLINPUT);
2097 else
2098 active = WaitForMultipleObjects (nh + nc, wait_hnd, FALSE, timeout_ms);
2099
2100 if (active == WAIT_FAILED)
2101 {
2102 DebPrint (("select.WaitForMultipleObjects (%d, %lu) failed with %lu\n",
2103 nh + nc, timeout_ms, GetLastError ()));
2104 /* don't return EBADF - this causes wait_reading_process_output to
2105 abort; WAIT_FAILED is returned when single-stepping under
2106 Windows 95 after switching thread focus in debugger, and
2107 possibly at other times. */
2108 errno = EINTR;
2109 return -1;
2110 }
2111 else if (active == WAIT_TIMEOUT)
2112 {
2113 if (noninteractive)
2114 {
2115 if (handle_file_notifications (NULL))
2116 return 1;
2117 }
2118 return 0;
2119 }
2120 else if (active >= WAIT_OBJECT_0
2121 && active < WAIT_OBJECT_0+MAXIMUM_WAIT_OBJECTS)
2122 {
2123 active -= WAIT_OBJECT_0;
2124 }
2125 else if (active >= WAIT_ABANDONED_0
2126 && active < WAIT_ABANDONED_0+MAXIMUM_WAIT_OBJECTS)
2127 {
2128 active -= WAIT_ABANDONED_0;
2129 }
2130 else
2131 emacs_abort ();
2132
2133 /* Loop over all handles after active (now officially documented as
2134 being the first signaled handle in the array). We do this to
2135 ensure fairness, so that all channels with data available will be
2136 processed - otherwise higher numbered channels could be starved. */
2137 do
2138 {
2139 if (active == nh + nc)
2140 {
2141 /* There are messages in the lisp thread's queue; we must
2142 drain the queue now to ensure they are processed promptly,
2143 because if we don't do so, we will not be woken again until
2144 further messages arrive.
2145
2146 NB. If ever we allow window message procedures to callback
2147 into lisp, we will need to ensure messages are dispatched
2148 at a safe time for lisp code to be run (*), and we may also
2149 want to provide some hooks in the dispatch loop to cater
2150 for modeless dialogs created by lisp (ie. to register
2151 window handles to pass to IsDialogMessage).
2152
2153 (*) Note that MsgWaitForMultipleObjects above is an
2154 internal dispatch point for messages that are sent to
2155 windows created by this thread. */
2156 if (drain_message_queue ()
2157 /* If drain_message_queue returns non-zero, that means
2158 we received a WM_EMACS_FILENOTIFY message. If this
2159 is a TTY frame, we must signal the caller that keyboard
2160 input is available, so that w32_console_read_socket
2161 will be called to pick up the notifications. If we
2162 don't do that, file notifications will only work when
2163 the Emacs TTY frame has focus. */
2164 && FRAME_TERMCAP_P (SELECTED_FRAME ())
2165 /* they asked for stdin reads */
2166 && FD_ISSET (0, &orfds)
2167 /* the stdin handle is valid */
2168 && keyboard_handle)
2169 {
2170 FD_SET (0, rfds);
2171 if (nr == 0)
2172 nr = 1;
2173 }
2174 }
2175 else if (active >= nh)
2176 {
2177 cp = cps[active - nh];
2178
2179 /* We cannot always signal SIGCHLD immediately; if we have not
2180 finished reading the process output, we must delay sending
2181 SIGCHLD until we do. */
2182
2183 if (cp->fd >= 0 && (fd_info[cp->fd].flags & FILE_AT_EOF) == 0)
2184 fd_info[cp->fd].flags |= FILE_SEND_SIGCHLD;
2185 /* SIG_DFL for SIGCHLD is ignore */
2186 else if (sig_handlers[SIGCHLD] != SIG_DFL &&
2187 sig_handlers[SIGCHLD] != SIG_IGN)
2188 {
2189 #ifdef FULL_DEBUG
2190 DebPrint (("select calling SIGCHLD handler for pid %d\n",
2191 cp->pid));
2192 #endif
2193 sig_handlers[SIGCHLD] (SIGCHLD);
2194 }
2195 }
2196 else if (fdindex[active] == -1)
2197 {
2198 /* Quit (C-g) was detected. */
2199 errno = EINTR;
2200 return -1;
2201 }
2202 else if (fdindex[active] == 0)
2203 {
2204 /* Keyboard input available */
2205 FD_SET (0, rfds);
2206 nr++;
2207 }
2208 else
2209 {
2210 /* must be a socket or pipe - read ahead should have
2211 completed, either succeeding or failing. */
2212 FD_SET (fdindex[active], rfds);
2213 nr++;
2214 }
2215
2216 /* Even though wait_reading_process_output only reads from at most
2217 one channel, we must process all channels here so that we reap
2218 all children that have died. */
2219 while (++active < nh + nc)
2220 if (WaitForSingleObject (wait_hnd[active], 0) == WAIT_OBJECT_0)
2221 break;
2222 } while (active < nh + nc);
2223
2224 if (noninteractive)
2225 {
2226 if (handle_file_notifications (NULL))
2227 nr++;
2228 }
2229
2230 /* If no input has arrived and timeout hasn't expired, wait again. */
2231 if (nr == 0)
2232 {
2233 DWORD elapsed = GetTickCount () - start_time;
2234
2235 if (timeout_ms > elapsed) /* INFINITE is MAX_UINT */
2236 {
2237 if (timeout_ms != INFINITE)
2238 timeout_ms -= elapsed;
2239 goto count_children;
2240 }
2241 }
2242
2243 return nr;
2244 }
2245
2246 /* Substitute for certain kill () operations */
2247
2248 static BOOL CALLBACK
2249 find_child_console (HWND hwnd, LPARAM arg)
2250 {
2251 child_process * cp = (child_process *) arg;
2252 DWORD process_id;
2253
2254 GetWindowThreadProcessId (hwnd, &process_id);
2255 if (process_id == cp->procinfo.dwProcessId)
2256 {
2257 char window_class[32];
2258
2259 GetClassName (hwnd, window_class, sizeof (window_class));
2260 if (strcmp (window_class,
2261 (os_subtype == OS_9X)
2262 ? "tty"
2263 : "ConsoleWindowClass") == 0)
2264 {
2265 cp->hwnd = hwnd;
2266 return FALSE;
2267 }
2268 }
2269 /* keep looking */
2270 return TRUE;
2271 }
2272
2273 /* Emulate 'kill', but only for other processes. */
2274 int
2275 sys_kill (pid_t pid, int sig)
2276 {
2277 child_process *cp;
2278 HANDLE proc_hand;
2279 int need_to_free = 0;
2280 int rc = 0;
2281
2282 /* Each process is in its own process group. */
2283 if (pid < 0)
2284 pid = -pid;
2285
2286 /* Only handle signals that will result in the process dying */
2287 if (sig != 0
2288 && sig != SIGINT && sig != SIGKILL && sig != SIGQUIT && sig != SIGHUP)
2289 {
2290 errno = EINVAL;
2291 return -1;
2292 }
2293
2294 if (sig == 0)
2295 {
2296 /* It will take _some_ time before PID 4 or less on Windows will
2297 be Emacs... */
2298 if (pid <= 4)
2299 {
2300 errno = EPERM;
2301 return -1;
2302 }
2303 proc_hand = OpenProcess (PROCESS_QUERY_INFORMATION, 0, pid);
2304 if (proc_hand == NULL)
2305 {
2306 DWORD err = GetLastError ();
2307
2308 switch (err)
2309 {
2310 case ERROR_ACCESS_DENIED: /* existing process, but access denied */
2311 errno = EPERM;
2312 return -1;
2313 case ERROR_INVALID_PARAMETER: /* process PID does not exist */
2314 errno = ESRCH;
2315 return -1;
2316 }
2317 }
2318 else
2319 CloseHandle (proc_hand);
2320 return 0;
2321 }
2322
2323 cp = find_child_pid (pid);
2324 if (cp == NULL)
2325 {
2326 /* We were passed a PID of something other than our subprocess.
2327 If that is our own PID, we will send to ourself a message to
2328 close the selected frame, which does not necessarily
2329 terminates Emacs. But then we are not supposed to call
2330 sys_kill with our own PID. */
2331 proc_hand = OpenProcess (PROCESS_TERMINATE, 0, pid);
2332 if (proc_hand == NULL)
2333 {
2334 errno = EPERM;
2335 return -1;
2336 }
2337 need_to_free = 1;
2338 }
2339 else
2340 {
2341 proc_hand = cp->procinfo.hProcess;
2342 pid = cp->procinfo.dwProcessId;
2343
2344 /* Try to locate console window for process. */
2345 EnumWindows (find_child_console, (LPARAM) cp);
2346 }
2347
2348 if (sig == SIGINT || sig == SIGQUIT)
2349 {
2350 if (NILP (Vw32_start_process_share_console) && cp && cp->hwnd)
2351 {
2352 BYTE control_scan_code = (BYTE) MapVirtualKey (VK_CONTROL, 0);
2353 /* Fake Ctrl-C for SIGINT, and Ctrl-Break for SIGQUIT. */
2354 BYTE vk_break_code = (sig == SIGINT) ? 'C' : VK_CANCEL;
2355 BYTE break_scan_code = (BYTE) MapVirtualKey (vk_break_code, 0);
2356 HWND foreground_window;
2357
2358 if (break_scan_code == 0)
2359 {
2360 /* Fake Ctrl-C for SIGQUIT if we can't manage Ctrl-Break. */
2361 vk_break_code = 'C';
2362 break_scan_code = (BYTE) MapVirtualKey (vk_break_code, 0);
2363 }
2364
2365 foreground_window = GetForegroundWindow ();
2366 if (foreground_window)
2367 {
2368 /* NT 5.0, and apparently also Windows 98, will not allow
2369 a Window to be set to foreground directly without the
2370 user's involvement. The workaround is to attach
2371 ourselves to the thread that owns the foreground
2372 window, since that is the only thread that can set the
2373 foreground window. */
2374 DWORD foreground_thread, child_thread;
2375 foreground_thread =
2376 GetWindowThreadProcessId (foreground_window, NULL);
2377 if (foreground_thread == GetCurrentThreadId ()
2378 || !AttachThreadInput (GetCurrentThreadId (),
2379 foreground_thread, TRUE))
2380 foreground_thread = 0;
2381
2382 child_thread = GetWindowThreadProcessId (cp->hwnd, NULL);
2383 if (child_thread == GetCurrentThreadId ()
2384 || !AttachThreadInput (GetCurrentThreadId (),
2385 child_thread, TRUE))
2386 child_thread = 0;
2387
2388 /* Set the foreground window to the child. */
2389 if (SetForegroundWindow (cp->hwnd))
2390 {
2391 /* Generate keystrokes as if user had typed Ctrl-Break or
2392 Ctrl-C. */
2393 keybd_event (VK_CONTROL, control_scan_code, 0, 0);
2394 keybd_event (vk_break_code, break_scan_code,
2395 (vk_break_code == 'C' ? 0 : KEYEVENTF_EXTENDEDKEY), 0);
2396 keybd_event (vk_break_code, break_scan_code,
2397 (vk_break_code == 'C' ? 0 : KEYEVENTF_EXTENDEDKEY)
2398 | KEYEVENTF_KEYUP, 0);
2399 keybd_event (VK_CONTROL, control_scan_code,
2400 KEYEVENTF_KEYUP, 0);
2401
2402 /* Sleep for a bit to give time for Emacs frame to respond
2403 to focus change events (if Emacs was active app). */
2404 Sleep (100);
2405
2406 SetForegroundWindow (foreground_window);
2407 }
2408 /* Detach from the foreground and child threads now that
2409 the foreground switching is over. */
2410 if (foreground_thread)
2411 AttachThreadInput (GetCurrentThreadId (),
2412 foreground_thread, FALSE);
2413 if (child_thread)
2414 AttachThreadInput (GetCurrentThreadId (),
2415 child_thread, FALSE);
2416 }
2417 }
2418 /* Ctrl-Break is NT equivalent of SIGINT. */
2419 else if (!GenerateConsoleCtrlEvent (CTRL_BREAK_EVENT, pid))
2420 {
2421 DebPrint (("sys_kill.GenerateConsoleCtrlEvent return %d "
2422 "for pid %lu\n", GetLastError (), pid));
2423 errno = EINVAL;
2424 rc = -1;
2425 }
2426 }
2427 else
2428 {
2429 if (NILP (Vw32_start_process_share_console) && cp && cp->hwnd)
2430 {
2431 #if 1
2432 if (os_subtype == OS_9X)
2433 {
2434 /*
2435 Another possibility is to try terminating the VDM out-right by
2436 calling the Shell VxD (id 0x17) V86 interface, function #4
2437 "SHELL_Destroy_VM", ie.
2438
2439 mov edx,4
2440 mov ebx,vm_handle
2441 call shellapi
2442
2443 First need to determine the current VM handle, and then arrange for
2444 the shellapi call to be made from the system vm (by using
2445 Switch_VM_and_callback).
2446
2447 Could try to invoke DestroyVM through CallVxD.
2448
2449 */
2450 #if 0
2451 /* On Windows 95, posting WM_QUIT causes the 16-bit subsystem
2452 to hang when cmdproxy is used in conjunction with
2453 command.com for an interactive shell. Posting
2454 WM_CLOSE pops up a dialog that, when Yes is selected,
2455 does the same thing. TerminateProcess is also less
2456 than ideal in that subprocesses tend to stick around
2457 until the machine is shutdown, but at least it
2458 doesn't freeze the 16-bit subsystem. */
2459 PostMessage (cp->hwnd, WM_QUIT, 0xff, 0);
2460 #endif
2461 if (!TerminateProcess (proc_hand, 0xff))
2462 {
2463 DebPrint (("sys_kill.TerminateProcess returned %d "
2464 "for pid %lu\n", GetLastError (), pid));
2465 errno = EINVAL;
2466 rc = -1;
2467 }
2468 }
2469 else
2470 #endif
2471 PostMessage (cp->hwnd, WM_CLOSE, 0, 0);
2472 }
2473 /* Kill the process. On W32 this doesn't kill child processes
2474 so it doesn't work very well for shells which is why it's not
2475 used in every case. */
2476 else if (!TerminateProcess (proc_hand, 0xff))
2477 {
2478 DebPrint (("sys_kill.TerminateProcess returned %d "
2479 "for pid %lu\n", GetLastError (), pid));
2480 errno = EINVAL;
2481 rc = -1;
2482 }
2483 }
2484
2485 if (need_to_free)
2486 CloseHandle (proc_hand);
2487
2488 return rc;
2489 }
2490
2491 /* The following two routines are used to manipulate stdin, stdout, and
2492 stderr of our child processes.
2493
2494 Assuming that in, out, and err are *not* inheritable, we make them
2495 stdin, stdout, and stderr of the child as follows:
2496
2497 - Save the parent's current standard handles.
2498 - Set the std handles to inheritable duplicates of the ones being passed in.
2499 (Note that _get_osfhandle() is an io.h procedure that retrieves the
2500 NT file handle for a crt file descriptor.)
2501 - Spawn the child, which inherits in, out, and err as stdin,
2502 stdout, and stderr. (see Spawnve)
2503 - Close the std handles passed to the child.
2504 - Reset the parent's standard handles to the saved handles.
2505 (see reset_standard_handles)
2506 We assume that the caller closes in, out, and err after calling us. */
2507
2508 void
2509 prepare_standard_handles (int in, int out, int err, HANDLE handles[3])
2510 {
2511 HANDLE parent;
2512 HANDLE newstdin, newstdout, newstderr;
2513
2514 parent = GetCurrentProcess ();
2515
2516 handles[0] = GetStdHandle (STD_INPUT_HANDLE);
2517 handles[1] = GetStdHandle (STD_OUTPUT_HANDLE);
2518 handles[2] = GetStdHandle (STD_ERROR_HANDLE);
2519
2520 /* make inheritable copies of the new handles */
2521 if (!DuplicateHandle (parent,
2522 (HANDLE) _get_osfhandle (in),
2523 parent,
2524 &newstdin,
2525 0,
2526 TRUE,
2527 DUPLICATE_SAME_ACCESS))
2528 report_file_error ("Duplicating input handle for child", Qnil);
2529
2530 if (!DuplicateHandle (parent,
2531 (HANDLE) _get_osfhandle (out),
2532 parent,
2533 &newstdout,
2534 0,
2535 TRUE,
2536 DUPLICATE_SAME_ACCESS))
2537 report_file_error ("Duplicating output handle for child", Qnil);
2538
2539 if (!DuplicateHandle (parent,
2540 (HANDLE) _get_osfhandle (err),
2541 parent,
2542 &newstderr,
2543 0,
2544 TRUE,
2545 DUPLICATE_SAME_ACCESS))
2546 report_file_error ("Duplicating error handle for child", Qnil);
2547
2548 /* and store them as our std handles */
2549 if (!SetStdHandle (STD_INPUT_HANDLE, newstdin))
2550 report_file_error ("Changing stdin handle", Qnil);
2551
2552 if (!SetStdHandle (STD_OUTPUT_HANDLE, newstdout))
2553 report_file_error ("Changing stdout handle", Qnil);
2554
2555 if (!SetStdHandle (STD_ERROR_HANDLE, newstderr))
2556 report_file_error ("Changing stderr handle", Qnil);
2557 }
2558
2559 void
2560 reset_standard_handles (int in, int out, int err, HANDLE handles[3])
2561 {
2562 /* close the duplicated handles passed to the child */
2563 CloseHandle (GetStdHandle (STD_INPUT_HANDLE));
2564 CloseHandle (GetStdHandle (STD_OUTPUT_HANDLE));
2565 CloseHandle (GetStdHandle (STD_ERROR_HANDLE));
2566
2567 /* now restore parent's saved std handles */
2568 SetStdHandle (STD_INPUT_HANDLE, handles[0]);
2569 SetStdHandle (STD_OUTPUT_HANDLE, handles[1]);
2570 SetStdHandle (STD_ERROR_HANDLE, handles[2]);
2571 }
2572
2573 void
2574 set_process_dir (char * dir)
2575 {
2576 process_dir = dir;
2577 }
2578
2579 /* To avoid problems with winsock implementations that work over dial-up
2580 connections causing or requiring a connection to exist while Emacs is
2581 running, Emacs no longer automatically loads winsock on startup if it
2582 is present. Instead, it will be loaded when open-network-stream is
2583 first called.
2584
2585 To allow full control over when winsock is loaded, we provide these
2586 two functions to dynamically load and unload winsock. This allows
2587 dial-up users to only be connected when they actually need to use
2588 socket services. */
2589
2590 /* From w32.c */
2591 extern HANDLE winsock_lib;
2592 extern BOOL term_winsock (void);
2593 extern BOOL init_winsock (int load_now);
2594
2595 DEFUN ("w32-has-winsock", Fw32_has_winsock, Sw32_has_winsock, 0, 1, 0,
2596 doc: /* Test for presence of the Windows socket library `winsock'.
2597 Returns non-nil if winsock support is present, nil otherwise.
2598
2599 If the optional argument LOAD-NOW is non-nil, the winsock library is
2600 also loaded immediately if not already loaded. If winsock is loaded,
2601 the winsock local hostname is returned (since this may be different from
2602 the value of `system-name' and should supplant it), otherwise t is
2603 returned to indicate winsock support is present. */)
2604 (Lisp_Object load_now)
2605 {
2606 int have_winsock;
2607
2608 have_winsock = init_winsock (!NILP (load_now));
2609 if (have_winsock)
2610 {
2611 if (winsock_lib != NULL)
2612 {
2613 /* Return new value for system-name. The best way to do this
2614 is to call init_system_name, saving and restoring the
2615 original value to avoid side-effects. */
2616 Lisp_Object orig_hostname = Vsystem_name;
2617 Lisp_Object hostname;
2618
2619 init_system_name ();
2620 hostname = Vsystem_name;
2621 Vsystem_name = orig_hostname;
2622 return hostname;
2623 }
2624 return Qt;
2625 }
2626 return Qnil;
2627 }
2628
2629 DEFUN ("w32-unload-winsock", Fw32_unload_winsock, Sw32_unload_winsock,
2630 0, 0, 0,
2631 doc: /* Unload the Windows socket library `winsock' if loaded.
2632 This is provided to allow dial-up socket connections to be disconnected
2633 when no longer needed. Returns nil without unloading winsock if any
2634 socket connections still exist. */)
2635 (void)
2636 {
2637 return term_winsock () ? Qt : Qnil;
2638 }
2639
2640 \f
2641 /* Some miscellaneous functions that are Windows specific, but not GUI
2642 specific (ie. are applicable in terminal or batch mode as well). */
2643
2644 DEFUN ("w32-short-file-name", Fw32_short_file_name, Sw32_short_file_name, 1, 1, 0,
2645 doc: /* Return the short file name version (8.3) of the full path of FILENAME.
2646 If FILENAME does not exist, return nil.
2647 All path elements in FILENAME are converted to their short names. */)
2648 (Lisp_Object filename)
2649 {
2650 char shortname[MAX_PATH];
2651
2652 CHECK_STRING (filename);
2653
2654 /* first expand it. */
2655 filename = Fexpand_file_name (filename, Qnil);
2656
2657 /* luckily, this returns the short version of each element in the path. */
2658 if (w32_get_short_filename (SDATA (ENCODE_FILE (filename)),
2659 shortname, MAX_PATH) == 0)
2660 return Qnil;
2661
2662 dostounix_filename (shortname);
2663
2664 /* No need to DECODE_FILE, because 8.3 names are pure ASCII. */
2665 return build_string (shortname);
2666 }
2667
2668
2669 DEFUN ("w32-long-file-name", Fw32_long_file_name, Sw32_long_file_name,
2670 1, 1, 0,
2671 doc: /* Return the long file name version of the full path of FILENAME.
2672 If FILENAME does not exist, return nil.
2673 All path elements in FILENAME are converted to their long names. */)
2674 (Lisp_Object filename)
2675 {
2676 char longname[ MAX_UTF8_PATH ];
2677 int drive_only = 0;
2678
2679 CHECK_STRING (filename);
2680
2681 if (SBYTES (filename) == 2
2682 && *(SDATA (filename) + 1) == ':')
2683 drive_only = 1;
2684
2685 /* first expand it. */
2686 filename = Fexpand_file_name (filename, Qnil);
2687
2688 if (!w32_get_long_filename (SDATA (ENCODE_FILE (filename)), longname,
2689 MAX_UTF8_PATH))
2690 return Qnil;
2691
2692 dostounix_filename (longname);
2693
2694 /* If we were passed only a drive, make sure that a slash is not appended
2695 for consistency with directories. Allow for drive mapping via SUBST
2696 in case expand-file-name is ever changed to expand those. */
2697 if (drive_only && longname[1] == ':' && longname[2] == '/' && !longname[3])
2698 longname[2] = '\0';
2699
2700 return DECODE_FILE (build_unibyte_string (longname));
2701 }
2702
2703 DEFUN ("w32-set-process-priority", Fw32_set_process_priority,
2704 Sw32_set_process_priority, 2, 2, 0,
2705 doc: /* Set the priority of PROCESS to PRIORITY.
2706 If PROCESS is nil, the priority of Emacs is changed, otherwise the
2707 priority of the process whose pid is PROCESS is changed.
2708 PRIORITY should be one of the symbols high, normal, or low;
2709 any other symbol will be interpreted as normal.
2710
2711 If successful, the return value is t, otherwise nil. */)
2712 (Lisp_Object process, Lisp_Object priority)
2713 {
2714 HANDLE proc_handle = GetCurrentProcess ();
2715 DWORD priority_class = NORMAL_PRIORITY_CLASS;
2716 Lisp_Object result = Qnil;
2717
2718 CHECK_SYMBOL (priority);
2719
2720 if (!NILP (process))
2721 {
2722 DWORD pid;
2723 child_process *cp;
2724
2725 CHECK_NUMBER (process);
2726
2727 /* Allow pid to be an internally generated one, or one obtained
2728 externally. This is necessary because real pids on Windows 95 are
2729 negative. */
2730
2731 pid = XINT (process);
2732 cp = find_child_pid (pid);
2733 if (cp != NULL)
2734 pid = cp->procinfo.dwProcessId;
2735
2736 proc_handle = OpenProcess (PROCESS_SET_INFORMATION, FALSE, pid);
2737 }
2738
2739 if (EQ (priority, Qhigh))
2740 priority_class = HIGH_PRIORITY_CLASS;
2741 else if (EQ (priority, Qlow))
2742 priority_class = IDLE_PRIORITY_CLASS;
2743
2744 if (proc_handle != NULL)
2745 {
2746 if (SetPriorityClass (proc_handle, priority_class))
2747 result = Qt;
2748 if (!NILP (process))
2749 CloseHandle (proc_handle);
2750 }
2751
2752 return result;
2753 }
2754
2755 #ifdef HAVE_LANGINFO_CODESET
2756 /* Emulation of nl_langinfo. Used in fns.c:Flocale_info. */
2757 char *
2758 nl_langinfo (nl_item item)
2759 {
2760 /* Conversion of Posix item numbers to their Windows equivalents. */
2761 static const LCTYPE w32item[] = {
2762 LOCALE_IDEFAULTANSICODEPAGE,
2763 LOCALE_SDAYNAME1, LOCALE_SDAYNAME2, LOCALE_SDAYNAME3,
2764 LOCALE_SDAYNAME4, LOCALE_SDAYNAME5, LOCALE_SDAYNAME6, LOCALE_SDAYNAME7,
2765 LOCALE_SMONTHNAME1, LOCALE_SMONTHNAME2, LOCALE_SMONTHNAME3,
2766 LOCALE_SMONTHNAME4, LOCALE_SMONTHNAME5, LOCALE_SMONTHNAME6,
2767 LOCALE_SMONTHNAME7, LOCALE_SMONTHNAME8, LOCALE_SMONTHNAME9,
2768 LOCALE_SMONTHNAME10, LOCALE_SMONTHNAME11, LOCALE_SMONTHNAME12
2769 };
2770
2771 static char *nl_langinfo_buf = NULL;
2772 static int nl_langinfo_len = 0;
2773
2774 if (nl_langinfo_len <= 0)
2775 nl_langinfo_buf = xmalloc (nl_langinfo_len = 1);
2776
2777 if (item < 0 || item >= _NL_NUM)
2778 nl_langinfo_buf[0] = 0;
2779 else
2780 {
2781 LCID cloc = GetThreadLocale ();
2782 int need_len = GetLocaleInfo (cloc, w32item[item] | LOCALE_USE_CP_ACP,
2783 NULL, 0);
2784
2785 if (need_len <= 0)
2786 nl_langinfo_buf[0] = 0;
2787 else
2788 {
2789 if (item == CODESET)
2790 {
2791 need_len += 2; /* for the "cp" prefix */
2792 if (need_len < 8) /* for the case we call GetACP */
2793 need_len = 8;
2794 }
2795 if (nl_langinfo_len <= need_len)
2796 nl_langinfo_buf = xrealloc (nl_langinfo_buf,
2797 nl_langinfo_len = need_len);
2798 if (!GetLocaleInfo (cloc, w32item[item] | LOCALE_USE_CP_ACP,
2799 nl_langinfo_buf, nl_langinfo_len))
2800 nl_langinfo_buf[0] = 0;
2801 else if (item == CODESET)
2802 {
2803 if (strcmp (nl_langinfo_buf, "0") == 0 /* CP_ACP */
2804 || strcmp (nl_langinfo_buf, "1") == 0) /* CP_OEMCP */
2805 sprintf (nl_langinfo_buf, "cp%u", GetACP ());
2806 else
2807 {
2808 memmove (nl_langinfo_buf + 2, nl_langinfo_buf,
2809 strlen (nl_langinfo_buf) + 1);
2810 nl_langinfo_buf[0] = 'c';
2811 nl_langinfo_buf[1] = 'p';
2812 }
2813 }
2814 }
2815 }
2816 return nl_langinfo_buf;
2817 }
2818 #endif /* HAVE_LANGINFO_CODESET */
2819
2820 DEFUN ("w32-get-locale-info", Fw32_get_locale_info,
2821 Sw32_get_locale_info, 1, 2, 0,
2822 doc: /* Return information about the Windows locale LCID.
2823 By default, return a three letter locale code which encodes the default
2824 language as the first two characters, and the country or regional variant
2825 as the third letter. For example, ENU refers to `English (United States)',
2826 while ENC means `English (Canadian)'.
2827
2828 If the optional argument LONGFORM is t, the long form of the locale
2829 name is returned, e.g. `English (United States)' instead; if LONGFORM
2830 is a number, it is interpreted as an LCTYPE constant and the corresponding
2831 locale information is returned.
2832
2833 If LCID (a 16-bit number) is not a valid locale, the result is nil. */)
2834 (Lisp_Object lcid, Lisp_Object longform)
2835 {
2836 int got_abbrev;
2837 int got_full;
2838 char abbrev_name[32] = { 0 };
2839 char full_name[256] = { 0 };
2840
2841 CHECK_NUMBER (lcid);
2842
2843 if (!IsValidLocale (XINT (lcid), LCID_SUPPORTED))
2844 return Qnil;
2845
2846 if (NILP (longform))
2847 {
2848 got_abbrev = GetLocaleInfo (XINT (lcid),
2849 LOCALE_SABBREVLANGNAME | LOCALE_USE_CP_ACP,
2850 abbrev_name, sizeof (abbrev_name));
2851 if (got_abbrev)
2852 return build_string (abbrev_name);
2853 }
2854 else if (EQ (longform, Qt))
2855 {
2856 got_full = GetLocaleInfo (XINT (lcid),
2857 LOCALE_SLANGUAGE | LOCALE_USE_CP_ACP,
2858 full_name, sizeof (full_name));
2859 if (got_full)
2860 return DECODE_SYSTEM (build_string (full_name));
2861 }
2862 else if (NUMBERP (longform))
2863 {
2864 got_full = GetLocaleInfo (XINT (lcid),
2865 XINT (longform),
2866 full_name, sizeof (full_name));
2867 /* GetLocaleInfo's return value includes the terminating null
2868 character, when the returned information is a string, whereas
2869 make_unibyte_string needs the string length without the
2870 terminating null. */
2871 if (got_full)
2872 return make_unibyte_string (full_name, got_full - 1);
2873 }
2874
2875 return Qnil;
2876 }
2877
2878
2879 DEFUN ("w32-get-current-locale-id", Fw32_get_current_locale_id,
2880 Sw32_get_current_locale_id, 0, 0, 0,
2881 doc: /* Return Windows locale id for current locale setting.
2882 This is a numerical value; use `w32-get-locale-info' to convert to a
2883 human-readable form. */)
2884 (void)
2885 {
2886 return make_number (GetThreadLocale ());
2887 }
2888
2889 static DWORD
2890 int_from_hex (char * s)
2891 {
2892 DWORD val = 0;
2893 static char hex[] = "0123456789abcdefABCDEF";
2894 char * p;
2895
2896 while (*s && (p = strchr (hex, *s)) != NULL)
2897 {
2898 unsigned digit = p - hex;
2899 if (digit > 15)
2900 digit -= 6;
2901 val = val * 16 + digit;
2902 s++;
2903 }
2904 return val;
2905 }
2906
2907 /* We need to build a global list, since the EnumSystemLocale callback
2908 function isn't given a context pointer. */
2909 Lisp_Object Vw32_valid_locale_ids;
2910
2911 static BOOL CALLBACK
2912 enum_locale_fn (LPTSTR localeNum)
2913 {
2914 DWORD id = int_from_hex (localeNum);
2915 Vw32_valid_locale_ids = Fcons (make_number (id), Vw32_valid_locale_ids);
2916 return TRUE;
2917 }
2918
2919 DEFUN ("w32-get-valid-locale-ids", Fw32_get_valid_locale_ids,
2920 Sw32_get_valid_locale_ids, 0, 0, 0,
2921 doc: /* Return list of all valid Windows locale ids.
2922 Each id is a numerical value; use `w32-get-locale-info' to convert to a
2923 human-readable form. */)
2924 (void)
2925 {
2926 Vw32_valid_locale_ids = Qnil;
2927
2928 EnumSystemLocales (enum_locale_fn, LCID_SUPPORTED);
2929
2930 Vw32_valid_locale_ids = Fnreverse (Vw32_valid_locale_ids);
2931 return Vw32_valid_locale_ids;
2932 }
2933
2934
2935 DEFUN ("w32-get-default-locale-id", Fw32_get_default_locale_id, Sw32_get_default_locale_id, 0, 1, 0,
2936 doc: /* Return Windows locale id for default locale setting.
2937 By default, the system default locale setting is returned; if the optional
2938 parameter USERP is non-nil, the user default locale setting is returned.
2939 This is a numerical value; use `w32-get-locale-info' to convert to a
2940 human-readable form. */)
2941 (Lisp_Object userp)
2942 {
2943 if (NILP (userp))
2944 return make_number (GetSystemDefaultLCID ());
2945 return make_number (GetUserDefaultLCID ());
2946 }
2947
2948
2949 DEFUN ("w32-set-current-locale", Fw32_set_current_locale, Sw32_set_current_locale, 1, 1, 0,
2950 doc: /* Make Windows locale LCID be the current locale setting for Emacs.
2951 If successful, the new locale id is returned, otherwise nil. */)
2952 (Lisp_Object lcid)
2953 {
2954 CHECK_NUMBER (lcid);
2955
2956 if (!IsValidLocale (XINT (lcid), LCID_SUPPORTED))
2957 return Qnil;
2958
2959 if (!SetThreadLocale (XINT (lcid)))
2960 return Qnil;
2961
2962 /* Need to set input thread locale if present. */
2963 if (dwWindowsThreadId)
2964 /* Reply is not needed. */
2965 PostThreadMessage (dwWindowsThreadId, WM_EMACS_SETLOCALE, XINT (lcid), 0);
2966
2967 return make_number (GetThreadLocale ());
2968 }
2969
2970
2971 /* We need to build a global list, since the EnumCodePages callback
2972 function isn't given a context pointer. */
2973 Lisp_Object Vw32_valid_codepages;
2974
2975 static BOOL CALLBACK
2976 enum_codepage_fn (LPTSTR codepageNum)
2977 {
2978 DWORD id = atoi (codepageNum);
2979 Vw32_valid_codepages = Fcons (make_number (id), Vw32_valid_codepages);
2980 return TRUE;
2981 }
2982
2983 DEFUN ("w32-get-valid-codepages", Fw32_get_valid_codepages,
2984 Sw32_get_valid_codepages, 0, 0, 0,
2985 doc: /* Return list of all valid Windows codepages. */)
2986 (void)
2987 {
2988 Vw32_valid_codepages = Qnil;
2989
2990 EnumSystemCodePages (enum_codepage_fn, CP_SUPPORTED);
2991
2992 Vw32_valid_codepages = Fnreverse (Vw32_valid_codepages);
2993 return Vw32_valid_codepages;
2994 }
2995
2996
2997 DEFUN ("w32-get-console-codepage", Fw32_get_console_codepage,
2998 Sw32_get_console_codepage, 0, 0, 0,
2999 doc: /* Return current Windows codepage for console input. */)
3000 (void)
3001 {
3002 return make_number (GetConsoleCP ());
3003 }
3004
3005
3006 DEFUN ("w32-set-console-codepage", Fw32_set_console_codepage,
3007 Sw32_set_console_codepage, 1, 1, 0,
3008 doc: /* Make Windows codepage CP be the codepage for Emacs tty keyboard input.
3009 This codepage setting affects keyboard input in tty mode.
3010 If successful, the new CP is returned, otherwise nil. */)
3011 (Lisp_Object cp)
3012 {
3013 CHECK_NUMBER (cp);
3014
3015 if (!IsValidCodePage (XINT (cp)))
3016 return Qnil;
3017
3018 if (!SetConsoleCP (XINT (cp)))
3019 return Qnil;
3020
3021 return make_number (GetConsoleCP ());
3022 }
3023
3024
3025 DEFUN ("w32-get-console-output-codepage", Fw32_get_console_output_codepage,
3026 Sw32_get_console_output_codepage, 0, 0, 0,
3027 doc: /* Return current Windows codepage for console output. */)
3028 (void)
3029 {
3030 return make_number (GetConsoleOutputCP ());
3031 }
3032
3033
3034 DEFUN ("w32-set-console-output-codepage", Fw32_set_console_output_codepage,
3035 Sw32_set_console_output_codepage, 1, 1, 0,
3036 doc: /* Make Windows codepage CP be the codepage for Emacs console output.
3037 This codepage setting affects display in tty mode.
3038 If successful, the new CP is returned, otherwise nil. */)
3039 (Lisp_Object cp)
3040 {
3041 CHECK_NUMBER (cp);
3042
3043 if (!IsValidCodePage (XINT (cp)))
3044 return Qnil;
3045
3046 if (!SetConsoleOutputCP (XINT (cp)))
3047 return Qnil;
3048
3049 return make_number (GetConsoleOutputCP ());
3050 }
3051
3052
3053 DEFUN ("w32-get-codepage-charset", Fw32_get_codepage_charset,
3054 Sw32_get_codepage_charset, 1, 1, 0,
3055 doc: /* Return charset ID corresponding to codepage CP.
3056 Returns nil if the codepage is not valid. */)
3057 (Lisp_Object cp)
3058 {
3059 CHARSETINFO info;
3060
3061 CHECK_NUMBER (cp);
3062
3063 if (!IsValidCodePage (XINT (cp)))
3064 return Qnil;
3065
3066 if (TranslateCharsetInfo ((DWORD *) XINT (cp), &info, TCI_SRCCODEPAGE))
3067 return make_number (info.ciCharset);
3068
3069 return Qnil;
3070 }
3071
3072
3073 DEFUN ("w32-get-valid-keyboard-layouts", Fw32_get_valid_keyboard_layouts,
3074 Sw32_get_valid_keyboard_layouts, 0, 0, 0,
3075 doc: /* Return list of Windows keyboard languages and layouts.
3076 The return value is a list of pairs of language id and layout id. */)
3077 (void)
3078 {
3079 int num_layouts = GetKeyboardLayoutList (0, NULL);
3080 HKL * layouts = (HKL *) alloca (num_layouts * sizeof (HKL));
3081 Lisp_Object obj = Qnil;
3082
3083 if (GetKeyboardLayoutList (num_layouts, layouts) == num_layouts)
3084 {
3085 while (--num_layouts >= 0)
3086 {
3087 HKL kl = layouts[num_layouts];
3088
3089 obj = Fcons (Fcons (make_number (LOWORD (kl)),
3090 make_number (HIWORD (kl))),
3091 obj);
3092 }
3093 }
3094
3095 return obj;
3096 }
3097
3098
3099 DEFUN ("w32-get-keyboard-layout", Fw32_get_keyboard_layout,
3100 Sw32_get_keyboard_layout, 0, 0, 0,
3101 doc: /* Return current Windows keyboard language and layout.
3102 The return value is the cons of the language id and the layout id. */)
3103 (void)
3104 {
3105 HKL kl = GetKeyboardLayout (dwWindowsThreadId);
3106
3107 return Fcons (make_number (LOWORD (kl)),
3108 make_number (HIWORD (kl)));
3109 }
3110
3111
3112 DEFUN ("w32-set-keyboard-layout", Fw32_set_keyboard_layout,
3113 Sw32_set_keyboard_layout, 1, 1, 0,
3114 doc: /* Make LAYOUT be the current keyboard layout for Emacs.
3115 The keyboard layout setting affects interpretation of keyboard input.
3116 If successful, the new layout id is returned, otherwise nil. */)
3117 (Lisp_Object layout)
3118 {
3119 HKL kl;
3120
3121 CHECK_CONS (layout);
3122 CHECK_NUMBER_CAR (layout);
3123 CHECK_NUMBER_CDR (layout);
3124
3125 kl = (HKL) ((XINT (XCAR (layout)) & 0xffff)
3126 | (XINT (XCDR (layout)) << 16));
3127
3128 /* Synchronize layout with input thread. */
3129 if (dwWindowsThreadId)
3130 {
3131 if (PostThreadMessage (dwWindowsThreadId, WM_EMACS_SETKEYBOARDLAYOUT,
3132 (WPARAM) kl, 0))
3133 {
3134 MSG msg;
3135 GetMessage (&msg, NULL, WM_EMACS_DONE, WM_EMACS_DONE);
3136
3137 if (msg.wParam == 0)
3138 return Qnil;
3139 }
3140 }
3141 else if (!ActivateKeyboardLayout (kl, 0))
3142 return Qnil;
3143
3144 return Fw32_get_keyboard_layout ();
3145 }
3146
3147 \f
3148 void
3149 syms_of_ntproc (void)
3150 {
3151 #include "w32proc.x"
3152
3153 DEFSYM (Qhigh, "high");
3154 DEFSYM (Qlow, "low");
3155
3156 DEFVAR_LISP ("w32-quote-process-args", Vw32_quote_process_args,
3157 doc: /* Non-nil enables quoting of process arguments to ensure correct parsing.
3158 Because Windows does not directly pass argv arrays to child processes,
3159 programs have to reconstruct the argv array by parsing the command
3160 line string. For an argument to contain a space, it must be enclosed
3161 in double quotes or it will be parsed as multiple arguments.
3162
3163 If the value is a character, that character will be used to escape any
3164 quote characters that appear, otherwise a suitable escape character
3165 will be chosen based on the type of the program. */);
3166 Vw32_quote_process_args = Qt;
3167
3168 DEFVAR_LISP ("w32-start-process-show-window",
3169 Vw32_start_process_show_window,
3170 doc: /* When nil, new child processes hide their windows.
3171 When non-nil, they show their window in the method of their choice.
3172 This variable doesn't affect GUI applications, which will never be hidden. */);
3173 Vw32_start_process_show_window = Qnil;
3174
3175 DEFVAR_LISP ("w32-start-process-share-console",
3176 Vw32_start_process_share_console,
3177 doc: /* When nil, new child processes are given a new console.
3178 When non-nil, they share the Emacs console; this has the limitation of
3179 allowing only one DOS subprocess to run at a time (whether started directly
3180 or indirectly by Emacs), and preventing Emacs from cleanly terminating the
3181 subprocess group, but may allow Emacs to interrupt a subprocess that doesn't
3182 otherwise respond to interrupts from Emacs. */);
3183 Vw32_start_process_share_console = Qnil;
3184
3185 DEFVAR_LISP ("w32-start-process-inherit-error-mode",
3186 Vw32_start_process_inherit_error_mode,
3187 doc: /* When nil, new child processes revert to the default error mode.
3188 When non-nil, they inherit their error mode setting from Emacs, which stops
3189 them blocking when trying to access unmounted drives etc. */);
3190 Vw32_start_process_inherit_error_mode = Qt;
3191
3192 DEFVAR_INT ("w32-pipe-read-delay", w32_pipe_read_delay,
3193 doc: /* Forced delay before reading subprocess output.
3194 This is done to improve the buffering of subprocess output, by
3195 avoiding the inefficiency of frequently reading small amounts of data.
3196
3197 If positive, the value is the number of milliseconds to sleep before
3198 reading the subprocess output. If negative, the magnitude is the number
3199 of time slices to wait (effectively boosting the priority of the child
3200 process temporarily). A value of zero disables waiting entirely. */);
3201 w32_pipe_read_delay = 50;
3202
3203 DEFVAR_LISP ("w32-downcase-file-names", Vw32_downcase_file_names,
3204 doc: /* Non-nil means convert all-upper case file names to lower case.
3205 This applies when performing completions and file name expansion.
3206 Note that the value of this setting also affects remote file names,
3207 so you probably don't want to set to non-nil if you use case-sensitive
3208 filesystems via ange-ftp. */);
3209 Vw32_downcase_file_names = Qnil;
3210
3211 #if 0
3212 DEFVAR_LISP ("w32-generate-fake-inodes", Vw32_generate_fake_inodes,
3213 doc: /* Non-nil means attempt to fake realistic inode values.
3214 This works by hashing the truename of files, and should detect
3215 aliasing between long and short (8.3 DOS) names, but can have
3216 false positives because of hash collisions. Note that determining
3217 the truename of a file can be slow. */);
3218 Vw32_generate_fake_inodes = Qnil;
3219 #endif
3220
3221 DEFVAR_LISP ("w32-get-true-file-attributes", Vw32_get_true_file_attributes,
3222 doc: /* Non-nil means determine accurate file attributes in `file-attributes'.
3223 This option controls whether to issue additional system calls to determine
3224 accurate link counts, file type, and ownership information. It is more
3225 useful for files on NTFS volumes, where hard links and file security are
3226 supported, than on volumes of the FAT family.
3227
3228 Without these system calls, link count will always be reported as 1 and file
3229 ownership will be attributed to the current user.
3230 The default value `local' means only issue these system calls for files
3231 on local fixed drives. A value of nil means never issue them.
3232 Any other non-nil value means do this even on remote and removable drives
3233 where the performance impact may be noticeable even on modern hardware. */);
3234 Vw32_get_true_file_attributes = Qlocal;
3235
3236 staticpro (&Vw32_valid_locale_ids);
3237 staticpro (&Vw32_valid_codepages);
3238 }
3239 /* end of w32proc.c */