franz/lam7.c
/* Lprocess -
 * C code to implement the *process function
 * call:
 * 	(*process 'st_command ['s_readp ['s_writep]])
 * where st_command is the command to execute
 *   s_readp is non nil if you want a port to read from returned
 *   s_writep is non nil if you want a port to write to returned
 *   both flags default to nil
 * *process returns
 *    the exit status of the process if s_readp and s_writep not given
 *	(in this case the parent waits for the child to finish)
 *    a list of (readport writeport childpid) if one of s_readp or s_writep
 *    is given.  If only s_readp is non nil, then writeport will be nil,
 *    If only s_writep is non nil, then readport will be nil
 */
Lprocess
C code to implement the *process function
call:
(*process 'st_command ['s_readp ['s_writep]])
where st_command is the command to execute
s_readp is non nil if you want a port to read from returned
s_writep is non nil if you want a port to write to returned
both flags default to nil
*process returns
the exit status of the process if s_readp and s_writep not given
(in this case the parent waits for the child to finish)
a list of (readport writeport childpid) if one of s_readp or s_writep
is given.  If only s_readp is non nil, then writeport will be nil,
If only s_writep is non nil, then readport will be nil
Lprocess C code to implement the * process function call : ( * process ' st_command [ ' s_readp [ ' s_writep ]] ) where st_command is the command to execute s_readp is non nil if you want a port to read from returned s_writep is non nil if you want a port to write to returned both flags default to nil * process returns the exit status of the process if s_readp and s_writep not given ( in this case the parent waits for the child to finish ) a list of ( readport writeport childpid ) if one of s_readp or s_writep is given . If only s_readp is non nil then writeport will be nil If only s_writep is non nil then readport will be nil
lispval
Lprocess()
{
	int wflag , childsi , childso , child;
	lispval handy;
	char *command, *p;
	int writep, readp;
	int itemp;
	int (*handler)(), (*signal())();
	FILE *bufs[2],*obufs[2], *fpipe();
	Savestack(0);
	writep = readp = FALSE;
	wflag = TRUE;
	switch(np-lbot) {
	case 3:  if(lbot[2].val != nil) writep = TRUE;
	case 2:  if(lbot[1].val != nil) readp = TRUE;
		 wflag = 0;
	case 1:  command = (char *) verify(lbot[0].val,
			   	  	    "*process: non atom first arg");
		 break;
	default:
		argerr("*process");
	}
	childsi = 0;
	childso = 1;
	if(writep) {
	    fpipe(bufs);
	    childsi = fileno(bufs[0]);
	}
	if(readp) {
		fpipe(obufs);
		childso = fileno(obufs[1]);
	}
	handler = signal(SIGINT,SIG_IGN);
	if((child = vfork()) == 0 ) {
		if(wflag && handler != SIG_IGN)
			signal(2,SIG_DFL);
		if(writep) {
			close(0);
			dup(childsi);
		}
		if (readp) {
			close(1);
			dup(childso);
		}
		if ((p = (char *)getenv("SHELL")) != (char *)0) {
			execlp(p , p, "-c",command,0);
			_exit(-1); 
		} else {
			execlp("csh", "csh", "-c",command,0);
			execlp("sh", "sh", "-c",command,0);
			_exit(-1); 
		}
	}
	if(writep) fclose(bufs[0]);
	if(readp) fclose(obufs[1]);
	if(wflag && child!= -1) {
		int status=0;
		while(wait(&status)!=child) {}
		signal(2,handler);	
		itemp = status >> 8;
		Restorestack();
		return(inewint(itemp));	
	}
	protect(handy = newdot());
	handy->d.cdr = newdot();
	handy->d.cdr->d.cdr = newdot();
	if(readp) {
	    handy->d.car = P(obufs[0]);
	    ioname[PN(obufs[0])] = (lispval) inewstr((char *) "from-process");
	}
	if(writep) {
	    handy->d.cdr->d.car = P(bufs[1]);
	    ioname[PN(bufs[1])] = (lispval) inewstr((char *) "to-process");
	}
	handy->d.cdr->d.cdr->d.car = (lispval) inewint(child);
	signal(SIGINT,handler);
	Restorestack();
	return(handy);
}
lispval Lprocess ( ) { int wflag , childsi , childso , child ; lispval handy ; char * command , * p ; int writep , readp ; int itemp ; int ( * handler ) ( ) , ( * signal ( ) ) ( ) ; FILE * bufs [ 2 ] , * obufs [ 2 ] , * fpipe ( ) ; Savestack ( 0 ) ; writep = readp = FALSE ; wflag = TRUE ; switch ( np - lbot ) { case 3 : if ( lbot [ 2 ] . val != nil ) writep = TRUE ; case 2 : if ( lbot [ 1 ] . val != nil ) readp = TRUE ; wflag = 0 ; case 1 : command = ( char * ) verify ( lbot [ 0 ] . val , " " ) ; break ; default : argerr ( " " ) ; } childsi = 0 ; childso = 1 ; if ( writep ) { fpipe ( bufs ) ; childsi = fileno ( bufs [ 0 ] ) ; } if ( readp ) { fpipe ( obufs ) ; childso = fileno ( obufs [ 1 ] ) ; } handler = signal ( SIGINT , SIG_IGN ) ; if ( ( child = vfork ( ) ) == 0 ) { if ( wflag && handler != SIG_IGN ) signal ( 2 , SIG_DFL ) ; if ( writep ) { close ( 0 ) ; dup ( childsi ) ; } if ( readp ) { close ( 1 ) ; dup ( childso ) ; } if ( ( p = ( char * ) getenv ( " " ) ) != ( char * ) 0 ) { execlp ( p , p , " " , command , 0 ) ; _exit ( -1 ) ; } else { execlp ( " " , " " , " " , command , 0 ) ; execlp ( " " , " " , " " , command , 0 ) ; _exit ( -1 ) ; } } if ( writep ) fclose ( bufs [ 0 ] ) ; if ( readp ) fclose ( obufs [ 1 ] ) ; if ( wflag && child != -1 ) { int status = 0 ; while ( wait ( & status ) != child ) { } signal ( 2 , handler ) ; itemp = status >> 8 ; Restorestack ( ) ; return ( inewint ( itemp ) ) ; } protect ( handy = newdot ( ) ) ; handy -> d . cdr = newdot ( ) ; handy -> d . cdr -> d . cdr = newdot ( ) ; if ( readp ) { handy -> d . car = P ( obufs [ 0 ] ) ; ioname [ PN ( obufs [ 0 ] ) ] = ( lispval ) inewstr ( ( char * ) " " ) ; } if ( writep ) { handy -> d . cdr -> d . car = P ( bufs [ 1 ] ) ; ioname [ PN ( bufs [ 1 ] ) ] = ( lispval ) inewstr ( ( char * ) " " ) ; } handy -> d . cdr -> d . cdr -> d . car = ( lispval ) inewint ( child ) ; signal ( SIGINT , handler ) ; Restorestack ( ) ; return ( handy ) ; }
Lprocess
 C code to implement the *process function
 call:
      (*process 'st_command ['s_readp ['s_writep]])
 where st_command is the command to execute
   s_readp is non nil if you want a port to read from returned
   s_writep is non nil if you want a port to write to returned
   both flags default to nil
 *process returns
    the exit status of the process if s_readp and s_writep not given
      (in this case the parent waits for the child to finish)
    a list of (readport writeport childpid) if one of s_readp or s_writep
    is given.
Lprocess C code to implement the * process function call : ( * process ' st_command [ ' s_readp [ ' s_writep ]] ) where st_command is the command to execute s_readp is non nil if you want a port to read from returned s_writep is non nil if you want a port to write to returned both flags default to nil * process returns the exit status of the process if s_readp and s_writep not given ( in this case the parent waits for the child to finish ) a list of ( readport writeport childpid ) if one of s_readp or s_writep is given .
/* if there will be communication between the processes,
	 * it will be through these pipes:
	 *  parent ->  bufs[1] ->  bufs[0] -> child    if writep
	 *  parent <- obufs[0] <- obufs[1] <- parent   if readp
	 */ /* if we will wait for the child to finish
		 * and if the process had ignored interrupts before
		 * we were called, then leave them ignored, else
		 * set it back the the default (death)
		 */ /* if exec fails, signal problems*/ /* if exec fails, signal problems*/ /* close the duplicated file descriptors
	 * e.g. if writep is true then we've created two desriptors,
	 *  bufs[0] and bufs[1],  we will write to bufs[1] and the
	 *  child (who has a copy of our bufs[0]) will read from bufs[0]
	 *  We (the parent) close bufs[0] since we will not be reading
	 *  from it.
	 */ /* we await the death of the child */ /* the child has died */ /* restore the interrupt handler */ /* return its status */ /* we are not waiting for the childs death
	 * build a list containing the write and read ports
	 */