Import Micropolis from http://www.donhopkins.com/home/micropolis/

[micropolis] / src / tcl / tclunxut.c

/* 
 * tclUnixUtil.c --
 *
 *      This file contains a collection of utility procedures that
 *      are present in the Tcl's UNIX core but not in the generic
 *      core.  For example, they do file manipulation and process
 *      manipulation.
 *
 *      The Tcl_Fork and Tcl_WaitPids procedures are based on code
 *      contributed by Karl Lehenbauer, Mark Diekhans and Peter
 *      da Silva.
 *
 * Copyright 1991 Regents of the University of California
 * Permission to use, copy, modify, and distribute this
 * software and its documentation for any purpose and without
 * fee is hereby granted, provided that this copyright
 * notice appears in all copies.  The University of California
 * makes no representations about the suitability of this
 * software for any purpose.  It is provided "as is" without
 * express or implied warranty.
 */

#ifndef lint
static char rcsid[] = "$Header: /user6/ouster/tcl/RCS/tclUnixUtil.c,v 1.18 91/11/21 14:53:46 ouster Exp $ SPRITE (Berkeley)";
#endif /* not lint */

#include "tclint.h"
#include "tclunix.h"

/*
 * Data structures of the following type are used by Tcl_Fork and
 * Tcl_WaitPids to keep track of child processes.
 */

typedef struct {
    int pid;                    /* Process id of child. */
    WAIT_STATUS_TYPE status;    /* Status returned when child exited or
                                 * suspended. */
    int flags;                  /* Various flag bits;  see below for
                                 * definitions. */
} WaitInfo;

/*
 * Flag bits in WaitInfo structures:
 *
 * WI_READY -                   Non-zero means process has exited or
 *                              suspended since it was forked or last
 *                              returned by Tcl_WaitPids.
 * WI_DETACHED -                Non-zero means no-one cares about the
 *                              process anymore.  Ignore it until it
 *                              exits, then forget about it.
 */

#define WI_READY        1
#define WI_DETACHED     2

static WaitInfo *waitTable = NULL;
static int waitTableSize = 0;   /* Total number of entries available in
                                 * waitTable. */
static int waitTableUsed = 0;   /* Number of entries in waitTable that
                                 * are actually in use right now.  Active
                                 * entries are always at the beginning
                                 * of the table. */
