Репозиторий Sisyphus
Последнее обновление: 1 октября 2023 | Пакетов: 18631 | Посещений: 37527931
en ru br
Репозитории ALT
S:1.2-alt4
5.1: 1.0-alt1
www.altlinux.org/Changes

Группа :: Разработка/Scheme
Пакет: gambit-signal

 Главная   Изменения   Спек   Патчи   Исходники   Загрузить   Gear   Bugs and FR  Repocop 

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 <manowar@altlinux.org>
;;
;; 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 <http://www.gnu.org/licenses/>.

(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 <manowar@altlinux.org>
;;
;; 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 <http://www.gnu.org/licenses/>.

(c-declare "
#include <signal.h>
#include <sys/types.h>
#include <string.h>
#include <unistd.h>

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 <manowar@altlinux.org>
;;
;; 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 <http://www.gnu.org/licenses/>.

(include "signal-ffi.scm")
(include "signal-common.scm")
 
дизайн и разработка: Vladimir Lettiev aka crux © 2004-2005, Andrew Avramenko aka liks © 2007-2008
текущий майнтейнер: Michael Shigorin