diff --git a/src/c/symbols_list.h b/src/c/symbols_list.h index bebcfb9ac..cce36efc2 100755 --- a/src/c/symbols_list.h +++ b/src/c/symbols_list.h @@ -1211,6 +1211,7 @@ cl_symbols[] = { {SYS_ "REPLACE-ARRAY", SI_ORDINARY, si_replace_array, 2, OBJNULL}, {SYS_ "ROW-MAJOR-ASET", SI_ORDINARY, si_row_major_aset, 3, OBJNULL}, {EXT_ "RUN-PROGRAM", EXT_ORDINARY, si_run_program, -1, OBJNULL}, +{SYS_ "WAIT-FOR-ALL-PROCESSES", SI_ORDINARY, si_wait_for_all_processes, -1, OBJNULL}, {EXT_ "SAFE-EVAL", EXT_ORDINARY, si_safe_eval, -1, OBJNULL}, {SYS_ "SCH-FRS-BASE", SI_ORDINARY, si_sch_frs_base, 2, OBJNULL}, {SYS_ "SCHAR-SET", SI_ORDINARY, si_char_set, 3, OBJNULL}, @@ -1717,7 +1718,7 @@ cl_symbols[] = { {SYS_ "TRAP-FPE", SI_ORDINARY, si_trap_fpe, 2, OBJNULL}, -{SYS_ "*ACTION-ON-UNDEFINED-VARIABLE*", SI_SPECIAL, NULL, -1, Cnil}, +{EXT_ "*ACTION-ON-UNDEFINED-VARIABLE*", EXT_SPECIAL, NULL, -1, Cnil}, {SYS_ "SET-BUFFERING-MODE", SI_ORDINARY, si_set_buffering_mode, 2, OBJNULL}, {KEY_ "NONE", KEYWORD, NULL, -1, OBJNULL}, diff --git a/src/c/symbols_list2.h b/src/c/symbols_list2.h index 4c6a3ed03..67a60b1c9 100644 --- a/src/c/symbols_list2.h +++ b/src/c/symbols_list2.h @@ -1211,6 +1211,7 @@ cl_symbols[] = { {SYS_ "REPLACE-ARRAY","si_replace_array"}, {SYS_ "ROW-MAJOR-ASET","si_row_major_aset"}, {EXT_ "RUN-PROGRAM","si_run_program"}, +{SYS_ "WAIT-FOR-ALL-PROCESSES","si_wait_for_all_processes"}, {EXT_ "SAFE-EVAL","si_safe_eval"}, {SYS_ "SCH-FRS-BASE","si_sch_frs_base"}, {SYS_ "SCHAR-SET","si_char_set"}, @@ -1717,7 +1718,7 @@ cl_symbols[] = { {SYS_ "TRAP-FPE","si_trap_fpe"}, -{SYS_ "*ACTION-ON-UNDEFINED-VARIABLE*",NULL}, +{EXT_ "*ACTION-ON-UNDEFINED-VARIABLE*",NULL}, {SYS_ "SET-BUFFERING-MODE","si_set_buffering_mode"}, {KEY_ "NONE",NULL}, diff --git a/src/c/time.d b/src/c/time.d index 45f9b5dba..4cc4e511d 100644 --- a/src/c/time.d +++ b/src/c/time.d @@ -19,6 +19,7 @@ #include #ifndef _MSC_VER # include +# include #endif #if defined(_MSC_VER) || defined(__MINGW32__) # include @@ -142,9 +143,19 @@ cl_sleep(cl_object z) } ECL_WITHOUT_FPE_END; #ifdef HAVE_NANOSLEEP { + int code; tm.tv_sec = (time_t)floor(time); tm.tv_nsec = (long)((time - floor(time)) * 1e9); - nanosleep(&tm, NULL); + AGAIN: + ecl_disable_interrupts(); + code = nanosleep(&tm, NULL); + { + int old_errno = errno; + ecl_enable_interrupts(); + if (code < 0 && old_errno == EINTR) { + goto AGAIN; + } + } } #else #if defined (ECL_MS_WINDOWS_HOST) diff --git a/src/c/unixint.d b/src/c/unixint.d index 9dc7c91f9..e8891770f 100644 --- a/src/c/unixint.d +++ b/src/c/unixint.d @@ -348,8 +348,7 @@ handler_fn_protype(lisp_signal_handler, int sig, siginfo_t *info, void *aux) #endif #ifdef SIGCHLD case SIGCHLD: - ecl_query_all_processes_status(0); - return Cnil; + return SYM_FUN(@'si::wait-for-all-processes'); #endif default: return MAKE_FIXNUM(sig); @@ -926,7 +925,9 @@ asynchronous_signal_servicing_thread() * use to communicate process interrupts. For some unknown * reason those signals may get lost. */ +#ifdef SIGCHLD sigaddset(&handled_set, SIGCHLD); +#endif if (interrupt_signal) { sigaddset(&handled_set, interrupt_signal); pthread_sigmask(SIG_SETMASK, &handled_set, NULL); @@ -940,7 +941,7 @@ asynchronous_signal_servicing_thread() goto RETURN; #ifdef SIGCHLD if (signo == SIGCHLD) { - ecl_query_all_processes_status(1); + si_wait_for_all_processes(0); continue; } #endif @@ -1049,8 +1050,8 @@ install_asynchronous_signal_handlers() if (ecl_get_option(ECL_OPT_TRAP_SIGCHLD)) { /* We have to set the process signal handler explicitly, * because on many platforms the default is SIG_IGN. */ - mysignal(SIGCHLD, non_evil_signal_handler); - async_handler(SIGCHLD, non_evil_signal_handler, &sigmask); + mysignal(SIGCHLD, lisp_signal_handler); + async_handler(SIGCHLD, lisp_signal_handler, &sigmask); } #endif #ifdef HAVE_SIGPROCMASK diff --git a/src/c/unixsys.d b/src/c/unixsys.d index 794d861ae..ea46754bb 100755 --- a/src/c/unixsys.d +++ b/src/c/unixsys.d @@ -285,13 +285,14 @@ ecl_waitpid(cl_object pid, cl_object wait) @(return status code pid) } -void -ecl_query_all_processes_status(int lock) +@(defun si::wait-for-all-processes (&optional flag) +@ { #if defined(SIGCHLD) && !defined(ECL_WINDOWS_HOST) const cl_env_ptr env = ecl_process_env(); # ifdef ECL_THREADS - if (lock) { + if (Null(flag)) { + /* We come from the parallel thread, must lock */ ECL_WITH_LOCK_BEGIN(env, cl_core.external_processes_lock) { ecl_query_all_processes_status(0); } ECL_WITH_LOCK_END(env, cl_core.external_processes_lock); @@ -320,6 +321,7 @@ ecl_query_all_processes_status(int lock) #error "FOO" #endif } +@) #if defined(ECL_MS_WINDOWS_HOST) cl_object @@ -689,7 +691,7 @@ make_windows_handle(HANDLE h) add_external_process(the_env, process); /* We have to protect this, to avoid the signal being delivered or handled * before we set the process pid */ - ecl_disable_interrupts_env(the_env); + ecl_bds_bind(the_env, @'ext::*interrupts-enabled*', Cnil); ECL_WITH_LOCK_BEGIN(the_env, cl_core.external_processes_lock) { child_pid = fork(); if (child_pid == 0) { @@ -728,7 +730,8 @@ make_windows_handle(HANDLE h) } set_external_process_pid(process, pid); } ECL_WITH_LOCK_END; - ecl_enable_interrupts_env(the_env); + ecl_bds_unwind1(the_env); + ecl_check_pending_interrupts(); close(child_stdin); close(child_stdout); close(child_stderr); diff --git a/src/h/internal.h b/src/h/internal.h index 5356e25a7..4cab61e48 100644 --- a/src/h/internal.h +++ b/src/h/internal.h @@ -441,7 +441,7 @@ extern cl_object mp_get_rwlock_write_wait(cl_object lock); extern void ecl_interrupt_process(cl_object process, cl_object function); /* unixsys.d */ -extern void ecl_query_all_processes_status(int lock); +extern cl_object si_wait_for_all_processes(cl_narg,...); /* * Fake several ISO C99 mathematical functions