Edit

IABSD.fr/xenocara/app/xedit/lisp/stream.c

Branch :

  • Show log

    Commit

  • Author : matthieu
    Date : 2006-11-25 20:07:29
    Hash : 616b6f15
    Message : Importing from X.Org 7.2RC2

  • app/xedit/lisp/stream.c
  • /*
     * Copyright (c) 2001 by The XFree86 Project, Inc.
     *
     * Permission is hereby granted, free of charge, to any person obtaining a
     * copy of this software and associated documentation files (the "Software"),
     * to deal in the Software without restriction, including without limitation
     * the rights to use, copy, modify, merge, publish, distribute, sublicense,
     * and/or sell copies of the Software, and to permit persons to whom the
     * Software is furnished to do so, subject to the following conditions:
     *
     * The above copyright notice and this permission notice shall be included in
     * all copies or substantial portions of the Software.
     *  
     * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
     * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
     * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
     * THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
     * WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
     * OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
     * SOFTWARE.
     *
     * Except as contained in this notice, the name of the XFree86 Project shall
     * not be used in advertising or otherwise to promote the sale, use or other
     * dealings in this Software without prior written authorization from the
     * XFree86 Project.
     *
     * Author: Paulo César Pereira de Andrade
     */
    
    /* $XFree86: xc/programs/xedit/lisp/stream.c,v 1.21tsi Exp $ */
    
    #include "lisp/read.h"
    #include "lisp/stream.h"
    #include "lisp/pathname.h"
    #include "lisp/write.h"
    #include "lisp/private.h"
    #include <errno.h>
    #include <fcntl.h>
    #include <signal.h>
    #include <string.h>
    #include <sys/wait.h>
    
    /*
     * Initialization
     */
    #define DIR_PROBE		0
    #define DIR_INPUT		1
    #define DIR_OUTPUT		2
    #define DIR_IO			3
    
    #define EXT_NIL			0
    #define EXT_ERROR		1
    #define EXT_NEW_VERSION		2
    #define EXT_RENAME		3
    #define EXT_RENAME_DELETE	4
    #define EXT_OVERWRITE		5
    #define EXT_APPEND		6
    #define EXT_SUPERSEDE		7
    
    #define NOEXT_NIL		0
    #define NOEXT_ERROR		1
    #define NOEXT_CREATE		2
    #define NOEXT_NOTHING		3
    
    extern char **environ;
    
    LispObj *Oopen, *Oclose, *Otruename;
    
    LispObj *Kif_does_not_exist, *Kprobe, *Kinput, *Koutput, *Kio,
    	*Knew_version, *Krename, *Krename_and_delete, *Koverwrite,
    	*Kappend, *Ksupersede, *Kcreate;
    
    /*
     * Implementation
     */
    void
    LispStreamInit(void)
    {
        Oopen		= STATIC_ATOM("OPEN");
        Oclose		= STATIC_ATOM("CLOSE");
        Otruename		= STATIC_ATOM("TRUENAME");
    
        Kif_does_not_exist	= KEYWORD("IF-DOES-NOT-EXIST");
        Kprobe		= KEYWORD("PROBE");
        Kinput		= KEYWORD("INPUT");
        Koutput		= KEYWORD("OUTPUT");
        Kio			= KEYWORD("IO");
        Knew_version	= KEYWORD("NEW-VERSION");
        Krename		= KEYWORD("RENAME");
        Krename_and_delete	= KEYWORD("RENAME-AND-DELETE");
        Koverwrite		= KEYWORD("OVERWRITE");
        Kappend		= KEYWORD("APPEND");
        Ksupersede		= KEYWORD("SUPERSEDE");
        Kcreate		= KEYWORD("CREATE");
    }
    
    LispObj *
    Lisp_DeleteFile(LispBuiltin *builtin)
    /*
     delete-file filename
     */
    {
        GC_ENTER();
        LispObj *filename;
    
        filename = ARGUMENT(0);
    
        if (STRINGP(filename)) {
    	filename = APPLY1(Oparse_namestring, filename);
    	GC_PROTECT(filename);
        }
        else if (STREAMP(filename)) {
    	if (filename->data.stream.type != LispStreamFile)
    	    LispDestroy("%s: %s is not a FILE-STREAM",
    			STRFUN(builtin), STROBJ(filename));
    	filename = filename->data.stream.pathname;
        }
        else {
    	CHECK_PATHNAME(filename);
        }
        GC_LEAVE();
    
        return (LispUnlink(THESTR(CAR(filename->data.pathname))) ? NIL : T);
    }
    
    LispObj *
    Lisp_RenameFile(LispBuiltin *builtin)
    /*
     rename-file filename new-name
     */
    {
        int code;
        GC_ENTER();
        char *from, *to;
        LispObj *old_truename, *new_truename;
    
        LispObj *filename, *new_name;
    
        new_name = ARGUMENT(1);
        filename = ARGUMENT(0);
    
        if (STRINGP(filename)) {
    	filename = APPLY1(Oparse_namestring, filename);
    	GC_PROTECT(filename);
        }
        else if (STREAMP(filename)) {
    	if (filename->data.stream.type != LispStreamFile)
    	    LispDestroy("%s: %s is not a FILE-STREAM",
    			STRFUN(builtin), STROBJ(filename));
    	filename = filename->data.stream.pathname;
        }
        else {
    	CHECK_PATHNAME(filename);
        }
        old_truename = APPLY1(Otruename, filename);
        GC_PROTECT(old_truename);
    
        if (STRINGP(new_name)) {
    	new_name = APPLY3(Oparse_namestring, new_name, NIL, filename);
    	GC_PROTECT(new_name);
        }
        else {
    	CHECK_PATHNAME(new_name);
        }
    
        from = THESTR(CAR(filename->data.pathname));
        to = THESTR(CAR(new_name->data.pathname));
        code = LispRename(from, to);
        if (code)
    	LispDestroy("%s: rename(%s, %s): %s",
    		    STRFUN(builtin), from, to, strerror(errno));
        GC_LEAVE();
    
        new_truename = APPLY1(Otruename, new_name);
        RETURN_COUNT = 2;
        RETURN(0) = old_truename;
        RETURN(1) = new_truename;
    
        return (new_name);
    }
    
    LispObj *
    Lisp_Streamp(LispBuiltin *builtin)
    /*
     streamp object
     */
    {
        LispObj *object;
    
        object = ARGUMENT(0);
    
        return (STREAMP(object) ? T : NIL);
    }
    
    LispObj *
    Lisp_InputStreamP(LispBuiltin *builtin)
    /*
     input-stream-p stream
     */
    {
        LispObj *stream;
    
        stream = ARGUMENT(0);
    
        CHECK_STREAM(stream);
    
        return (stream->data.stream.readable ? T : NIL);
    }
    
    LispObj *
    Lisp_OpenStreamP(LispBuiltin *builtin)
    /*
     open-stream-p stream
     */
    {
       LispObj *stream;
    
        stream = ARGUMENT(0);
    
        CHECK_STREAM(stream);
    
        return (stream->data.stream.readable || stream->data.stream.writable ?
    	    T : NIL);
    }
    
    LispObj *
    Lisp_OutputStreamP(LispBuiltin *builtin)
    /*
     output-stream-p stream
     */
    {
        LispObj *stream;
    
        stream = ARGUMENT(0);
    
        CHECK_STREAM(stream);
    
        return (stream->data.stream.writable ? T : NIL);
    }
    
    LispObj *
    Lisp_Open(LispBuiltin *builtin)
    /*
     open filename &key direction element-type if-exists if-does-not-exist external-format
     */
    {
        GC_ENTER();
        char *string;
        LispObj *stream = NIL;
        int mode, flags, direction, exist, noexist, file_exist;
        LispFile *file;
    
        LispObj *filename, *odirection, *element_type, *if_exists,
    	    *if_does_not_exist, *external_format;
    
        external_format = ARGUMENT(5);
        if_does_not_exist = ARGUMENT(4);
        if_exists = ARGUMENT(3);
        element_type = ARGUMENT(2);
        odirection = ARGUMENT(1);
        filename = ARGUMENT(0);
    
        if (STRINGP(filename)) {
    	filename = APPLY1(Oparse_namestring, filename);
    	GC_PROTECT(filename);
        }
        else if (STREAMP(filename)) {
    	if (filename->data.stream.type != LispStreamFile)
    	    LispDestroy("%s: %s is not a FILE-STREAM",
    			STRFUN(builtin), STROBJ(filename));
    	filename = filename->data.stream.pathname;
        }
        else {
    	CHECK_PATHNAME(filename);
        }
    
        if (odirection != UNSPEC) {
    	direction = -1;
    	if (KEYWORDP(odirection)) {
    	    if (odirection == Kprobe)
    		direction = DIR_PROBE;
    	    else if (odirection == Kinput)
    		direction = DIR_INPUT;
    	    else if (odirection == Koutput)
    		direction = DIR_OUTPUT;
    	    else if (odirection == Kio)
    		direction = DIR_IO;
    	}
    	if (direction == -1)
    	    LispDestroy("%s: bad :DIRECTION %s",
    			STRFUN(builtin), STROBJ(odirection));
        }
        else
    	direction = DIR_INPUT;
    
        if (element_type != UNSPEC) {
    	/* just check argument... */
    	if (SYMBOLP(element_type) &&
    	    ATOMID(element_type) == Scharacter)
    	    ;	/* do nothing */
    	else if (KEYWORDP(element_type) &&
    	    ATOMID(element_type) == Sdefault)
    	    ;	/* do nothing */
    	else
    	    LispDestroy("%s: only :%s and %s supported for :ELEMENT-TYPE, not %s",
    			STRFUN(builtin), Sdefault, Scharacter, STROBJ(element_type));
        }
    
        if (if_exists != UNSPEC) {
    	exist = -1;
    	if (if_exists == NIL)
    	    exist = EXT_NIL;
    	else if (KEYWORDP(if_exists)) {
    	    if (if_exists == Kerror)
    		exist = EXT_ERROR;
    	    else if (if_exists == Knew_version)
    		exist = EXT_NEW_VERSION;
    	    else if (if_exists == Krename)
    		exist = EXT_RENAME;
    	    else if (if_exists == Krename_and_delete)
    		exist = EXT_RENAME_DELETE;
    	    else if (if_exists == Koverwrite)
    		exist = EXT_OVERWRITE;
    	    else if (if_exists == Kappend)
    		exist = EXT_APPEND;
    	    else if (if_exists == Ksupersede)
    		exist = EXT_SUPERSEDE;
    	}
    	if (exist == -1)
    	    LispDestroy("%s: bad :IF-EXISTS %s",
    			STRFUN(builtin), STROBJ(if_exists));
        }
        else
    	exist = EXT_ERROR;
    
        if (if_does_not_exist != UNSPEC) {
    	noexist = -1;
    	if (if_does_not_exist == NIL)
    	    noexist = NOEXT_NIL;
    	if (KEYWORDP(if_does_not_exist)) {
    	    if (if_does_not_exist == Kerror)
    		noexist = NOEXT_ERROR;
    	    else if (if_does_not_exist == Kcreate)
    		noexist = NOEXT_CREATE;
    	}
    	if (noexist == -1)
    	    LispDestroy("%s: bad :IF-DOES-NO-EXISTS %s",
    			STRFUN(builtin), STROBJ(if_does_not_exist));
        }
        else
    	noexist = direction != DIR_INPUT ? NOEXT_NOTHING : NOEXT_ERROR;
    
        if (external_format != UNSPEC) {
    	/* just check argument... */
    	if (SYMBOLP(external_format) &&
    	    ATOMID(external_format) == Scharacter)
    	    ;	/* do nothing */
    	else if (KEYWORDP(external_format) &&
    	    ATOMID(external_format) == Sdefault)
    	    ;	/* do nothing */
    	else
    	    LispDestroy("%s: only :%s and %s supported for :EXTERNAL-FORMAT, not %s",
    			STRFUN(builtin), Sdefault, Scharacter, STROBJ(external_format));
        }
    
        /* string representation of pathname */
        string = THESTR(CAR(filename->data.pathname));
        mode = 0;
    
        file_exist = access(string, F_OK) == 0;
        if (file_exist) {
    	if (exist == EXT_NIL) {
    	    GC_LEAVE();
    	    return (NIL);
    	}
        }
        else {
    	if (noexist == NOEXT_NIL) {
    	    GC_LEAVE();
    	    return (NIL);
    	}
    	if (noexist == NOEXT_ERROR)
    	    LispDestroy("%s: file %s does not exist",
    			STRFUN(builtin), STROBJ(CAR(filename->data.quote)));
    	else if (noexist == NOEXT_CREATE) {
    	    LispFile *tmp = LispFopen(string, FILE_WRITE);
    
    	    if (tmp)
    		LispFclose(tmp);
    	    else
    		LispDestroy("%s: cannot create file %s",
    			    STRFUN(builtin),
    			    STROBJ(CAR(filename->data.quote)));
    	}
        }
    
        if (direction == DIR_OUTPUT || direction == DIR_IO) {
    	if (file_exist) {
    	    if (exist == EXT_ERROR)
    		LispDestroy("%s: file %s already exists",
    			    STRFUN(builtin), STROBJ(CAR(filename->data.quote)));
    	    if (exist == EXT_RENAME) {
    		/* Add an ending '~' at the end of the backup file */
    		char tmp[PATH_MAX + 1];
    
    		strcpy(tmp, string);
    		if (strlen(tmp) + 1 > PATH_MAX)
    		    LispDestroy("%s: backup name for %s too long",
    				STRFUN(builtin),
    				STROBJ(CAR(filename->data.quote)));
    		strcat(tmp, "~");
    		if (rename(string, tmp))
    		    LispDestroy("%s: rename: %s",
    				STRFUN(builtin), strerror(errno));
    		mode |= FILE_WRITE;
    	    }
    	    else if (exist == EXT_OVERWRITE)
    		mode |= FILE_WRITE;
    	    else if (exist == EXT_APPEND)
    		mode |= FILE_APPEND;
    	}
    	else
    	    mode |= FILE_WRITE;
    	if (direction == DIR_IO)
    	    mode |= FILE_IO;
        }
        else
    	mode |= FILE_READ;
    
        file = LispFopen(string, mode);
        if (file == NULL)
    	LispDestroy("%s: open: %s", STRFUN(builtin), strerror(errno));
    
        flags = 0;
        if (direction == DIR_PROBE) {
    	LispFclose(file);
    	file = NULL;
        }
        else {
    	if (direction == DIR_INPUT || direction == DIR_IO)
    	    flags |= STREAM_READ;
    	if (direction == DIR_OUTPUT || direction == DIR_IO)
    	    flags |= STREAM_WRITE;
        }
        stream = FILESTREAM(file, filename, flags);
        GC_LEAVE();
    
        return (stream);
    }
    
    LispObj *
    Lisp_Close(LispBuiltin *builtin)
    /*
     close stream &key abort
     */
    {
        LispObj *stream, *oabort;
    
        oabort = ARGUMENT(1);
        stream = ARGUMENT(0);
    
        CHECK_STREAM(stream);
    
        if (stream->data.stream.readable || stream->data.stream.writable) {
    	stream->data.stream.readable = stream->data.stream.writable = 0;
    	if (stream->data.stream.type == LispStreamFile) {
    	    LispFclose(stream->data.stream.source.file);
    	    stream->data.stream.source.file = NULL;
    	}
    	else if (stream->data.stream.type == LispStreamPipe) {
    	    if (IPSTREAMP(stream)) {
    		LispFclose(IPSTREAMP(stream));
    		IPSTREAMP(stream) = NULL;
    	    }
    	    if (OPSTREAMP(stream)) {
    		LispFclose(OPSTREAMP(stream));
    		OPSTREAMP(stream) = NULL;
    	    }
    	    if (EPSTREAMP(stream)) {
    		LispFclose(EPSTREAMP(stream));
    		EPSTREAMP(stream) = NULL;
    	    }
    	    if (PIDPSTREAMP(stream) > 0) {
    		kill(PIDPSTREAMP(stream),
    		     oabort == UNSPEC || oabort == NIL ? SIGTERM : SIGKILL);
    		waitpid(PIDPSTREAMP(stream), NULL, 0);
    	    }
    	}
    	return (T);
        }
    
        return (NIL);
    }
    
    LispObj *
    Lisp_Listen(LispBuiltin *builtin)
    /*
     listen &optional input-stream
     */
    {
        LispFile *file = NULL;
        LispObj *result = NIL;
    
        LispObj *stream;
    
        stream = ARGUMENT(0);
    
        if (stream == UNSPEC)
    	stream = NIL;
        else if (stream != NIL) {
    	CHECK_STREAM(stream);
        }
        else
    	stream = lisp__data.standard_input;
    
        if (stream->data.stream.readable) {
    	switch (stream->data.stream.type) {
    	    case LispStreamString:
    		if (SSTREAMP(stream)->input < SSTREAMP(stream)->length)
    		    result = T;
    		break;
    	    case LispStreamFile:
    		file = FSTREAMP(stream);
    		break;
    	    case LispStreamStandard:
    		file = FSTREAMP(stream);
    		break;
    	    case LispStreamPipe:
    		file = IPSTREAMP(stream);
    		break;
    	}
    
    	if (file != NULL) {
    	    if (file->available || file->offset < file->length)
    		result = T;
    	    else {
    		unsigned char c;
    
    		if (!file->nonblock) {
    		    if (fcntl(file->descriptor, F_SETFL, O_NONBLOCK) < 0)
    			LispDestroy("%s: fcntl: %s",
    				    STRFUN(builtin), strerror(errno));
    		    file->nonblock = 1;
    		}
    		if (read(file->descriptor, &c, 1) == 1) {
    		    LispFungetc(file, c);
    		    result = T;
    		}
    	    }
    	}
        }
    
        return (result);
    }
    
    LispObj *
    Lisp_MakeStringInputStream(LispBuiltin *builtin)
    /*
     make-string-input-stream string &optional start end
     */
    {
        char *string;
        long start, end, length;
    
        LispObj *ostring, *ostart, *oend, *result;
    
        oend = ARGUMENT(2);
        ostart = ARGUMENT(1);
        ostring = ARGUMENT(0);
    
        start = end = 0;
        CHECK_STRING(ostring);
        LispCheckSequenceStartEnd(builtin, ostring, ostart, oend,
    			      &start, &end, &length);
        string = THESTR(ostring);
    
        if (end - start != length)
    	length = end - start;
        result = LSTRINGSTREAM(string + start, STREAM_READ, length);
    
        return (result);
    }
    
    LispObj *
    Lisp_MakeStringOutputStream(LispBuiltin *builtin)
    /*
     make-string-output-stream &key element-type
     */
    {
        LispObj *element_type;
    
        element_type = ARGUMENT(0);
    
        if (element_type != UNSPEC) {
    	/* just check argument... */
    	if (SYMBOLP(element_type) && ATOMID(element_type) == Scharacter)
    	    ;	/* do nothing */
    	else if (KEYWORDP(element_type) &&
    	    ATOMID(element_type) == Sdefault)
    	    ;	/* do nothing */
    	else
    	    LispDestroy("%s: only :%s and %s supported for :ELEMENT-TYPE, not %s",
    			STRFUN(builtin), Sdefault, Scharacter, STROBJ(element_type));
        }
    
        return (LSTRINGSTREAM("", STREAM_WRITE, 1));
    }
    
    LispObj *
    Lisp_GetOutputStreamString(LispBuiltin *builtin)
    /*
     get-output-stream-string string-output-stream
     */
    {
        int length;
        char *string;
        LispObj *string_output_stream, *result;
    
        string_output_stream = ARGUMENT(0);
    
        if (!STREAMP(string_output_stream) ||
    	string_output_stream->data.stream.type != LispStreamString ||
    	string_output_stream->data.stream.readable ||
    	!string_output_stream->data.stream.writable)
    	LispDestroy("%s: %s is not an output string stream",
    		    STRFUN(builtin), STROBJ(string_output_stream));
    
        string = LispGetSstring(SSTREAMP(string_output_stream), &length);
        result = LSTRING(string, length);
    
        /* reset string */
        SSTREAMP(string_output_stream)->output =
    	SSTREAMP(string_output_stream)->length =
    	SSTREAMP(string_output_stream)->column = 0;
    
        return (result);
    }
    
    
    /* XXX Non standard functions below
     */
    LispObj *
    Lisp_MakePipe(LispBuiltin *builtin)
    /*
     make-pipe command-line &key :direction :element-type :external-format
     */
    {
        char *string;
        LispObj *stream = NIL;
        int flags, direction;
        LispFile *error_file;
        LispPipe *program;
        int ifd[2];
        int ofd[2];
        int efd[2];
        char *argv[4];
    
        LispObj *command_line, *odirection, *element_type, *external_format;
    
        external_format = ARGUMENT(3);
        element_type = ARGUMENT(2);
        odirection = ARGUMENT(1);
        command_line = ARGUMENT(0);
    
        if (PATHNAMEP(command_line))
    	command_line = CAR(command_line->data.quote);
        else if (!STRINGP(command_line))
    	LispDestroy("%s: %s is a bad pathname",
    		    STRFUN(builtin), STROBJ(command_line));
    
        if (odirection != UNSPEC) {
    	direction = -1;
    	if (KEYWORDP(odirection)) {
    	    if (odirection == Kprobe)
    		direction = DIR_PROBE;
    	    else if (odirection == Kinput)
    		direction = DIR_INPUT;
    	    else if (odirection == Koutput)
    		direction = DIR_OUTPUT;
    	    else if (odirection == Kio)
    		direction = DIR_IO;
    	}
    	if (direction == -1)
    	    LispDestroy("%s: bad :DIRECTION %s",
    			STRFUN(builtin), STROBJ(odirection));
        }
        else
    	direction = DIR_INPUT;
    
        if (element_type != UNSPEC) {
    	/* just check argument... */
    	if (SYMBOLP(element_type) && ATOMID(element_type) == Scharacter)
    	    ;	/* do nothing */
    	else if (KEYWORDP(element_type) && ATOMID(element_type) == Sdefault)
    	    ;	/* do nothing */
    	else
    	    LispDestroy("%s: only :%s and %s supported for :ELEMENT-TYPE, not %s",
    			STRFUN(builtin), Sdefault, Scharacter, STROBJ(element_type));
        }
    
        if (external_format != UNSPEC) {
    	/* just check argument... */
    	if (SYMBOLP(external_format) && ATOMID(external_format) == Scharacter)
    	    ;	/* do nothing */
    	else if (KEYWORDP(external_format) &&
    		 ATOMID(external_format) == Sdefault)
    	    ;	/* do nothing */
    	else
    	    LispDestroy("%s: only :%s and %s supported for :EXTERNAL-FORMAT, not %s",
    			STRFUN(builtin), Sdefault, Scharacter, STROBJ(external_format));
        }
    
        string = THESTR(command_line);
        program = LispMalloc(sizeof(LispPipe));
        if (direction != DIR_PROBE) {
    	argv[0] = "sh";
    	argv[1] = "-c";
    	argv[2] = string;
    	argv[3] = NULL;
    	pipe(ifd);
    	pipe(ofd);
    	pipe(efd);
    	if ((program->pid = fork()) == 0) {
    	    close(0);
    	    close(1);
    	    close(2);
    	    dup2(ofd[0], 0);
    	    dup2(ifd[1], 1);
    	    dup2(efd[1], 2);
    	    close(ifd[0]);
    	    close(ifd[1]);
    	    close(ofd[0]);
    	    close(ofd[1]);
    	    close(efd[0]);
    	    close(efd[1]);
    	    execve("/bin/sh", argv, environ);
    	    exit(-1);
    	}
    	else if (program->pid < 0)
    	    LispDestroy("%s: fork: %s", STRFUN(builtin), strerror(errno));
    
    	program->input = LispFdopen(ifd[0], FILE_READ | FILE_UNBUFFERED);
    	close(ifd[1]);
    	program->output = LispFdopen(ofd[1], FILE_WRITE | FILE_UNBUFFERED);
    	close(ofd[0]);
    	error_file = LispFdopen(efd[0], FILE_READ | FILE_UNBUFFERED);
    	close(efd[1]);
        }
        else {
    	program->pid = -1;
    	program->input = program->output = error_file = NULL;
        }
    
        flags = direction == DIR_PROBE ? 0 : STREAM_READ;
        program->errorp = FILESTREAM(error_file, command_line, flags);
    
        flags = 0;
        if (direction != DIR_PROBE) {
    	if (direction == DIR_INPUT || direction == DIR_IO)
    	    flags |= STREAM_READ;
    	if (direction == DIR_OUTPUT || direction == DIR_IO)
    	    flags |= STREAM_WRITE;
        }
        stream = PIPESTREAM(program, command_line, flags);
        LispMused(program);
    
        return (stream);
    }
    
    /* Helper function, primarily for use with the xt module
     */
    LispObj *
    Lisp_PipeBroken(LispBuiltin *builtin)
    /*
     pipe-broken pipe-stream
     */
    {
        int pid, status, retval;
        LispObj *result = NIL;
    
        LispObj *pipe_stream;
    
        pipe_stream = ARGUMENT(0);
    
        if (!STREAMP(pipe_stream) ||
    	pipe_stream->data.stream.type != LispStreamPipe)
    	LispDestroy("%s: %s is not a pipe stream",
    		    STRFUN(builtin), STROBJ(pipe_stream));
    
        if ((pid = PIDPSTREAMP(pipe_stream)) > 0) {
    	retval = waitpid(pid, &status, WNOHANG | WUNTRACED);
    	if (retval == pid || (retval == -1 && errno == ECHILD))
    	    result = T;
        }
    
        return (result);
    }
    
    /*
     Helper function, so that it is not required to redirect error output
     */
    LispObj *
    Lisp_PipeErrorStream(LispBuiltin *builtin)
    /*
     pipe-error-stream pipe-stream
     */
    {
        LispObj *pipe_stream;
    
        pipe_stream = ARGUMENT(0);
    
        if (!STREAMP(pipe_stream) ||
    	pipe_stream->data.stream.type != LispStreamPipe)
    	LispDestroy("%s: %s is not a pipe stream",
    		    STRFUN(builtin), STROBJ(pipe_stream));
    
        return (pipe_stream->data.stream.source.program->errorp);
    }
    
    /*
     Helper function, primarily for use with the xt module
     */
    LispObj *
    Lisp_PipeInputDescriptor(LispBuiltin *builtin)
    /*
     pipe-input-descriptor pipe-stream
     */
    {
        LispObj *pipe_stream;
    
        pipe_stream = ARGUMENT(0);
    
        if (!STREAMP(pipe_stream) ||
    	pipe_stream->data.stream.type != LispStreamPipe)
    	LispDestroy("%s: %s is not a pipe stream",
    		    STRFUN(builtin), STROBJ(pipe_stream));
        if (!IPSTREAMP(pipe_stream))
    	LispDestroy("%s: pipe %s is unreadable",
    		    STRFUN(builtin), STROBJ(pipe_stream));
    
        return (INTEGER(LispFileno(IPSTREAMP(pipe_stream))));
    }
    
    /*
     Helper function, primarily for use with the xt module
     */
    LispObj *
    Lisp_PipeErrorDescriptor(LispBuiltin *builtin)
    /*
     pipe-error-descriptor pipe-stream
     */
    {
        LispObj *pipe_stream;
    
        pipe_stream = ARGUMENT(0);
    
        if (!STREAMP(pipe_stream) ||
    	pipe_stream->data.stream.type != LispStreamPipe)
    	LispDestroy("%s: %s is not a pipe stream",
    		    STRFUN(builtin), STROBJ(pipe_stream));
        if (!EPSTREAMP(pipe_stream))
    	LispDestroy("%s: pipe %s is closed",
    		    STRFUN(builtin), STROBJ(pipe_stream));
    
        return (INTEGER(LispFileno(EPSTREAMP(pipe_stream))));
    }