gambit-signal-1.1/000075500000000000000000000000001230737654400141025ustar00rootroot00000000000000gambit-signal-1.1/Makefile000064400000000000000000000030021230737654400155350ustar00rootroot00000000000000 libdir=/usr/lib includedir=/usr/include BASENAME=signal LIBS= #LIBS=-l$(BASENAME) all: libgambc-$(BASENAME).so libgambc-$(BASENAME).c: $(BASENAME).scm $(BASENAME)-common.scm $(BASENAME)-ffi.scm gsc -:daq- -link -flat -o libgambc-$(BASENAME).c $(BASENAME).scm $(BASENAME).c: libgambc-$(BASENAME).c [ -f $< ] libgambc-$(BASENAME).o: $(BASENAME).c libgambc-$(BASENAME).c gsc -:daq- -obj -cc-options "-D___LIBRARY -D___SHARED -D___PRIMAL" $(BASENAME).c libgambc-$(BASENAME).c $(BASENAME).o: libgambc-$(BASENAME).o [ -f $< ] libgambc-$(BASENAME).so: $(BASENAME).o libgambc-$(BASENAME).o gcc -shared $(BASENAME).o libgambc-$(BASENAME).o -lgambc $(LIBS) -o libgambc-$(BASENAME).so install: libgambc-$(BASENAME).so libgambc-$(BASENAME).c install -Dp -m0644 libgambc-$(BASENAME).so $(libdir)/gambit/libgambc-$(BASENAME).so install -Dp -m0644 libgambc-$(BASENAME).c $(includedir)/gambit/libgambc-$(BASENAME).c $(BASENAME)-test: $(BASENAME)-test.scm libgambc-$(BASENAME).so echo "Run $(BASENAME)-test.scm to verify the library" gsc -:daq- -link ./libgambc-$(BASENAME).c $(BASENAME)-test.scm gsc -:daq- -obj $(BASENAME)-test.c $(BASENAME)-test_.c gcc $(BASENAME)-test.o $(BASENAME)-test_.o -lgambc -L. -lgambc-$(BASENAME) -o $(BASENAME)-test check: $(BASENAME)-test LD_LIBRARY_PATH=. ./$(BASENAME)-test -:daq- clean: rm -fv libgambc-$(BASENAME).c libgambc-$(BASENAME).o libgambc-$(BASENAME).so rm -fv $(BASENAME)-test $(BASENAME)-test.c $(BASENAME)-test.o $(BASENAME)-test_.c $(BASENAME)-test_.o $(BASENAME).c $(BASENAME).o gambit-signal-1.1/signal-common.scm000064400000000000000000000070541230737654400173570ustar00rootroot00000000000000;; UNIX signals for Gambit-C. High-level interface. ;; ;; Copyright (C) 2013 Paul Wolneykien ;; ;; This program is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. ;; ;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see . (define *SIGHUP* (signal-SIGHUP-code)) (define *SIGINT* (signal-SIGINT-code)) (define *SIGQUIT* (signal-SIGQUIT-code)) (define *SIGILL* (signal-SIGILL-code)) (define *SIGTRAP* (signal-SIGTRAP-code)) (define *SIGABRT* (signal-SIGABRT-code)) (define *SIGBUS* (signal-SIGBUS-code)) (define *SIGFPE* (signal-SIGFPE-code)) (define *SIGKILL* (signal-SIGKILL-code)) (define *SIGUSR1* (signal-SIGUSR1-code)) (define *SIGSEGV* (signal-SIGSEGV-code)) (define *SIGUSR2* (signal-SIGUSR2-code)) (define *SIGPIPE* (signal-SIGPIPE-code)) (define *SIGALRM* (signal-SIGALRM-code)) (define *SIGTERM* (signal-SIGTERM-code)) (define *SIGSTKFLT* (signal-SIGSTKFLT-code)) (define *SIGCHLD* (signal-SIGCHLD-code)) (define *SIGCONT* (signal-SIGCONT-code)) (define *SIGSTOP* (signal-SIGSTOP-code)) (define *SIGTSTP* (signal-SIGTSTP-code)) (define *SIGTTIN* (signal-SIGTTIN-code)) (define *SIGTTOU* (signal-SIGTTOU-code)) (define *SIGURG* (signal-SIGURG-code)) (define *SIGXCPU* (signal-SIGXCPU-code)) (define *SIGXFSZ* (signal-SIGXFSZ-code)) (define *SIGVTALRM* (signal-SIGVTALRM-code)) (define *SIGPROF* (signal-SIGPROF-code)) (define *SIGWINCH* (signal-SIGWINCH-code)) (define *SIGIO* (signal-SIGIO-code)) (define *SIGPWR* (signal-SIGPWR-code)) (define *SIGSYS* (signal-SIGSYS-code)) (define *SIGRTMIN* (signal-SIGRTMIN-code)) (define *SIGRTMIN+1* (signal-SIGRTMIN+1-code)) (define *SIGRTMIN+2* (signal-SIGRTMIN+2-code)) (define *SIGRTMIN+3* (signal-SIGRTMIN+3-code)) (define *SIGRTMIN+4* (signal-SIGRTMIN+4-code)) (define *SIGRTMIN+5* (signal-SIGRTMIN+5-code)) (define *SIGRTMIN+6* (signal-SIGRTMIN+6-code)) (define *SIGRTMIN+7* (signal-SIGRTMIN+7-code)) (define *SIGRTMIN+8* (signal-SIGRTMIN+8-code)) (define *SIGRTMIN+9* (signal-SIGRTMIN+9-code)) (define *SIGRTMIN+10* (signal-SIGRTMIN+10-code)) (define *SIGRTMIN+11* (signal-SIGRTMIN+11-code)) (define *SIGRTMIN+12* (signal-SIGRTMIN+12-code)) (define *SIGRTMIN+13* (signal-SIGRTMIN+13-code)) (define *SIGRTMIN+14* (signal-SIGRTMIN+14-code)) (define *SIGRTMIN+15* (signal-SIGRTMIN+15-code)) (define *SIGRTMAX-14* (signal-SIGRTMAX-14-code)) (define *SIGRTMAX-13* (signal-SIGRTMAX-13-code)) (define *SIGRTMAX-12* (signal-SIGRTMAX-12-code)) (define *SIGRTMAX-11* (signal-SIGRTMAX-11-code)) (define *SIGRTMAX-10* (signal-SIGRTMAX-10-code)) (define *SIGRTMAX-9* (signal-SIGRTMAX-9-code)) (define *SIGRTMAX-8* (signal-SIGRTMAX-8-code)) (define *SIGRTMAX-7* (signal-SIGRTMAX-7-code)) (define *SIGRTMAX-6* (signal-SIGRTMAX-6-code)) (define *SIGRTMAX-5* (signal-SIGRTMAX-5-code)) (define *SIGRTMAX-4* (signal-SIGRTMAX-4-code)) (define *SIGRTMAX-3* (signal-SIGRTMAX-3-code)) (define *SIGRTMAX-2* (signal-SIGRTMAX-2-code)) (define *SIGRTMAX-1* (signal-SIGRTMAX-1-code)) (define *SIGRTMAX* (signal-SIGRTMAX-code)) (define (signal-exception? e) (and (pair? e) (eq? 'signal-exception (car e)))) (define (signal-exception-number e) (cdr e)) gambit-signal-1.1/signal-ffi.scm000064400000000000000000000155261230737654400166360ustar00rootroot00000000000000;; UNIX signals for Gambit-C. Low-level interface. ;; ;; Copyright (C) 2013 Paul Wolneykien ;; ;; This program is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. ;; ;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see . (c-declare " #include #include #include #include typedef void (*SIGNAL_HANDLER)(int); static int signal_table[256]; static void set_signal (int signum) { if (signum < (sizeof (signal_table) / sizeof (int))) { signal_table[signum] = 1; ___EXT (___raise_interrupt) (___INTR_USER); } } static int clear_signal () { int signum = 0; while (signum < (sizeof (signal_table) / sizeof (int)) && !signal_table[signum]) { signum++; } if (signum < (sizeof (signal_table) / sizeof (int))) { signal_table[signum] = 0; return signum; } else { return 0; } } ") (c-initialize " memset (signal_table, 0, sizeof (signal_table)); ") (define clear-signal (c-lambda () int "___result = clear_signal ();")) (define (init-signal-interrupt-handler) (##interrupt-vector-set! 0 (let ((recipient (current-thread))) (lambda () (let ((signum (clear-signal))) (if (> signum 0) (thread-interrupt! recipient (lambda () (raise (cons 'signal-exception signum)))))))))) (define ##signal-set-exception! (c-lambda (int) void "signal(___arg1, set_signal);")) (define (signal-set-exception! signum) (init-signal-interrupt-handler) (##signal-set-exception! signum)) (define signal-set-ignore! (c-lambda (int) void "signal(___arg1, SIG_IGN);")) (define signal-set-default! (c-lambda (int) void "signal(___arg1, SIG_DFL);")) (define send-signal (c-lambda (unsigned-int int) int "___result = kill(___arg1, ___arg2);")) (define get-pid (c-lambda () int "___result = getpid();")) (define get-parent-pid (c-lambda () int "___result = getppid();")) (define signal-SIGHUP-code (c-lambda () int "___result = SIGHUP;")) (define signal-SIGINT-code (c-lambda () int "___result = SIGINT;")) (define signal-SIGQUIT-code (c-lambda () int "___result = SIGQUIT;")) (define signal-SIGILL-code (c-lambda () int "___result = SIGILL;")) (define signal-SIGTRAP-code (c-lambda () int "___result = SIGTRAP;")) (define signal-SIGABRT-code (c-lambda () int "___result = SIGABRT;")) (define signal-SIGBUS-code (c-lambda () int "___result = SIGBUS;")) (define signal-SIGFPE-code (c-lambda () int "___result = SIGFPE;")) (define signal-SIGKILL-code (c-lambda () int "___result = SIGKILL;")) (define signal-SIGUSR1-code (c-lambda () int "___result = SIGUSR1;")) (define signal-SIGSEGV-code (c-lambda () int "___result = SIGSEGV;")) (define signal-SIGUSR2-code (c-lambda () int "___result = SIGUSR2;")) (define signal-SIGPIPE-code (c-lambda () int "___result = SIGPIPE;")) (define signal-SIGALRM-code (c-lambda () int "___result = SIGALRM;")) (define signal-SIGTERM-code (c-lambda () int "___result = SIGTERM;")) (define signal-SIGSTKFLT-code (c-lambda () int "___result = SIGSTKFLT;")) (define signal-SIGCHLD-code (c-lambda () int "___result = SIGCHLD;")) (define signal-SIGCONT-code (c-lambda () int "___result = SIGCONT;")) (define signal-SIGSTOP-code (c-lambda () int "___result = SIGSTOP;")) (define signal-SIGTSTP-code (c-lambda () int "___result = SIGTSTP;")) (define signal-SIGTTIN-code (c-lambda () int "___result = SIGTTIN;")) (define signal-SIGTTOU-code (c-lambda () int "___result = SIGTTOU;")) (define signal-SIGURG-code (c-lambda () int "___result = SIGURG;")) (define signal-SIGXCPU-code (c-lambda () int "___result = SIGXCPU;")) (define signal-SIGXFSZ-code (c-lambda () int "___result = SIGXFSZ;")) (define signal-SIGVTALRM-code (c-lambda () int "___result = SIGVTALRM;")) (define signal-SIGPROF-code (c-lambda () int "___result = SIGPROF;")) (define signal-SIGWINCH-code (c-lambda () int "___result = SIGWINCH;")) (define signal-SIGIO-code (c-lambda () int "___result = SIGIO;")) (define signal-SIGPWR-code (c-lambda () int "___result = SIGPWR;")) (define signal-SIGSYS-code (c-lambda () int "___result = SIGSYS;")) (define signal-SIGRTMIN-code (c-lambda () int "___result = SIGRTMIN;")) (define signal-SIGRTMIN+1-code (c-lambda () int "___result = SIGRTMIN+1;")) (define signal-SIGRTMIN+2-code (c-lambda () int "___result = SIGRTMIN+2;")) (define signal-SIGRTMIN+3-code (c-lambda () int "___result = SIGRTMIN+3;")) (define signal-SIGRTMIN+4-code (c-lambda () int "___result = SIGRTMIN+4;")) (define signal-SIGRTMIN+5-code (c-lambda () int "___result = SIGRTMIN+5;")) (define signal-SIGRTMIN+6-code (c-lambda () int "___result = SIGRTMIN+6;")) (define signal-SIGRTMIN+7-code (c-lambda () int "___result = SIGRTMIN+7;")) (define signal-SIGRTMIN+8-code (c-lambda () int "___result = SIGRTMIN+8;")) (define signal-SIGRTMIN+9-code (c-lambda () int "___result = SIGRTMIN+9;")) (define signal-SIGRTMIN+10-code (c-lambda () int "___result = SIGRTMIN+10;")) (define signal-SIGRTMIN+11-code (c-lambda () int "___result = SIGRTMIN+11;")) (define signal-SIGRTMIN+12-code (c-lambda () int "___result = SIGRTMIN+12;")) (define signal-SIGRTMIN+13-code (c-lambda () int "___result = SIGRTMIN+13;")) (define signal-SIGRTMIN+14-code (c-lambda () int "___result = SIGRTMIN+14;")) (define signal-SIGRTMIN+15-code (c-lambda () int "___result = SIGRTMIN+15;")) (define signal-SIGRTMAX-14-code (c-lambda () int "___result = SIGRTMAX-14;")) (define signal-SIGRTMAX-13-code (c-lambda () int "___result = SIGRTMAX-13;")) (define signal-SIGRTMAX-12-code (c-lambda () int "___result = SIGRTMAX-12;")) (define signal-SIGRTMAX-11-code (c-lambda () int "___result = SIGRTMAX-11;")) (define signal-SIGRTMAX-10-code (c-lambda () int "___result = SIGRTMAX-10;")) (define signal-SIGRTMAX-9-code (c-lambda () int "___result = SIGRTMAX-9;")) (define signal-SIGRTMAX-8-code (c-lambda () int "___result = SIGRTMAX-8;")) (define signal-SIGRTMAX-7-code (c-lambda () int "___result = SIGRTMAX-7;")) (define signal-SIGRTMAX-6-code (c-lambda () int "___result = SIGRTMAX-6;")) (define signal-SIGRTMAX-5-code (c-lambda () int "___result = SIGRTMAX-5;")) (define signal-SIGRTMAX-4-code (c-lambda () int "___result = SIGRTMAX-4;")) (define signal-SIGRTMAX-3-code (c-lambda () int "___result = SIGRTMAX-3;")) (define signal-SIGRTMAX-2-code (c-lambda () int "___result = SIGRTMAX-2;")) (define signal-SIGRTMAX-1-code (c-lambda () int "___result = SIGRTMAX-1;")) (define signal-SIGRTMAX-code (c-lambda () int "___result = SIGRTMAX;")) gambit-signal-1.1/signal-test.scm000064400000000000000000000012741230737654400170440ustar00rootroot00000000000000 (define *signum* *SIGUSR1*) (signal-set-exception! *signum*) (with-exception-catcher (lambda (e) (if (signal-exception? e) (begin (display "Signal received: ") (display (cdr e)) (newline) (if (= *signum* (cdr e)) (begin (display "Test passed") (newline) (exit 0))) (display "Test FAILED") (newline) (exit 1)) (begin (display "Error: ") (pp e) (exit 1)))) (lambda () (display "Sending signal: ") (display *signum*) (newline) (send-signal (get-pid) *signum*) (thread-sleep! 1) (display "No signals received. Test FAILED") (newline) (exit 1))) gambit-signal-1.1/signal.scm000064400000000000000000000014411230737654400160630ustar00rootroot00000000000000;; UNIX signals for Gambit-C. ;; ;; Copyright (C) 2013 Paul Wolneykien ;; ;; This program is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. ;; ;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see . (include "signal-ffi.scm") (include "signal-common.scm")