xenocara/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->value, Scharacter->value, 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->value, Scharacter->value, 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->value, Scharacter->value, 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->value, Scharacter->value, 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->value, Scharacter->value, 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))));
}