Initial revision

1 files changed, 866 insertions, 0 deletions

diff --git a/lisp/stream.c b/lisp/stream.c
new file mode 100644
index 0000000..be0f44d
--- /dev/null
+++ b/lisp/stream.c
@@ -0,0 +1,866 @@
+/*
+ * 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.21 2002/12/10 03:59:03 paulo Exp $ */
+
+#include "read.h"
+#include "stream.h"
+#include "pathname.h"
+#include "write.h"
+#include "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))));
+}