#define WAIT_TABLE_GROW_BY 4
\f
/*
 *----------------------------------------------------------------------
 *
 * Tcl_EvalFile --
 *
 *      Read in a file and process the entire file as one gigantic
 *      Tcl command.
 *
 * Results:
 *      A standard Tcl result, which is either the result of executing
 *      the file or an error indicating why the file couldn't be read.
 *
 * Side effects:
 *      Depends on the commands in the file.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_EvalFile(interp, fileName)
    Tcl_Interp *interp;         /* Interpreter in which to process file. */
    char *fileName;             /* Name of file to process.  Tilde-substitution
                                 * will be performed on this name. */
{
    int fileId, result;
    struct stat statBuf;
    char *cmdBuffer, *end, *oldScriptFile;
    Interp *iPtr = (Interp *) interp;

    oldScriptFile = iPtr->scriptFile;
    iPtr->scriptFile = fileName;
    fileName = Tcl_TildeSubst(interp, fileName);
    if (fileName == NULL) {
        goto error;
    }
#ifdef MSDOS
    filename2DOS(fileName);
#endif
    fileId = open(fileName, O_RDONLY, 0);

    if (fileId < 0) {
        Tcl_AppendResult(interp, "couldn't read file \"", fileName,
                "\": ", Tcl_UnixError(interp), (char *) NULL);
        goto error;
    }
    if (fstat(fileId, &statBuf) == -1) {
        Tcl_AppendResult(interp, "couldn't stat file \"", fileName,
                "\": ", Tcl_UnixError(interp), (char *) NULL);
        close(fileId);
        goto error;
    }
    cmdBuffer = (char *) ckalloc((unsigned) statBuf.st_size+1);
#ifdef MSDOS
    if (read(fileId, cmdBuffer, (int) statBuf.st_size) < 0) {
#else
    if (read(fileId, cmdBuffer, (int) statBuf.st_size) != statBuf.st_size) {
#endif
        Tcl_AppendResult(interp, "error in reading file \"", fileName,
                "\": ", Tcl_UnixError(interp), (char *) NULL);
        close(fileId);
        goto error;
    }
    if (close(fileId) != 0) {
        Tcl_AppendResult(interp, "error closing file \"", fileName,
                "\": ", Tcl_UnixError(interp), (char *) NULL);
        goto error;
    }
    cmdBuffer[statBuf.st_size] = 0;
    result = Tcl_Eval(interp, cmdBuffer, 0, &end);
    if (result == TCL_RETURN) {
        result = TCL_OK;
    }
    if (result == TCL_ERROR) {
        char msg[200];

        /*
         * Record information telling where the error occurred.
         */

        sprintf(msg, "\n    (file \"%.150s\" line %d)", fileName,
                interp->errorLine);
        Tcl_AddErrorInfo(interp, msg);
    }
    ckfree(cmdBuffer);
    iPtr->scriptFile = oldScriptFile;
    return result;

    error:
    iPtr->scriptFile = oldScriptFile;
    return TCL_ERROR;
}
\f
/*
 *----------------------------------------------------------------------
 *
 * Tcl_Fork --
 *
 *      Create a new process using the vfork system call, and keep
 *      track of it for "safe" waiting with Tcl_WaitPids.
 *
 * Results:
 *      The return value is the value returned by the vfork system
 *      call (0 means child, > 0 means parent (value is child id),
 *      < 0 means error).
 *
 * Side effects:
 *      A new process is created, and an entry is added to an internal
 *      table of child processes if the process is created successfully.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_Fork()
{
    WaitInfo *waitPtr;
    pid_t pid;

    /*
     * Disable SIGPIPE signals:  if they were allowed, this process
     * might go away unexpectedly if children misbehave.  This code
     * can potentially interfere with other application code that
     * expects to handle SIGPIPEs;  what's really needed is an
     * arbiter for signals to allow them to be "shared".
     */

    if (waitTable == NULL) {
        (void) signal(SIGPIPE, SIG_IGN);
    }

    /*
     * Enlarge the wait table if there isn't enough space for a new
     * entry.
     */

    if (waitTableUsed == waitTableSize) {
        int newSize;
        WaitInfo *newWaitTable;

        newSize = waitTableSize + WAIT_TABLE_GROW_BY;
        newWaitTable = (WaitInfo *) ckalloc((unsigned)
                (newSize * sizeof(WaitInfo)));
        memcpy((VOID *) newWaitTable, (VOID *) waitTable,
                (waitTableSize * sizeof(WaitInfo)));
        if (waitTable != NULL) {
            ckfree((char *) waitTable);
        }
        waitTable = newWaitTable;
        waitTableSize = newSize;
    }

    /*
     * Make a new process and enter it into the table if the fork
     * is successful.
     */

    waitPtr = &waitTable[waitTableUsed];
    pid = fork();
    if (pid > 0) {
        waitPtr->pid = pid;
        waitPtr->flags = 0;
        waitTableUsed++;
    }
    return pid;
}
\f
/*
 *----------------------------------------------------------------------
 *
 * Tcl_WaitPids --
 *
 *      This procedure is used to wait for one or more processes created
 *      by Tcl_Fork to exit or suspend.  It records information about
 *      all processes that exit or suspend, even those not waited for,
 *      so that later waits for them will be able to get the status
 *      information.
 *
 * Results:
 *      -1 is returned if there is an error in the wait kernel call.
 *      Otherwise the pid of an exited/suspended process from *pidPtr
 *      is returned and *statusPtr is set to the status value returned
 *      by the wait kernel call.
 *
 * Side effects:
 *      Doesn't return until one of the pids at *pidPtr exits or suspends.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_WaitPids(numPids, pidPtr, statusPtr)
    int numPids;                /* Number of pids to wait on:  gives size
                                 * of array pointed to by pidPtr. */
    int *pidPtr;                /* Pids to wait on:  return when one of
                                 * these processes exits or suspends. */
    int *statusPtr;             /* Wait status is returned here. */
{
    int i, count, pid;
    register WaitInfo *waitPtr;
    int anyProcesses;
    WAIT_STATUS_TYPE status;

    while (1) {
        /*
         * Scan the table of child processes to see if one of the
         * specified children has already exited or suspended.  If so,
         * remove it from the table and return its status.
         */

        anyProcesses = 0;
        for (waitPtr = waitTable, count = waitTableUsed;
                count > 0; waitPtr++, count--) {
            for (i = 0; i < numPids; i++) {
                if (pidPtr[i] != waitPtr->pid) {
                    continue;
                }
                anyProcesses = 1;
                if (waitPtr->flags & WI_READY) {
                    *statusPtr = *((int *) &waitPtr->status);
                    pid = waitPtr->pid;
                    if (WIFEXITED(waitPtr->status)
                            || WIFSIGNALED(waitPtr->status)) {
                        *waitPtr = waitTable[waitTableUsed-1];
                        waitTableUsed--;
                    } else {
                        waitPtr->flags &= ~WI_READY;
                    }
                    return pid;
                }
            }
        }

        /*
         * Make sure that the caller at least specified one valid
         * process to wait for.
         */

        if (!anyProcesses) {
            errno = ECHILD;
            return -1;
        }

        /*
         * Wait for a process to exit or suspend, then update its
         * entry in the table and go back to the beginning of the
         * loop to see if it's one of the desired processes.
         */

        pid = wait(&status);
        if (pid < 0) {
            return pid;
        }
        for (waitPtr = waitTable, count = waitTableUsed; ;
                waitPtr++, count--) {
            if (count == 0) {
                break;                  /* Ignore unknown processes. */
            }
            if (pid != waitPtr->pid) {
                continue;
            }

            /*
             * If the process has been detached, then ignore anything
             * other than an exit, and drop the entry on exit.
             */

            if (waitPtr->flags & WI_DETACHED) {
                if (WIFEXITED(status) || WIFSIGNALED(status)) {
                    *waitPtr = waitTable[waitTableUsed-1];
                    waitTableUsed--;
                }
            } else {
                waitPtr->status = status;
                waitPtr->flags |= WI_READY;
            }
            break;
        }
    }
}
\f
/*
 *----------------------------------------------------------------------
 *
 * Tcl_DetachPids --
 *
 *      This procedure is called to indicate that one or more child
 *      processes have been placed in background and are no longer
 *      cared about.  They should be ignored in future calls to
 *      Tcl_WaitPids.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_DetachPids(numPids, pidPtr)
    int numPids;                /* Number of pids to detach:  gives size
                                 * of array pointed to by pidPtr. */
    int *pidPtr;                /* Array of pids to detach:  must have
                                 * been created by Tcl_Fork. */
{
    register WaitInfo *waitPtr;
    int i, count, pid;

    for (i = 0; i < numPids; i++) {
        pid = pidPtr[i];
        for (waitPtr = waitTable, count = waitTableUsed;
                count > 0; waitPtr++, count--) {
            if (pid != waitPtr->pid) {
                continue;
            }

            /*
             * If the process has already exited then destroy its
             * table entry now.
             */

            if ((waitPtr->flags & WI_READY) && (WIFEXITED(waitPtr->status)
                    || WIFSIGNALED(waitPtr->status))) {
                *waitPtr = waitTable[waitTableUsed-1];
                waitTableUsed--;
            } else {
                waitPtr->flags |= WI_DETACHED;
            }
            goto nextPid;
        }
        panic("Tcl_Detach couldn't find process");

        nextPid:
        continue;
    }
}
\f
/*
 *----------------------------------------------------------------------
 *
 * Tcl_CreatePipeline --
 *
 *      Given an argc/argv array, instantiate a pipeline of processes
 *      as described by the argv.
 *
 * Results:
 *      The return value is a count of the number of new processes
 *      created, or -1 if an error occurred while creating the pipeline.
 *      *pidArrayPtr is filled in with the address of a dynamically
 *      allocated array giving the ids of all of the processes.  It
 *      is up to the caller to free this array when it isn't needed
 *      anymore.  If inPipePtr is non-NULL, *inPipePtr is filled in
 *      with the file id for the input pipe for the pipeline (if any):
 *      the caller must eventually close this file.  If outPipePtr
 *      isn't NULL, then *outPipePtr is filled in with the file id
 *      for the output pipe from the pipeline:  the caller must close
 *      this file.  If errFilePtr isn't NULL, then *errFilePtr is filled
 *      with a file id that may be used to read error output after the
 *      pipeline completes.
 *
 * Side effects:
 *      Processes and pipes are created.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_CreatePipeline(interp, argc, argv, pidArrayPtr, inPipePtr,
        outPipePtr, errFilePtr)
    Tcl_Interp *interp;         /* Interpreter to use for error reporting. */
    int argc;                   /* Number of entries in argv. */
    char **argv;                /* Array of strings describing commands in
                                 * pipeline plus I/O redirection with <,
                                 * <<, and >.  Argv[argc] must be NULL. */
    int **pidArrayPtr;          /* Word at *pidArrayPtr gets filled in with
                                 * address of array of pids for processes
                                 * in pipeline (first pid is first process
                                 * in pipeline). */
    int *inPipePtr;             /* If non-NULL, input to the pipeline comes
                                 * from a pipe (unless overridden by
                                 * redirection in the command).  The file
                                 * id with which to write to this pipe is
                                 * stored at *inPipePtr.  -1 means command
                                 * specified its own input source. */
    int *outPipePtr;            /* If non-NULL, output to the pipeline goes
                                 * to a pipe, unless overriden by redirection
                                 * in the command.  The file id with which to
                                 * read frome this pipe is stored at
                                 * *outPipePtr.  -1 means command specified
                                 * its own output sink. */
    int *errFilePtr;            /* If non-NULL, all stderr output from the
                                 * pipeline will go to a temporary file
                                 * created here, and a descriptor to read
                                 * the file will be left at *errFilePtr.
                                 * The file will be removed already, so
                                 * closing this descriptor will be the end
                                 * of the file.  If this is NULL, then
                                 * all stderr output goes to our stderr. */
{
    int *pidPtr = NULL;         /* Points to malloc-ed array holding all
                                 * the pids of child processes. */
    int numPids = 0;            /* Actual number of processes that exist
                                 * at *pidPtr right now. */
    int cmdCount;               /* Count of number of distinct commands
                                 * found in argc/argv. */
    char *input = NULL;         /* Describes input for pipeline, depending
                                 * on "inputFile".  NULL means take input
                                 * from stdin/pipe. */
    int inputFile = 0;          /* Non-zero means input is name of input
                                 * file.  Zero means input holds actual
                                 * text to be input to command. */
    char *output = NULL;        /* Holds name of output file to pipe to,
                                 * or NULL if output goes to stdout/pipe. */
    int inputId = -1;           /* Readable file id input to current command in
                                 * pipeline (could be file or pipe).  -1
                                 * means use stdin. */
    int outputId = -1;          /* Writable file id for output from current
                                 * command in pipeline (could be file or pipe).
                                 * -1 means use stdout. */
    int errorId = -1;           /* Writable file id for all standard error
                                 * output from all commands in pipeline.  -1
                                 * means use stderr. */
    int lastOutputId = -1;      /* Write file id for output from last command
                                 * in pipeline (could be file or pipe).
                                 * -1 means use stdout. */
    int pipeIds[2];             /* File ids for pipe that's being created. */
    int firstArg, lastArg;      /* Indexes of first and last arguments in
                                 * current command. */
    int lastBar;
    char *execName;
    int i, j, pid;

    if (inPipePtr != NULL) {
        *inPipePtr = -1;
    }
    if (outPipePtr != NULL) {
        *outPipePtr = -1;
    }
    if (errFilePtr != NULL) {
        *errFilePtr = -1;
    }
    pipeIds[0] = pipeIds[1] = -1;

    /*
     * First, scan through all the arguments to figure out the structure
     * of the pipeline.  Count the number of distinct processes (it's the
     * number of "|" arguments).  If there are "<", "<<", or ">" arguments
     * then make note of input and output redirection and remove these
     * arguments and the arguments that follow them.
     */

    cmdCount = 1;
    lastBar = -1;
    for (i = 0; i < argc; i++) {
        if ((argv[i][0] == '|') && ((argv[i][1] == 0))) {
            if ((i == (lastBar+1)) || (i == (argc-1))) {
                interp->result = "illegal use of | in command";
                return -1;
            }
            lastBar = i;
            cmdCount++;
            continue;
        } else if (argv[i][0] == '<') {
            if (argv[i][1] == 0) {
                input = argv[i+1];
                inputFile = 1;
            } else if ((argv[i][1] == '<') && (argv[i][2] == 0)) {
                input = argv[i+1];
                inputFile = 0;
            } else {
                continue;
            }
        } else if ((argv[i][0] == '>') && (argv[i][1] == 0)) {
            output = argv[i+1];
        } else {
            continue;
        }
        if (i >= (argc-1)) {
            Tcl_AppendResult(interp, "can't specify \"", argv[i],
                    "\" as last word in command", (char *) NULL);
            return -1;
        }
        for (j = i+2; j < argc; j++) {
            argv[j-2] = argv[j];
        }
        argc -= 2;
        i--;                    /* Process new arg from same position. */
    }
    if (argc == 0) {
        interp->result =  "didn't specify command to execute";
        return -1;
    }

    /*
     * Set up the redirected input source for the pipeline, if
     * so requested.
     */

    if (input != NULL) {
        if (!inputFile) {
            /*
             * Immediate data in command.  Create temporary file and
             * put data into file.
             */

#ifdef MSDOS
#           define TMP_STDIN_NAME "tcl.in"
#else
#           define TMP_STDIN_NAME "/tmp/tcl.in.XXXXXX"
#endif
            char inName[sizeof(TMP_STDIN_NAME) + 1];
            int length;

            strcpy(inName, TMP_STDIN_NAME);
            mkstemp(inName);
            inputId = open(inName, O_RDWR|O_CREAT|O_TRUNC, 0600);
            if (inputId < 0) {
                Tcl_AppendResult(interp,
                        "couldn't create input file for command: ",
                        Tcl_UnixError(interp), (char *) NULL);
                goto error;
            }
            length = strlen(input);
#ifdef MSDOS
            if (write(inputId, input, length) < 0) {
#else
            if (write(inputId, input, length) != length) {
#endif
                Tcl_AppendResult(interp,
                        "couldn't write file input for command: ",
                        Tcl_UnixError(interp), (char *) NULL);
                goto error;
            }
            if ((lseek(inputId, 0L, 0) == -1) || (unlink(inName) == -1)) {
                Tcl_AppendResult(interp,
                        "couldn't reset or remove input file for command: ",
                        Tcl_UnixError(interp), (char *) NULL);
                goto error;
            }
        } else {
            /*
             * File redirection.  Just open the file.
             */

            inputId = open(input, O_RDONLY, 0);
            if (inputId < 0) {
                Tcl_AppendResult(interp,
                        "couldn't read file \"", input, "\": ",
                        Tcl_UnixError(interp), (char *) NULL);
                goto error;
            }
        }
    } else if (inPipePtr != NULL) {
        if (pipe(pipeIds) != 0) {
            Tcl_AppendResult(interp,
                    "couldn't create input pipe for command: ",
                    Tcl_UnixError(interp), (char *) NULL);
            goto error;
        }
        inputId = pipeIds[0];
        *inPipePtr = pipeIds[1];
        pipeIds[0] = pipeIds[1] = -1;
    }

    /*
     * Set up the redirected output sink for the pipeline from one
     * of two places, if requested.
     */

    if (output != NULL) {
        /*
         * Output is to go to a file.
         */

        lastOutputId = open(output, O_WRONLY|O_CREAT|O_TRUNC, 0666);
        if (lastOutputId < 0) {
            Tcl_AppendResult(interp,
                    "couldn't write file \"", output, "\": ",
                    Tcl_UnixError(interp), (char *) NULL);
            goto error;
        }
    } else if (outPipePtr != NULL) {
        /*
         * Output is to go to a pipe.
         */

        if (pipe(pipeIds) != 0) {
            Tcl_AppendResult(interp,
                    "couldn't create output pipe: ",
                    Tcl_UnixError(interp), (char *) NULL);
            goto error;
        }
        lastOutputId = pipeIds[1];
        *outPipePtr = pipeIds[0];
        pipeIds[0] = pipeIds[1] = -1;
    }

    /*
     * Set up the standard error output sink for the pipeline, if
     * requested.  Use a temporary file which is opened, then deleted.
     * Could potentially just use pipe, but if it filled up it could
     * cause the pipeline to deadlock:  we'd be waiting for processes
     * to complete before reading stderr, and processes couldn't complete
     * because stderr was backed up.
     */

    if (errFilePtr != NULL) {
#       define TMP_STDERR_NAME "/tmp/tcl.err.XXXXXX"
        char errName[sizeof(TMP_STDERR_NAME) + 1];

        strcpy(errName, TMP_STDERR_NAME);
        mkstemp(errName);
        errorId = open(errName, O_WRONLY|O_CREAT|O_TRUNC, 0600);
        if (errorId < 0) {
            errFileError:
            Tcl_AppendResult(interp,
                    "couldn't create error file for command: ",
                    Tcl_UnixError(interp), (char *) NULL);
            goto error;
        }
        *errFilePtr = open(errName, O_RDONLY, 0);
        if (*errFilePtr < 0) {
            goto errFileError;
        }
        if (unlink(errName) == -1) {
            Tcl_AppendResult(interp,
                    "couldn't remove error file for command: ",
                    Tcl_UnixError(interp), (char *) NULL);
            goto error;
        }
    }

    /*
     * Scan through the argc array, forking off a process for each
     * group of arguments between "|" arguments.
     */

    pidPtr = (int *) ckalloc((unsigned) (cmdCount * sizeof(int)));
    for (i = 0; i < numPids; i++) {
        pidPtr[i] = -1;
    }
    for (firstArg = 0; firstArg < argc; numPids++, firstArg = lastArg+1) {
        for (lastArg = firstArg; lastArg < argc; lastArg++) {
            if ((argv[lastArg][0] == '|') && (argv[lastArg][1] == 0)) {
                break;
            }
        }
        argv[lastArg] = NULL;
        if (lastArg == argc) {
            outputId = lastOutputId;
        } else {
            if (pipe(pipeIds) != 0) {
                Tcl_AppendResult(interp, "couldn't create pipe: ",
                        Tcl_UnixError(interp), (char *) NULL);
                goto error;
            }
            outputId = pipeIds[1];
        }
        execName = Tcl_TildeSubst(interp, argv[firstArg]);
        pid = Tcl_Fork();
        if (pid == -1) {
            Tcl_AppendResult(interp, "couldn't fork child process: ",
                    Tcl_UnixError(interp), (char *) NULL);
            goto error;
        }
        if (pid == 0) {
            char errSpace[200];

            if (((inputId != -1) && (dup2(inputId, 0) == -1))
                    || ((outputId != -1) && (dup2(outputId, 1) == -1))
                    || ((errorId != -1) && (dup2(errorId, 2) == -1))) {
                char *err;
                err = "forked process couldn't set up input/output\n";
                write(errorId < 0 ? 2 : errorId, err, strlen(err));
                _exit(1);
            }
            for (i = 3; (i <= outputId) || (i <= inputId) || (i <= errorId);
                    i++) {
                close(i);
            }
            execvp(execName, &argv[firstArg]);
            sprintf(errSpace, "couldn't find \"%.150s\" to execute\n",
                    argv[firstArg]);
            write(2, errSpace, strlen(errSpace));
            _exit(1);
        } else {
            pidPtr[numPids] = pid;
        }

        /*
         * Close off our copies of file descriptors that were set up for
         * this child, then set up the input for the next child.
         */

        if (inputId != -1) {
            close(inputId);
        }
        if (outputId != -1) {
            close(outputId);
        }
        inputId = pipeIds[0];
        pipeIds[0] = pipeIds[1] = -1;
    }
    *pidArrayPtr = pidPtr;

    /*
     * All done.  Cleanup open files lying around and then return.
     */

cleanup:
    if (inputId != -1) {
        close(inputId);
    }
    if (lastOutputId != -1) {
        close(lastOutputId);
    }
    if (errorId != -1) {
        close(errorId);
    }
    return numPids;

    /*
     * An error occurred.  There could have been extra files open, such
     * as pipes between children.  Clean them all up.  Detach any child
     * processes that have been created.
     */

    error:
    if ((inPipePtr != NULL) && (*inPipePtr != -1)) {
        close(*inPipePtr);
        *inPipePtr = -1;
    }
    if ((outPipePtr != NULL) && (*outPipePtr != -1)) {
        close(*outPipePtr);
        *outPipePtr = -1;
    }
    if ((errFilePtr != NULL) && (*errFilePtr != -1)) {
        close(*errFilePtr);
        *errFilePtr = -1;
    }
    if (pipeIds[0] != -1) {
        close(pipeIds[0]);
    }
    if (pipeIds[1] != -1) {
        close(pipeIds[1]);
    }
    if (pidPtr != NULL) {
        for (i = 0; i < numPids; i++) {
            if (pidPtr[i] != -1) {
                Tcl_DetachPids(1, &pidPtr[i]);
            }
        }
        ckfree((char *) pidPtr);
    }
    numPids = -1;
    goto cleanup;
}
\f
/*
 *----------------------------------------------------------------------
 *
 * Tcl_UnixError --
 *
 *      This procedure is typically called after UNIX kernel calls
 *      return errors.  It stores machine-readable information about
 *      the error in $errorCode returns an information string for
 *      the caller's use.
 *
 * Results:
 *      The return value is a human-readable string describing the
 *      error, as returned by strerror.
 *
 * Side effects:
 *      The global variable $errorCode is reset.
 *
 *----------------------------------------------------------------------
 */

char *
Tcl_UnixError(interp)
    Tcl_Interp *interp;         /* Interpreter whose $errorCode variable
                                 * is to be changed. */
{
    char *id, *msg;

    id = Tcl_ErrnoId();
    msg = strerror(errno);
    Tcl_SetErrorCode(interp, "UNIX", id, msg, (char *) NULL);
    return msg;
}
\f
/*
 *----------------------------------------------------------------------
 *
 * TclMakeFileTable --
 *
 *      Create or enlarge the file table for the interpreter, so that
 *      there is room for a given index.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      The file table for iPtr will be created if it doesn't exist
 *      (and entries will be added for stdin, stdout, and stderr).
 *      If it already exists, then it will be grown if necessary.
 *
 *----------------------------------------------------------------------
 */

void
TclMakeFileTable(iPtr, index)
    Interp *iPtr;               /* Interpreter whose table of files is
                                 * to be manipulated. */
    int index;                  /* Make sure table is large enough to
                                 * hold at least this index. */
{
    /*
     * If the table doesn't even exist, then create it and initialize
     * entries for standard files.
     */

    if (iPtr->numFiles == 0) {
        OpenFile *filePtr;
        int i;

        if (index < 2) {
            iPtr->numFiles = 3;
        } else {
            iPtr->numFiles = index+1;
        }
        iPtr->filePtrArray = (OpenFile **) ckalloc((unsigned)
                ((iPtr->numFiles)*sizeof(OpenFile *)));
        for (i = iPtr->numFiles-1; i >= 0; i--) {
            iPtr->filePtrArray[i] = NULL;
        }

        filePtr = (OpenFile *) ckalloc(sizeof(OpenFile));
        filePtr->f = stdin;
        filePtr->f2 = NULL;
        filePtr->readable = 1;
        filePtr->writable = 0;
        filePtr->numPids = 0;
        filePtr->pidPtr = NULL;
        filePtr->errorId = -1;
        iPtr->filePtrArray[0] = filePtr;

        filePtr = (OpenFile *) ckalloc(sizeof(OpenFile));
        filePtr->f = stdout;
        filePtr->f2 = NULL;
        filePtr->readable = 0;
        filePtr->writable = 1;
        filePtr->numPids = 0;
        filePtr->pidPtr = NULL;
        filePtr->errorId = -1;
        iPtr->filePtrArray[1] = filePtr;

        filePtr = (OpenFile *) ckalloc(sizeof(OpenFile));
        filePtr->f = stderr;
        filePtr->f2 = NULL;
        filePtr->readable = 0;
        filePtr->writable = 1;
        filePtr->numPids = 0;
        filePtr->pidPtr = NULL;
        filePtr->errorId = -1;
        iPtr->filePtrArray[2] = filePtr;
    } else if (index >= iPtr->numFiles) {
        int newSize;
        OpenFile **newPtrArray;
        int i;

        newSize = index+1;
        newPtrArray = (OpenFile **) ckalloc((unsigned)
                ((newSize)*sizeof(OpenFile *)));
        memcpy((VOID *) newPtrArray, (VOID *) iPtr->filePtrArray,
                iPtr->numFiles*sizeof(OpenFile *));
        for (i = iPtr->numFiles; i < newSize; i++) {
            newPtrArray[i] = NULL;
        }
        ckfree((char *) iPtr->filePtrArray);
        iPtr->numFiles = newSize;
        iPtr->filePtrArray = newPtrArray;
    }
}
\f
/*
 *----------------------------------------------------------------------
 *
 * TclGetOpenFile --
 *
 *      Given a string identifier for an open file, find the corresponding
 *      open file structure, if there is one.
 *
 * Results:
 *      A standard Tcl return value.  If the open file is successfully
 *      located, *filePtrPtr is modified to point to its structure.
 *      If TCL_ERROR is returned then interp->result contains an error
 *      message.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */

int
TclGetOpenFile(interp, string, filePtrPtr)
    Tcl_Interp *interp;         /* Interpreter in which to find file. */
    char *string;               /* String that identifies file. */
    OpenFile **filePtrPtr;      /* Address of word in which to store pointer
                                 * to structure about open file. */
{
    int fd = 0;                 /* Initial value needed only to stop compiler
                                 * warnings. */
    Interp *iPtr = (Interp *) interp;

    if ((string[0] == 'f') && (string[1] == 'i') && (string[2] == 'l')
            & (string[3] == 'e')) {
        char *end;

        fd = strtoul(string+4, &end, 10);
        if ((end == string+4) || (*end != 0)) {
            goto badId;
        }
    } else if ((string[0] == 's') && (string[1] == 't')
            && (string[2] == 'd')) {
        if (strcmp(string+3, "in") == 0) {
            fd = 0;
        } else if (strcmp(string+3, "out") == 0) {
            fd = 1;
        } else if (strcmp(string+3, "err") == 0) {
            fd = 2;
        } else {
            goto badId;
        }
    } else {
        badId:
        Tcl_AppendResult(interp, "bad file identifier \"", string,
                "\"", (char *) NULL);
        return TCL_ERROR;
    }

    if (fd >= iPtr->numFiles) {
        if ((iPtr->numFiles == 0) && (fd <= 2)) {
            TclMakeFileTable(iPtr, fd);
        } else {
            notOpen:
            Tcl_AppendResult(interp, "file \"", string, "\" isn't open",
                    (char *) NULL);
            return TCL_ERROR;
        }
    }
    if (iPtr->filePtrArray[fd] == NULL) {
        goto notOpen;
    }
    *filePtrPtr = iPtr->filePtrArray[fd];
    return TCL_OK;
}

#ifdef MSDOS
int
filename2DOS(name)
    char *name;
{
    for ( ; *name; name++) if (*name == '/') *name = '\\';
}
#endif