From: Pascal Obry Date: Mon, 26 Oct 2015 11:59:42 +0000 (+0000) Subject: s-os_lib.ads, [...] (Kill): New routine. X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=3fee081aa9efc529c87f812e1b04d691d8c13c88;p=gcc.git s-os_lib.ads, [...] (Kill): New routine. 2015-10-26 Pascal Obry * s-os_lib.ads, s-os_lib.adb (Kill): New routine. This routine makes visible support for killing processes in expect.c. * expect.c (__gnat_kill): Removed from here. * adaint.c (__gnat_kill): Added here to be usable in the compiler (System.OS_Lib). * make.adb (Sigint_Intercepted): Use the Kill routine from System.OS_Lib. From-SVN: r229348 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 87bf6be7ba5..62367175f26 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,13 @@ +2015-10-26 Pascal Obry + + * s-os_lib.ads, s-os_lib.adb (Kill): New routine. This routine + makes visible support for killing processes in expect.c. + * expect.c (__gnat_kill): Removed from here. + * adaint.c (__gnat_kill): Added here to be usable in the compiler + (System.OS_Lib). + * make.adb (Sigint_Intercepted): Use the Kill routine from + System.OS_Lib. + 2015-10-26 Arnaud Charlet * einfo.ads, einfo.adb, exp_unst.adb (Needs_Typedef, diff --git a/gcc/ada/adaint.c b/gcc/ada/adaint.c index 59032470365..df6dbffaadf 100644 --- a/gcc/ada/adaint.c +++ b/gcc/ada/adaint.c @@ -168,6 +168,7 @@ UINT CurrentCCSEncoding; #if defined (_WIN32) #include +#include #include #include #include @@ -3183,6 +3184,35 @@ __gnat_get_executable_load_address (void) #endif } +void +__gnat_kill (int pid, int sig, int close ATTRIBUTE_UNUSED) +{ +#if defined(_WIN32) + HANDLE h = OpenProcess (PROCESS_ALL_ACCESS, FALSE, pid); + if (h == NULL) + return; + if (sig == 9) + { + TerminateProcess (h, 0); + __gnat_win32_remove_handle (NULL, pid); + } + else if (sig == SIGINT) + GenerateConsoleCtrlEvent (CTRL_C_EVENT, pid); + else if (sig == SIGBREAK) + GenerateConsoleCtrlEvent (CTRL_BREAK_EVENT, pid); + /* ??? The last two alternatives don't really work. SIGBREAK requires setting + up process groups at start time which we don't do; treating SIGINT is just + not possible apparently. So we really only support signal 9. Fortunately + that's all we use in GNAT.Expect */ + + CloseHandle (h); +#elif defined (__vxworks) + /* Not implemented */ +#else + kill (pid, sig); +#endif +} + #ifdef __cplusplus } #endif diff --git a/gcc/ada/expect.c b/gcc/ada/expect.c index a6c1c8fee03..4da70180b77 100644 --- a/gcc/ada/expect.c +++ b/gcc/ada/expect.c @@ -83,29 +83,6 @@ #include #include "mingw32.h" -void -__gnat_kill (int pid, int sig, int close) -{ - HANDLE h = OpenProcess (PROCESS_ALL_ACCESS, FALSE, pid); - if (h == NULL) - return; - if (sig == 9) - { - TerminateProcess (h, 0); - __gnat_win32_remove_handle (NULL, pid); - } - else if (sig == SIGINT) - GenerateConsoleCtrlEvent (CTRL_C_EVENT, pid); - else if (sig == SIGBREAK) - GenerateConsoleCtrlEvent (CTRL_BREAK_EVENT, pid); - /* ??? The last two alternatives don't really work. SIGBREAK requires setting - up process groups at start time which we don't do; treating SIGINT is just - not possible apparently. So we really only support signal 9. Fortunately - that's all we use in GNAT.Expect */ - - CloseHandle (h); -} - int __gnat_waitpid (int pid) { @@ -214,12 +191,6 @@ __gnat_expect_poll (int *fd, #include #include -void -__gnat_kill (int pid, int sig, int close) -{ - kill (pid, sig); -} - int __gnat_waitpid (int pid) { @@ -371,12 +342,6 @@ typedef long fd_mask; #endif /* !_IBMR2 */ #endif /* !NO_FD_SET */ -void -__gnat_kill (int pid, int sig, int close) -{ - kill (pid, sig); -} - int __gnat_waitpid (int pid) { @@ -497,13 +462,6 @@ __gnat_expect_poll (int *fd, #else -void -__gnat_kill (int pid ATTRIBUTE_UNUSED, - int sig ATTRIBUTE_UNUSED, - int close ATTRIBUTE_UNUSED) -{ -} - int __gnat_waitpid (int pid ATTRIBUTE_UNUSED, int sig ATTRIBUTE_UNUSED) { diff --git a/gcc/ada/make.adb b/gcc/ada/make.adb index 90eb0ed1c9c..f4bd63c81b2 100644 --- a/gcc/ada/make.adb +++ b/gcc/ada/make.adb @@ -87,10 +87,6 @@ package body Make is -- Every program depends on this package, that must then be checked, -- especially when -f and -a are used. - procedure Kill (Pid : Process_Id; Sig_Num : Integer; Close : Integer); - pragma Import (C, Kill, "__gnat_kill"); - -- Called by Sigint_Intercepted to kill all spawned compilation processes - type Sigint_Handler is access procedure; pragma Convention (C, Sigint_Handler); @@ -7306,8 +7302,6 @@ package body Make is ------------------------ procedure Sigint_Intercepted is - SIGINT : constant := 2; - begin Set_Standard_Error; Write_Line ("*** Interrupted ***"); @@ -7315,7 +7309,7 @@ package body Make is -- Send SIGINT to all outstanding compilation processes spawned for J in 1 .. Outstanding_Compiles loop - Kill (Running_Compile (J).Pid, SIGINT, 1); + Kill (Running_Compile (J).Pid, Hard_Kill => False); end loop; Finish_Program (Project_Tree, E_No_Compile); diff --git a/gcc/ada/s-os_lib.adb b/gcc/ada/s-os_lib.adb index 46fdd006784..61c0b41ea16 100644 --- a/gcc/ada/s-os_lib.adb +++ b/gcc/ada/s-os_lib.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1995-2014, AdaCore -- +-- Copyright (C) 1995-2015, AdaCore -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -1497,6 +1497,25 @@ package body System.OS_Lib is return Is_Writable_File (F_Name'Address); end Is_Writable_File; + ---------- + -- Kill -- + ---------- + + procedure Kill (Pid : Process_Id; Hard_Kill : Boolean := True) is + SIGKILL : constant := 9; + SIGINT : constant := 2; + + procedure C_Kill (Pid : Process_Id; Sig_Num : Integer; Close : Integer); + pragma Import (C, C_Kill, "__gnat_kill"); + + begin + if Hard_Kill then + C_Kill (Pid, SIGKILL, 1); + else + C_Kill (Pid, SIGINT, 1); + end if; + end Kill; + ------------------------- -- Locate_Exec_On_Path -- ------------------------- diff --git a/gcc/ada/s-os_lib.ads b/gcc/ada/s-os_lib.ads index 142937ea414..e9bb9bf65b9 100644 --- a/gcc/ada/s-os_lib.ads +++ b/gcc/ada/s-os_lib.ads @@ -876,6 +876,16 @@ package System.OS_Lib is -- This function will always set success to False under VxWorks, since -- there is no notion of executables under this OS. + procedure Kill (Pid : Process_Id; Hard_Kill : Boolean := True); + -- Kill process known as Pid by the OS. Does nothing if Pid is + -- Invalid_Pid or on platforms where it is not supported like + -- VxWorks. + -- Hard_Kill is True by default and in this case the process + -- is terminated immediately. If Hard_Kill is False a signal + -- SIGINT is sent to the process on POSIX OS or a CTRL-C event + -- on Windows, this let the process a chance to quit properly + -- using a corresponding handler. + function Argument_String_To_List (Arg_String : String) return Argument_List_Access; -- Take a string that is a program and its arguments and parse it into an