17 |
*/ |
*/ |
18 |
|
|
19 |
#include <string.h> |
#include <string.h> |
20 |
|
#include <sys/types.h> |
21 |
|
#include <sys/wait.h> |
22 |
|
|
23 |
#define IN_RUN_PROCESS |
#define IN_RUN_PROCESS |
24 |
#include "include.h" |
#include "include.h" |
583 |
make_socket_pair(); |
make_socket_pair(); |
584 |
} |
} |
585 |
|
|
586 |
DEFUNO_NEW("KILL",object,fSkill,SI,1,1,NONE,OO,OO,OO,OO,void,siLkill,(object x),"") { |
#define unpack_handle(a_,b_,c_) ({if (!consp(a_))\ |
587 |
if (!consp(x)) |
TYPE_ERROR(a_,sLcons);\ |
588 |
TYPE_ERROR(x,sLcons); |
if (type_of(a_->c.c_car)!=t_fixnum)\ |
589 |
if (type_of(x->c.c_car)!=t_fixnum) |
TYPE_ERROR(a_->c.c_car,sLfixnum);\ |
590 |
TYPE_ERROR(x->c.c_car,t_fixnum); |
b_=fix(a_->c.c_car);\ |
591 |
if (type_of(x->c.c_cdr) != t_stream || |
if (type_of(a_->c.c_cdr) != t_fixnum)\ |
592 |
x->c.c_cdr->sm.sm_mode!=smm_input) |
TYPE_ERROR(a_->c.c_cdr,sLfixnum);\ |
593 |
TYPE_ERROR(x->c.c_cdr,sLinput_stream); |
c_=fix(a_->c.c_cdr);}) |
594 |
kill(fix(x->c.c_car),SIGTERM); |
|
595 |
close_stream(x->c.c_cdr); |
|
596 |
|
DEFUNO_NEW("KILL",object,fSkill,SI,2,2,NONE,OO,IO,OO,OO,void,siLkill,(object x,fixnum err),"") { |
597 |
|
|
598 |
|
fixnum k,l; |
599 |
|
int e,status; |
600 |
|
|
601 |
|
unpack_handle(x,k,l); |
602 |
|
|
603 |
|
if (l>=0) { |
604 |
|
ASSERT((e=waitpid(k,&status,WNOHANG))>=0); |
605 |
|
if (e) { |
606 |
|
if (!WIFEXITED(status)) { |
607 |
|
ASSERT(WIFSIGNALED(status)); |
608 |
|
FEerror("Child %u died with signal %u\n",k,WTERMSIG(status)); |
609 |
|
} else if ((e=WEXITSTATUS(status))) |
610 |
|
FEerror("Child %u exited with error status %d\n",k,e); |
611 |
|
} else { |
612 |
|
ASSERT(!kill(k,SIGTERM)); |
613 |
|
ASSERT(waitpid(k,&status,0)==k); |
614 |
|
if (WIFSIGNALED(status)) { |
615 |
|
ASSERT(WTERMSIG(status)==SIGTERM); |
616 |
|
} else { |
617 |
|
ASSERT(WIFEXITED(status)); |
618 |
|
if ((e=WEXITSTATUS(status))) |
619 |
|
FEerror("Child %u exited with error status %d\n",k,e); |
620 |
|
} |
621 |
|
} |
622 |
|
/* ASSERT(!close(l)); */ |
623 |
|
close(l);/*FIXME*/ |
624 |
|
x->c.c_cdr=make_fixnum(-1); |
625 |
|
} |
626 |
return Cnil; |
return Cnil; |
627 |
} |
} |
628 |
|
|
637 |
if (x!=Cnil && !consp(x)) |
if (x!=Cnil && !consp(x)) |
638 |
TYPE_ERROR(x,sLlist); |
TYPE_ERROR(x,sLlist); |
639 |
for (;!endp(x);x=x->c.c_cdr) { |
for (;!endp(x);x=x->c.c_cdr) { |
640 |
if (!consp(x->c.c_car)) |
unpack_handle(x->c.c_car,i,k); |
|
TYPE_ERROR(x->c.c_car,sLcons); |
|
|
if (type_of(x->c.c_car->c.c_cdr) != t_stream || |
|
|
x->c.c_car->c.c_cdr->sm.sm_mode!=smm_input) |
|
|
TYPE_ERROR(x->c.c_car->c.c_cdr,sLinput_stream); |
|
|
k=x->c.c_car->c.c_cdr->sm.sm_fd; |
|
641 |
if (k<0) continue;/*closed stream*/ |
if (k<0) continue;/*closed stream*/ |
642 |
max=max<k ? k : max; |
max=max<k ? k : max; |
643 |
FD_SET(k,&fds); |
FD_SET(k,&fds); |
644 |
} |
} |
645 |
select(max+1,&fds,NULL,NULL,usec < 0 ? NULL : &tv); |
select(max+1,&fds,NULL,NULL,usec < 0 ? NULL : &tv); |
646 |
for (x=y,i=mask=0;!endp(x);x=x->c.c_cdr,i++) { |
for (x=y,i=mask=0;!endp(x);x=x->c.c_cdr,i++) { |
647 |
k=x->c.c_car->c.c_cdr->sm.sm_fd; |
k=fix(x->c.c_car->c.c_cdr); |
648 |
if (k<0) continue; |
if (k<0) continue; |
649 |
if (FD_ISSET(k,&fds)) |
if (FD_ISSET(k,&fds)) |
650 |
mask|=(1<<i); |
mask|=(1<<i); |
652 |
return (object)mask; |
return (object)mask; |
653 |
} |
} |
654 |
|
|
655 |
|
DEFUNO_NEW("WRITE-POINTER-OBJECT",object,fSwrite_pointer_object,SI,2,2,NONE,OO,IO,OO,OO, |
656 |
|
void,siLwrite_pointer_object,(object x,object z),"") { |
657 |
|
|
658 |
|
object y; |
659 |
|
fixnum pid,s; |
660 |
|
|
661 |
|
unpack_handle(z,pid,s); |
662 |
|
|
663 |
|
y=x; |
664 |
|
if (stack_alloc_end<=stack_alloc_start || !writable_ptr(x)) |
665 |
|
y=OBJNULL; |
666 |
|
ASSERT(write(s,&y,sizeof(y))==sizeof(y)); |
667 |
|
if (y==OBJNULL) { |
668 |
|
char b[BUFSIZ]; |
669 |
|
stack_alloc_off(); |
670 |
|
y=make_fd_stream(s,smm_output,"w",b); |
671 |
|
prin1(x,y); |
672 |
|
fclose(y->sm.sm_fp); |
673 |
|
} |
674 |
|
return Cnil; |
675 |
|
} |
676 |
|
|
677 |
|
DEFUNO_NEW("READ-POINTER-OBJECT",object,fSread_pointer_object,SI,1,1,NONE,OO,OO,OO,OO, |
678 |
|
void,siLread_pointer_object,(object z),"") { |
679 |
|
|
680 |
|
object x; |
681 |
|
fixnum pid,s; |
682 |
|
|
683 |
|
unpack_handle(z,pid,s); |
684 |
|
|
685 |
|
ASSERT(read(s,&x,sizeof(x))==sizeof(x)); |
686 |
|
if (x==OBJNULL) { |
687 |
|
object y; |
688 |
|
char b[BUFSIZ]; |
689 |
|
/*FIXME this could be somewhat faster if the malloc induced by |
690 |
|
fdopen could be avoided.*/ |
691 |
|
y=make_fd_stream(s,smm_input,"r",b); |
692 |
|
x=read_object(y); |
693 |
|
fclose(y->sm.sm_fp); |
694 |
|
} |
695 |
|
fSkill(z,1); |
696 |
|
return x; |
697 |
|
|
698 |
|
} |
699 |
|
|
700 |
|
DEFVAR("*CHILD-STACK-ALLOC*",sSAchild_stack_allocA,SI,make_shortfloat(0.8),""); |
701 |
|
|
702 |
DEFUNO_NEW("FORK",object,fSfork,SI,0,0,NONE,OO,OO,OO,OO,void,siLfork,(void),"") { |
DEFUNO_NEW("FORK",object,fSfork,SI,0,0,NONE,OO,OO,OO,OO,void,siLfork,(void),"") { |
703 |
int p[2],j; |
int p[2],j=0; |
704 |
pid_t pid; |
pid_t pid; |
|
struct sigaction sa; |
|
|
object x; |
|
705 |
|
|
706 |
ASSERT(!pipe(p)); |
ASSERT(!pipe(p)); |
707 |
|
|
|
sa.sa_handler=SIG_IGN; |
|
|
sa.sa_flags=SA_NOCLDWAIT; |
|
|
sigemptyset(&sa.sa_mask); |
|
|
|
|
|
sigaction(SIGCHLD,&sa,NULL); |
|
|
|
|
708 |
ASSERT((pid=fork())>=0); |
ASSERT((pid=fork())>=0); |
709 |
|
|
710 |
if (!pid) { |
if (!pid) { |
|
fd_set fds; |
|
|
|
|
|
FD_ZERO(&fds); |
|
|
FD_SET(p[1],&fds); |
|
|
select(p[1]+1,NULL,&fds,NULL,NULL); |
|
711 |
|
|
712 |
|
j=1; |
713 |
close(STDIN_FILENO); |
close(STDIN_FILENO); |
|
/* dup2(p[0],STDIN_FILENO); */ |
|
|
/* close(p[0]); */ |
|
714 |
close(STDOUT_FILENO); |
close(STDOUT_FILENO); |
|
/* dup2(p[1],STDOUT_FILENO); */ |
|
|
/* close(p[1]); */ |
|
715 |
close(STDERR_FILENO); |
close(STDERR_FILENO); |
716 |
|
|
717 |
} |
} |
718 |
|
|
|
j=pid ? 0 : 1; |
|
719 |
close(p[1-j]); |
close(p[1-j]); |
720 |
|
|
721 |
x = alloc_object(t_stream); |
return MMcons(make_fixnum(pid),make_fixnum(p[j])); |
|
x->sm.sm_mode = j ? smm_output : smm_input; |
|
|
x->sm.sm_fp = fdopen(p[j],j ? "w" : "r"); |
|
|
x->sm.sm_buffer = 0; |
|
|
x->sm.sm_object0 = sLcharacter; |
|
|
x->sm.sm_object1 = Cnil; |
|
|
x->sm.sm_fd=p[j]; |
|
|
/* x->sm.sm_int0 = p[0]; */ |
|
|
/* x->sm.sm_int1 = p[1]; */ |
|
|
|
|
|
return MMcons(make_fixnum(pid),x); |
|
722 |
|
|
723 |
} |
} |
724 |
|
|
726 |
|
|
727 |
void |
void |
728 |
gcl_init_socket_function() |
gcl_init_socket_function() |
729 |
{ |
{ |
730 |
|
|
731 |
|
/* struct sigaction sa; */ |
732 |
|
/* sa.sa_handler=SIG_IGN; */ |
733 |
|
/* sa.sa_flags=SA_NOCLDWAIT; */ |
734 |
|
/* sigemptyset(&sa.sa_mask); */ |
735 |
|
|
736 |
|
/* sigaction(SIGCHLD,&sa,NULL); */ |
737 |
|
|
738 |
make_si_function("MAKE-SOCKET-STREAM", siLmake_socket_stream); |
make_si_function("MAKE-SOCKET-STREAM", siLmake_socket_stream); |
739 |
make_si_function("MAKE-SOCKET-PAIR", siLmake_socket_pair); |
make_si_function("MAKE-SOCKET-PAIR", siLmake_socket_pair); |
740 |
make_si_function("RUN-PROCESS", siLrun_process); |
make_si_function("RUN-PROCESS", siLrun_process); |