From b4b65e0d09bac99a4ba5249c159add3e77c97531 Mon Sep 17 00:00:00 2001 From: Peter Bex Date: Mon, 30 Apr 2018 17:57:18 +0200 Subject: [PATCH 4/5] Refactor chicken.process.signals so it no longer refers to chicken.posix Again, similar to the previous commit. This one is very straightforward. --- posix-common.scm | 13 +++--- posix.scm | 114 +++++++++++++++++++++++---------------------- posixunix.scm | 137 ++++++++++++++++++++++++++++++++----------------------- posixwin.scm | 80 +++++++++++++++++--------------- types.db | 76 ++++++++++++++++-------------- 5 files changed, 227 insertions(+), 193 deletions(-) diff --git a/posix-common.scm b/posix-common.scm index af338db4..35dd99b8 100644 --- a/posix-common.scm +++ b/posix-common.scm @@ -581,17 +581,18 @@ EOF ;;; Signals -(define (set-signal-handler! sig proc) - (##sys#check-fixnum sig 'set-signal-handler!) - (##core#inline "C_establish_signal_handler" sig (and proc sig)) - (vector-set! ##sys#signal-vector sig proc) ) +(set! chicken.process.signal#set-signal-handler! + (lambda (sig proc) + (##sys#check-fixnum sig 'set-signal-handler!) + (##core#inline "C_establish_signal_handler" sig (and proc sig)) + (vector-set! ##sys#signal-vector sig proc) ) ) -(define signal-handler +(set! chicken.process.signal#signal-handler (getter-with-setter (lambda (sig) (##sys#check-fixnum sig 'signal-handler) (##sys#slot ##sys#signal-vector sig) ) - set-signal-handler!)) + chicken.process.signal#set-signal-handler!)) ;;; Processes diff --git a/posix.scm b/posix.scm index 89bb0aff..2d74fb54 100644 --- a/posix.scm +++ b/posix.scm @@ -262,6 +262,61 @@ ) ; chicken.process +(module chicken.process.signal + (set-alarm! set-signal-handler! set-signal-mask! + signal-handler signal-mask signal-mask! signal-masked? signal-unmask! + signal/abrt signal/alrm signal/break signal/bus signal/chld + signal/cont signal/fpe signal/hup signal/ill signal/int signal/io + signal/kill signal/pipe signal/prof signal/quit signal/segv + signal/stop signal/term signal/trap signal/tstp signal/urg + signal/usr1 signal/usr2 signal/vtalrm signal/winch signal/xcpu + signal/xfsz signals-list) + +(import scheme) + +;; These are all set! inside the posix module +(define set-alarm!) +(define set-signal-handler!) +(define set-signal-mask!) +(define signal-handler) + +(define signal-mask) +(define signal-mask!) +(define signal-masked?) +(define signal-unmask!) + +(define signal/abrt) +(define signal/alrm) +(define signal/break) +(define signal/bus) +(define signal/chld) +(define signal/cont) +(define signal/fpe) +(define signal/hup) +(define signal/ill) +(define signal/int) +(define signal/io) +(define signal/kill) +(define signal/pipe) +(define signal/prof) +(define signal/quit) +(define signal/segv) +(define signal/stop) +(define signal/term) +(define signal/trap) +(define signal/tstp) +(define signal/urg) +(define signal/usr1) +(define signal/usr2) +(define signal/vtalrm) +(define signal/winch) +(define signal/xcpu) +(define signal/xfsz) + +(define signals-list) +) ; chicken.process.signal + + ;; This module really does nothing. It is used to keep all the posix ;; stuff in one place, in a clean namespace. The included file will ;; set! values from the modules defined above. @@ -271,14 +326,7 @@ current-effective-user-name current-group-id current-process-id current-user-id current-user-name parent-process-id process-group-id - set-alarm! set-root-directory! set-signal-handler! set-signal-mask! - signal-handler signal-mask signal-mask! signal-masked? signal-unmask! - signal/abrt signal/alrm signal/break signal/bus signal/chld - signal/cont signal/fpe signal/hup signal/ill signal/int signal/io - signal/kill signal/pipe signal/prof signal/quit signal/segv - signal/stop signal/term signal/trap signal/tstp signal/urg - signal/usr1 signal/usr2 signal/vtalrm signal/winch signal/xcpu - signal/xfsz signals-list) + set-root-directory!) (import scheme chicken.base @@ -346,56 +394,6 @@ ) ; chicken.errno -(module chicken.process.signal - (set-signal-handler! set-signal-mask! signal-handler signal-mask - signal-mask! signal-masked? signal-unmask! signal/abrt signal/alrm - signal/break signal/bus signal/chld signal/cont signal/fpe signal/hup - signal/ill signal/int signal/io signal/kill signal/pipe signal/prof - signal/quit signal/segv signal/stop signal/term signal/trap - signal/tstp signal/urg signal/usr1 signal/usr2 signal/vtalrm - signal/winch signal/xcpu signal/xfsz set-alarm!) - -(import scheme) - -(define set-signal-handler! chicken.posix#set-signal-handler!) -(define set-signal-mask! chicken.posix#set-signal-mask!) -(define signal-handler chicken.posix#signal-handler) - -(define signal-mask chicken.posix#signal-mask) -(define signal-mask! chicken.posix#signal-mask!) -(define signal-masked? chicken.posix#signal-masked?) -(define signal-unmask! chicken.posix#signal-unmask!) - -(define signal/abrt chicken.posix#signal/abrt) -(define signal/alrm chicken.posix#signal/alrm) -(define signal/break chicken.posix#signal/break) -(define signal/bus chicken.posix#signal/bus) -(define signal/chld chicken.posix#signal/chld) -(define signal/cont chicken.posix#signal/cont) -(define signal/fpe chicken.posix#signal/fpe) -(define signal/hup chicken.posix#signal/hup) -(define signal/ill chicken.posix#signal/ill) -(define signal/int chicken.posix#signal/int) -(define signal/io chicken.posix#signal/io) -(define signal/kill chicken.posix#signal/kill) -(define signal/pipe chicken.posix#signal/pipe) -(define signal/prof chicken.posix#signal/prof) -(define signal/quit chicken.posix#signal/quit) -(define signal/segv chicken.posix#signal/segv) -(define signal/stop chicken.posix#signal/stop) -(define signal/term chicken.posix#signal/term) -(define signal/trap chicken.posix#signal/trap) -(define signal/tstp chicken.posix#signal/tstp) -(define signal/urg chicken.posix#signal/urg) -(define signal/usr1 chicken.posix#signal/usr1) -(define signal/usr2 chicken.posix#signal/usr2) -(define signal/vtalrm chicken.posix#signal/vtalrm) -(define signal/winch chicken.posix#signal/winch) -(define signal/xcpu chicken.posix#signal/xcpu) -(define signal/xfsz chicken.posix#signal/xfsz) -(define set-alarm! chicken.posix#set-alarm!) -) ; chicken.process.signal - (module chicken.process-context.posix (change-directory* set-root-directory! current-effective-group-id current-effective-user-id diff --git a/posixunix.scm b/posixunix.scm index 2daade46..157a2cff 100644 --- a/posixunix.scm +++ b/posixunix.scm @@ -500,43 +500,64 @@ static int set_file_mtime(char *filename, C_word atime, C_word mtime) (define-foreign-variable _sigxfsz int "SIGXFSZ") (define-foreign-variable _sigwinch int "SIGWINCH") -(define signal/term _sigterm) -(define signal/kill _sigkill) -(define signal/int _sigint) -(define signal/hup _sighup) -(define signal/fpe _sigfpe) -(define signal/ill _sigill) -(define signal/segv _sigsegv) -(define signal/abrt _sigabrt) -(define signal/trap _sigtrap) -(define signal/quit _sigquit) -(define signal/alrm _sigalrm) -(define signal/vtalrm _sigvtalrm) -(define signal/prof _sigprof) -(define signal/io _sigio) -(define signal/urg _sigurg) -(define signal/chld _sigchld) -(define signal/cont _sigcont) -(define signal/stop _sigstop) -(define signal/tstp _sigtstp) -(define signal/pipe _sigpipe) -(define signal/xcpu _sigxcpu) -(define signal/xfsz _sigxfsz) -(define signal/usr1 _sigusr1) -(define signal/usr2 _sigusr2) -(define signal/winch _sigwinch) -(define signal/bus _sigbus) -(define signal/break 0) - -(define signals-list +(set! chicken.process.signal#signal/term _sigterm) +(set! chicken.process.signal#signal/kill _sigkill) +(set! chicken.process.signal#signal/int _sigint) +(set! chicken.process.signal#signal/hup _sighup) +(set! chicken.process.signal#signal/fpe _sigfpe) +(set! chicken.process.signal#signal/ill _sigill) +(set! chicken.process.signal#signal/segv _sigsegv) +(set! chicken.process.signal#signal/abrt _sigabrt) +(set! chicken.process.signal#signal/trap _sigtrap) +(set! chicken.process.signal#signal/quit _sigquit) +(set! chicken.process.signal#signal/alrm _sigalrm) +(set! chicken.process.signal#signal/vtalrm _sigvtalrm) +(set! chicken.process.signal#signal/prof _sigprof) +(set! chicken.process.signal#signal/io _sigio) +(set! chicken.process.signal#signal/urg _sigurg) +(set! chicken.process.signal#signal/chld _sigchld) +(set! chicken.process.signal#signal/cont _sigcont) +(set! chicken.process.signal#signal/stop _sigstop) +(set! chicken.process.signal#signal/tstp _sigtstp) +(set! chicken.process.signal#signal/pipe _sigpipe) +(set! chicken.process.signal#signal/xcpu _sigxcpu) +(set! chicken.process.signal#signal/xfsz _sigxfsz) +(set! chicken.process.signal#signal/usr1 _sigusr1) +(set! chicken.process.signal#signal/usr2 _sigusr2) +(set! chicken.process.signal#signal/winch _sigwinch) +(set! chicken.process.signal#signal/bus _sigbus) +(set! chicken.process.signal#signal/break 0) + +(set! chicken.process.signal#signals-list (list - signal/term signal/kill signal/int signal/hup signal/fpe signal/ill - signal/segv signal/abrt signal/trap signal/quit signal/alrm signal/vtalrm - signal/prof signal/io signal/urg signal/chld signal/cont signal/stop - signal/tstp signal/pipe signal/xcpu signal/xfsz signal/usr1 signal/usr2 - signal/winch signal/bus)) - -(define set-signal-mask! + chicken.process.signal#signal/term + chicken.process.signal#signal/kill + chicken.process.signal#signal/int + chicken.process.signal#signal/hup + chicken.process.signal#signal/fpe + chicken.process.signal#signal/ill + chicken.process.signal#signal/segv + chicken.process.signal#signal/abrt + chicken.process.signal#signal/trap + chicken.process.signal#signal/quit + chicken.process.signal#signal/alrm + chicken.process.signal#signal/vtalrm + chicken.process.signal#signal/prof + chicken.process.signal#signal/io + chicken.process.signal#signal/urg + chicken.process.signal#signal/chld + chicken.process.signal#signal/cont + chicken.process.signal#signal/stop + chicken.process.signal#signal/tstp + chicken.process.signal#signal/pipe + chicken.process.signal#signal/xcpu + chicken.process.signal#signal/xfsz + chicken.process.signal#signal/usr1 + chicken.process.signal#signal/usr2 + chicken.process.signal#signal/winch + chicken.process.signal#signal/bus)) + +(set! chicken.process.signal#set-signal-mask! (lambda (sigs) (##sys#check-list sigs 'set-signal-mask!) (##core#inline "C_sigemptyset" 0) @@ -548,36 +569,39 @@ static int set_file_mtime(char *filename, C_word atime, C_word mtime) (when (fx< (##core#inline "C_sigprocmask_set" 0) 0) (posix-error #:process-error 'set-signal-mask! "cannot set signal mask") ))) -(define signal-mask +(define chicken.process.signal#signal-mask (getter-with-setter (lambda () (##core#inline "C_sigprocmask_get" 0) - (let loop ([sigs signals-list] [mask '()]) + (let loop ((sigs chicken.process.signal#signals-list) (mask '())) (if (null? sigs) mask (let ([sig (car sigs)]) (loop (cdr sigs) (if (##core#inline "C_sigismember" sig) (cons sig mask) mask)) ) ) ) ) - set-signal-mask!)) + chicken.process.signal#set-signal-mask!)) -(define (signal-masked? sig) - (##sys#check-fixnum sig 'signal-masked?) - (##core#inline "C_sigprocmask_get" 0) - (##core#inline "C_sigismember" sig) ) +(set! chicken.process.signal#signal-masked? + (lambda (sig) + (##sys#check-fixnum sig 'signal-masked?) + (##core#inline "C_sigprocmask_get" 0) + (##core#inline "C_sigismember" sig)) ) -(define (signal-mask! sig) - (##sys#check-fixnum sig 'signal-mask!) - (##core#inline "C_sigemptyset" 0) - (##core#inline "C_sigaddset" sig) - (when (fx< (##core#inline "C_sigprocmask_block" 0) 0) - (posix-error #:process-error 'signal-mask! "cannot block signal") )) +(set! chicken.process.signal#signal-mask! + (lambda (sig) + (##sys#check-fixnum sig 'signal-mask!) + (##core#inline "C_sigemptyset" 0) + (##core#inline "C_sigaddset" sig) + (when (fx< (##core#inline "C_sigprocmask_block" 0) 0) + (posix-error #:process-error 'signal-mask! "cannot block signal") ))) -(define (signal-unmask! sig) - (##sys#check-fixnum sig 'signal-unmask!) - (##core#inline "C_sigemptyset" 0) - (##core#inline "C_sigaddset" sig) - (when (fx< (##core#inline "C_sigprocmask_unblock" 0) 0) - (posix-error #:process-error 'signal-unmask! "cannot unblock signal") ) ) +(set! chicken.process.signal#signal-unmask! + (lambda (sig) + (##sys#check-fixnum sig 'signal-unmask!) + (##core#inline "C_sigemptyset" 0) + (##core#inline "C_sigaddset" sig) + (when (fx< (##core#inline "C_sigprocmask_unblock" 0) 0) + (posix-error #:process-error 'signal-unmask! "cannot unblock signal") )) ) ;;; Getting group- and user-information: @@ -1043,7 +1067,8 @@ static int set_file_mtime(char *filename, C_word atime, C_word mtime) ;;; Other things: -(define set-alarm! (foreign-lambda int "C_alarm" int)) +(set! chicken.process.signal#set-alarm! + (foreign-lambda int "C_alarm" int)) ;;; Process handling: diff --git a/posixwin.scm b/posixwin.scm index caaa3e06..28932fae 100644 --- a/posixwin.scm +++ b/posixwin.scm @@ -627,39 +627,43 @@ static int set_file_mtime(char *filename, C_word atime, C_word mtime) (define-foreign-variable _sigabrt int "SIGABRT") (define-foreign-variable _sigbreak int "SIGBREAK") -(define signal/term _sigterm) -(define signal/int _sigint) -(define signal/fpe _sigfpe) -(define signal/ill _sigill) -(define signal/segv _sigsegv) -(define signal/abrt _sigabrt) -(define signal/break _sigbreak) -(define signal/alrm 0) -(define signal/bus 0) -(define signal/chld 0) -(define signal/cont 0) -(define signal/hup 0) -(define signal/io 0) -(define signal/kill 0) -(define signal/pipe 0) -(define signal/prof 0) -(define signal/quit 0) -(define signal/stop 0) -(define signal/trap 0) -(define signal/tstp 0) -(define signal/urg 0) -(define signal/usr1 0) -(define signal/usr2 0) -(define signal/vtalrm 0) -(define signal/winch 0) -(define signal/xcpu 0) -(define signal/xfsz 0) - -(define signals-list +(set! chicken.process.signal#signal/term _sigterm) +(set! chicken.process.signal#signal/int _sigint) +(set! chicken.process.signal#signal/fpe _sigfpe) +(set! chicken.process.signal#signal/ill _sigill) +(set! chicken.process.signal#signal/segv _sigsegv) +(set! chicken.process.signal#signal/abrt _sigabrt) +(set! chicken.process.signal#signal/break _sigbreak) +(set! chicken.process.signal#signal/alrm 0) +(set! chicken.process.signal#signal/bus 0) +(set! chicken.process.signal#signal/chld 0) +(set! chicken.process.signal#signal/cont 0) +(set! chicken.process.signal#signal/hup 0) +(set! chicken.process.signal#signal/io 0) +(set! chicken.process.signal#signal/kill 0) +(set! chicken.process.signal#signal/pipe 0) +(set! chicken.process.signal#signal/prof 0) +(set! chicken.process.signal#signal/quit 0) +(set! chicken.process.signal#signal/stop 0) +(set! chicken.process.signal#signal/trap 0) +(set! chicken.process.signal#signal/tstp 0) +(set! chicken.process.signal#signal/urg 0) +(set! chicken.process.signal#signal/usr1 0) +(set! chicken.process.signal#signal/usr2 0) +(set! chicken.process.signal#signal/vtalrm 0) +(set! chicken.process.signal#signal/winch 0) +(set! chicken.process.signal#signal/xcpu 0) +(set! chicken.process.signal#signal/xfsz 0) + +(set! chicken.process.signal#signals-list (list - signal/term signal/int signal/fpe signal/ill - signal/segv signal/abrt signal/break)) - + chicken.process.signal#signal/term + chicken.process.signal#signal/int + chicken.process.signal#signal/fpe + chicken.process.signal#signal/ill + chicken.process.signal#signal/segv + chicken.process.signal#signal/abrt + chicken.process.signal#signal/break)) ;;; Using file-descriptors: @@ -891,16 +895,16 @@ static int set_file_mtime(char *filename, C_word atime, C_word mtime) (define-unimplemented process-group-id) (set!-unimplemented chicken.process#process-signal) (set!-unimplemented chicken.file.posix#read-symbolic-link) -(define-unimplemented set-alarm!) +(set!-unimplemented chicken.process.signal#set-alarm!) (define-unimplemented set-group-id!) (define-unimplemented set-process-group-id!) (define-unimplemented set-root-directory!) -(define-unimplemented set-signal-mask!) +(set!-unimplemented chicken.process.signal#set-signal-mask!) (define-unimplemented set-user-id!) -(define-unimplemented signal-mask) -(define-unimplemented signal-mask!) -(define-unimplemented signal-masked?) -(define-unimplemented signal-unmask!) +(set!-unimplemented chicken.process.signal#signal-mask) +(set!-unimplemented chicken.process.signal#signal-mask!) +(set!-unimplemented chicken.process.signal#signal-masked?) +(set!-unimplemented chicken.process.signal#signal-unmask!) (define-unimplemented user-information) (set!-unimplemented chicken.time.posix#utc-time->seconds) (set!-unimplemented chicken.time.posix#string->time) diff --git a/types.db b/types.db index ff18fa4f..b890b52b 100644 --- a/types.db +++ b/types.db @@ -2048,42 +2048,7 @@ (chicken.posix#parent-process-id (#(procedure #:clean) chicken.posix#parent-process-id () fixnum)) (chicken.posix#process-group-id (#(procedure #:clean #:enforce) chicken.posix#process-group-id () fixnum)) -(chicken.posix#set-alarm! (#(procedure #:clean #:enforce) chicken.posix#set-alarm! (integer) integer)) (chicken.posix#set-root-directory! (#(procedure #:clean #:enforce) chicken.posix#set-root-directory! (string) undefined)) -(chicken.posix#set-signal-handler! (#(procedure #:clean #:enforce) chicken.posix#set-signal-handler! (fixnum (or false (procedure (fixnum) . *))) undefined)) -(chicken.posix#set-signal-mask! (#(procedure #:clean #:enforce) chicken.posix#set-signal-mask! ((list-of fixnum)) undefined)) -(chicken.posix#signal-handler (#(procedure #:clean #:enforce) chicken.posix#signal-handler (fixnum) (or false (procedure (fixnum) . *)))) -(chicken.posix#signal-mask (#(procedure #:clean) chicken.posix#signal-mask () fixnum)) -(chicken.posix#signal-mask! (#(procedure #:clean #:enforce) chicken.posix#signal-mask! (fixnum) undefined)) -(chicken.posix#signal-masked? (#(procedure #:clean #:enforce) chicken.posix#signal-masked? (fixnum) boolean)) -(chicken.posix#signal-unmask! (#(procedure #:clean #:enforce) chicken.posix#signal-unmask! (fixnum) undefined)) -(chicken.posix#signal/abrt fixnum) -(chicken.posix#signal/alrm fixnum) -(chicken.posix#signal/chld fixnum) -(chicken.posix#signal/cont fixnum) -(chicken.posix#signal/fpe fixnum) -(chicken.posix#signal/hup fixnum) -(chicken.posix#signal/ill fixnum) -(chicken.posix#signal/int fixnum) -(chicken.posix#signal/io fixnum) -(chicken.posix#signal/bus fixnum) -(chicken.posix#signal/kill fixnum) -(chicken.posix#signal/pipe fixnum) -(chicken.posix#signal/prof fixnum) -(chicken.posix#signal/quit fixnum) -(chicken.posix#signal/segv fixnum) -(chicken.posix#signal/stop fixnum) -(chicken.posix#signal/term fixnum) -(chicken.posix#signal/trap fixnum) -(chicken.posix#signal/tstp fixnum) -(chicken.posix#signal/urg fixnum) -(chicken.posix#signal/usr1 fixnum) -(chicken.posix#signal/usr2 fixnum) -(chicken.posix#signal/vtalrm fixnum) -(chicken.posix#signal/winch fixnum) -(chicken.posix#signal/xcpu fixnum) -(chicken.posix#signal/xfsz fixnum) -(chicken.posix#signals-list list) (chicken.posix#user-information (#(procedure #:clean #:enforce) chicken.posix#user-information ((or string fixnum) #!optional *) *)) ;; process @@ -2119,6 +2084,47 @@ (chicken.process#spawn/nowaito fixnum) (chicken.process#spawn/detach fixnum) + +;; process.signal + +(chicken.process.signal#set-alarm! (#(procedure #:clean #:enforce) chicken.process#set-alarm! (integer) integer)) +(chicken.process.signal#set-signal-handler! (#(procedure #:clean #:enforce) chicken.process.signal#set-signal-handler! (fixnum (or false (procedure (fixnum) . *))) undefined)) +(chicken.process.signal#set-signal-mask! (#(procedure #:clean #:enforce) chicken.process.signal#set-signal-mask! ((list-of fixnum)) undefined)) +(chicken.process.signal#signal-handler (#(procedure #:clean #:enforce) chicken.process.signal#signal-handler (fixnum) (or false (procedure (fixnum) . *)))) +(chicken.process.signal#signal-mask (#(procedure #:clean) chicken.process.signal#signal-mask () fixnum)) +(chicken.process.signal#signal-mask! (#(procedure #:clean #:enforce) chicken.process.signal#signal-mask! (fixnum) undefined)) +(chicken.process.signal#signal-masked? (#(procedure #:clean #:enforce) chicken.process.signal#signal-masked? (fixnum) boolean)) +(chicken.process.signal#signal-unmask! (#(procedure #:clean #:enforce) chicken.process.signal#signal-unmask! (fixnum) undefined)) + +(chicken.process.signal#signal/abrt fixnum) +(chicken.process.signal#signal/alrm fixnum) +(chicken.process.signal#signal/chld fixnum) +(chicken.process.signal#signal/cont fixnum) +(chicken.process.signal#signal/fpe fixnum) +(chicken.process.signal#signal/hup fixnum) +(chicken.process.signal#signal/ill fixnum) +(chicken.process.signal#signal/int fixnum) +(chicken.process.signal#signal/io fixnum) +(chicken.process.signal#signal/bus fixnum) +(chicken.process.signal#signal/kill fixnum) +(chicken.process.signal#signal/pipe fixnum) +(chicken.process.signal#signal/prof fixnum) +(chicken.process.signal#signal/quit fixnum) +(chicken.process.signal#signal/segv fixnum) +(chicken.process.signal#signal/stop fixnum) +(chicken.process.signal#signal/term fixnum) +(chicken.process.signal#signal/trap fixnum) +(chicken.process.signal#signal/tstp fixnum) +(chicken.process.signal#signal/urg fixnum) +(chicken.process.signal#signal/usr1 fixnum) +(chicken.process.signal#signal/usr2 fixnum) +(chicken.process.signal#signal/vtalrm fixnum) +(chicken.process.signal#signal/winch fixnum) +(chicken.process.signal#signal/xcpu fixnum) +(chicken.process.signal#signal/xfsz fixnum) +(chicken.process.signal#signals-list (list-of fixnum)) + + ;; sort (chicken.sort#merge -- 2.11.0