conservatory
/
ikarus
4
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Applied a patch supplied by Derick Eddington that provides enhanced 

functionality for waitpid (nonblocking waitpid and more status info)
as well as the ability to send a signal to a process, e.g., 
  (kill pid 'HUP).
This commit is contained in:
Abdulaziz Ghuloum 2008-06-13 05:43:17 -07:00
parent 041f9fdafa
commit 8f0f0abbca
7 changed files with 206 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

93
scheme/ikarus.posix.ss
View File

@ -19,7 +19,8 @@
nanosleep getenv env environ file-ctime current-directory
file-regular? file-directory? file-symbolic-link? make-symbolic-link
directory-list make-directory delete-directory change-mode
strerror)
kill strerror
wstatus-pid wstatus-exit-status wstatus-received-signal)
(import
(rnrs bytevectors)
(except (ikarus)
@ -28,7 +29,8 @@
getenv env environ file-ctime current-directory
file-regular? file-directory? file-symbolic-link? make-symbolic-link
directory-list make-directory delete-directory change-mode
strerror))
kill strerror
wstatus-pid wstatus-exit-status wstatus-received-signal))
(define posix-fork
(lambda ()
@ -42,14 +44,87 @@
[(fx< pid 0) (raise/strerror 'fork pid)]
[else (parent-proc pid)]))))
(module (signal-code->signal-name signal-name->signal-code)
(define signal-names-al
;; From ikarus-process.c
'((1 . SIGABRT)
(2 . SIGALRM)
(3 . SIGBUS)
(4 . SIGCHLD)
(5 . SIGCONT)
(6 . SIGFPE)
(7 . SIGHUP)
(8 . SIGILL)
(9 . SIGINT)
(10 . SIGKILL)
(11 . SIGPIPE)
(12 . SIGQUIT)
(13 . SIGSEGV)
(14 . SIGSTOP)
(15 . SIGTERM)
(16 . SIGTSTP)
(17 . SIGTTIN)
(18 . SIGTTOU)
(19 . SIGUSR1)
(20 . SIGUSR2)
(21 . SIGPOLL)
(22 . SIGPROF)
(23 . SIGSYS)
(24 . SIGTRAP)
(25 . SIGURG)
(26 . SIGVTALRM)
(27 . SIGXCPU)
(28 . SIGXFSZ)))
(define signal-code->signal-name
(lambda (sigcode)
(cond
[(assv sigcode signal-names-al) => cdr]
[else sigcode])))
(define signal-name->signal-code
(lambda (signame)
(cond
[(find (lambda (p) (eqv? (cdr p) signame)) signal-names-al) => car]
[else #f])))
)
(define kill
(lambda (pid signame)
(define who 'kill)
(unless (fixnum? pid) (die who "not a fixnum" pid))
(unless (symbol? signame) (die who "not a symbol" signame))
(let ([r (foreign-call "ikrt_kill" pid
(or (signal-name->signal-code signame)
(die who "invalid signal name" signame)))])
(when (fx< r 0)
(error who (strerror r) pid signame)))))
(define-struct wstatus (pid exit-status received-signal))
(define waitpid
(lambda (pid)
(unless (fixnum? pid)
(die 'waitpid "not a fixnum" pid))
(let ([r (foreign-call "ikrt_waitpid" pid)])
(if (fx< r 0)
(raise/strerror 'waitpid r)
r))))
;; If block? is #f and waitpid() would have blocked,
;; or if want-error? is #f and there was an error,
;; the value returned is #f
(case-lambda
[() (waitpid -1 #t #t)]
[(pid) (waitpid pid #t #t)]
[(pid block?) (waitpid pid block? #t)]
[(pid block? want-error?)
(define who 'waitpid)
(unless (fixnum? pid) (die who "not a fixnum" pid))
(unless (boolean? block?) (die who "not a boolean" block?))
(let ([r (foreign-call "ikrt_waitpid" (make-wstatus #f #f #f) pid block?)])
(cond
[(wstatus? r)
(set-wstatus-received-signal! r
(signal-code->signal-name
(wstatus-received-signal r)))
r]
[want-error?
(error who (strerror r) pid)]
[else #f]))]))
(define system
(lambda (x)

7
scheme/ikarus.strings.ss
View File

@ -497,7 +497,8 @@
(define uuid
(lambda ()
(let ([s ($make-bytevector 16)])
(utf8->string
(or (foreign-call "ik_uuid" s)
(die 'uuid "failed!"))))))
(let ([r (foreign-call "ik_uuid" s)])
(if (bytevector? r)
(utf8->string r)
(error 'uuid "cannot obtain unique id"))))))
)

2
scheme/last-revision
View File

@ -1 +1 @@
1514
1515

4
scheme/makefile.ss
View File

@ -393,6 +393,10 @@
[process i]
[process-nonblocking i]
[waitpid i]
[wstatus-pid i]
[wstatus-exit-status i]
[wstatus-received-signal i]
[kill i]
[installed-libraries i]
[library-path i]
[library-extensions i]

2
src/ikarus-io.c
View File

@ -272,7 +272,7 @@ ikrt_accept(ikptr s, ikptr bv /*, ikpcb* pcb */){
}
ikptr
ikrt_shutdown(ikptr s, ikpcb* pcb){
ikrt_shutdown(ikptr s /*, ikpcb* pcb*/){
#ifdef __CYGWIN__
int err = close(unfix(s));
#else

113
src/ikarus-process.c
View File

@ -23,6 +23,7 @@
#include <stdio.h>
#include <string.h>
#include <errno.h>
#include <signal.h>
#include "ikarus-data.h"
extern ikptr ik_errno_to_code();
@ -91,14 +92,112 @@ ikrt_process(ikptr rvec, ikptr cmd, ikptr argv /*, ikpcb* pcb */){
}
}
typedef struct signal_info {
int n;
ikptr c;
} signal_info;
#define signal_info_table_len 28
static signal_info signal_info_table[signal_info_table_len] = {
/* Signals from POSIX */
{SIGABRT, fix(1)},
{SIGALRM, fix(2)},
{SIGBUS, fix(3)},
{SIGCHLD, fix(4)},
{SIGCONT, fix(5)},
{SIGFPE, fix(6)},
{SIGHUP, fix(7)},
{SIGILL, fix(8)},
{SIGINT, fix(9)},
{SIGKILL, fix(10)},
{SIGPIPE, fix(11)},
{SIGQUIT, fix(12)},
{SIGSEGV, fix(13)},
{SIGSTOP, fix(14)},
{SIGTERM, fix(15)},
{SIGTSTP, fix(16)},
{SIGTTIN, fix(17)},
{SIGTTOU, fix(18)},
{SIGUSR1, fix(19)},
{SIGUSR2, fix(20)},
#ifdef SIGPOLL
{SIGPOLL, fix(21)},
#else
{SIGEMT, fix(21)},
#endif
{SIGPROF, fix(22)},
{SIGSYS, fix(23)},
{SIGTRAP, fix(24)},
{SIGURG, fix(25)},
{SIGVTALRM, fix(26)},
{SIGXCPU, fix(27)},
{SIGXFSZ, fix(28)}
};
ikptr
ikrt_waitpid(ikptr pid /*, ikpcb* pcb */){
int status;
pid_t r = waitpid(unfix(pid), &status, 0);
if(r >= 0){
return fix(status);
} else {
return ik_errno_to_code();
ik_signal_num_to_code(int signum){
signal_info* si;
int i;
for(i=0; i < signal_info_table_len; i++){
si = &signal_info_table[i];
if(si->n == signum){
return si->c;
}
}
fprintf(stderr, "\n*** ik_signal_num_to_code: Don't know signal %d ***\n\n",
signum);
return fix(99999);
}
int
ik_signal_code_to_num(ikptr sigcode){
signal_info* si;
int i;
for(i=0; i < signal_info_table_len; i++){
si = &signal_info_table[i];
if(si->c == sigcode){
return si->n;
}
}
fprintf(stderr, "ik_signal_code_to_num: Don't know code %ld\n",
unfix(sigcode));
exit(EXIT_FAILURE);
return 0;
}
ikptr
ikrt_kill(ikptr pid, ikptr sigcode /*, ikpcb* pcb */){
int r = kill((pid_t)unfix(pid), ik_signal_code_to_num(sigcode));
if(r == 0){
return fix(0);
}
return ik_errno_to_code();
}
ikptr
ikrt_waitpid(ikptr rvec, ikptr pid, ikptr block /*, ikpcb* pcb */){
/* rvec is assumed to come in as #(#f #f #f) */
int status, options = 0;
if(block == false_object){
options = WNOHANG;
}
pid_t r = waitpid(unfix(pid), &status, options);
if(r > 0){
ref(rvec, off_record_data+0*wordsize) = fix(r);
if(WIFEXITED(status)) {
ref(rvec, off_record_data+1*wordsize) = fix(WEXITSTATUS(status));
}
if(WIFSIGNALED(status)) {
ref(rvec, off_record_data+2*wordsize) =
ik_signal_num_to_code(WTERMSIG(status));
}
}else if(r == 0){ /* would have blocked */
; /* let rvec return as all #f's */
}else {
return ik_errno_to_code();
}
return rvec;
}

7
src/ikarus-runtime.c
View File

@ -539,13 +539,16 @@ ikptr ik_uuid(ikptr bv){
if(fd == -1){
fd = open("/dev/urandom", O_RDONLY);
if(fd == -1){
return false_object;
return ik_errno_to_code();
}
uuid_strlen = strlen(uuid_chars);
}
long int n = unfix(ref(bv, off_bytevector_length));
unsigned char* data = (unsigned char*)(long)(bv+off_bytevector_data);
read(fd, data, n);
int r = read(fd, data, n);
if(r < 0){
return ik_errno_to_code();
}
unsigned char* p = data;
unsigned char* q = data + n;
while(p < q){