Mercurial > hg > xemacs-beta
annotate src/process-nt.c @ 5167:e374ea766cc1
clean up, rearrange allocation statistics code
-------------------- ChangeLog entries follow: --------------------
src/ChangeLog addition:
2010-03-21 Ben Wing <ben@xemacs.org>
* alloc.c:
* alloc.c (assert_proper_sizing):
* alloc.c (c_readonly):
* alloc.c (malloced_storage_size):
* alloc.c (fixed_type_block_overhead):
* alloc.c (lisp_object_storage_size):
* alloc.c (inc_lrecord_stats):
* alloc.c (dec_lrecord_stats):
* alloc.c (pluralize_word):
* alloc.c (object_memory_usage_stats):
* alloc.c (Fobject_memory_usage):
* alloc.c (compute_memusage_stats_length):
* alloc.c (disksave_object_finalization_1):
* alloc.c (Fgarbage_collect):
* mc-alloc.c:
* mc-alloc.c (mc_alloced_storage_size):
* mc-alloc.h:
No functionality change here. Collect the allocations-statistics
code that was scattered throughout alloc.c into one place. Add
remaining section headings so that all sections have headings
clearly identifying the start of the section and its purpose.
Expose mc_alloced_storage_size() even when not MEMORY_USAGE_STATS;
this fixes build problems and is related to the export of
lisp_object_storage_size() and malloced_storage_size() when
non-MEMORY_USAGE_STATS in the previous change set.
| author | Ben Wing <ben@xemacs.org> |
|---|---|
| date | Sun, 21 Mar 2010 04:41:49 -0500 |
| parents | b5df3737028a |
| children | 308d34e9f07d |
| rev | line source |
|---|---|
| 428 | 1 /* Asynchronous subprocess implementation for Win32 |
| 2 Copyright (C) 1985, 1986, 1987, 1988, 1992, 1993, 1994, 1995 | |
| 3 Free Software Foundation, Inc. | |
| 4 Copyright (C) 1995 Sun Microsystems, Inc. | |
| 2367 | 5 Copyright (C) 1995, 1996, 2000, 2001, 2002, 2004 Ben Wing. |
| 428 | 6 |
| 7 This file is part of XEmacs. | |
| 8 | |
| 9 XEmacs is free software; you can redistribute it and/or modify it | |
| 10 under the terms of the GNU General Public License as published by the | |
| 11 Free Software Foundation; either version 2, or (at your option) any | |
| 12 later version. | |
| 13 | |
| 14 XEmacs is distributed in the hope that it will be useful, but WITHOUT | |
| 15 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
| 16 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
| 17 for more details. | |
| 18 | |
| 19 You should have received a copy of the GNU General Public License | |
| 20 along with XEmacs; see the file COPYING. If not, write to | |
| 21 the Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
| 22 Boston, MA 02111-1307, USA. */ | |
| 23 | |
| 24 /* Written by Kirill M. Katsnelson <kkm@kis.ru>, April 1998 */ | |
| 25 | |
| 771 | 26 /* Mule-ized as of 8-6-00 */ |
| 27 | |
| 2367 | 28 /* Major comment about parsing and/or constructing a command line taken |
| 29 from Windows, or suitable for giving to one of the library routines that | |
| 30 calls a subprocess is in win32-native.el */ | |
| 31 | |
| 428 | 32 #include <config.h> |
| 33 #include "lisp.h" | |
| 34 | |
| 442 | 35 #include "console-msw.h" |
| 2367 | 36 #include "events.h" |
| 428 | 37 #include "hash.h" |
| 38 #include "lstream.h" | |
| 39 #include "process.h" | |
| 40 #include "procimpl.h" | |
| 41 | |
| 558 | 42 #include "sysfile.h" |
| 43 #include "sysproc.h" | |
| 859 | 44 #include "syssignal.h" |
| 428 | 45 |
| 442 | 46 /* Bound by win32-native.el */ |
| 47 Lisp_Object Qmswindows_construct_process_command_line; | |
| 48 | |
| 428 | 49 /* Arbitrary size limit for code fragments passed to run_in_other_process */ |
| 50 #define FRAGMENT_CODE_SIZE 32 | |
| 51 | |
| 52 /* Implementation-specific data. Pointed to by Lisp_Process->process_data */ | |
| 53 struct nt_process_data | |
| 54 { | |
| 55 HANDLE h_process; | |
| 442 | 56 DWORD dwProcessId; |
| 57 HWND hwnd; /* console window */ | |
| 853 | 58 int selected_for_exit_notify; |
| 428 | 59 }; |
| 60 | |
| 442 | 61 /* Control whether create_child causes the process to inherit Emacs' |
| 62 console window, or be given a new one of its own. The default is | |
| 63 nil, to allow multiple DOS programs to run on Win95. Having separate | |
| 64 consoles also allows Emacs to cleanly terminate process groups. */ | |
| 65 Lisp_Object Vmswindows_start_process_share_console; | |
| 66 | |
| 67 /* Control whether create_child cause the process to inherit Emacs' | |
| 68 error mode setting. The default is t, to minimize the possibility of | |
| 69 subprocesses blocking when accessing unmounted drives. */ | |
| 70 Lisp_Object Vmswindows_start_process_inherit_error_mode; | |
| 71 | |
| 771 | 72 #define NT_DATA(p) ((struct nt_process_data *)((p)->process_data)) |
| 428 | 73 |
| 74 /*-----------------------------------------------------------------------*/ | |
| 75 /* Process helpers */ | |
| 76 /*-----------------------------------------------------------------------*/ | |
| 77 | |
| 853 | 78 /* These break process abstraction. Prototypes in console-msw.h, |
| 79 used by select_process method in event-msw.c. | |
| 80 | |
| 81 If called the first time on a process, return the process handle, so we | |
| 82 can select on it and receive exit notification. "First time only" so we | |
| 83 don't select the same process multiple times if someone turns off and on | |
| 84 the receipt of process data. */ | |
| 85 | |
| 86 HANDLE | |
| 87 get_nt_process_handle_only_first_time (Lisp_Process *p) | |
| 88 { | |
| 89 if (NT_DATA (p)->selected_for_exit_notify) | |
| 90 return INVALID_HANDLE_VALUE; | |
| 91 NT_DATA (p)->selected_for_exit_notify = 1; | |
| 92 return (NT_DATA (p)->h_process); | |
| 93 } | |
| 94 | |
| 428 | 95 HANDLE |
| 440 | 96 get_nt_process_handle (Lisp_Process *p) |
| 428 | 97 { |
| 98 return (NT_DATA (p)->h_process); | |
| 99 } | |
| 442 | 100 |
| 101 static struct Lisp_Process * | |
| 102 find_process_from_pid (DWORD pid) | |
| 103 { | |
| 104 Lisp_Object tail, proc; | |
| 105 | |
| 106 for (tail = Vprocess_list; CONSP (tail); tail = XCDR (tail)) | |
| 107 { | |
| 108 proc = XCAR (tail); | |
| 109 if (NT_DATA (XPROCESS (proc))->dwProcessId == pid) | |
| 110 return XPROCESS (proc); | |
| 111 } | |
| 112 return 0; | |
| 113 } | |
| 114 | |
| 428 | 115 |
| 116 /*-----------------------------------------------------------------------*/ | |
| 117 /* Running remote threads. See Microsoft Systems Journal 1994 Number 5 */ | |
| 118 /* Jeffrey Richter, Load Your 32-bit DLL into Another Process's Address..*/ | |
| 119 /*-----------------------------------------------------------------------*/ | |
| 120 | |
| 121 typedef struct | |
| 122 { | |
| 123 HANDLE h_process; | |
| 124 HANDLE h_thread; | |
| 125 LPVOID address; | |
| 126 } process_memory; | |
| 127 | |
| 2367 | 128 static void |
| 129 free_process_memory (process_memory *pmc) | |
| 130 { | |
| 131 ResumeThread (pmc->h_thread); | |
| 132 CloseHandle (pmc->h_thread); | |
| 133 } | |
| 134 | |
| 428 | 135 /* |
| 136 * Allocate SIZE bytes in H_PROCESS address space. Fill in PMC used | |
| 137 * further by other routines. Return nonzero if successful. | |
| 138 * | |
| 139 * The memory in other process is allocated by creating a suspended | |
| 140 * thread. Initial stack of that thread is used as the memory | |
| 141 * block. The thread entry point is the routine ExitThread in | |
| 854 | 142 * kernel32.dll, so the allocated memory is freed just by resuming the |
| 428 | 143 * thread, which immediately terminates after that. |
| 144 */ | |
| 145 | |
| 854 | 146 static int |
| 665 | 147 alloc_process_memory (HANDLE h_process, Bytecount size, |
| 771 | 148 process_memory *pmc) |
| 428 | 149 { |
| 150 LPTHREAD_START_ROUTINE adr_ExitThread = | |
| 151 (LPTHREAD_START_ROUTINE) | |
| 771 | 152 GetProcAddress (qxeGetModuleHandle (XETEXT ("kernel32")), "ExitThread"); |
| 428 | 153 DWORD dw_unused; |
| 154 CONTEXT context; | |
| 155 MEMORY_BASIC_INFORMATION mbi; | |
| 156 | |
| 157 pmc->h_process = h_process; | |
| 158 pmc->h_thread = CreateRemoteThread (h_process, NULL, size, | |
| 771 | 159 adr_ExitThread, NULL, |
| 160 CREATE_SUSPENDED, &dw_unused); | |
| 428 | 161 if (pmc->h_thread == NULL) |
| 162 return 0; | |
| 163 | |
| 164 /* Get context, for thread's stack pointer */ | |
| 165 context.ContextFlags = CONTEXT_CONTROL; | |
| 166 if (!GetThreadContext (pmc->h_thread, &context)) | |
| 167 goto failure; | |
| 168 | |
| 169 /* Determine base address of the committed range */ | |
| 170 if (sizeof(mbi) != VirtualQueryEx (h_process, | |
| 171 #if defined (_X86_) | |
| 172 (LPDWORD)context.Esp - 1, | |
| 173 #elif defined (_ALPHA_) | |
| 174 (LPDWORD)context.IntSp - 1, | |
| 175 #else | |
| 176 #error Unknown processor architecture | |
| 177 #endif | |
| 178 &mbi, sizeof(mbi))) | |
| 179 goto failure; | |
| 180 | |
| 181 /* Change the page protection of the allocated memory to executable, | |
| 182 read, and write. */ | |
| 183 if (!VirtualProtectEx (h_process, mbi.BaseAddress, size, | |
| 184 PAGE_EXECUTE_READWRITE, &dw_unused)) | |
| 185 goto failure; | |
| 186 | |
| 187 pmc->address = mbi.BaseAddress; | |
| 188 return 1; | |
| 189 | |
| 190 failure: | |
| 2367 | 191 free_process_memory (pmc); |
| 428 | 192 pmc->address = 0; |
| 193 return 0; | |
| 194 } | |
| 195 | |
| 196 /* | |
| 197 * Run ROUTINE in the context of process determined by H_PROCESS. The | |
| 198 * routine is passed the address of DATA as parameter. The ROUTINE must | |
| 199 * not be longer than ROUTINE_CODE_SIZE bytes. DATA_SIZE is the size of | |
| 200 * DATA structure. | |
| 201 * | |
| 202 * Note that the code must be positionally independent, and compiled | |
| 203 * without stack checks (they cause implicit calls into CRT so will | |
| 204 * fail). DATA should not refer any data in calling process, as both | |
| 205 * routine and its data are copied into remote process. Size of data | |
| 206 * and code together should not exceed one page (4K on x86 systems). | |
| 207 * | |
| 208 * Return the value returned by ROUTINE, or (DWORD)-1 if call failed. | |
| 209 */ | |
| 210 static DWORD | |
| 211 run_in_other_process (HANDLE h_process, | |
| 212 LPTHREAD_START_ROUTINE routine, | |
| 665 | 213 LPVOID data, Bytecount data_size) |
| 428 | 214 { |
| 215 process_memory pm; | |
| 665 | 216 const Bytecount code_size = FRAGMENT_CODE_SIZE; |
| 428 | 217 /* Need at most 3 extra bytes of memory, for data alignment */ |
| 665 | 218 Bytecount total_size = code_size + data_size + 3; |
| 428 | 219 LPVOID remote_data; |
| 220 HANDLE h_thread; | |
| 221 DWORD dw_unused; | |
| 222 | |
| 223 /* Allocate memory */ | |
| 224 if (!alloc_process_memory (h_process, total_size, &pm)) | |
| 225 return (DWORD)-1; | |
| 226 | |
| 227 /* Copy code */ | |
| 228 if (!WriteProcessMemory (h_process, pm.address, (LPVOID)routine, | |
| 229 code_size, NULL)) | |
| 230 goto failure; | |
| 231 | |
| 232 /* Copy data */ | |
| 233 if (data_size) | |
| 234 { | |
| 235 remote_data = (LPBYTE)pm.address + ((code_size + 4) & ~3); | |
| 236 if (!WriteProcessMemory (h_process, remote_data, data, data_size, NULL)) | |
| 237 goto failure; | |
| 238 } | |
| 239 else | |
| 240 remote_data = NULL; | |
| 241 | |
| 242 /* Execute the remote copy of code, passing it remote data */ | |
| 243 h_thread = CreateRemoteThread (h_process, NULL, 0, | |
| 244 (LPTHREAD_START_ROUTINE) pm.address, | |
| 245 remote_data, 0, &dw_unused); | |
| 246 if (h_thread == NULL) | |
| 247 goto failure; | |
| 248 | |
| 249 /* Wait till thread finishes */ | |
| 250 WaitForSingleObject (h_thread, INFINITE); | |
| 251 | |
| 252 /* Free remote memory */ | |
| 253 free_process_memory (&pm); | |
| 254 | |
| 255 /* Return thread's exit code */ | |
| 256 { | |
| 257 DWORD exit_code; | |
| 258 GetExitCodeThread (h_thread, &exit_code); | |
| 259 CloseHandle (h_thread); | |
| 260 return exit_code; | |
| 261 } | |
| 262 | |
| 263 failure: | |
| 264 free_process_memory (&pm); | |
| 2367 | 265 return (DWORD) -1; |
| 428 | 266 } |
| 267 | |
| 268 /*-----------------------------------------------------------------------*/ | |
| 269 /* Sending signals */ | |
| 270 /*-----------------------------------------------------------------------*/ | |
| 271 | |
| 442 | 272 /* ---------------------------- the NT way ------------------------------- */ |
| 273 | |
| 428 | 274 /* |
| 275 * We handle the following signals: | |
| 276 * | |
| 277 * SIGKILL, SIGTERM, SIGQUIT, SIGHUP - These four translate to ExitProcess | |
| 278 * executed by the remote process | |
| 279 * SIGINT - The remote process is sent CTRL_BREAK_EVENT | |
| 280 * | |
| 281 * The MSVC5.0 compiler feels free to re-order functions within a | |
| 282 * compilation unit, so we have no way of finding out the size of the | |
| 283 * following functions. Therefore these functions must not be larger than | |
| 284 * FRAGMENT_CODE_SIZE. | |
| 285 */ | |
| 286 | |
| 287 /* | |
| 288 * Sending SIGKILL | |
| 289 */ | |
| 290 typedef struct | |
| 291 { | |
| 292 void (WINAPI *adr_ExitProcess) (UINT); | |
| 293 } sigkill_data; | |
| 294 | |
| 295 static DWORD WINAPI | |
| 771 | 296 sigkill_proc (sigkill_data *data) |
| 428 | 297 { |
| 298 (*data->adr_ExitProcess)(255); | |
| 299 return 1; | |
| 300 } | |
| 301 | |
| 302 /* | |
| 303 * Sending break or control c | |
| 304 */ | |
| 305 typedef struct | |
| 306 { | |
| 307 BOOL (WINAPI *adr_GenerateConsoleCtrlEvent) (DWORD, DWORD); | |
| 308 DWORD event; | |
| 309 } sigint_data; | |
| 310 | |
| 311 static DWORD WINAPI | |
| 771 | 312 sigint_proc (sigint_data *data) |
| 428 | 313 { |
| 314 return (*data->adr_GenerateConsoleCtrlEvent) (data->event, 0); | |
| 315 } | |
| 316 | |
| 317 /* | |
| 318 * Enabling signals | |
| 319 */ | |
| 320 typedef struct | |
| 321 { | |
| 322 BOOL (WINAPI *adr_SetConsoleCtrlHandler) (LPVOID, BOOL); | |
| 323 } sig_enable_data; | |
| 324 | |
| 325 static DWORD WINAPI | |
| 771 | 326 sig_enable_proc (sig_enable_data *data) |
| 428 | 327 { |
| 328 (*data->adr_SetConsoleCtrlHandler) (NULL, FALSE); | |
| 329 return 1; | |
| 330 } | |
| 331 | |
| 332 /* | |
| 333 * Send signal SIGNO to process H_PROCESS. | |
| 334 * Return nonzero if successful. | |
| 335 */ | |
| 336 | |
| 337 static int | |
| 442 | 338 send_signal_the_nt_way (struct nt_process_data *cp, int pid, int signo) |
| 428 | 339 { |
| 442 | 340 HANDLE h_process; |
| 771 | 341 HMODULE h_kernel = qxeGetModuleHandle (XETEXT ("kernel32")); |
| 442 | 342 int close_process = 0; |
| 428 | 343 DWORD retval; |
| 854 | 344 |
| 428 | 345 assert (h_kernel != NULL); |
| 854 | 346 |
| 442 | 347 if (cp) |
| 348 { | |
| 349 pid = cp->dwProcessId; | |
| 350 h_process = cp->h_process; | |
| 351 } | |
| 352 else | |
| 353 { | |
| 354 close_process = 1; | |
| 355 /* Try to open the process with required privileges */ | |
| 356 h_process = OpenProcess (PROCESS_CREATE_THREAD | |
| 854 | 357 | PROCESS_QUERY_INFORMATION |
| 442 | 358 | PROCESS_VM_OPERATION |
| 359 | PROCESS_VM_WRITE, | |
| 360 FALSE, pid); | |
| 361 if (!h_process) | |
| 362 return 0; | |
| 363 } | |
| 364 | |
| 428 | 365 switch (signo) |
| 366 { | |
| 367 case SIGKILL: | |
| 368 case SIGTERM: | |
| 369 case SIGQUIT: | |
| 370 case SIGHUP: | |
| 371 { | |
| 372 sigkill_data d; | |
| 442 | 373 |
| 374 d.adr_ExitProcess = | |
| 375 (void (WINAPI *) (UINT)) GetProcAddress (h_kernel, "ExitProcess"); | |
| 428 | 376 assert (d.adr_ExitProcess); |
| 854 | 377 retval = run_in_other_process (h_process, |
| 771 | 378 (LPTHREAD_START_ROUTINE) sigkill_proc, |
| 428 | 379 &d, sizeof (d)); |
| 380 break; | |
| 381 } | |
| 382 case SIGINT: | |
| 383 { | |
| 384 sigint_data d; | |
| 385 d.adr_GenerateConsoleCtrlEvent = | |
| 442 | 386 (BOOL (WINAPI *) (DWORD, DWORD)) |
| 428 | 387 GetProcAddress (h_kernel, "GenerateConsoleCtrlEvent"); |
| 388 assert (d.adr_GenerateConsoleCtrlEvent); | |
| 389 d.event = CTRL_C_EVENT; | |
| 854 | 390 retval = run_in_other_process (h_process, |
| 2367 | 391 (LPTHREAD_START_ROUTINE) sigint_proc, |
| 428 | 392 &d, sizeof (d)); |
| 393 break; | |
| 394 } | |
| 395 default: | |
| 396 assert (0); | |
| 397 } | |
| 398 | |
| 442 | 399 if (close_process) |
| 400 CloseHandle (h_process); | |
| 2367 | 401 return (int) retval > 0 ? 1 : 0; |
| 428 | 402 } |
| 403 | |
| 404 /* | |
| 405 * Enable CTRL_C_EVENT handling in a new child process | |
| 406 */ | |
| 407 static void | |
| 408 enable_child_signals (HANDLE h_process) | |
| 409 { | |
| 771 | 410 HMODULE h_kernel = qxeGetModuleHandle (XETEXT ("kernel32")); |
| 428 | 411 sig_enable_data d; |
| 854 | 412 |
| 428 | 413 assert (h_kernel != NULL); |
| 414 d.adr_SetConsoleCtrlHandler = | |
| 442 | 415 (BOOL (WINAPI *) (LPVOID, BOOL)) |
| 428 | 416 GetProcAddress (h_kernel, "SetConsoleCtrlHandler"); |
| 417 assert (d.adr_SetConsoleCtrlHandler); | |
| 418 run_in_other_process (h_process, (LPTHREAD_START_ROUTINE)sig_enable_proc, | |
| 419 &d, sizeof (d)); | |
| 420 } | |
| 854 | 421 |
| 442 | 422 /* ---------------------------- the 95 way ------------------------------- */ |
| 423 | |
| 424 static BOOL CALLBACK | |
| 425 find_child_console (HWND hwnd, long putada) | |
| 426 { | |
| 427 DWORD thread_id; | |
| 428 DWORD process_id; | |
| 429 struct nt_process_data *cp = (struct nt_process_data *) putada; | |
| 430 | |
| 431 thread_id = GetWindowThreadProcessId (hwnd, &process_id); | |
| 432 if (process_id == cp->dwProcessId) | |
| 433 { | |
| 771 | 434 Extbyte window_class[32]; |
| 442 | 435 |
| 771 | 436 /* GetClassNameA to avoid problems with Unicode return values */ |
| 437 GetClassNameA (hwnd, window_class, sizeof (window_class)); | |
| 442 | 438 if (strcmp (window_class, |
| 771 | 439 mswindows_windows9x_p |
| 442 | 440 ? "tty" |
| 441 : "ConsoleWindowClass") == 0) | |
| 442 { | |
| 443 cp->hwnd = hwnd; | |
| 444 return FALSE; | |
| 445 } | |
| 446 } | |
| 447 /* keep looking */ | |
| 448 return TRUE; | |
| 449 } | |
| 450 | |
| 451 static int | |
| 452 send_signal_the_95_way (struct nt_process_data *cp, int pid, int signo) | |
| 453 { | |
| 454 HANDLE h_process; | |
| 455 int close_process = 0; | |
| 456 int rc = 1; | |
| 854 | 457 |
| 442 | 458 if (cp) |
| 459 { | |
| 460 pid = cp->dwProcessId; | |
| 461 h_process = cp->h_process; | |
| 462 | |
| 463 /* Try to locate console window for process. */ | |
| 464 EnumWindows (find_child_console, (LPARAM) cp); | |
| 465 } | |
| 466 else | |
| 467 { | |
| 468 close_process = 1; | |
| 469 /* Try to open the process with required privileges */ | |
| 470 h_process = OpenProcess (PROCESS_TERMINATE, FALSE, pid); | |
| 471 if (!h_process) | |
| 472 return 0; | |
| 473 } | |
| 854 | 474 |
| 442 | 475 if (signo == SIGINT) |
| 476 { | |
| 477 if (NILP (Vmswindows_start_process_share_console) && cp && cp->hwnd) | |
| 478 { | |
| 771 | 479 BYTE control_scan_code = (BYTE) MapVirtualKeyA (VK_CONTROL, 0); |
| 442 | 480 BYTE vk_break_code = VK_CANCEL; |
| 771 | 481 BYTE break_scan_code = (BYTE) MapVirtualKeyA (vk_break_code, 0); |
| 442 | 482 HWND foreground_window; |
| 483 | |
| 484 if (break_scan_code == 0) | |
| 485 { | |
| 486 /* Fake Ctrl-C if we can't manage Ctrl-Break. */ | |
| 487 vk_break_code = 'C'; | |
| 771 | 488 break_scan_code = (BYTE) MapVirtualKeyA (vk_break_code, 0); |
| 442 | 489 } |
| 490 | |
| 491 foreground_window = GetForegroundWindow (); | |
| 492 if (foreground_window) | |
| 493 { | |
| 494 /* NT 5.0, and apparently also Windows 98, will not allow | |
| 495 a Window to be set to foreground directly without the | |
| 496 user's involvement. The workaround is to attach | |
| 497 ourselves to the thread that owns the foreground | |
| 498 window, since that is the only thread that can set the | |
| 499 foreground window. */ | |
| 500 DWORD foreground_thread, child_thread; | |
| 501 foreground_thread = | |
| 502 GetWindowThreadProcessId (foreground_window, NULL); | |
| 503 if (foreground_thread == GetCurrentThreadId () | |
| 504 || !AttachThreadInput (GetCurrentThreadId (), | |
| 505 foreground_thread, TRUE)) | |
| 506 foreground_thread = 0; | |
| 507 | |
| 508 child_thread = GetWindowThreadProcessId (cp->hwnd, NULL); | |
| 509 if (child_thread == GetCurrentThreadId () | |
| 510 || !AttachThreadInput (GetCurrentThreadId (), | |
| 511 child_thread, TRUE)) | |
| 512 child_thread = 0; | |
| 513 | |
| 514 /* Set the foreground window to the child. */ | |
| 515 if (SetForegroundWindow (cp->hwnd)) | |
| 516 { | |
| 517 /* Generate keystrokes as if user had typed Ctrl-Break or | |
| 518 Ctrl-C. */ | |
| 519 keybd_event (VK_CONTROL, control_scan_code, 0, 0); | |
| 520 keybd_event (vk_break_code, break_scan_code, | |
| 521 (vk_break_code == 'C' ? 0 : KEYEVENTF_EXTENDEDKEY), 0); | |
| 522 keybd_event (vk_break_code, break_scan_code, | |
| 523 (vk_break_code == 'C' ? 0 : KEYEVENTF_EXTENDEDKEY) | |
| 524 | KEYEVENTF_KEYUP, 0); | |
| 525 keybd_event (VK_CONTROL, control_scan_code, | |
| 526 KEYEVENTF_KEYUP, 0); | |
| 527 | |
| 528 /* Sleep for a bit to give time for Emacs frame to respond | |
| 529 to focus change events (if Emacs was active app). */ | |
| 530 Sleep (100); | |
| 531 | |
| 532 SetForegroundWindow (foreground_window); | |
| 533 } | |
| 534 /* Detach from the foreground and child threads now that | |
| 535 the foreground switching is over. */ | |
| 536 if (foreground_thread) | |
| 537 AttachThreadInput (GetCurrentThreadId (), | |
| 538 foreground_thread, FALSE); | |
| 539 if (child_thread) | |
| 540 AttachThreadInput (GetCurrentThreadId (), | |
| 541 child_thread, FALSE); | |
| 542 } | |
| 543 } | |
| 544 /* Ctrl-Break is NT equivalent of SIGINT. */ | |
| 545 else if (!GenerateConsoleCtrlEvent (CTRL_BREAK_EVENT, pid)) | |
| 546 { | |
| 547 #if 0 /* FSF Emacs */ | |
| 548 DebPrint (("sys_kill.GenerateConsoleCtrlEvent return %d " | |
| 549 "for pid %lu\n", GetLastError (), pid)); | |
| 550 errno = EINVAL; | |
| 551 #endif | |
| 552 rc = 0; | |
| 553 } | |
| 554 } | |
| 555 else | |
| 556 { | |
| 557 if (NILP (Vmswindows_start_process_share_console) && cp && cp->hwnd) | |
| 558 { | |
| 559 #if 1 | |
| 771 | 560 if (mswindows_windows9x_p) |
| 442 | 561 { |
| 562 /* | |
| 563 Another possibility is to try terminating the VDM out-right by | |
| 564 calling the Shell VxD (id 0x17) V86 interface, function #4 | |
| 565 "SHELL_Destroy_VM", ie. | |
| 566 | |
| 567 mov edx,4 | |
| 568 mov ebx,vm_handle | |
| 569 call shellapi | |
| 570 | |
| 571 First need to determine the current VM handle, and then arrange for | |
| 572 the shellapi call to be made from the system vm (by using | |
| 573 Switch_VM_and_callback). | |
| 574 | |
| 575 Could try to invoke DestroyVM through CallVxD. | |
| 576 | |
| 577 */ | |
| 578 #if 0 | |
| 579 /* On Win95, posting WM_QUIT causes the 16-bit subsystem | |
| 580 to hang when cmdproxy is used in conjunction with | |
| 581 command.com for an interactive shell. Posting | |
| 582 WM_CLOSE pops up a dialog that, when Yes is selected, | |
| 583 does the same thing. TerminateProcess is also less | |
| 584 than ideal in that subprocesses tend to stick around | |
| 585 until the machine is shutdown, but at least it | |
| 586 doesn't freeze the 16-bit subsystem. */ | |
| 800 | 587 qxePostMessage (cp->hwnd, WM_QUIT, 0xff, 0); |
| 442 | 588 #endif |
| 589 if (!TerminateProcess (h_process, 0xff)) | |
| 590 { | |
| 591 #if 0 /* FSF Emacs */ | |
| 592 DebPrint (("sys_kill.TerminateProcess returned %d " | |
| 593 "for pid %lu\n", GetLastError (), pid)); | |
| 594 errno = EINVAL; | |
| 595 #endif | |
| 596 rc = 0; | |
| 597 } | |
| 598 } | |
| 599 else | |
| 600 #endif | |
| 800 | 601 qxePostMessage (cp->hwnd, WM_CLOSE, 0, 0); |
| 442 | 602 } |
| 603 /* Kill the process. On W32 this doesn't kill child processes | |
| 604 so it doesn't work very well for shells which is why it's not | |
| 605 used in every case. */ | |
| 606 else if (!TerminateProcess (h_process, 0xff)) | |
| 607 { | |
| 608 #if 0 /* FSF Emacs */ | |
| 609 DebPrint (("sys_kill.TerminateProcess returned %d " | |
| 610 "for pid %lu\n", GetLastError (), pid)); | |
| 611 errno = EINVAL; | |
| 612 #endif | |
| 613 rc = 0; | |
| 614 } | |
| 615 } | |
| 616 | |
| 617 if (close_process) | |
| 618 CloseHandle (h_process); | |
| 619 | |
| 620 return rc; | |
| 621 } | |
| 622 | |
| 623 /* -------------------------- all-OS functions ---------------------------- */ | |
| 624 | |
| 625 static int | |
| 626 send_signal (struct nt_process_data *cp, int pid, int signo) | |
| 627 { | |
| 771 | 628 return (!mswindows_windows9x_p && send_signal_the_nt_way (cp, pid, signo)) |
| 442 | 629 || send_signal_the_95_way (cp, pid, signo); |
| 630 } | |
| 631 | |
| 428 | 632 /* |
| 633 * Signal error if SIGNO is not supported | |
| 634 */ | |
| 635 static void | |
| 636 validate_signal_number (int signo) | |
| 637 { | |
| 638 if (signo != SIGKILL && signo != SIGTERM | |
| 639 && signo != SIGQUIT && signo != SIGINT | |
| 640 && signo != SIGHUP) | |
| 563 | 641 invalid_constant ("Signal number not supported", make_int (signo)); |
| 428 | 642 } |
| 854 | 643 |
| 428 | 644 /*-----------------------------------------------------------------------*/ |
| 645 /* Process methods */ | |
| 646 /*-----------------------------------------------------------------------*/ | |
| 647 | |
| 648 /* | |
| 649 * Allocate and initialize Lisp_Process->process_data | |
| 650 */ | |
| 651 | |
| 652 static void | |
| 440 | 653 nt_alloc_process_data (Lisp_Process *p) |
| 428 | 654 { |
| 655 p->process_data = xnew_and_zero (struct nt_process_data); | |
| 656 } | |
| 657 | |
| 658 static void | |
|
5124
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
2526
diff
changeset
|
659 nt_finalize_process_data (Lisp_Process *p) |
| 428 | 660 { |
| 791 | 661 /* If it's still in the list of processes we are waiting on delete |
| 2367 | 662 it. This can happen if we forcibly delete a process and are unable |
| 663 to kill it. */ | |
| 791 | 664 mswindows_unwait_process (p); |
| 442 | 665 if (NT_DATA (p)->h_process) |
| 2367 | 666 { |
| 667 CloseHandle (NT_DATA (p)->h_process); | |
| 668 NT_DATA (p)->h_process = 0; | |
| 669 } | |
| 428 | 670 } |
| 671 | |
| 672 /* | |
| 673 * Initialize XEmacs process implementation once | |
| 674 */ | |
| 675 static void | |
| 676 nt_init_process (void) | |
| 677 { | |
| 678 /* Initialize winsock */ | |
| 679 WSADATA wsa_data; | |
| 680 /* Request Winsock v1.1 Note the order: (minor=1, major=1) */ | |
| 681 WSAStartup (MAKEWORD (1,1), &wsa_data); | |
| 682 } | |
| 683 | |
| 853 | 684 /* |
| 685 * Fork off a subprocess. P is a pointer to newly created subprocess | |
| 686 * object. If this function signals, the caller is responsible for | |
| 687 * deleting (and finalizing) the process object. | |
| 688 * | |
| 689 * The method must return PID of the new process, a (positive??? ####) number | |
| 690 * which fits into Lisp_Int. No return value indicates an error, the method | |
| 691 * must signal an error instead. | |
| 692 */ | |
| 693 | |
| 563 | 694 static DOESNT_RETURN |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
2526
diff
changeset
|
695 mswindows_report_winsock_error (const Ascbyte *reason, Lisp_Object data, |
| 563 | 696 int errnum) |
| 428 | 697 { |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
698 signal_error_2 (Qnetwork_error, reason, mswindows_lisp_error (errnum), data); |
| 442 | 699 } |
| 700 | |
| 701 static void | |
| 702 ensure_console_window_exists (void) | |
| 703 { | |
| 771 | 704 if (mswindows_windows9x_p) |
| 442 | 705 mswindows_hide_console (); |
| 706 } | |
| 707 | |
| 708 int | |
| 771 | 709 mswindows_compare_env (const void *strp1, const void *strp2) |
| 442 | 710 { |
| 2367 | 711 const Itext *str1 = * (const Itext **) strp1, |
| 712 *str2 = * (const Itext **) strp2; | |
| 442 | 713 |
| 714 while (*str1 && *str2 && *str1 != '=' && *str2 != '=') | |
| 715 { | |
| 716 if ((*str1) > (*str2)) | |
| 717 return 1; | |
| 718 else if ((*str1) < (*str2)) | |
| 719 return -1; | |
| 720 str1++, str2++; | |
| 721 } | |
| 722 | |
| 723 if (*str1 == '=' && *str2 == '=') | |
| 724 return 0; | |
| 725 else if (*str1 == '=') | |
| 726 return -1; | |
| 727 else | |
| 728 return 1; | |
| 428 | 729 } |
| 730 | |
| 563 | 731 /* |
| 732 * Fork off a subprocess. P is a pointer to newly created subprocess | |
| 733 * object. If this function signals, the caller is responsible for | |
| 734 * deleting (and finalizing) the process object. | |
| 735 * | |
| 736 * The method must return PID of the new process, a (positive??? ####) number | |
| 737 * which fits into Lisp_Int. No return value indicates an error, the method | |
| 738 * must signal an error instead. | |
| 739 */ | |
| 740 | |
| 428 | 741 static int |
| 440 | 742 nt_create_process (Lisp_Process *p, |
| 428 | 743 Lisp_Object *argv, int nargv, |
| 853 | 744 Lisp_Object program, Lisp_Object cur_dir, |
| 745 int separate_err) | |
| 428 | 746 { |
| 442 | 747 /* Synched up with sys_spawnve in FSF 20.6. Significantly different |
| 748 but still synchable. */ | |
| 853 | 749 HANDLE hmyshove, hmyslurp, hmyslurp_err, hprocin, hprocout, hprocerr; |
| 442 | 750 Extbyte *command_line; |
| 428 | 751 BOOL do_io, windowed; |
| 771 | 752 Extbyte *proc_env; |
| 428 | 753 |
| 442 | 754 /* No need to DOS-ize the filename; expand-file-name (called prior) |
| 755 already does this. */ | |
| 756 | |
| 428 | 757 /* Find out whether the application is windowed or not */ |
| 771 | 758 { |
| 759 /* SHGetFileInfo tends to return ERROR_FILE_NOT_FOUND on most | |
| 760 errors. This leads to bogus error message. */ | |
| 761 DWORD image_type; | |
| 1204 | 762 if (mswindows_is_executable (XSTRING_DATA (program))) |
| 771 | 763 { |
| 764 Extbyte *progext; | |
| 2526 | 765 LISP_PATHNAME_CONVERT_OUT (program, progext); |
| 771 | 766 image_type = qxeSHGetFileInfo (progext, 0, NULL, 0, SHGFI_EXETYPE); |
| 767 } | |
| 768 else | |
| 769 { | |
| 770 DECLARE_EISTRING (progext); | |
| 2526 | 771 Ibyte *prog2; |
| 772 LISP_PATHNAME_RESOLVE_LINKS (program, prog2); | |
| 773 eicpy_rawz (progext, prog2); | |
| 2421 | 774 eicat_ascii (progext, ".exe"); |
| 771 | 775 eito_external (progext, Qmswindows_tstr); |
| 776 image_type = qxeSHGetFileInfo (eiextdata (progext), 0, NULL, 0, | |
| 777 SHGFI_EXETYPE); | |
| 778 } | |
| 779 if (image_type == 0) | |
| 780 mswindows_report_process_error | |
| 781 ("Determining executable file type", | |
| 782 program, | |
| 783 GetLastError () == ERROR_FILE_NOT_FOUND | |
| 784 ? ERROR_BAD_FORMAT : GetLastError ()); | |
| 785 windowed = HIWORD (image_type) != 0; | |
| 786 } | |
| 787 | |
| 428 | 788 |
| 789 /* Decide whether to do I/O on process handles, or just mark the | |
| 790 process exited immediately upon successful launching. We do I/O if the | |
| 791 process is a console one, or if it is windowed but windowed_process_io | |
| 792 is non-zero */ | |
| 793 do_io = !windowed || windowed_process_io ; | |
| 854 | 794 |
| 428 | 795 if (do_io) |
| 796 { | |
| 797 /* Create two unidirectional named pipes */ | |
| 798 HANDLE htmp; | |
| 799 SECURITY_ATTRIBUTES sa; | |
| 800 | |
| 826 | 801 sa.nLength = sizeof (sa); |
| 428 | 802 sa.bInheritHandle = TRUE; |
| 803 sa.lpSecurityDescriptor = NULL; | |
| 804 | |
| 805 CreatePipe (&hprocin, &hmyshove, &sa, 0); | |
| 806 CreatePipe (&hmyslurp, &hprocout, &sa, 0); | |
| 807 | |
| 853 | 808 if (separate_err) |
| 809 CreatePipe (&hmyslurp_err, &hprocerr, &sa, 0); | |
| 810 else | |
| 811 /* Duplicate the stdout handle for use as stderr */ | |
| 2367 | 812 DuplicateHandle (GetCurrentProcess(), hprocout, GetCurrentProcess(), |
| 813 &hprocerr, 0, TRUE, DUPLICATE_SAME_ACCESS); | |
| 430 | 814 |
| 428 | 815 /* Stupid Win32 allows to create a pipe with *both* ends either |
| 816 inheritable or not. We need process ends inheritable, and local | |
| 817 ends not inheritable. */ | |
| 442 | 818 DuplicateHandle (GetCurrentProcess(), hmyshove, GetCurrentProcess(), |
| 819 &htmp, 0, FALSE, | |
| 820 DUPLICATE_CLOSE_SOURCE | DUPLICATE_SAME_ACCESS); | |
| 428 | 821 hmyshove = htmp; |
| 442 | 822 DuplicateHandle (GetCurrentProcess(), hmyslurp, GetCurrentProcess(), |
| 823 &htmp, 0, FALSE, | |
| 824 DUPLICATE_CLOSE_SOURCE | DUPLICATE_SAME_ACCESS); | |
| 428 | 825 hmyslurp = htmp; |
| 853 | 826 if (separate_err) |
| 827 { | |
| 828 DuplicateHandle (GetCurrentProcess(), hmyslurp_err, | |
| 829 GetCurrentProcess(), &htmp, 0, FALSE, | |
| 830 DUPLICATE_CLOSE_SOURCE | DUPLICATE_SAME_ACCESS); | |
| 831 hmyslurp_err = htmp; | |
| 832 } | |
| 428 | 833 } |
| 834 | |
| 835 /* Convert an argv vector into Win32 style command line by a call to | |
| 442 | 836 lisp function `mswindows-construct-process-command-line' |
| 837 (in win32-native.el) */ | |
| 428 | 838 { |
| 839 int i; | |
| 840 Lisp_Object args_or_ret = Qnil; | |
| 841 struct gcpro gcpro1; | |
| 842 | |
| 843 GCPRO1 (args_or_ret); | |
| 844 | |
| 845 for (i = 0; i < nargv; ++i) | |
| 846 args_or_ret = Fcons (*argv++, args_or_ret); | |
| 847 args_or_ret = Fnreverse (args_or_ret); | |
| 848 args_or_ret = Fcons (program, args_or_ret); | |
| 849 | |
| 2367 | 850 /* This Lisp function is in win32-native.el and has lots of comments |
| 851 about what exactly is going on. */ | |
| 442 | 852 args_or_ret = call1 (Qmswindows_construct_process_command_line, |
| 853 args_or_ret); | |
| 428 | 854 |
| 855 if (!STRINGP (args_or_ret)) | |
| 856 /* Luser wrote his/her own clever version */ | |
| 442 | 857 invalid_argument |
| 858 ("Bogus return value from `mswindows-construct-process-command-line'", | |
| 859 args_or_ret); | |
| 428 | 860 |
| 2526 | 861 /* #### What about path names, which may be links? */ |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
862 command_line = LISP_STRING_TO_TSTR (args_or_ret); |
| 428 | 863 |
| 864 UNGCPRO; /* args_or_ret */ | |
| 865 } | |
| 866 | |
| 867 /* Set `proc_env' to a nul-separated array of the strings in | |
| 868 Vprocess_environment terminated by 2 nuls. */ | |
| 771 | 869 |
| 428 | 870 { |
| 867 | 871 Ibyte **env; |
| 428 | 872 REGISTER Lisp_Object tem; |
| 867 | 873 REGISTER Ibyte **new_env; |
| 771 | 874 REGISTER int new_length = 0, i; |
| 854 | 875 |
| 428 | 876 for (tem = Vprocess_environment; |
| 877 (CONSP (tem) | |
| 878 && STRINGP (XCAR (tem))); | |
| 879 tem = XCDR (tem)) | |
| 880 new_length++; | |
| 442 | 881 |
| 882 /* FSF adds an extra env var to hold the current process ID of the | |
| 883 Emacs process. Apparently this is used only by emacsserver.c, | |
| 771 | 884 which we have superseded by gnuserv.c. (#### Does it work under |
| 442 | 885 MS Windows?) |
| 886 | |
| 854 | 887 sprintf (ppid_env_var_buffer, "EM_PARENT_PROCESS_ID=%d", |
| 442 | 888 GetCurrentProcessId ()); |
| 889 arglen += strlen (ppid_env_var_buffer) + 1; | |
| 890 numenv++; | |
| 891 */ | |
| 854 | 892 |
| 428 | 893 /* new_length + 1 to include terminating 0. */ |
| 867 | 894 env = new_env = alloca_array (Ibyte *, new_length + 1); |
| 854 | 895 |
| 428 | 896 /* Copy the Vprocess_environment strings into new_env. */ |
| 897 for (tem = Vprocess_environment; | |
| 898 (CONSP (tem) | |
| 899 && STRINGP (XCAR (tem))); | |
| 900 tem = XCDR (tem)) | |
| 901 { | |
| 867 | 902 Ibyte **ep = env; |
| 903 Ibyte *string = XSTRING_DATA (XCAR (tem)); | |
| 428 | 904 /* See if this string duplicates any string already in the env. |
| 905 If so, don't put it in. | |
| 906 When an env var has multiple definitions, | |
| 907 we keep the definition that comes first in process-environment. */ | |
| 908 for (; ep != new_env; ep++) | |
| 909 { | |
| 867 | 910 Ibyte *p = *ep, *q = string; |
| 428 | 911 while (1) |
| 912 { | |
| 913 if (*q == 0) | |
| 914 /* The string is malformed; might as well drop it. */ | |
| 915 goto duplicate; | |
| 916 if (*q != *p) | |
| 917 break; | |
| 918 if (*q == '=') | |
| 919 goto duplicate; | |
| 920 p++, q++; | |
| 921 } | |
| 922 } | |
| 923 *new_env++ = string; | |
| 924 duplicate: ; | |
| 925 } | |
| 926 *new_env = 0; | |
| 854 | 927 |
| 428 | 928 /* Sort the environment variables */ |
| 929 new_length = new_env - env; | |
| 867 | 930 qsort (env, new_length, sizeof (Ibyte *), mswindows_compare_env); |
| 771 | 931 |
| 932 { | |
| 933 DECLARE_EISTRING (envout); | |
| 934 | |
| 935 for (i = 0; i < new_length; i++) | |
| 936 { | |
| 1204 | 937 eicat_raw (envout, env[i], qxestrlen (env[i])); |
| 938 eicat_raw (envout, (Ibyte *) "\0", 1); | |
| 771 | 939 } |
| 940 | |
| 1204 | 941 eicat_raw (envout, (Ibyte *) "\0", 1); |
| 771 | 942 eito_external (envout, Qmswindows_tstr); |
| 943 proc_env = eiextdata (envout); | |
| 944 } | |
| 428 | 945 } |
| 442 | 946 |
| 947 #if 0 | |
| 948 /* #### we need to port this. */ | |
| 949 /* On Windows 95, if cmdname is a DOS app, we invoke a helper | |
| 950 application to start it by specifying the helper app as cmdname, | |
| 951 while leaving the real app name as argv[0]. */ | |
| 952 if (is_dos_app) | |
| 953 { | |
| 2421 | 954 cmdname = alloca_ibytes (PATH_MAX_INTERNAL); |
| 442 | 955 if (egetenv ("CMDPROXY")) |
| 771 | 956 qxestrcpy (cmdname, egetenv ("CMDPROXY")); |
| 442 | 957 else |
| 958 { | |
| 771 | 959 qxestrcpy (cmdname, XSTRING_DATA (Vinvocation_directory)); |
| 867 | 960 qxestrcat (cmdname, (Ibyte *) "cmdproxy.exe"); |
| 442 | 961 } |
| 962 } | |
| 963 #endif | |
| 854 | 964 |
| 428 | 965 /* Create process */ |
| 966 { | |
| 771 | 967 STARTUPINFOW si; |
| 428 | 968 PROCESS_INFORMATION pi; |
| 969 DWORD err; | |
| 442 | 970 DWORD flags; |
| 428 | 971 |
| 972 xzero (si); | |
| 973 si.dwFlags = STARTF_USESHOWWINDOW; | |
| 974 si.wShowWindow = windowed ? SW_SHOWNORMAL : SW_HIDE; | |
| 975 if (do_io) | |
| 976 { | |
| 977 si.hStdInput = hprocin; | |
| 978 si.hStdOutput = hprocout; | |
| 430 | 979 si.hStdError = hprocerr; |
| 428 | 980 si.dwFlags |= STARTF_USESTDHANDLES; |
| 981 } | |
| 982 | |
| 442 | 983 flags = CREATE_SUSPENDED; |
| 771 | 984 if (mswindows_windows9x_p) |
| 442 | 985 flags |= (!NILP (Vmswindows_start_process_share_console) |
| 986 ? CREATE_NEW_PROCESS_GROUP | |
| 987 : CREATE_NEW_CONSOLE); | |
| 988 else | |
| 989 flags |= CREATE_NEW_CONSOLE | CREATE_NEW_PROCESS_GROUP; | |
| 990 if (NILP (Vmswindows_start_process_inherit_error_mode)) | |
| 991 flags |= CREATE_DEFAULT_ERROR_MODE; | |
| 992 | |
| 993 ensure_console_window_exists (); | |
| 994 | |
| 771 | 995 { |
| 996 Extbyte *curdirext; | |
| 997 | |
| 2526 | 998 LISP_PATHNAME_CONVERT_OUT (cur_dir, curdirext); |
| 771 | 999 |
| 1000 err = (qxeCreateProcess (NULL, command_line, NULL, NULL, TRUE, | |
| 1001 (XEUNICODE_P ? | |
| 1002 flags | CREATE_UNICODE_ENVIRONMENT : | |
| 1003 flags), proc_env, | |
| 1004 curdirext, &si, &pi) | |
| 1005 ? 0 : GetLastError ()); | |
| 1006 } | |
| 428 | 1007 |
| 1008 if (do_io) | |
| 1009 { | |
| 1010 /* These just have been inherited; we do not need a copy */ | |
| 1011 CloseHandle (hprocin); | |
| 1012 CloseHandle (hprocout); | |
| 430 | 1013 CloseHandle (hprocerr); |
| 428 | 1014 } |
| 854 | 1015 |
| 428 | 1016 /* Handle process creation failure */ |
| 1017 if (err) | |
| 1018 { | |
| 1019 if (do_io) | |
| 1020 { | |
| 1021 CloseHandle (hmyshove); | |
| 1022 CloseHandle (hmyslurp); | |
| 853 | 1023 if (separate_err) |
| 1024 CloseHandle (hmyslurp_err); | |
| 428 | 1025 } |
| 563 | 1026 mswindows_report_process_error |
| 1027 ("Error starting", | |
| 1028 program, GetLastError ()); | |
| 428 | 1029 } |
| 1030 | |
| 1031 /* The process started successfully */ | |
| 1032 if (do_io) | |
| 1033 { | |
| 1034 NT_DATA(p)->h_process = pi.hProcess; | |
| 442 | 1035 NT_DATA(p)->dwProcessId = pi.dwProcessId; |
| 853 | 1036 init_process_io_handles (p, (void *) hmyslurp, (void *) hmyshove, |
| 1037 separate_err ? (void *) hmyslurp_err | |
| 1038 : (void *) -1, 0); | |
| 428 | 1039 } |
| 1040 else | |
| 1041 { | |
| 1042 /* Indicate as if the process has exited immediately. */ | |
| 1043 p->status_symbol = Qexit; | |
| 1044 CloseHandle (pi.hProcess); | |
| 1045 } | |
| 1046 | |
| 442 | 1047 if (!windowed) |
| 1048 enable_child_signals (pi.hProcess); | |
| 1049 | |
| 428 | 1050 ResumeThread (pi.hThread); |
| 1051 CloseHandle (pi.hThread); | |
| 1052 | |
| 432 | 1053 return ((int)pi.dwProcessId); |
| 428 | 1054 } |
| 1055 } | |
| 1056 | |
| 854 | 1057 /* |
| 428 | 1058 * This method is called to update status fields of the process |
| 1059 * structure. If the process has not existed, this method is expected | |
| 1060 * to do nothing. | |
| 1061 * | |
| 854 | 1062 * The method is called only for real child processes. |
| 428 | 1063 */ |
| 1064 | |
| 1065 static void | |
| 771 | 1066 nt_update_status_if_terminated (Lisp_Process *p) |
| 428 | 1067 { |
| 1068 DWORD exit_code; | |
| 1069 if (GetExitCodeProcess (NT_DATA(p)->h_process, &exit_code) | |
| 1070 && exit_code != STILL_ACTIVE) | |
| 1071 { | |
| 1072 p->tick++; | |
| 1073 p->core_dumped = 0; | |
| 1074 /* The exit code can be a code returned by process, or an | |
| 1075 NTSTATUS value. We cannot accurately handle the latter since | |
| 1076 it is a full 32 bit integer */ | |
| 1077 if (exit_code & 0xC0000000) | |
| 1078 { | |
| 1079 p->status_symbol = Qsignal; | |
| 1080 p->exit_code = exit_code & 0x1FFFFFFF; | |
| 1081 } | |
| 1082 else | |
| 1083 { | |
| 1084 p->status_symbol = Qexit; | |
| 1085 p->exit_code = exit_code; | |
| 1086 } | |
| 1087 } | |
| 1088 } | |
| 1089 | |
| 1090 /* | |
| 1091 * Stuff the entire contents of LSTREAM to the process output pipe | |
| 1092 */ | |
| 1093 | |
| 1094 /* #### If only this function could be somehow merged with | |
| 1095 unix_send_process... */ | |
| 1096 | |
| 1097 static void | |
| 771 | 1098 nt_send_process (Lisp_Object proc, struct lstream *lstream) |
| 428 | 1099 { |
| 432 | 1100 volatile Lisp_Object vol_proc = proc; |
| 440 | 1101 Lisp_Process *volatile p = XPROCESS (proc); |
| 428 | 1102 |
| 1103 /* use a reasonable-sized buffer (somewhere around the size of the | |
| 1104 stream buffer) so as to avoid inundating the stream with blocked | |
| 1105 data. */ | |
| 867 | 1106 Ibyte chunkbuf[512]; |
| 428 | 1107 Bytecount chunklen; |
| 1108 | |
| 1109 while (1) | |
| 1110 { | |
| 771 | 1111 int writeret; |
| 428 | 1112 |
| 442 | 1113 chunklen = Lstream_read (lstream, chunkbuf, 512); |
| 428 | 1114 if (chunklen <= 0) |
| 2500 | 1115 break; /* perhaps should ABORT() if < 0? |
| 428 | 1116 This should never happen. */ |
| 1117 | |
| 1118 /* Lstream_write() will never successfully write less than the | |
| 1119 amount sent in. In the worst case, it just buffers the | |
| 1120 unwritten data. */ | |
| 771 | 1121 writeret = Lstream_write (XLSTREAM (DATA_OUTSTREAM (p)), chunkbuf, |
| 428 | 1122 chunklen); |
| 771 | 1123 Lstream_flush (XLSTREAM (DATA_OUTSTREAM (p))); |
| 428 | 1124 if (writeret < 0) |
| 1125 { | |
| 1126 p->status_symbol = Qexit; | |
| 1127 p->exit_code = ERROR_BROKEN_PIPE; | |
| 1128 p->core_dumped = 0; | |
| 1129 p->tick++; | |
| 1130 process_tick++; | |
| 432 | 1131 deactivate_process (*((Lisp_Object *) (&vol_proc))); |
| 442 | 1132 invalid_operation ("Broken pipe error sending to process; closed it", |
| 1133 p->name); | |
| 428 | 1134 } |
| 1135 | |
| 1136 { | |
| 1137 int wait_ms = 25; | |
| 1138 while (Lstream_was_blocked_p (XLSTREAM (p->pipe_outstream))) | |
| 1139 { | |
| 1140 /* Buffer is full. Wait, accepting input; that may allow | |
| 1141 the program to finish doing output and read more. */ | |
| 1142 Faccept_process_output (Qnil, Qzero, make_int (wait_ms)); | |
| 1143 Lstream_flush (XLSTREAM (p->pipe_outstream)); | |
| 1144 wait_ms = min (1000, 2 * wait_ms); | |
| 1145 } | |
| 1146 } | |
| 1147 } | |
| 1148 } | |
| 1149 | |
| 2367 | 1150 static void |
| 1151 nt_deactivate_process (Lisp_Process *p, | |
| 1152 USID *in_usid, | |
| 1153 USID *err_usid) | |
| 1154 { | |
| 1155 event_stream_delete_io_streams (p->pipe_instream, p->pipe_outstream, | |
| 1156 p->pipe_errstream, in_usid, err_usid); | |
| 1157 /* Go ahead and close the process handle now to prevent accumulation | |
| 1158 of handles when lots of processes are run. (The handle gets closed | |
| 1159 anyway upon GC, but that might be a ways away, esp. if | |
| 1160 deleted-exited-processes is set to nil.) */ | |
|
5124
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
2526
diff
changeset
|
1161 nt_finalize_process_data (p); |
| 2367 | 1162 } |
| 1163 | |
| 428 | 1164 /* |
| 1165 * Send a signal number SIGNO to PROCESS. | |
| 1166 * CURRENT_GROUP means send to the process group that currently owns | |
| 1167 * the terminal being used to communicate with PROCESS. | |
| 1168 * This is used for various commands in shell mode. | |
| 1169 * If NOMSG is zero, insert signal-announcements into process's buffers | |
| 1170 * right away. | |
| 1171 * | |
| 1172 * If we can, we try to signal PROCESS by sending control characters | |
| 1173 * down the pty. This allows us to signal inferiors who have changed | |
| 1174 * their uid, for which killpg would return an EPERM error. | |
| 1175 * | |
| 1176 * The method signals an error if the given SIGNO is not valid | |
| 1177 */ | |
| 1178 | |
| 1179 static void | |
| 1180 nt_kill_child_process (Lisp_Object proc, int signo, | |
| 2286 | 1181 int UNUSED (current_group), int UNUSED (nomsg)) |
| 428 | 1182 { |
| 440 | 1183 Lisp_Process *p = XPROCESS (proc); |
| 428 | 1184 |
| 1185 /* Signal error if SIGNO cannot be sent */ | |
| 1186 validate_signal_number (signo); | |
| 1187 | |
| 1188 /* Send signal */ | |
| 442 | 1189 if (!send_signal (NT_DATA (p), 0, signo)) |
| 1190 invalid_operation ("Cannot send signal to process", proc); | |
| 428 | 1191 } |
| 1192 | |
| 1193 /* | |
| 442 | 1194 * Kill any process in the system given its PID |
| 428 | 1195 * |
| 1196 * Returns zero if a signal successfully sent, or | |
| 1197 * negative number upon failure | |
| 1198 */ | |
| 1199 static int | |
| 1200 nt_kill_process_by_pid (int pid, int signo) | |
| 1201 { | |
| 442 | 1202 struct Lisp_Process *p; |
| 1203 | |
| 428 | 1204 /* Signal error if SIGNO cannot be sent */ |
| 1205 validate_signal_number (signo); | |
| 1206 | |
| 442 | 1207 p = find_process_from_pid (pid); |
| 1208 return send_signal (p ? NT_DATA (p) : 0, pid, signo) ? 0 : -1; | |
| 428 | 1209 } |
| 1210 | |
| 1211 /*-----------------------------------------------------------------------*/ | |
| 1212 /* Sockets connections */ | |
| 1213 /*-----------------------------------------------------------------------*/ | |
| 1214 #ifdef HAVE_SOCKETS | |
| 1215 | |
| 1216 /* #### Hey MS, how long Winsock 2 for '95 will be in beta? */ | |
| 1217 | |
| 1218 #define SOCK_TIMER_ID 666 | |
| 1219 #define XM_SOCKREPLY (WM_USER + 666) | |
| 1220 | |
| 563 | 1221 /* Return 0 for success, or error code */ |
| 1222 | |
| 428 | 1223 static int |
| 563 | 1224 get_internet_address (Lisp_Object host, struct sockaddr_in *address) |
| 428 | 1225 { |
| 2367 | 1226 CBinbyte buf[MAXGETHOSTSTRUCT]; |
| 428 | 1227 HWND hwnd; |
| 1228 HANDLE hasync; | |
| 563 | 1229 int errcode = 0; |
| 428 | 1230 |
| 1231 address->sin_family = AF_INET; | |
| 1232 | |
| 1233 /* First check if HOST is already a numeric address */ | |
| 1234 { | |
| 1204 | 1235 Extbyte *hostext; |
| 1236 unsigned long inaddr; | |
| 1237 | |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
1238 hostext = LISP_STRING_TO_EXTERNAL (host, Qmswindows_host_name_encoding); |
| 1204 | 1239 inaddr = inet_addr (hostext); |
| 428 | 1240 if (inaddr != INADDR_NONE) |
| 1241 { | |
| 1242 address->sin_addr.s_addr = inaddr; | |
| 563 | 1243 return 0; |
| 428 | 1244 } |
| 1245 } | |
| 1246 | |
| 1247 /* Create a window which will receive completion messages */ | |
| 771 | 1248 hwnd = qxeCreateWindow (XETEXT ("STATIC"), NULL, WS_OVERLAPPED, 0, 0, 1, 1, |
| 1249 NULL, NULL, NULL, NULL); | |
| 428 | 1250 assert (hwnd); |
| 1251 | |
| 1252 /* Post name resolution request */ | |
| 771 | 1253 { |
| 1254 Extbyte *hostext; | |
| 1255 | |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
1256 hostext = LISP_STRING_TO_EXTERNAL (host, Qmswindows_host_name_encoding); |
| 771 | 1257 |
| 1258 hasync = WSAAsyncGetHostByName (hwnd, XM_SOCKREPLY, hostext, | |
| 1259 buf, sizeof (buf)); | |
| 1260 if (hasync == NULL) | |
| 1261 { | |
| 1262 errcode = WSAGetLastError (); | |
| 1263 goto done; | |
| 1264 } | |
| 1265 } | |
| 428 | 1266 |
| 1267 /* Set a timer to poll for quit every 250 ms */ | |
| 1268 SetTimer (hwnd, SOCK_TIMER_ID, 250, NULL); | |
| 1269 | |
| 1270 while (1) | |
| 1271 { | |
| 1272 MSG msg; | |
| 800 | 1273 qxeGetMessage (&msg, hwnd, 0, 0); |
| 428 | 1274 if (msg.message == XM_SOCKREPLY) |
| 1275 { | |
| 1276 /* Ok, got an answer */ | |
| 563 | 1277 errcode = WSAGETASYNCERROR (msg.lParam); |
| 428 | 1278 goto done; |
| 1279 } | |
| 1280 else if (msg.message == WM_TIMER && msg.wParam == SOCK_TIMER_ID) | |
| 1281 { | |
| 1282 if (QUITP) | |
| 1283 { | |
| 1284 WSACancelAsyncRequest (hasync); | |
| 1285 KillTimer (hwnd, SOCK_TIMER_ID); | |
| 1286 DestroyWindow (hwnd); | |
| 853 | 1287 QUIT; |
| 428 | 1288 } |
| 1289 } | |
| 800 | 1290 qxeDispatchMessage (&msg); |
| 428 | 1291 } |
| 1292 | |
| 1293 done: | |
| 1294 KillTimer (hwnd, SOCK_TIMER_ID); | |
| 1295 DestroyWindow (hwnd); | |
| 563 | 1296 if (!errcode) |
| 428 | 1297 { |
| 1298 /* BUF starts with struct hostent */ | |
| 771 | 1299 struct hostent *he = (struct hostent *) buf; |
| 1300 address->sin_addr.s_addr = * (unsigned long *) he->h_addr_list[0]; | |
| 428 | 1301 } |
| 563 | 1302 return errcode; |
| 428 | 1303 } |
| 1304 | |
| 1305 static Lisp_Object | |
| 1306 nt_canonicalize_host_name (Lisp_Object host) | |
| 1307 { | |
| 1308 struct sockaddr_in address; | |
| 1309 | |
| 563 | 1310 if (get_internet_address (host, &address)) /* error */ |
| 428 | 1311 return host; |
| 1312 | |
| 1313 if (address.sin_family == AF_INET) | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
1314 return build_extstring (inet_ntoa (address.sin_addr), |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
2526
diff
changeset
|
1315 Qunix_host_name_encoding); |
| 428 | 1316 else |
| 1317 return host; | |
| 1318 } | |
| 1319 | |
| 1320 /* open a TCP network connection to a given HOST/SERVICE. Treated | |
| 1321 exactly like a normal process when reading and writing. Only | |
| 1322 differences are in status display and process deletion. A network | |
| 1323 connection has no PID; you cannot signal it. All you can do is | |
| 1324 deactivate and close it via delete-process */ | |
| 1325 | |
| 1326 static void | |
| 442 | 1327 nt_open_network_stream (Lisp_Object name, Lisp_Object host, |
| 1328 Lisp_Object service, | |
| 771 | 1329 Lisp_Object protocol, void **vinfd, void **voutfd) |
| 428 | 1330 { |
| 1331 struct sockaddr_in address; | |
| 1332 SOCKET s; | |
| 1333 int port; | |
| 1334 int retval; | |
| 563 | 1335 int errnum; |
| 428 | 1336 |
| 1337 CHECK_STRING (host); | |
| 1338 | |
| 1339 if (!EQ (protocol, Qtcp)) | |
| 563 | 1340 invalid_constant ("Unsupported protocol", protocol); |
| 428 | 1341 |
| 1342 if (INTP (service)) | |
| 1343 port = htons ((unsigned short) XINT (service)); | |
| 1344 else | |
| 1345 { | |
| 1346 struct servent *svc_info; | |
| 771 | 1347 Extbyte *servext; |
| 1348 | |
| 428 | 1349 CHECK_STRING (service); |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
1350 servext = LISP_STRING_TO_EXTERNAL (service, |
|
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
1351 Qmswindows_service_name_encoding); |
| 771 | 1352 |
| 1353 svc_info = getservbyname (servext, "tcp"); | |
| 428 | 1354 if (svc_info == 0) |
| 442 | 1355 invalid_argument ("Unknown service", service); |
| 428 | 1356 port = svc_info->s_port; |
| 1357 } | |
| 1358 | |
| 563 | 1359 retval = get_internet_address (host, &address); |
| 1360 if (retval) | |
| 1361 mswindows_report_winsock_error ("Getting IP address", host, | |
| 1362 retval); | |
| 428 | 1363 address.sin_port = port; |
| 1364 | |
| 1365 s = socket (address.sin_family, SOCK_STREAM, 0); | |
| 1366 if (s < 0) | |
| 563 | 1367 mswindows_report_winsock_error ("Creating socket", name, |
| 1368 WSAGetLastError ()); | |
| 428 | 1369 |
| 1370 /* We don't want to be blocked on connect */ | |
| 1371 { | |
| 1372 unsigned long nonblock = 1; | |
| 1373 ioctlsocket (s, FIONBIO, &nonblock); | |
| 1374 } | |
| 854 | 1375 |
| 428 | 1376 retval = connect (s, (struct sockaddr *) &address, sizeof (address)); |
| 1377 if (retval != NO_ERROR && WSAGetLastError() != WSAEWOULDBLOCK) | |
| 563 | 1378 { |
| 1379 errnum = WSAGetLastError (); | |
| 1380 goto connect_failed; | |
| 1381 } | |
| 1382 | |
| 1383 #if 0 /* PUTA! I thought getsockopt() was failing, so I created the | |
| 1384 following based on the code in get_internet_address(), but | |
| 1385 it was my own fault down below. Both versions should work. */ | |
| 428 | 1386 /* Wait while connection is established */ |
| 563 | 1387 { |
| 1388 HWND hwnd; | |
| 1389 | |
| 1390 /* Create a window which will receive completion messages */ | |
| 771 | 1391 hwnd = qxeCreateWindow (XETEXT ("STATIC"), NULL, WS_OVERLAPPED, 0, 0, 1, 1, |
| 1392 NULL, NULL, NULL, NULL); | |
| 563 | 1393 assert (hwnd); |
| 1394 | |
| 1395 /* Post request */ | |
| 1396 if (WSAAsyncSelect (s, hwnd, XM_SOCKREPLY, FD_CONNECT)) | |
| 1397 { | |
| 1398 errnum = WSAGetLastError (); | |
| 1399 goto done; | |
| 1400 } | |
| 1401 | |
| 1402 /* Set a timer to poll for quit every 250 ms */ | |
| 1403 SetTimer (hwnd, SOCK_TIMER_ID, 250, NULL); | |
| 1404 | |
| 1405 while (1) | |
| 1406 { | |
| 1407 MSG msg; | |
| 1408 GetMessage (&msg, hwnd, 0, 0); | |
| 1409 if (msg.message == XM_SOCKREPLY) | |
| 1410 { | |
| 1411 /* Ok, got an answer */ | |
| 1412 errnum = WSAGETASYNCERROR (msg.lParam); | |
| 1413 goto done; | |
| 1414 } | |
| 1415 | |
| 1416 else if (msg.message == WM_TIMER && msg.wParam == SOCK_TIMER_ID) | |
| 1417 { | |
| 1418 if (QUITP) | |
| 1419 { | |
| 1420 WSAAsyncSelect (s, hwnd, XM_SOCKREPLY, 0); | |
| 1421 KillTimer (hwnd, SOCK_TIMER_ID); | |
| 1422 DestroyWindow (hwnd); | |
| 853 | 1423 QUIT; |
| 563 | 1424 } |
| 1425 } | |
| 1426 DispatchMessage (&msg); | |
| 1427 } | |
| 1428 | |
| 1429 done: | |
| 1430 WSAAsyncSelect (s, hwnd, XM_SOCKREPLY, 0); | |
| 1431 KillTimer (hwnd, SOCK_TIMER_ID); | |
| 1432 DestroyWindow (hwnd); | |
| 1433 if (errnum) | |
| 1434 goto connect_failed; | |
| 1435 } | |
| 1436 | |
| 1437 #else | |
| 428 | 1438 while (1) |
| 1439 { | |
| 563 | 1440 fd_set fdwriteset, fdexceptset; |
| 428 | 1441 struct timeval tv; |
| 1442 int nsel; | |
| 1443 | |
| 1444 if (QUITP) | |
| 1445 { | |
| 1446 closesocket (s); | |
| 853 | 1447 QUIT; |
| 428 | 1448 } |
| 1449 | |
| 1450 /* Poll for quit every 250 ms */ | |
| 1451 tv.tv_sec = 0; | |
| 1452 tv.tv_usec = 250 * 1000; | |
| 1453 | |
| 563 | 1454 FD_ZERO (&fdwriteset); |
| 1455 FD_SET (s, &fdwriteset); | |
| 1456 FD_ZERO (&fdexceptset); | |
| 1457 FD_SET (s, &fdexceptset); | |
| 1458 nsel = select (0, NULL, &fdwriteset, &fdexceptset, &tv); | |
| 1459 | |
| 1460 if (nsel == SOCKET_ERROR) | |
| 1461 { | |
| 1462 errnum = WSAGetLastError (); | |
| 1463 goto connect_failed; | |
| 1464 } | |
| 428 | 1465 |
| 1466 if (nsel > 0) | |
| 1467 { | |
| 1468 /* Check: was connection successful or not? */ | |
| 563 | 1469 if (FD_ISSET (s, &fdwriteset)) |
| 1470 break; | |
| 1471 else if (FD_ISSET (s, &fdexceptset)) | |
| 1472 { | |
| 1473 int store_me_harder = sizeof (errnum); | |
| 1474 /* OK, we finally can get the REAL error code. Any paths | |
| 1475 in this code that lead to a call of WSAGetLastError() | |
| 1476 indicate probable logic failure. */ | |
| 1477 if (getsockopt (s, SOL_SOCKET, SO_ERROR, (char *) &errnum, | |
| 1478 &store_me_harder)) | |
| 1479 errnum = WSAGetLastError (); | |
| 1480 goto connect_failed; | |
| 1481 } | |
| 428 | 1482 else |
| 563 | 1483 { |
| 1484 signal_error (Qinternal_error, | |
| 1485 "Porra, esse caralho de um sistema de operacao", | |
| 1486 Qunbound); | |
| 1487 break; | |
| 1488 } | |
| 428 | 1489 } |
| 1490 } | |
| 563 | 1491 #endif |
| 428 | 1492 |
| 1493 /* We are connected at this point */ | |
| 771 | 1494 *vinfd = (void *)s; |
| 428 | 1495 DuplicateHandle (GetCurrentProcess(), (HANDLE)s, |
| 1496 GetCurrentProcess(), (LPHANDLE)voutfd, | |
| 1497 0, FALSE, DUPLICATE_SAME_ACCESS); | |
| 1498 return; | |
| 1499 | |
| 563 | 1500 connect_failed: |
| 1501 { | |
| 1502 closesocket (s); | |
| 1503 mswindows_report_winsock_error ("Connection failed", | |
| 1504 list3 (Qunbound, host, service), | |
| 1505 errnum); | |
| 1506 } | |
| 428 | 1507 } |
| 1508 | |
| 1509 #endif | |
| 771 | 1510 |
| 1511 | |
| 1512 DEFUN ("mswindows-set-process-priority", Fmswindows_set_process_priority, 2, 2, "", /* | |
| 1513 Set the priority of PROCESS to PRIORITY. | |
| 1514 If PROCESS is nil, the priority of Emacs is changed, otherwise the | |
| 1515 priority of the process whose pid is PROCESS is changed. | |
| 1516 PRIORITY should be one of the symbols high, normal, or low; | |
| 1517 any other symbol will be interpreted as normal. | |
| 1518 | |
| 1519 If successful, the return value is t, otherwise nil. | |
| 1520 */ | |
| 1521 (process, priority)) | |
| 1522 { | |
| 1523 HANDLE proc_handle = GetCurrentProcess (); | |
| 1524 DWORD priority_class = NORMAL_PRIORITY_CLASS; | |
| 1525 Lisp_Object result = Qnil; | |
| 1526 | |
| 1527 CHECK_SYMBOL (priority); | |
| 1528 | |
| 1529 if (!NILP (process)) | |
| 1530 { | |
| 1531 DWORD pid; | |
| 1532 struct Lisp_Process *p = 0; | |
| 1533 | |
| 1534 if (PROCESSP (process)) | |
| 1535 { | |
| 1536 CHECK_LIVE_PROCESS (process); | |
| 1537 p = XPROCESS (process); | |
| 1538 pid = NT_DATA (p)->dwProcessId; | |
| 1539 } | |
| 1540 else | |
| 1541 { | |
| 1542 CHECK_INT (process); | |
| 1543 | |
| 1544 /* Allow pid to be an internally generated one, or one obtained | |
| 1545 externally. This is necessary because real pids on Win95 are | |
| 1546 negative. */ | |
| 1547 | |
| 1548 pid = XINT (process); | |
| 1549 p = find_process_from_pid (pid); | |
| 1550 if (p != NULL) | |
| 1551 pid = NT_DATA (p)->dwProcessId; | |
| 1552 } | |
| 1553 | |
| 1554 /* #### Should we be using the existing process handle from NT_DATA(p)? | |
| 1555 Will we fail if we open it a second time? */ | |
| 1556 proc_handle = OpenProcess (PROCESS_SET_INFORMATION, FALSE, pid); | |
| 1557 } | |
| 1558 | |
| 1559 if (EQ (priority, Qhigh)) | |
| 1560 priority_class = HIGH_PRIORITY_CLASS; | |
| 1561 else if (EQ (priority, Qlow)) | |
| 1562 priority_class = IDLE_PRIORITY_CLASS; | |
| 1563 | |
| 1564 if (proc_handle != NULL) | |
| 1565 { | |
| 1566 if (SetPriorityClass (proc_handle, priority_class)) | |
| 1567 result = Qt; | |
| 1568 if (!NILP (process)) | |
| 1569 CloseHandle (proc_handle); | |
| 1570 } | |
| 1571 | |
| 1572 return result; | |
| 1573 } | |
| 1574 | |
| 428 | 1575 |
| 1576 /*-----------------------------------------------------------------------*/ | |
| 1577 /* Initialization */ | |
| 1578 /*-----------------------------------------------------------------------*/ | |
| 1579 | |
| 1580 void | |
| 1581 process_type_create_nt (void) | |
| 1582 { | |
| 1583 PROCESS_HAS_METHOD (nt, alloc_process_data); | |
| 1584 PROCESS_HAS_METHOD (nt, finalize_process_data); | |
| 1585 PROCESS_HAS_METHOD (nt, init_process); | |
| 1586 PROCESS_HAS_METHOD (nt, create_process); | |
| 1587 PROCESS_HAS_METHOD (nt, update_status_if_terminated); | |
| 1588 PROCESS_HAS_METHOD (nt, send_process); | |
| 2367 | 1589 PROCESS_HAS_METHOD (nt, deactivate_process); |
| 428 | 1590 PROCESS_HAS_METHOD (nt, kill_child_process); |
| 1591 PROCESS_HAS_METHOD (nt, kill_process_by_pid); | |
| 1592 #ifdef HAVE_SOCKETS | |
| 1593 PROCESS_HAS_METHOD (nt, canonicalize_host_name); | |
| 1594 PROCESS_HAS_METHOD (nt, open_network_stream); | |
| 1595 #ifdef HAVE_MULTICAST | |
| 1596 #error I won't do this until '95 has winsock2 | |
| 1597 PROCESS_HAS_METHOD (nt, open_multicast_group); | |
| 1598 #endif | |
| 1599 #endif | |
| 1600 } | |
| 1601 | |
| 1602 void | |
| 1603 syms_of_process_nt (void) | |
| 1604 { | |
| 771 | 1605 DEFSUBR (Fmswindows_set_process_priority); |
| 442 | 1606 DEFSYMBOL (Qmswindows_construct_process_command_line); |
| 428 | 1607 } |
| 1608 | |
| 1609 void | |
| 1610 vars_of_process_nt (void) | |
| 1611 { | |
| 442 | 1612 DEFVAR_LISP ("mswindows-start-process-share-console", |
| 1613 &Vmswindows_start_process_share_console /* | |
| 1614 When nil, new child processes are given a new console. | |
| 1615 When non-nil, they share the Emacs console; this has the limitation of | |
| 638 | 1616 allowing only one DOS subprocess to run at a time (whether started directly |
| 442 | 1617 or indirectly by Emacs), and preventing Emacs from cleanly terminating the |
| 1618 subprocess group, but may allow Emacs to interrupt a subprocess that doesn't | |
| 1619 otherwise respond to interrupts from Emacs. | |
| 1620 */ ); | |
| 1621 Vmswindows_start_process_share_console = Qnil; | |
| 1622 | |
| 1623 DEFVAR_LISP ("mswindows-start-process-inherit-error-mode", | |
| 1624 &Vmswindows_start_process_inherit_error_mode /* | |
| 1625 "When nil, new child processes revert to the default error mode. | |
| 1626 When non-nil, they inherit their error mode setting from Emacs, which stops | |
| 1627 them blocking when trying to access unmounted drives etc. | |
| 1628 */ ); | |
| 1629 Vmswindows_start_process_inherit_error_mode = Qt; | |
| 428 | 1630 } |