/[gcl]/gcl/o/run_process.c
ViewVC logotype

Diff of /gcl/o/run_process.c

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.17 by camm, Tue Nov 1 12:14:04 2005 UTC revision 1.18 by camm, Sun Nov 6 18:07:37 2005 UTC
# Line 17  License for more details. Line 17  License for more details.
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"
# Line 581  FFN(siLmake_socket_pair)() Line 583  FFN(siLmake_socket_pair)()
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        
# Line 605  DEFUNO_NEW("SELECT-READ",object,fSselect Line 637  DEFUNO_NEW("SELECT-READ",object,fSselect
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);
# Line 625  DEFUNO_NEW("SELECT-READ",object,fSselect Line 652  DEFUNO_NEW("SELECT-READ",object,fSselect
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    
# Line 680  DEFUNO_NEW("FORK",object,fSfork,SI,0,0,N Line 726  DEFUNO_NEW("FORK",object,fSfork,SI,0,0,N
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);

Legend:
Removed from v.1.17  
changed lines
  Added in v.1.18

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26