On Fri, 5 Aug 2011 00:11:51 -0400
Matthew Mondor <mm_li...@pulsar-zone.net> wrote:
> > So I here attach what I have so far in case it's obvious to you; I
> > might be able to resume working on it this weekend.
>
> Argh, I should have checked the diff first. Beware: previous mangles
> the KEYWORD symbol to |kEYWORD|, here's the updated diff.
Oh well, when getting ready for bed I realized that the @ preprocessor
might have always be producing a nargs argument even for functions not
using &key/&optional, so I did a last test and this appears to now be
working fine for me. Sorry for the repetition.
--
Matt
diff --git a/src/c/symbols_list.h b/src/c/symbols_list.h
index 43577b0..dc122f6 100755
--- a/src/c/symbols_list.h
+++ b/src/c/symbols_list.h
@@ -1292,7 +1292,8 @@ cl_symbols[] = {
{SYS_ "LOOKUP-HOST-ENTRY", SI_ORDINARY, IF_TCP(si_lookup_host_entry), 1,
OBJNULL},
/* #endif TCP */
-{EXT_ "CATCH-SIGNAL", EXT_ORDINARY, si_catch_signal, -1, OBJNULL},
+{EXT_ "POSIX-SIGNAL-ACTION", EXT_ORDINARY, si_posix_signal_action, 2, OBJNULL},
+{EXT_ "POSIX-SIGNAL-MASK", EXT_ORDINARY, si_posix_signal_mask, -1, OBJNULL},
/* KEYWORD PACKAGE */
{KEY_ "ADJUSTABLE", KEYWORD, NULL, -1, OBJNULL},
@@ -1306,6 +1307,7 @@ cl_symbols[] = {
{KEY_ "BLOCK", KEYWORD, NULL, -1, OBJNULL},
{KEY_ "CAPITALIZE", KEYWORD, NULL, -1, OBJNULL},
{KEY_ "CASE", KEYWORD, NULL, -1, OBJNULL},
+{KEY_ "CATCH", KEYWORD, NULL, -1, OBJNULL},
{KEY_ "CIRCLE", KEYWORD, NULL, -1, OBJNULL},
{KEY_ "COMPILE-TOPLEVEL", KEYWORD, NULL, -1, OBJNULL},
{KEY_ "COMMON",KEYWORD,NULL,-1,OBJNULL},
@@ -1343,10 +1345,12 @@ cl_symbols[] = {
{KEY_ "FORMAT-CONTROL", KEYWORD, NULL, -1, OBJNULL},
{KEY_ "FUNCTION", KEYWORD, NULL, -1, OBJNULL},
{KEY_ "GENSYM", KEYWORD, NULL, -1, OBJNULL},
+{KEY_ "GLOBAL", KEYWORD, NULL, -1, OBJNULL},
{KEY_ "HOST", KEYWORD, NULL, -1, OBJNULL},
{KEY_ "IF-DOES-NOT-EXIST", KEYWORD, NULL, -1, OBJNULL},
{KEY_ "IF-EXISTS", KEYWORD, NULL, -1, OBJNULL},
{KEY_ "IF-OUTPUT-EXISTS", KEYWORD, NULL, -1, OBJNULL},
+{KEY_ "IGNORE", KEYWORD, NULL, -1, OBJNULL},
{KEY_ "IMPORT-FROM", KEYWORD, NULL, -1, OBJNULL},
{KEY_ "INCLUDE", KEYWORD, NULL, -1, OBJNULL},
{KEY_ "INHERITED", KEYWORD, NULL, -1, OBJNULL},
@@ -1401,6 +1405,7 @@ cl_symbols[] = {
{KEY_ "RENAME-AND-DELETE", KEYWORD, NULL, -1, OBJNULL},
{KEY_ "REPORT", KEYWORD, NULL, -1, OBJNULL},
{KEY_ "RIGHT-MARGIN", KEYWORD, NULL, -1, OBJNULL},
+{KEY_ "SCOPE", KEYWORD, NULL, -1, OBJNULL},
{KEY_ "SET-DEFAULT-PATHNAME", KEYWORD, NULL, -1, OBJNULL},
{KEY_ "SEARCH-LIST", KEYWORD, NULL, -1, OBJNULL},
{KEY_ "SHADOW", KEYWORD, NULL, -1, OBJNULL},
diff --git a/src/c/symbols_list2.h b/src/c/symbols_list2.h
index 557636e..1934c27 100644
--- a/src/c/symbols_list2.h
+++ b/src/c/symbols_list2.h
@@ -1292,7 +1292,8 @@ cl_symbols[] = {
{SYS_ "LOOKUP-HOST-ENTRY",IF_TCP("si_lookup_host_entry")},
/* #endif TCP */
-{EXT_ "CATCH-SIGNAL","si_catch_signal"},
+{EXT_ "POSIX-SIGNAL-ACTION","si_posix_signal_action"},
+{EXT_ "POSIX-SIGNAL-MASK","si_posix_signal_mask"},
/* KEYWORD PACKAGE */
{KEY_ "ADJUSTABLE",NULL},
@@ -1306,6 +1307,7 @@ cl_symbols[] = {
{KEY_ "BLOCK",NULL},
{KEY_ "CAPITALIZE",NULL},
{KEY_ "CASE",NULL},
+{KEY_ "CATCH",NULL},
{KEY_ "CIRCLE",NULL},
{KEY_ "COMPILE-TOPLEVEL",NULL},
{KEY_ "COMMON",NULL},
@@ -1343,10 +1345,12 @@ cl_symbols[] = {
{KEY_ "FORMAT-CONTROL",NULL},
{KEY_ "FUNCTION",NULL},
{KEY_ "GENSYM",NULL},
+{KEY_ "GLOBAL",NULL},
{KEY_ "HOST",NULL},
{KEY_ "IF-DOES-NOT-EXIST",NULL},
{KEY_ "IF-EXISTS",NULL},
{KEY_ "IF-OUTPUT-EXISTS",NULL},
+{KEY_ "IGNORE",NULL},
{KEY_ "IMPORT-FROM",NULL},
{KEY_ "INCLUDE",NULL},
{KEY_ "INHERITED",NULL},
@@ -1401,6 +1405,7 @@ cl_symbols[] = {
{KEY_ "RENAME-AND-DELETE",NULL},
{KEY_ "REPORT",NULL},
{KEY_ "RIGHT-MARGIN",NULL},
+{KEY_ "SCOPE",NULL},
{KEY_ "SET-DEFAULT-PATHNAME",NULL},
{KEY_ "SEARCH-LIST",NULL},
{KEY_ "SHADOW",NULL},
diff --git a/src/c/unixint.d b/src/c/unixint.d
index 770cc2a..435b66f 100644
--- a/src/c/unixint.d
+++ b/src/c/unixint.d
@@ -661,70 +661,105 @@ ecl_check_pending_interrupts(void)
}
}
-@(defun ext::catch-signal (code flag &key local)
-@
+static void
+signal_validate(int sig)
{
- cl_object output = Cnil;
- int code_int = fixnnint(code);
- int i;
+ int i, known = 0;
+
+ for (i = 0; known_signals[i].code >= 0; i++)
+ if (known_signals[i].code == sig)
+ known = 1;
+ if (known == 0)
+ FEerror("Unknown signal number ~A.", 1, MAKE_FIXNUM(sig));
+
#ifdef GBC_BOEHM
# ifdef SIGSEGV
- if ((code_int == SIGSEGV) && ecl_get_option(ECL_OPT_INCREMENTAL_GC))
- FEerror("It is not allowed to change the behavior of SIGSEGV.",
- 0);
+ if ((sig == SIGSEGV) && ecl_get_option(ECL_OPT_INCREMENTAL_GC))
+ FEerror("Cannot change the behavior of signal SIGSEGV.", 1,
+ MAKE_FIXNUM(sig));
# endif
# ifdef SIGBUS
- if (code_int == SIGBUS)
- FEerror("It is not allowed to change the behavior of SIGBUS.",
- 0);
+ if (sig == SIGBUS)
+ FEerror("Cannot change the behavior of signal SIGBUS.", 1,
+ MAKE_FIXNUM(sig));
# endif
#endif
#if defined(ECL_THREADS) && !defined(ECL_MS_WINDOWS_HOST)
- if (code_int == ecl_get_option(ECL_OPT_THREAD_INTERRUPT_SIGNAL)) {
- FEerror("It is not allowed to change the behavior of ~D", 1,
- MAKE_FIXNUM(code_int));
+ if (sig == ecl_get_option(ECL_OPT_THREAD_INTERRUPT_SIGNAL)) {
+ FEerror("Cannot change the behavior of signal ~D", 1,
+ MAKE_FIXNUM(sig));
}
#endif
- for (i = 0; known_signals[i].code >= 0; i++) {
- if (known_signals[i].code == code_int) {
- output = Ct;
-#if defined(ECL_THREADS) && defined(HAVE_SIGPROCMASK)
- if (!Null(local)) {
- sigset_t handled_set;
- pthread_sigmask(SIG_SETMASK, NULL,
&handled_set);
- if (Null(flag)) {
- sigdelset(&handled_set, code_int);
- } else {
- sigaddset(&handled_set, code_int);
- }
- pthread_sigmask(SIG_SETMASK, &handled_set,
NULL);
- break;
- }
+}
+
+cl_object
+si_posix_signal_action(cl_object signo, cl_object behavior)
+{
+ cl_object ret = Cnil;
+ int sig = fixnnint(signo);
+
+ signal_validate(sig);
+
+ if (behavior == @':default')
+ signal(sig, SIG_DFL); /* XXX Use sigaction(2) */
+ else if (behavior == @':ignore')
+ signal(sig, SIG_IGN); /* XXX Use sigaction(2) */
+ else if (behavior == @':catch') {
+#ifdef SIGSEGV
+ if (sig == SIGSEGV) {
+ mysignal(sig, sigsegv_handler);
+ goto done;
+ }
#endif
- if (Null(flag)) {
- signal(code_int, SIG_DFL);
- } else if (code_int == SIGSEGV) {
- mysignal(code_int, sigsegv_handler);
- }
#ifdef SIGBUS
- else if (code_int == SIGBUS) {
- mysignal(code_int, sigbus_handler);
- }
+ if (sig == SIGBUS) {
+ mysignal(sig, sigbus_handler);
+ goto done;
+ }
#endif
#ifdef SIGCHLD
- else if (code_int == SIGCHLD) {
-#ifndef ECL_THREADS
- mysignal(SIGCHLD, non_evil_signal_handler);
-#endif
- }
-#endif
- else {
- mysignal(code_int, non_evil_signal_handler);
- }
- break;
+ if (sig == SIGCHLD) {
+ mysignal(sig, non_evil_signal_handler);
+ goto done;
}
- }
- @(return output)
+#endif
+ mysignal(sig, non_evil_signal_handler);
+ } else
+ FEerror("BEHAVIOR not one of :IGNORE :DEFAULT :CATCH", 0);
+
+done:
+ @(return Ct);
+}
+
+@(defun ext::posix-signal-mask (signo allow &key (scope @':global'))
+@
+{
+ int sig = fixnnint(signo);
+
+ signal_validate(sig);
+
+ if (scope == @':global') {
+ sigset_t set;
+
+ sigprocmask(SIG_SETMASK, NULL, &set);
+ if (Null(allow))
+ sigdelset(&set, sig);
+ else
+ sigaddset(&set, sig);
+ sigprocmask(SIG_SETMASK, &set, NULL);
+ } else if (scope == @':local') {
+ sigset_t set;
+
+ pthread_sigmask(SIG_SETMASK, NULL, &set);
+ if (Null(allow))
+ sigdelset(&set, sig);
+ else
+ sigaddset(&set, sig);
+ pthread_sigmask(SIG_SETMASK, &set, NULL);
+ } else
+ FEerror("SCOPE not one of :GLOBAL :LOCAL", 0);
+
+ @(return Ct);
}
@)
diff --git a/src/cmp/proclamations.lsp b/src/cmp/proclamations.lsp
index 78c028b..9d3ae6d 100644
--- a/src/cmp/proclamations.lsp
+++ b/src/cmp/proclamations.lsp
@@ -329,7 +329,8 @@
;; (proclamation restart-name (restart) t)
;; ECL extensions
-(proclamation ext:catch-signal (fixnum gen-bool &key) null)
+(proclamation ext:posix-signal-action (fixnum symbol) null)
+(proclamation ext:posix-signal-mask (fixnum gen-bool &key) null)
;;;
;;; 10. SYMBOLS
diff --git a/src/h/external.h b/src/h/external.h
index 9f83db9..edf6e00 100755
--- a/src/h/external.h
+++ b/src/h/external.h
@@ -1856,7 +1856,8 @@ extern ECL_API cl_object si_copy_file(cl_object orig,
cl_object end);
#define ECL_PSEUDO_ATOMIC_ENV(env,stmt)
(ecl_disable_interrupts_env(env),(stmt),ecl_enable_interrupts_env(env))
#define ECL_PSEUDO_ATOMIC(stmt)
(ecl_disable_interrupts(),(stmt),ecl_enable_interrupts())
extern ECL_API cl_object si_handle_signal(cl_object signal);
-extern ECL_API cl_object si_catch_signal(cl_narg narg, cl_object signal,
cl_object state, ...);
+extern ECL_API cl_object si_posix_signal_action(cl_object signal, cl_object
behavior);
+extern ECL_API cl_object si_posix_signal_mask(cl_narg narg, cl_object signal,
cl_object allow, ...);
extern ECL_API cl_object si_check_pending_interrupts(void);
extern ECL_API cl_object si_disable_interrupts(void);
extern ECL_API cl_object si_enable_interrupts(void);
------------------------------------------------------------------------------
BlackBerry® DevCon Americas, Oct. 18-20, San Francisco, CA
The must-attend event for mobile developers. Connect with experts.
Get tools for creating Super Apps. See the latest technologies.
Sessions, hands-on labs, demos & much more. Register early & save!
http://p.sf.net/sfu/rim-blackberry-1
_______________________________________________
Ecls-list mailing list
Ecls-list@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/ecls-list
