*.so
*.exe
*.Z
*.elc
*.ln
core
# CVS default ignores end

/* Dbg.c - Tcl Debugger - See cmdHelp() for commands

Written by: Don Libes, NIST, 3/23/93

Design and implementation of this program was paid for by U.S. tax
dollars.  Therefore it is public domain.  However, the author and NIST
would appreciate credit if this program or parts of it are used.

 RCS: @(#) $Id:  Exp $

*/

#include <stdio.h>

#include "tcldbgcf.h"
#if 0
/* tclInt.h drags in stdlib.  By claiming no-stdlib, force it to drag in */
/* Tcl's compat version.  This avoids having to test for its presence */
/* which is too tricky - configure can't generate two cf files, so when */
/* Expect (or any app) uses the debugger, there's no way to get the info */
/* about whether stdlib exists or not, except pointing the debugger at */
/* an app-dependent .h file and I don't want to do that. */
#define NO_STDLIB_H
#endif


#include "tclInt.h"
/*#include <varargs.h>		tclInt.h drags in varargs.h.  Since Pyramid */
/*				objects to including varargs.h twice, just */
/*				omit this one. */
/*#include "string.h"		tclInt.h drags this in, too! */
#include "tcldbg.h"

#ifndef TRUE
#define TRUE 1
#define FALSE 0
#endif

static int simple_interactor();
static int zero();

/* most of the static variables in this file may be */
/* moved into Tcl_Interp */

static Dbg_InterProc *interactor = simple_interactor;
static ClientData interdata = 0;
static Dbg_IgnoreFuncsProc *ignoreproc = zero;
static Dbg_OutputProc *printproc = 0;
static ClientData printdata = 0;

static void print _ANSI_ARGS_(TCL_VARARGS(Tcl_Interp *,interp));

static int debugger_active = FALSE;

/* this is not externally documented anywhere as of yet */
char *Dbg_VarName = "dbg";

#define DEFAULT_COMPRESS	0
static int compress = DEFAULT_COMPRESS;
#define DEFAULT_WIDTH		75	/* leave a little space for printing */
					/*  stack level */
static int buf_width = DEFAULT_WIDTH;

static int main_argc = 1;
static char *default_argv = "application";
static char **main_argv = &default_argv;

static Tcl_Trace debug_handle;
static int step_count = 1;	/* count next/step */

#define FRAMENAMELEN 10		/* enough to hold strings like "#4" */
static char viewFrameName[FRAMENAMELEN];/* destination frame name for up/down */

static CallFrame *goalFramePtr;	/* destination for next/return */
static int goalNumLevel;	/* destination for Next */

static enum debug_cmd {
	none, step, next, ret, cont, up, down, where, Next
} debug_cmd = step;

/* info about last action to use as a default */
static enum debug_cmd last_action_cmd = next;
static int last_step_count = 1;

/* this acts as a strobe (while testing breakpoints).  It is set to true */
/* every time a new debugger command is issued that is an action */
static debug_new_action;

#define NO_LINE -1	/* if break point is not set by line number */

struct breakpoint {
	int id;
	Tcl_Obj *file;	/* file where breakpoint is */
	int line;	/* line where breakpoint is */
	int re;		/* 1 if this is regexp pattern */
	Tcl_Obj *pat;	/* pattern defining where breakpoint can be */
	Tcl_Obj *expr;	/* expr to trigger breakpoint */
	Tcl_Obj *cmd;	/* cmd to eval at breakpoint */
	struct breakpoint *next, *previous;
};

static struct breakpoint *break_base = 0;
static int breakpoint_max_id = 0;

static struct breakpoint *
breakpoint_new()
{
	struct breakpoint *b = (struct breakpoint *)ckalloc(sizeof(struct breakpoint));
	if (break_base) break_base->previous = b;
	b->next = break_base;
	b->previous = 0;
	b->id = breakpoint_max_id++;
	b->file = 0;
	b->line = NO_LINE;
	b->pat = 0;
	b->re = 0;
	b->expr = 0;
	b->cmd = 0;
	break_base = b;
	return(b);
}

static
void
breakpoint_print(interp,b)
Tcl_Interp *interp;
struct breakpoint *b;
{
    print(interp,"breakpoint %d: ",b->id);

    if (b->re) {
	print(interp,"-re \"%s\" ",Tcl_GetString(b->pat));
    } else if (b->pat) {
	print(interp,"-glob \"%s\" ",Tcl_GetString(b->pat));
    } else if (b->line != NO_LINE) {
	if (b->file) {
	    print(interp,"%s:",Tcl_GetString(b->file));
	}
	print(interp,"%d ",b->line);
    }

    if (b->expr)
	print(interp,"if {%s} ",Tcl_GetString(b->expr));

    if (b->cmd)
	print(interp,"then {%s}",Tcl_GetString(b->cmd));

    print(interp,"\n");
}

static void
save_re_matches(interp, re, objPtr)
Tcl_Interp *interp;
Tcl_RegExp re;
Tcl_Obj *objPtr;
{
    Tcl_RegExpInfo info;
    int i, start;
    char name[20];

    Tcl_RegExpGetInfo(re, &info); 
    for (i=0;i<=info.nsubs;i++) {
	start = info.matches[i].start;
	/* end = info.matches[i].end-1;*/

	if (start == -1) continue;

	sprintf(name,"%d",i);
	Tcl_SetVar2Ex(interp, Dbg_VarName, name, Tcl_GetRange(objPtr,
		info.matches[i].start, info.matches[i].end-1), 0);
    }
}

/* return 1 to break, 0 to continue */
static int
breakpoint_test(interp,cmd,bp)
Tcl_Interp *interp;
char *cmd;		/* command about to be executed */
struct breakpoint *bp;	/* breakpoint to test */
{
    if (bp->re) {
        int found = 0;
	Tcl_Obj *cmdObj;
	Tcl_RegExp re = Tcl_GetRegExpFromObj(NULL, bp->pat,
		TCL_REG_ADVANCED);
	cmdObj = Tcl_NewStringObj(cmd,-1);
	Tcl_IncrRefCount(cmdObj);
	if (Tcl_RegExpExecObj(NULL, re, cmdObj, 0 /* offset */,
		-1 /* nmatches */, 0 /* eflags */) > 0) {
	    save_re_matches(interp, re, cmdObj);
	    found = 1;
	}
	Tcl_DecrRefCount(cmdObj);
	if (!found) return 0;
    } else if (bp->pat) {
	if (0 == Tcl_StringMatch(cmd,
		Tcl_GetString(bp->pat))) return 0;
    } else if (bp->line != NO_LINE) {
	/* not yet implemented - awaiting support from Tcl */
	return 0;
    }

    if (bp->expr) {
	int value;

	/* ignore errors, since they are likely due to */
	/* simply being out of scope a lot */
	if (TCL_OK != Tcl_ExprBooleanObj(interp,bp->expr,&value)
		|| (value == 0)) return 0;
    }

    if (bp->cmd) {
	Tcl_EvalObjEx(interp, bp->cmd, 0);
    } else {
	breakpoint_print(interp,bp);
    }

    return 1;
}

static char *already_at_top_level = "already at top level";

/* similar to TclGetFrame but takes two frame ptrs and a direction.
If direction is up,   search up stack from curFrame
If direction is down, simulate searching down stack by
		      seaching up stack from origFrame
*/
static
int
TclGetFrame2(interp, origFramePtr, string, framePtrPtr, dir)
    Tcl_Interp *interp;
    CallFrame *origFramePtr;	/* frame that is true top-of-stack */
    char *string;		/* String describing frame. */
    CallFrame **framePtrPtr;	/* Store pointer to frame here (or NULL
				 * if global frame indicated). */
    enum debug_cmd dir;	/* look up or down the stack */
{
    Interp *iPtr = (Interp *) interp;
    int level, result;
    CallFrame *framePtr;	/* frame currently being searched */

    CallFrame *curFramePtr = iPtr->varFramePtr;

    /*
     * Parse string to figure out which level number to go to.
     */

    result = 1;
    if (*string == '#') {
	if (Tcl_GetInt(interp, string+1, &level) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (level < 0) {
	    levelError:
	    Tcl_AppendResult(interp, "bad level \"", string, "\"",
		    (char *) NULL);
	    return TCL_ERROR;
	}
	framePtr = origFramePtr; /* start search here */
	
    } else if (isdigit(*string)) {
	if (Tcl_GetInt(interp, string, &level) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (dir == up) {
		if (curFramePtr == 0) {
			Tcl_SetResult(interp,already_at_top_level,TCL_STATIC);
			return TCL_ERROR;
		}
		level = curFramePtr->level - level;
		framePtr = curFramePtr; /* start search here */
	} else {
		if (curFramePtr != 0) {
			level = curFramePtr->level + level;
		}
		framePtr = origFramePtr; /* start search here */
	}
    } else {
	level = curFramePtr->level - 1;
	result = 0;
    }

    /*
     * Figure out which frame to use.
     */

    if (level == 0) {
	framePtr = NULL;
    } else {
	for (;framePtr != NULL;	framePtr = framePtr->callerVarPtr) {
	    if (framePtr->level == level) {
		break;
	    }
	}
	if (framePtr == NULL) {
	    goto levelError;
	}
    }
    *framePtrPtr = framePtr;
    return result;
}


static char *printify(s)
char *s;
{
    static int destlen = 0;
    char *d;		/* ptr into dest */
    unsigned int need;
    static char buf_basic[DEFAULT_WIDTH+1];
    static char *dest = buf_basic;
    Tcl_UniChar ch;

    if (s == 0) return("<null>");

    /* worst case is every character takes 4 to printify */
    need = strlen(s)*6;
    if (need > destlen) {
	if (dest && (dest != buf_basic)) ckfree(dest);
	dest = (char *)ckalloc(need+1);
	destlen = need;
    }

    for (d = dest;*s;) {
	s += Tcl_UtfToUniChar(s, &ch);
	if (ch == '\b') {
	    strcpy(d,"\\b");		d += 2;
	} else if (ch == '\f') {
	    strcpy(d,"\\f");		d += 2;
	} else if (ch == '\v') {
	    strcpy(d,"\\v");		d += 2;
	} else if (ch == '\r') {
	    strcpy(d,"\\r");		d += 2;
	} else if (ch == '\n') {
	    strcpy(d,"\\n");		d += 2;
	} else if (ch == '\t') {
	    strcpy(d,"\\t");		d += 2;
	} else if ((unsigned)ch < 0x20) { /* unsigned strips parity */
	    sprintf(d,"\\%03o",ch);		d += 4;
	} else if (ch == 0177) {
	    strcpy(d,"\\177");		d += 4;
	} else if ((ch < 0x80) && isprint(UCHAR(ch))) {
	    *d = (char)ch;		d += 1;
	} else {
	    sprintf(d,"\\u%04x",ch);	d += 6;
	}
    }
    *d = '\0';
    return(dest);
}

static
char *
print_argv(interp,argc,argv)
Tcl_Interp *interp;
int argc;
char *argv[];
{
	static int buf_width_max = DEFAULT_WIDTH;
	static char buf_basic[DEFAULT_WIDTH+1];	/* basic buffer */
	static char *buf = buf_basic;
	int space;		/* space remaining in buf */
	int len;
	char *bufp;
	int proc;		/* if current command is "proc" */
	int arg_index;

	if (buf_width > buf_width_max) {
		if (buf && (buf != buf_basic)) ckfree(buf);
		buf = (char *)ckalloc(buf_width + 1);
		buf_width_max = buf_width;
	}

	proc = (0 == strcmp("proc",argv[0]));
	sprintf(buf,"%.*s",buf_width,argv[0]);
	len = strlen(buf);
	space = buf_width - len;
	bufp = buf + len;
	argc--; argv++;
	arg_index = 1;
	
	while (argc && (space > 0)) {
		CONST char *elementPtr;
		CONST char *nextPtr;
		int wrap;

		/* braces/quotes have been stripped off arguments */
		/* so put them back.  We wrap everything except lists */
		/* with one argument.  One exception is to always wrap */
		/* proc's 2nd arg (the arg list), since people are */
		/* used to always seeing it this way. */

		if (proc && (arg_index > 1)) wrap = TRUE;
		else {
			(void) TclFindElement(interp,*argv,
#if TCL_MAJOR_VERSION >= 8
					      -1,
#endif
				&elementPtr,&nextPtr,(int *)0,(int *)0);
			if (*elementPtr == '\0') wrap = TRUE;
			else if (*nextPtr == '\0') wrap = FALSE;
			else wrap = TRUE;
		}

		/* wrap lists (or null) in braces */
		if (wrap) {
			sprintf(bufp," {%.*s}",space-3,*argv);
		} else {
			sprintf(bufp," %.*s",space-1,*argv);
		}
		len = strlen(buf);
		space = buf_width - len;
		bufp = buf + len;
		argc--; argv++;
		arg_index++;
	}

	if (compress) {
		/* this copies from our static buf to printify's static buf */
		/* and back to our static buf */
		strncpy(buf,printify(buf),buf_width);
	}

	/* usually but not always right, but assume truncation if buffer is */
	/* full.  this avoids tiny but odd-looking problem of appending "}" */
	/* to truncated lists during {}-wrapping earlier */
	if (strlen(buf) == buf_width) {
		buf[buf_width-1] = buf[buf_width-2] = buf[buf_width-3] = '.';
	}

	return(buf);
}

#if TCL_MAJOR_VERSION >= 8
static
char *
print_objv(interp,objc,objv)
Tcl_Interp *interp;
int objc;
Tcl_Obj *objv[];
{
    char **argv;
    int argc;
    int len;
    argv = (char **)ckalloc(objc+1 * sizeof(char *));
    for (argc=0 ; argc<objc ; argc++) {
	argv[argc] = Tcl_GetStringFromObj(objv[argc],&len);
    }
    argv[argc] = NULL;
    return(print_argv(interp,argc,argv));
}
#endif

static
void
PrintStackBelow(interp,curf,viewf)
Tcl_Interp *interp;
CallFrame *curf;	/* current FramePtr */
CallFrame *viewf;	/* view FramePtr */
{
	char ptr;	/* graphically indicate where we are in the stack */

	/* indicate where we are in the stack */
	ptr = ((curf == viewf)?'*':' ');

	if (curf == 0) {
		print(interp,"%c0: %s\n",
				ptr,print_argv(interp,main_argc,main_argv));
	} else {
		PrintStackBelow(interp,curf->callerVarPtr,viewf);
		print(interp,"%c%d: %s\n",ptr,curf->level,
#if TCL_MAJOR_VERSION >= 8
			print_objv(interp,curf->objc,curf->objv));
#else
			print_argv(interp,curf->argc,curf->argv));
#endif
	}
}

static
void
PrintStack(interp,curf,viewf,argc,argv,level)
Tcl_Interp *interp;
CallFrame *curf;	/* current FramePtr */
CallFrame *viewf;	/* view FramePtr */
int argc;
char *argv[];
char *level;
{
	PrintStackBelow(interp,curf,viewf);
	
	print(interp," %s: %s\n",level,print_argv(interp,argc,argv));
}

/* return 0 if goal matches current frame or goal can't be found */
/*	anywere in frame stack */
/* else return 1 */
/* This catches things like a proc called from a Tcl_Eval which in */
/* turn was not called from a proc but some builtin such as source */
/* or Tcl_Eval.  These builtin calls to Tcl_Eval lose any knowledge */
/* the FramePtr from the proc, so we have to search the entire */
/* stack frame to see if it's still there. */
static int
GoalFrame(goal,iptr)
CallFrame *goal;
Interp *iptr;
{
	CallFrame *cf = iptr->varFramePtr;

	/* if at current level, return success immediately */
	if (goal == cf) return 0;

	while (cf) {
		cf = cf->callerVarPtr;
		if (goal == cf) {
			/* found, but since it's above us, fail */
			return 1;
		}
	}
	return 0;
}

static char *cmd_print(cmdtype)
enum debug_cmd cmdtype;
{
	switch (cmdtype) {
	case none:  return "cmd: none";
	case step:  return "cmd: step";
	case next:  return "cmd: next";
	case ret:   return "cmd: ret";
	case cont:  return "cmd: cont";
	case up:    return "cmd: up";
	case down:  return "cmd: down";
	case where: return "cmd: where";
	case Next:  return "cmd: Next";
	}
	return "cmd: Unknown";
}

/* debugger's trace handler */
/*ARGSUSED*/
static void
debugger_trap(clientData,interp,level,command,cmdProc,cmdClientData,argc,argv)
ClientData clientData;		/* not used */
Tcl_Interp *interp;
int level;			/* positive number if called by Tcl, -1 if */
				/* called by Dbg_On in which case we don't */
				/* know the level */
char *command;
int (*cmdProc)();		/* not used */
ClientData cmdClientData;
int argc;
char *argv[];
{
	char level_text[6];	/* textual representation of level */

	int break_status;
	Interp *iPtr = (Interp *)interp;

	CallFrame *trueFramePtr;	/* where the pc is */
	CallFrame *viewFramePtr;	/* where up/down are */

	int print_command_first_time = TRUE;
	static int debug_suspended = FALSE;

	struct breakpoint *b;

	/* skip commands that are invoked interactively */
	if (debug_suspended) return;

	/* skip debugger commands */
	if (argv[0][1] == '\0') {
		switch (argv[0][0]) {
		case 'n':
		case 's':
		case 'c':
		case 'r':
		case 'w':
		case 'b':
		case 'u':
		case 'd': return;
		}
	}

	if ((*ignoreproc)(interp,argv[0])) return;

	/* if level is unknown, use "?" */
	sprintf(level_text,(level == -1)?"?":"%d",level);

	/* save so we can restore later */
	trueFramePtr = iPtr->varFramePtr;

	/* do not allow breaking while testing breakpoints */
	debug_suspended = TRUE;

	/* test all breakpoints to see if we should break */
	/* if any successful breakpoints, start interactor */
	debug_new_action = FALSE;	/* reset strobe */
	break_status = FALSE;		/* no successful breakpoints yet */
	for (b = break_base;b;b=b->next) {
		break_status |= breakpoint_test(interp,command,b);
	}
	if (break_status) {
		if (!debug_new_action) {
			goto start_interact;
		}

		/* if s or n triggered by breakpoint, make "s 1" */
		/* (and so on) refer to next command, not this one */
		/* step_count++;*/
		goto end_interact;
	}

	switch (debug_cmd) {
	case cont:
		goto finish;
	case step:
		step_count--;
		if (step_count > 0) goto finish;
		goto start_interact;
	case next:
		/* check if we are back at the same level where the next */
		/* command was issued.  Also test */
		/* against all FramePtrs and if no match, assume that */
		/* we've missed a return, and so we should break  */
/*		if (goalFramePtr != iPtr->varFramePtr) goto finish;*/
		if (GoalFrame(goalFramePtr,iPtr)) goto finish;
		step_count--;
		if (step_count > 0) goto finish;
		goto start_interact;
	case Next:
		/* check if we are back at the same level where the next */
		/* command was issued.  */
		if (goalNumLevel < iPtr->numLevels) goto finish;
		step_count--;
		if (step_count > 0) goto finish;
		goto start_interact;
	case ret:
		/* same comment as in "case next" */
		if (goalFramePtr != iPtr->varFramePtr) goto finish;
		goto start_interact;
	}

start_interact:
	if (print_command_first_time) {
		print(interp,"%s: %s\n",
				level_text,print_argv(interp,1,&command));
		print_command_first_time = FALSE;
	}
	/* since user is typing a command, don't interrupt it immediately */
	debug_cmd = cont;
	debug_suspended = TRUE;

	/* interactor won't return until user gives a debugger cmd */
	(*interactor)(interp,interdata);
end_interact:

	/* save this so it can be restored after "w" command */
	viewFramePtr = iPtr->varFramePtr;

	if (debug_cmd == up || debug_cmd == down) {
		/* calculate new frame */
		if (-1 == TclGetFrame2(interp,trueFramePtr,viewFrameName,
					&iPtr->varFramePtr,debug_cmd)) {
			print(interp,"%s\n",interp->result);
			Tcl_ResetResult(interp);
		}
		goto start_interact;
	}

	/* reset view back to normal */
	iPtr->varFramePtr = trueFramePtr;

#if 0
	/* allow trapping */
	debug_suspended = FALSE;
#endif

	switch (debug_cmd) {
	case cont:
	case step:
		goto finish;
	case next:
		goalFramePtr = iPtr->varFramePtr;
		goto finish;
	case Next:
		goalNumLevel = iPtr->numLevels;
		goto finish;
	case ret:
		goalFramePtr = iPtr->varFramePtr;
		if (goalFramePtr == 0) {
			print(interp,"nowhere to return to\n");
			break;
		}
		goalFramePtr = goalFramePtr->callerVarPtr;
		goto finish;
	case where:
		PrintStack(interp,iPtr->varFramePtr,viewFramePtr,argc,argv,level_text);
		break;
	}

	/* restore view and restart interactor */
	iPtr->varFramePtr = viewFramePtr;
	goto start_interact;

 finish:
	debug_suspended = FALSE;
}

/*ARGSUSED*/
static
int
cmdNext(clientData, interp, argc, argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;
char **argv;
{
	debug_new_action = TRUE;
	debug_cmd = *(enum debug_cmd *)clientData;

	last_action_cmd = debug_cmd;

	step_count = (argc == 1)?1:atoi(argv[1]);
	last_step_count = step_count;
	return(TCL_RETURN);
}

/*ARGSUSED*/
static
int
cmdDir(clientData, interp, argc, argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;
char **argv;
{
	debug_cmd = *(enum debug_cmd *)clientData;

	if (argc == 1) argv[1] = "1";
	strncpy(viewFrameName,argv[1],FRAMENAMELEN);

	return TCL_RETURN;
}

/*ARGSUSED*/
static
int
cmdSimple(clientData, interp, argc, argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;
char **argv;
{
	debug_new_action = TRUE;
	debug_cmd = *(enum debug_cmd *)clientData;
	last_action_cmd = debug_cmd;

	return TCL_RETURN;
}

static
void
breakpoint_destroy(b)
struct breakpoint *b;
{
	if (b->file) Tcl_DecrRefCount(b->file);
	if (b->pat) Tcl_DecrRefCount(b->pat);
	if (b->cmd) Tcl_DecrRefCount(b->cmd);
	if (b->expr) Tcl_DecrRefCount(b->expr);

	/* unlink from chain */
	if ((b->previous == 0) && (b->next == 0)) {
		break_base = 0;
	} else if (b->previous == 0) {
		break_base = b->next;
		b->next->previous = 0;
	} else if (b->next == 0) {
		b->previous->next = 0;
	} else {
		b->previous->next = b->next;
		b->next->previous = b->previous;
	}

	ckfree((char *)b);
}

static void
savestr(objPtr,str)
Tcl_Obj **objPtr;
char *str;
{
    *objPtr = Tcl_NewStringObj(str, -1);
    Tcl_IncrRefCount(*objPtr);
}

/* return 1 if a string is substring of a flag */
static int
flageq(flag,string,minlen)
char *flag;
char *string;
int minlen;		/* at least this many chars must match */
{
	for (;*flag;flag++,string++,minlen--) {
		if (*string == '\0') break;
		if (*string != *flag) return 0;
	}
	if (*string == '\0' && minlen <= 0) return 1;
	return 0;
}

/*ARGSUSED*/
static
int
cmdWhere(clientData, interp, argc, argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;
char **argv;
{
	if (argc == 1) {
		debug_cmd = where;
		return TCL_RETURN;
	}

	argc--; argv++;

	while (argc) {
		if (flageq("-width",*argv,2)) {
			argc--; argv++;
			if (*argv) {
				buf_width = atoi(*argv);
				argc--; argv++;
			} else print(interp,"%d\n",buf_width);
		} else if (flageq("-compress",*argv,2)) {
			argc--; argv++;
			if (*argv) {
				compress = atoi(*argv);
				argc--; argv++;
			} else print(interp,"%d\n",compress);
		} else {
			print(interp,"usage: w [-width #] [-compress 0|1]\n");
			return TCL_ERROR;
		}
	}
	return TCL_OK;
}

#define breakpoint_fail(msg) {error_msg = msg; goto break_fail;}

/*ARGSUSED*/
static
int
cmdBreak(clientData, interp, argc, argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;
char **argv;
{
	struct breakpoint *b;
	char *error_msg;

	argc--; argv++;

	if (argc < 1) {
		for (b = break_base;b;b=b->next) breakpoint_print(interp,b);
		return(TCL_OK);
	}

	if (argv[0][0] == '-') {
		if (argv[0][1] == '\0') {
			while (break_base) {
				breakpoint_destroy(break_base);
			}
			breakpoint_max_id = 0;
			return(TCL_OK);
		} else if (isdigit(argv[0][1])) {
			int id = atoi(argv[0]+1);

			for (b = break_base;b;b=b->next) {
				if (b->id == id) {
					breakpoint_destroy(b);
					if (!break_base) breakpoint_max_id = 0;
					return(TCL_OK);
				}
			}
			Tcl_SetResult(interp,"no such breakpoint",TCL_STATIC);
			return(TCL_ERROR);
		}
	}

	b = breakpoint_new();

	if (flageq("-regexp",argv[0],2)) {
		argc--; argv++;
		if (argc > 0) {
		    b->re = 1;
		    savestr(&b->pat,argv[0]);
		    if (Tcl_GetRegExpFromObj(interp, b->pat, TCL_REG_ADVANCED)
			    == NULL) {
			breakpoint_destroy(b);
			return TCL_ERROR;
		    }
		    argc--; argv++;
		} else {
			breakpoint_fail("bad regular expression")
		}
	} else if (flageq("-glob",argv[0],2)) {
		argc--; argv++;
		if (argc > 0) {
			savestr(&b->pat,argv[0]);
			argc--; argv++;
		} else {
			breakpoint_fail("no pattern?");
		}
	} else if ((!(flageq("if",*argv,1)) && (!(flageq("then",*argv,1))))) {
		/* look for [file:]line */
		char *colon;
		char *linep;	/* pointer to beginning of line number */

		colon = strchr(argv[0],':');
		if (colon) {
			*colon = '\0';
			savestr(&b->file,argv[0]);
			*colon = ':';
			linep = colon + 1;
		} else {
			linep = argv[0];
			/* get file from current scope */
			/* savestr(&b->file, ?); */
		}

		if (TCL_OK == Tcl_GetInt(interp,linep,&b->line)) {
			argc--; argv++;
			print(interp,"setting breakpoints by line number is currently unimplemented - use patterns or expressions\n");
		} else {
			/* not an int? - unwind & assume it is an expression */

			if (b->file) Tcl_DecrRefCount(b->file);
		}
	}

	if (argc > 0) {
		int do_if = FALSE;

		if (flageq("if",argv[0],1)) {
			argc--; argv++;
			do_if = TRUE;
		} else if (!flageq("then",argv[0],1)) {
			do_if = TRUE;
		}

		if (do_if) {
			if (argc < 1) {
				breakpoint_fail("if what");
			}

			savestr(&b->expr,argv[0]);
			argc--; argv++;
		}
	}

	if (argc > 0) {
		if (flageq("then",argv[0],1)) {
			argc--; argv++;
		}

		if (argc < 1) {
			breakpoint_fail("then what?");
		}

		savestr(&b->cmd,argv[0]);
	}

	sprintf(interp->result,"%d",b->id);
	return(TCL_OK);

 break_fail:
	breakpoint_destroy(b);
	Tcl_SetResult(interp,error_msg,TCL_STATIC);
	return(TCL_ERROR);
}

static char *help[] = {
"s [#]		step into procedure",
"n [#]		step over procedure",
"N [#]		step over procedures, commands, and arguments",
"c		continue",
"r		continue until return to caller",
"u [#]		move scope up level",
"d [#]		move scope down level",
"		go to absolute frame if # is prefaced by \"#\"",
"w		show stack (\"where\")",
"w -w [#]	show/set width",
"w -c [0|1]	show/set compress",
"b		show breakpoints",
"b [-r regexp-pattern] [if expr] [then command]",
"b [-g glob-pattern]   [if expr] [then command]",
"b [[file:]#]          [if expr] [then command]",
"		if pattern given, break if command resembles pattern",
"		if # given, break on line #",
"		if expr given, break if expr true",
"		if command given, execute command at breakpoint",
"b -#		delete breakpoint",
"b -		delete all breakpoints",
0};

/*ARGSUSED*/
static
int
cmdHelp(clientData, interp, argc, argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;
char **argv;
{
	char **hp;

	for (hp=help;*hp;hp++) {
		print(interp,"%s\n",*hp);
	}

	return(TCL_OK);
}

/* occasionally, we print things larger buf_max but not by much */
/* see print statements in PrintStack routines for examples */
#define PAD 80

/*VARARGS*/
static void
print TCL_VARARGS_DEF(Tcl_Interp *,arg1)
{
	Tcl_Interp *interp;
	char *fmt;
	va_list args;

	interp = TCL_VARARGS_START(Tcl_Interp *,arg1,args);
	fmt = va_arg(args,char *);
	if (!printproc) vprintf(fmt,args);
	else {
		static int buf_width_max = DEFAULT_WIDTH+PAD;
		static char buf_basic[DEFAULT_WIDTH+PAD+1];
		static char *buf = buf_basic;

		if (buf_width+PAD > buf_width_max) {
			if (buf && (buf != buf_basic)) ckfree(buf);
			buf = (char *)ckalloc(buf_width+PAD+1);
			buf_width_max = buf_width+PAD;
		}

		vsprintf(buf,fmt,args);
		(*printproc)(interp,buf,printdata);
	}
	va_end(args);
}

/*ARGSUSED*/
Dbg_InterStruct
Dbg_Interactor(interp,inter_proc,data)
Tcl_Interp *interp;
Dbg_InterProc *inter_proc;
ClientData data;
{
	Dbg_InterStruct tmp;

	tmp.func = interactor;
	tmp.data = interdata;
	interactor = (inter_proc?inter_proc:simple_interactor);
	interdata = data;
	return tmp;
}

/*ARGSUSED*/
Dbg_IgnoreFuncsProc *
Dbg_IgnoreFuncs(interp,proc)
Tcl_Interp *interp;
Dbg_IgnoreFuncsProc *proc;
{
	Dbg_IgnoreFuncsProc *tmp = ignoreproc;
	ignoreproc = (proc?proc:zero);
	return tmp;
}

/*ARGSUSED*/
Dbg_OutputStruct
Dbg_Output(interp,proc,data)
Tcl_Interp *interp;
Dbg_OutputProc *proc;
ClientData data;
{
	Dbg_OutputStruct tmp;

	tmp.func = printproc;
	tmp.data = printdata;
	printproc = proc;
	printdata = data;
	return tmp;
}

/*ARGSUSED*/
int
Dbg_Active(interp)
Tcl_Interp *interp;
{
	return debugger_active;
}

char **
Dbg_ArgcArgv(argc,argv,copy)
int argc;
char *argv[];
int copy;
{
	char **alloc;

	main_argc = argc;

	if (!copy) {
		main_argv = argv;
		alloc = 0;
	} else {
		main_argv = alloc = (char **)ckalloc((argc+1)*sizeof(char *));
		while (argc-- >= 0) {
			*main_argv++ = *argv++;
		}
		main_argv = alloc;
	}
	return alloc;
}

static struct cmd_list {
	char *cmdname;
	Tcl_CmdProc *cmdproc;
	enum debug_cmd cmdtype;
} cmd_list[]  = {
		{"n", cmdNext,   next},
		{"s", cmdNext,   step},
		{"N", cmdNext,   Next},
		{"c", cmdSimple, cont},
		{"r", cmdSimple, ret},
		{"w", cmdWhere,  none},
		{"b", cmdBreak,  none},
		{"u", cmdDir,    up},
		{"d", cmdDir,    down},
		{"h", cmdHelp,   none},
		{0}
};

/* this may seem excessive, but this avoids the explicit test for non-zero */
/* in the caller, and chances are that that test will always be pointless */
/*ARGSUSED*/
static int zero(interp,string)
Tcl_Interp *interp;
char *string;
{
	return 0;
}

static int
simple_interactor(interp)
Tcl_Interp *interp;
{
	int rc;
	char *ccmd;		/* pointer to complete command */
	char line[BUFSIZ+1];	/* space for partial command */
	int newcmd = TRUE;
	Interp *iPtr = (Interp *)interp;

	Tcl_DString dstring;
	Tcl_DStringInit(&dstring);

	newcmd = TRUE;
	while (TRUE) {
		struct cmd_list *c;

		if (newcmd) {
#if TCL_MAJOR_VERSION < 8
			print(interp,"dbg%d.%d> ",iPtr->numLevels,iPtr->curEventNum+1);
#else
			/* unncessarily tricky coding - if nextid
			   isn't defined, maintain our own static
			   version */

			static int nextid = 0;
			char *nextidstr = Tcl_GetVar2(interp,"tcl::history","nextid",0);
			if (nextidstr) {
				sscanf(nextidstr,"%d",&nextid);
			}
			print(interp,"dbg%d.%d> ",iPtr->numLevels,nextid++);
#endif
		} else {
			print(interp,"dbg+> ");
		}
		fflush(stdout);

		if (0 >= (rc = read(0,line,BUFSIZ))) {
			if (!newcmd) line[0] = 0;
			else exit(0);
		} else line[rc] = '\0';

		ccmd = Tcl_DStringAppend(&dstring,line,rc);
		if (!Tcl_CommandComplete(ccmd)) {
			newcmd = FALSE;
			continue;	/* continue collecting command */
		}
		newcmd = TRUE;

		/* if user pressed return with no cmd, use previous one */
		if ((ccmd[0] == '\n' || ccmd[0] == '\r') && ccmd[1] == '\0') {

			/* this loop is guaranteed to exit through break */
			for (c = cmd_list;c->cmdname;c++) {
				if (c->cmdtype == last_action_cmd) break;
			}

			/* recreate textual version of command */
			Tcl_DStringAppend(&dstring,c->cmdname,-1);

			if (c->cmdtype == step ||
			    c->cmdtype == next ||
			    c->cmdtype == Next) {
				char num[10];

				sprintf(num," %d",last_step_count);
				Tcl_DStringAppend(&dstring,num,-1);
			}
		}

#if TCL_MAJOR_VERSION == 7 && TCL_MINOR_VERSION < 4
		rc = Tcl_RecordAndEval(interp,ccmd,0);
#else
		rc = Tcl_RecordAndEval(interp,ccmd,TCL_NO_EVAL);
		rc = Tcl_Eval(interp,ccmd);
#endif
		Tcl_DStringFree(&dstring);

		switch (rc) {
		case TCL_OK:
			if (*interp->result != 0)
				print(interp,"%s\n",interp->result);
			continue;
		case TCL_ERROR:
			print(interp,"%s\n",Tcl_GetVar(interp,"errorInfo",TCL_GLOBAL_ONLY));
			/* since user is typing by hand, we expect lots
			   of errors, and want to give another chance */
			continue;
		case TCL_BREAK:
		case TCL_CONTINUE:
#define finish(x)	{rc = x; goto done;}
			finish(rc);
		case TCL_RETURN:
			finish(TCL_OK);
		default:
			/* note that ccmd has trailing newline */
			print(interp,"error %d: %s\n",rc,ccmd);
			continue;
		}
	}
	/* cannot fall thru here, must jump to label */
 done:
	Tcl_DStringFree(&dstring);

	return(rc);
}

static char init_auto_path[] = "lappend auto_path $dbg_library";

static void
init_debugger(interp)
Tcl_Interp *interp;
{
	struct cmd_list *c;

	for (c = cmd_list;c->cmdname;c++) {
		Tcl_CreateCommand(interp,c->cmdname,c->cmdproc,
			(ClientData)&c->cmdtype,(Tcl_CmdDeleteProc *)0);
	}

	debug_handle = Tcl_CreateTrace(interp,
				10000,debugger_trap,(ClientData)0);

	debugger_active = TRUE;
	Tcl_SetVar2(interp,Dbg_VarName,"active","1",0);
#ifdef DBG_SCRIPTDIR
	Tcl_SetVar(interp,"dbg_library",DBG_SCRIPTDIR,0);
#endif
	Tcl_Eval(interp,init_auto_path);

}

/* allows any other part of the application to jump to the debugger */
/*ARGSUSED*/
void
Dbg_On(interp,immediate)
Tcl_Interp *interp;
int immediate;		/* if true, stop immediately */
			/* should only be used in safe places */
			/* i.e., when Tcl_Eval can be called */
{
	if (!debugger_active) init_debugger(interp);

	/* Initialize debugger in single-step mode.
	 *
	 * Note: if the command reader is already active, it's too late
	 * which is why we also statically initialize debug_cmd to step.
	 */
	debug_cmd = step; 
	step_count = 1;

	if (immediate) {
		static char *fake_cmd = "--interrupted-- (command_unknown)";

		debugger_trap((ClientData)0,interp,-1,fake_cmd,(int (*)())0,
					(ClientData)0,1,&fake_cmd);
/*		(*interactor)(interp);*/
	}
}

void
Dbg_Off(interp)
Tcl_Interp *interp;
{
	struct cmd_list *c;

	if (!debugger_active) return;

	for (c = cmd_list;c->cmdname;c++) {
		Tcl_DeleteCommand(interp,c->cmdname);
	}

	Tcl_DeleteTrace(interp,debug_handle);
	debugger_active = FALSE;
	Tcl_UnsetVar(interp,Dbg_VarName,TCL_GLOBAL_ONLY);

	/* initialize for next use */
	debug_cmd = step;
	step_count = 1;
}

/* 
 * tclUnixChan.c
 *
 *	Channel driver for Expect channels.
 *      Based on UNIX File channel from TclUnixChan.c
 *
 */

#include <sys/types.h>
#include <stdio.h>
#include <signal.h>
#include <errno.h>
#include <ctype.h>	/* for isspace */
#include <time.h>	/* for time(3) */

#include "expect_cf.h"

#ifdef HAVE_SYS_WAIT_H
#include <sys/wait.h>
#endif

#ifdef HAVE_UNISTD_H
# include <unistd.h>
#endif

#include	"tclInt.h"	/* Internal definitions for Tcl. */

#include "tcl.h"

#include "string.h"

#include "exp_rename.h"
#include "exp_prog.h"
#include "exp_command.h"
#include "exp_log.h"

static int		ExpCloseProc _ANSI_ARGS_((ClientData instanceData,
			    Tcl_Interp *interp));
static int		ExpInputProc _ANSI_ARGS_((ClientData instanceData,
		            char *buf, int toRead, int *errorCode));
static int		ExpOutputProc _ANSI_ARGS_((
			    ClientData instanceData, char *buf, int toWrite,
                            int *errorCode));
static void		ExpWatchProc _ANSI_ARGS_((ClientData instanceData,
		            int mask));
static int		ExpGetHandleProc _ANSI_ARGS_((ClientData instanceData,
		            int direction, ClientData *handlePtr));

/*
 * This structure describes the channel type structure for Expect-based IO:
 */

Tcl_ChannelType expChannelType = {
    "exp",				/* Type name. */
    /* Expect channels are always blocking */
    NULL,				/* Set blocking/nonblocking mode.*/
    ExpCloseProc,			/* Close proc. */
    ExpInputProc,			/* Input proc. */
    ExpOutputProc,			/* Output proc. */
    NULL,				/* Seek proc. */
    NULL,				/* Set option proc. */
    NULL,				/* Get option proc. */
    ExpWatchProc,			/* Initialize notifier. */
    ExpGetHandleProc,			/* Get OS handles out of channel. */
    NULL,				/* Close2 proc */
};

typedef struct ThreadSpecificData {
    /*
     * List of all exp channels currently open.  This is per thread and is
     * used to match up fd's to channels, which rarely occurs.
     */
    
    ExpState *firstExpPtr;
    int channelCount;	 /* this is process-wide as it is used to
			     give user some hint as to why a spawn has failed
			     by looking at process-wide resource usage */
} ThreadSpecificData;

static Tcl_ThreadDataKey dataKey;


/*
 *----------------------------------------------------------------------
 *
 * ExpInputProc --
 *
 *	This procedure is invoked from the generic IO level to read
 *	input from an exp-based channel.
 *
 * Results:
 *	The number of bytes read is returned or -1 on error. An output
 *	argument contains a POSIX error code if an error occurs, or zero.
 *
 * Side effects:
 *	Reads input from the input device of the channel.
 *
 *----------------------------------------------------------------------
 */

static int
ExpInputProc(instanceData, buf, toRead, errorCodePtr)
    ClientData instanceData;		/* Exp state. */
    char *buf;				/* Where to store data read. */
    int toRead;				/* How much space is available
                                         * in the buffer? */
    int *errorCodePtr;			/* Where to store error code. */
{
    ExpState *esPtr = (ExpState *) instanceData;
    int bytesRead;			/* How many bytes were actually
                                         * read from the input device? */

    *errorCodePtr = 0;
    
    /*
     * Assume there is always enough input available. This will block
     * appropriately, and read will unblock as soon as a short read is
     * possible, if the channel is in blocking mode. If the channel is
     * nonblocking, the read will never block.
     */

    bytesRead = read(esPtr->fdin, buf, (size_t) toRead);
    /*printf("ExpInputProc: read(%d,,) = %d\r\n",esPtr->fdin,bytesRead);*/
    if (bytesRead > -1) {
	/* strip parity if requested */
	if (esPtr->parity == 0) {
	    char *end = buf+bytesRead;
	    for (;buf < end;buf++) {
		*buf &= 0x7f;
	    }
	}
        return bytesRead;
    }
    *errorCodePtr = errno;
    return -1;
}

/*
 *----------------------------------------------------------------------
 *
 * ExpOutputProc--
 *
 *	This procedure is invoked from the generic IO level to write
 *	output to an exp channel.
 *
 * Results:
 *	The number of bytes written is returned or -1 on error. An
 *	output argument	contains a POSIX error code if an error occurred,
 *	or zero.
 *
 * Side effects:
 *	Writes output on the output device of the channel.
 *
 *----------------------------------------------------------------------
 */

static int
ExpOutputProc(instanceData, buf, toWrite, errorCodePtr)
    ClientData instanceData;		/* Exp state. */
    char *buf;				/* The data buffer. */
    int toWrite;			/* How many bytes to write? */
    int *errorCodePtr;			/* Where to store error code. */
{
    ExpState *esPtr = (ExpState *) instanceData;
    int written = 0;

    *errorCodePtr = 0;

    if (toWrite < 0) Tcl_Panic("ExpOutputProc: called with negative char count");

    while (toWrite > 0) {
	written = write(esPtr->fdout, buf, (size_t) toWrite);
	if (written == 0) {
	    /* This shouldn't happen but I'm told that it does
	     * nonetheless (at least on SunOS 4.1.3).  Since this is
	     * not a documented return value, the most reasonable
	     * thing is to complain here and retry in the hopes that
	     * it is some transient condition.  */
	    sleep(1);
	    expDiagLogU("write() failed to write anything - will sleep(1) and retry...\n");
	} else if (written < 0) {
	    *errorCodePtr = errno;
	    return -1;
	}
	buf += written;
	toWrite -= written;
    }
    return written;
}

/*
 *----------------------------------------------------------------------
 *
 * ExpCloseProc --
 *
 *	This procedure is called from the generic IO level to perform
 *	channel-type-specific cleanup when an exp-based channel is closed.
 *
 * Results:
 *	0 if successful, errno if failed.
 *
 * Side effects:
 *	Closes the device of the channel.
 *
 *----------------------------------------------------------------------
 */

/*ARGSUSED*/
static int
ExpCloseProc(instanceData, interp)
    ClientData instanceData;	/* Exp state. */
    Tcl_Interp *interp;		/* For error reporting - unused. */
{
    ExpState *esPtr = (ExpState *) instanceData;
    ExpState **nextPtrPtr;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    esPtr->registered = FALSE;

#if 0
    /*
      Really should check that we created one first.  Since we're sharing fds
      with Tcl, perhaps a filehandler was created with a plain tcl file - we
      wouldn't want to delete that.  Although if user really close Expect's
      user_spawn_id, it probably doesn't matter anyway.
    */

    Tcl_DeleteFileHandler(esPtr->fdin);
#endif /*0*/

    Tcl_DecrRefCount(esPtr->buffer);

    /* Actually file descriptor should have been closed earlier. */
    /* So do nothing here */

    /*
     * Conceivably, the process may not yet have been waited for.  If this
     * becomes a requirement, we'll have to revisit this code.  But for now, if
     * it's just Tcl exiting, the processes will exit on their own soon
     * anyway.
     */

    for (nextPtrPtr = &(tsdPtr->firstExpPtr); (*nextPtrPtr) != NULL;
	 nextPtrPtr = &((*nextPtrPtr)->nextPtr)) {
	if ((*nextPtrPtr) == esPtr) {
	    (*nextPtrPtr) = esPtr->nextPtr;
	    break;
	}
    }
    tsdPtr->channelCount--;

    if (esPtr->bg_status == blocked ||
	    esPtr->bg_status == disarm_req_while_blocked) {
	esPtr->freeWhenBgHandlerUnblocked = 1;
	/*
	 * If we're in the middle of a bg event handler, then the event
	 * handler will have to take care of freeing esPtr.
	 */
    } else {
	expStateFree(esPtr);
    }
    return 0;
}

/*
 *----------------------------------------------------------------------
 *
 * ExpWatchProc --
 *
 *	Initialize the notifier to watch the fd from this channel.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Sets up the notifier so that a future event on the channel will
 *	be seen by Tcl.
 *
 *----------------------------------------------------------------------
 */

static void
ExpWatchProc(instanceData, mask)
    ClientData instanceData;		/* The exp state. */
    int mask;				/* Events of interest; an OR-ed
                                         * combination of TCL_READABLE,
                                         * TCL_WRITABLE and TCL_EXCEPTION. */
{
    ExpState *esPtr = (ExpState *) instanceData;

    /*
     * Make sure we only register for events that are valid on this exp.
     * Note that we are passing Tcl_NotifyChannel directly to
     * Tcl_CreateExpHandler with the channel pointer as the client data.
     */

    mask &= esPtr->validMask;
    if (mask) {
	/*printf("  CreateFileHandler: %d (mask = %d)\r\n",esPtr->fdin,mask);*/
	Tcl_CreateFileHandler(esPtr->fdin, mask,
		(Tcl_FileProc *) Tcl_NotifyChannel,
		(ClientData) esPtr->channel);
    } else {
	/*printf("  DeleteFileHandler: %d (mask = %d)\r\n",esPtr->fdin,mask);*/
	Tcl_DeleteFileHandler(esPtr->fdin);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * ExpGetHandleProc --
 *
 *	Called from Tcl_GetChannelHandle to retrieve OS handles from
 *	an exp-based channel.
 *
 * Results:
 *	Returns TCL_OK with the fd in handlePtr, or TCL_ERROR if
 *	there is no handle for the specified direction. 
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
ExpGetHandleProc(instanceData, direction, handlePtr)
    ClientData instanceData;	/* The exp state. */
    int direction;		/* TCL_READABLE or TCL_WRITABLE */
    ClientData *handlePtr;	/* Where to store the handle.  */
{
    ExpState *esPtr = (ExpState *) instanceData;

    if (direction & TCL_WRITABLE) {
	*handlePtr = (ClientData) esPtr->fdin;
    }
    if (direction & TCL_READABLE) {
	*handlePtr = (ClientData) esPtr->fdin;
    } else {
	return TCL_ERROR;
    }
    return TCL_OK;
}

int
expChannelCountGet()
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    return tsdPtr->channelCount;
}

int
expSizeGet(esPtr)
    ExpState *esPtr;
{
    int len;
    Tcl_GetStringFromObj(esPtr->buffer,&len);
    return len;
}

int
expSizeZero(esPtr)
    ExpState *esPtr;
{
    int len;
    Tcl_GetStringFromObj(esPtr->buffer,&len);
    return (len == 0);
}

void
expStateFree(esPtr)
    ExpState *esPtr;
{
  if (esPtr->fdBusy) {
    close(esPtr->fdin);
  }

    esPtr->valid = FALSE;
    
    if (!esPtr->keepForever) {
	ckfree((char *)esPtr);
    }
}

/* close all connections
 * 
 * The kernel would actually do this by default, however Tcl is going to come
 * along later and try to reap its exec'd processes.  If we have inherited any
 * via spawn -open, Tcl can hang if we don't close the connections first.
 */
void
exp_close_all(interp)
Tcl_Interp *interp;
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    ExpState *esPtr;

    /* no need to keep things in sync (i.e., tsdPtr, count) since we could only
       be doing this if we're exiting.  Just close everything down. */

    for (esPtr = tsdPtr->firstExpPtr;esPtr;esPtr = esPtr->nextPtr) {
	exp_close(interp,esPtr);
    }
}

/* wait for any of our own spawned processes we call waitpid rather
 * than wait to avoid running into someone else's processes.  Yes,
 * according to Ousterhout this is the best way to do it.
 * returns the ExpState or 0 if nothing to wait on */
ExpState *
expWaitOnAny()
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    int result;
    ExpState *esPtr;

    for (esPtr = tsdPtr->firstExpPtr;esPtr;esPtr = esPtr->nextPtr) {
	if (esPtr->pid == exp_getpid) continue; /* skip ourself */
	if (esPtr->user_waited) continue;	/* one wait only! */
	if (esPtr->sys_waited) break;
      restart:
	result = waitpid(esPtr->pid,&esPtr->wait,WNOHANG);
	if (result == esPtr->pid) break;
	if (result == 0) continue;	/* busy, try next */
	if (result == -1) {
	    if (errno == EINTR) goto restart;
	    else break;
	}
    }
    return esPtr;
}

ExpState *
expWaitOnOne() {
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    ExpState *esPtr;
    int pid;
    /* should really be recoded using the common wait code in command.c */
    WAIT_STATUS_TYPE status;

    pid = wait(&status);
    for (esPtr = tsdPtr->firstExpPtr;esPtr;esPtr = esPtr->nextPtr) {
	if (esPtr->pid == pid) {
	    esPtr->sys_waited = TRUE;
	    esPtr->wait = status;
	    return esPtr;
	}
    }
}

void
exp_background_channelhandlers_run_all()
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    ExpState *esPtr;

    /* kick off any that already have input waiting */
    for (esPtr = tsdPtr->firstExpPtr;esPtr;esPtr = esPtr->nextPtr) {
	/* is bg_interp the best way to check if armed? */
	if (esPtr->bg_interp && !expSizeZero(esPtr)) {
	    exp_background_channelhandler((ClientData)esPtr,0);
	}
    }
}

ExpState *
expCreateChannel(interp,fdin,fdout,pid)
    Tcl_Interp *interp;
    int fdin;
    int fdout;
    int pid;
{
    ExpState *esPtr;
    int mask;
    Tcl_ChannelType *channelTypePtr;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    channelTypePtr = &expChannelType;

    esPtr = (ExpState *) ckalloc((unsigned) sizeof(ExpState));

    esPtr->nextPtr = tsdPtr->firstExpPtr;
    tsdPtr->firstExpPtr = esPtr;

    sprintf(esPtr->name,"exp%d",fdin);

    /*
     * For now, stupidly assume this.  We we will likely have to revisit this
     * later to prevent people from doing stupid things.
     */
    mask = TCL_READABLE | TCL_WRITABLE;

    /* not sure about this - what about adopted channels */
    esPtr->validMask = mask | TCL_EXCEPTION;
    esPtr->fdin = fdin;
    esPtr->fdout = fdout;

    /* set close-on-exec for everything but std channels */
    /* (system and stty commands need access to std channels) */
    if (fdin != 0 && fdin != 2) {
      expCloseOnExec(fdin);
      if (fdin != fdout) expCloseOnExec(fdout);
    }

    esPtr->fdBusy = FALSE;
    esPtr->channel = Tcl_CreateChannel(channelTypePtr, esPtr->name,
	    (ClientData) esPtr, mask);
    Tcl_RegisterChannel(interp,esPtr->channel);
    esPtr->registered = TRUE;
    Tcl_SetChannelOption(interp,esPtr->channel,"-buffering","none");
    Tcl_SetChannelOption(interp,esPtr->channel,"-blocking","0");
    Tcl_SetChannelOption(interp,esPtr->channel,"-translation","lf");

    esPtr->pid = pid;
    esPtr->msize = 0;

    /* initialize a dummy buffer */
    esPtr->buffer = Tcl_NewStringObj("",0);
    Tcl_IncrRefCount(esPtr->buffer);
    esPtr->umsize = exp_default_match_max;
    /* this will reallocate object with an appropriate sized buffer */
    expAdjust(esPtr);

    esPtr->printed = 0;
    esPtr->echoed = 0;
    esPtr->rm_nulls = exp_default_rm_nulls;
    esPtr->parity = exp_default_parity;
    esPtr->key = expect_key++;
    esPtr->force_read = FALSE;
    esPtr->fg_armed = FALSE;
    esPtr->channel_orig = 0;
    esPtr->fd_slave = EXP_NOFD;
#ifdef HAVE_PTYTRAP
    esPtr->slave_name = 0;
#endif /* HAVE_PTYTRAP */
    esPtr->open = TRUE;
    esPtr->notified = FALSE;
    esPtr->user_waited = FALSE;
    esPtr->sys_waited = FALSE;
    esPtr->bg_interp = 0;
    esPtr->bg_status = unarmed;
    esPtr->bg_ecount = 0;
    esPtr->freeWhenBgHandlerUnblocked = FALSE;
    esPtr->keepForever = FALSE;
    esPtr->valid = TRUE;
    tsdPtr->channelCount++;

    return esPtr;
}

void
expChannelInit() {
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    tsdPtr->channelCount = 0;
}

/* exp_clib.c - top-level functions in the expect C library, libexpect.a

Written by: Don Libes, [email protected], NIST, 12/3/90

Design and implementation of this program was paid for by U.S. tax
dollars.  Therefore it is public domain.  However, the author and NIST
would appreciate credit if this program or parts of it are used.
*/

#include "expect_cf.h"
#include <stdio.h>
#include <setjmp.h>
#ifdef HAVE_INTTYPES_H
#  include <inttypes.h>
#endif
#include <sys/types.h>
#include <sys/ioctl.h>

#ifdef TIME_WITH_SYS_TIME
# include <sys/time.h>
# include <time.h>
#else
# if HAVE_SYS_TIME_H
#  include <sys/time.h>
# else
#  include <time.h>
# endif
#endif

#ifdef CRAY
# ifndef TCSETCTTY
#  if defined(HAVE_TERMIOS)
#   include <termios.h>
#  else
#   include <termio.h>
#  endif
# endif
#endif

#ifdef HAVE_SYS_FCNTL_H
#  include <sys/fcntl.h>
#else
#  include <fcntl.h>
#endif

#ifdef HAVE_STRREDIR_H
#include <sys/strredir.h>
# ifdef SRIOCSREDIR
#  undef TIOCCONS
# endif
#endif

#include <signal.h>
/*#include <memory.h> - deprecated - ANSI C moves them into string.h */
#include "string.h"

#include <errno.h>

#ifdef NO_STDLIB_H

/*
 * Tcl's compat/stdlib.h
 */

/*
 * stdlib.h --
 *
 *	Declares facilities exported by the "stdlib" portion of
 *	the C library.  This file isn't complete in the ANSI-C
 *	sense;  it only declares things that are needed by Tcl.
 *	This file is needed even on many systems with their own
 *	stdlib.h (e.g. SunOS) because not all stdlib.h files
 *	declare all the procedures needed here (such as strtod).
 *
 * Copyright (c) 1991 The Regents of the University of California.
 * Copyright (c) 1994 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: exp_clib.c,v 5.29 2000/01/06 23:22:02 wart Exp $
 */

#ifndef _STDLIB
#define _STDLIB

#include <tcl.h>

extern void		abort _ANSI_ARGS_((void));
extern double		atof _ANSI_ARGS_((CONST char *string));
extern int		atoi _ANSI_ARGS_((CONST char *string));
extern long		atol _ANSI_ARGS_((CONST char *string));
extern char *		calloc _ANSI_ARGS_((unsigned int numElements,
			    unsigned int size));
extern void		exit _ANSI_ARGS_((int status));
extern int		free _ANSI_ARGS_((char *blockPtr));
extern char *		getenv _ANSI_ARGS_((CONST char *name));
extern char *		malloc _ANSI_ARGS_((unsigned int numBytes));
extern void		qsort _ANSI_ARGS_((VOID *base, int n, int size,
			    int (*compar)(CONST VOID *element1, CONST VOID
			    *element2)));
extern char *		realloc _ANSI_ARGS_((char *ptr, unsigned int numBytes));
extern double		strtod _ANSI_ARGS_((CONST char *string, char **endPtr));
extern long		strtol _ANSI_ARGS_((CONST char *string, char **endPtr,
			    int base));
extern unsigned long	strtoul _ANSI_ARGS_((CONST char *string,
			    char **endPtr, int base));

#endif /* _STDLIB */

/*
 * end of Tcl's compat/stdlib.h
 */

#else
#include <stdlib.h>		/* for malloc */
#endif

#include "expect.h"
#define TclRegError exp_TclRegError

/*
 * regexp code - from tcl8.0.4/generic/regexp.c
 */

/*
 * TclRegComp and TclRegExec -- TclRegSub is elsewhere
 *
 *	Copyright (c) 1986 by University of Toronto.
 *	Written by Henry Spencer.  Not derived from licensed software.
 *
 *	Permission is granted to anyone to use this software for any
 *	purpose on any computer system, and to redistribute it freely,
 *	subject to the following restrictions:
 *
 *	1. The author is not responsible for the consequences of use of
 *		this software, no matter how awful, even if they arise
 *		from defects in it.
 *
 *	2. The origin of this software must not be misrepresented, either
 *		by explicit claim or by omission.
 *
 *	3. Altered versions must be plainly marked as such, and must not
 *		be misrepresented as being the original software.
 *
 * Beware that some of this code is subtly aware of the way operator
 * precedence is structured in regular expressions.  Serious changes in
 * regular-expression syntax might require a total rethink.
 *
 * *** NOTE: this code has been altered slightly for use in Tcl: ***
 * *** 1. Use ckalloc and ckfree instead of  malloc and free.	 ***
 * *** 2. Add extra argument to regexp to specify the real	 ***
 * ***    start of the string separately from the start of the	 ***
 * ***    current search. This is needed to search for multiple	 ***
 * ***    matches within a string.				 ***
 * *** 3. Names have been changed, e.g. from regcomp to		 ***
 * ***    TclRegComp, to avoid clashes with other 		 ***
 * ***    regexp implementations used by applications. 		 ***
 * *** 4. Added errMsg declaration and TclRegError procedure	 ***
 * *** 5. Various lint-like things, such as casting arguments	 ***
 * ***	  in procedure calls.					 ***
 *
 * *** NOTE: This code has been altered for use in MT-Sturdy Tcl ***
 * *** 1. All use of static variables has been changed to access ***
 * ***    fields of a structure.                                 ***
 * *** 2. This in addition to changes to TclRegError makes the   ***
 * ***    code multi-thread safe.                                ***
 *
 * RCS: @(#) $Id: exp_clib.c,v 5.29 2000/01/06 23:22:02 wart Exp $
 */

#if 0
#include "tclInt.h"
#include "tclPort.h"
#endif

/*
 * The variable below is set to NULL before invoking regexp functions
 * and checked after those functions.  If an error occurred then TclRegError
 * will set the variable to point to a (static) error message.  This
 * mechanism unfortunately does not support multi-threading, but the
 * procedures TclRegError and TclGetRegError can be modified to use
 * thread-specific storage for the variable and thereby make the code
 * thread-safe.
 */

static char *errMsg = NULL;

/*
 * The "internal use only" fields in regexp.h are present to pass info from
 * compile to execute that permits the execute phase to run lots faster on
 * simple cases.  They are:
 *
 * regstart	char that must begin a match; '\0' if none obvious
 * reganch	is the match anchored (at beginning-of-line only)?
 * regmust	string (pointer into program) that match must include, or NULL
 * regmlen	length of regmust string
 *
 * Regstart and reganch permit very fast decisions on suitable starting points
 * for a match, cutting down the work a lot.  Regmust permits fast rejection
 * of lines that cannot possibly match.  The regmust tests are costly enough
 * that TclRegComp() supplies a regmust only if the r.e. contains something
 * potentially expensive (at present, the only such thing detected is * or +
 * at the start of the r.e., which can involve a lot of backup).  Regmlen is
 * supplied because the test in TclRegExec() needs it and TclRegComp() is
 * computing it anyway.
 */

/*
 * Structure for regexp "program".  This is essentially a linear encoding
 * of a nondeterministic finite-state machine (aka syntax charts or
 * "railroad normal form" in parsing technology).  Each node is an opcode
 * plus a "next" pointer, possibly plus an operand.  "Next" pointers of
 * all nodes except BRANCH implement concatenation; a "next" pointer with
 * a BRANCH on both ends of it is connecting two alternatives.  (Here we
 * have one of the subtle syntax dependencies:  an individual BRANCH (as
 * opposed to a collection of them) is never concatenated with anything
 * because of operator precedence.)  The operand of some types of node is
 * a literal string; for others, it is a node leading into a sub-FSM.  In
 * particular, the operand of a BRANCH node is the first node of the branch.
 * (NB this is *not* a tree structure:  the tail of the branch connects
 * to the thing following the set of BRANCHes.)  The opcodes are:
 */

/* definition	number	opnd?	meaning */
#define	END	0	/* no	End of program. */
#define	BOL	1	/* no	Match "" at beginning of line. */
#define	EOL	2	/* no	Match "" at end of line. */
#define	ANY	3	/* no	Match any one character. */
#define	ANYOF	4	/* str	Match any character in this string. */
#define	ANYBUT	5	/* str	Match any character not in this string. */
#define	BRANCH	6	/* node	Match this alternative, or the next... */
#define	BACK	7	/* no	Match "", "next" ptr points backward. */
#define	EXACTLY	8	/* str	Match this string. */
#define	NOTHING	9	/* no	Match empty string. */
#define	STAR	10	/* node	Match this (simple) thing 0 or more times. */
#define	PLUS	11	/* node	Match this (simple) thing 1 or more times. */
#define	OPEN	20	/* no	Mark this point in input as start of #n. */
			/*	OPEN+1 is number 1, etc. */
#define	CLOSE	(OPEN+NSUBEXP)	/* no	Analogous to OPEN. */

/*
 * Opcode notes:
 *
 * BRANCH	The set of branches constituting a single choice are hooked
 *		together with their "next" pointers, since precedence prevents
 *		anything being concatenated to any individual branch.  The
 *		"next" pointer of the last BRANCH in a choice points to the
 *		thing following the whole choice.  This is also where the
 *		final "next" pointer of each individual branch points; each
 *		branch starts with the operand node of a BRANCH node.
 *
 * BACK		Normal "next" pointers all implicitly point forward; BACK
 *		exists to make loop structures possible.
 *
 * STAR,PLUS	'?', and complex '*' and '+', are implemented as circular
 *		BRANCH structures using BACK.  Simple cases (one character
 *		per match) are implemented with STAR and PLUS for speed
 *		and to minimize recursive plunges.
 *
 * OPEN,CLOSE	...are numbered at compile time.
 */

/*
 * A node is one char of opcode followed by two chars of "next" pointer.
 * "Next" pointers are stored as two 8-bit pieces, high order first.  The
 * value is a positive offset from the opcode of the node containing it.
 * An operand, if any, simply follows the node.  (Note that much of the
 * code generation knows about this implicit relationship.)
 *
 * Using two bytes for the "next" pointer is vast overkill for most things,
 * but allows patterns to get big without disasters.
 */
#define	OP(p)	(*(p))
#define	NEXT(p)	(((*((p)+1)&0377)<<8) + (*((p)+2)&0377))
#define	OPERAND(p)	((p) + 3)

/*
 * See regmagic.h for one further detail of program structure.
 */


/*
 * Utility definitions.
 */
#ifndef CHARBITS
#define	UCHARAT(p)	((int)*(unsigned char *)(p))
#else
#define	UCHARAT(p)	((int)*(p)&CHARBITS)
#endif

#define	FAIL(m)	{ TclRegError(m); return(NULL); }
#define	ISMULT(c)	((c) == '*' || (c) == '+' || (c) == '?')
#define	META	"^$.[()|?+*\\"

/*
 * Flags to be passed up and down.
 */
#define	HASWIDTH	01	/* Known never to match null string. */
#define	SIMPLE		02	/* Simple enough to be STAR/PLUS operand. */
#define	SPSTART		04	/* Starts with * or +. */
#define	WORST		0	/* Worst case. */

/*
 * Global work variables for TclRegComp().
 */
struct regcomp_state  {
    char *regparse;		/* Input-scan pointer. */
    int regnpar;		/* () count. */
    char *regcode;		/* Code-emit pointer; &regdummy = don't. */
    long regsize;		/* Code size. */
};

static char regdummy;

/*
 * The first byte of the regexp internal "program" is actually this magic
 * number; the start node begins in the second byte.
 */
#define	MAGIC	0234


/*
 * Forward declarations for TclRegComp()'s friends.
 */

static char *		reg _ANSI_ARGS_((int paren, int *flagp,
			    struct regcomp_state *rcstate));
static char *		regatom _ANSI_ARGS_((int *flagp,
			    struct regcomp_state *rcstate));
static char *		regbranch _ANSI_ARGS_((int *flagp,
			    struct regcomp_state *rcstate));
static void		regc _ANSI_ARGS_((int b,
			    struct regcomp_state *rcstate));
static void		reginsert _ANSI_ARGS_((int op, char *opnd,
			    struct regcomp_state *rcstate));
static char *		regnext _ANSI_ARGS_((char *p));
static char *		regnode _ANSI_ARGS_((int op,
			    struct regcomp_state *rcstate));
static void 		regoptail _ANSI_ARGS_((char *p, char *val));
static char *		regpiece _ANSI_ARGS_((int *flagp,
			    struct regcomp_state *rcstate));
static void 		regtail _ANSI_ARGS_((char *p, char *val));

#ifdef STRCSPN
static int strcspn _ANSI_ARGS_((char *s1, char *s2));
#endif

/*
 - TclRegComp - compile a regular expression into internal code
 *
 * We can't allocate space until we know how big the compiled form will be,
 * but we can't compile it (and thus know how big it is) until we've got a
 * place to put the code.  So we cheat:  we compile it twice, once with code
 * generation turned off and size counting turned on, and once "for real".
 * This also means that we don't allocate space until we are sure that the
 * thing really will compile successfully, and we never have to move the
 * code and thus invalidate pointers into it.  (Note that it has to be in
 * one piece because free() must be able to free it all.)
 *
 * Beware that the optimization-preparation code in here knows about some
 * of the structure of the compiled regexp.
 */
regexp *
TclRegComp(exp)
char *exp;
{
	register regexp *r;
	register char *scan;
	register char *longest;
	register int len;
	int flags;
	struct regcomp_state state;
	struct regcomp_state *rcstate= &state;

	if (exp == NULL)
		FAIL("NULL argument");

	/* First pass: determine size, legality. */
	rcstate->regparse = exp;
	rcstate->regnpar = 1;
	rcstate->regsize = 0L;
	rcstate->regcode = &regdummy;
	regc(MAGIC, rcstate);
	if (reg(0, &flags, rcstate) == NULL)
		return(NULL);

	/* Small enough for pointer-storage convention? */
	if (rcstate->regsize >= 32767L)		/* Probably could be 65535L. */
		FAIL("regexp too big");

	/* Allocate space. */
	r = (regexp *)ckalloc(sizeof(regexp) + (unsigned)rcstate->regsize);
	if (r == NULL)
		FAIL("out of space");

	/* Second pass: emit code. */
	rcstate->regparse = exp;
	rcstate->regnpar = 1;
	rcstate->regcode = r->program;
	regc(MAGIC, rcstate);
	if (reg(0, &flags, rcstate) == NULL)
		return(NULL);

	/* Dig out information for optimizations. */
	r->regstart = '\0';	/* Worst-case defaults. */
	r->reganch = 0;
	r->regmust = NULL;
	r->regmlen = 0;
	scan = r->program+1;			/* First BRANCH. */
	if (OP(regnext(scan)) == END) {		/* Only one top-level choice. */
		scan = OPERAND(scan);

		/* Starting-point info. */
		if (OP(scan) == EXACTLY)
			r->regstart = *OPERAND(scan);
		else if (OP(scan) == BOL)
			r->reganch++;

		/*
		 * If there's something expensive in the r.e., find the
		 * longest literal string that must appear and make it the
		 * regmust.  Resolve ties in favor of later strings, since
		 * the regstart check works with the beginning of the r.e.
		 * and avoiding duplication strengthens checking.  Not a
		 * strong reason, but sufficient in the absence of others.
		 */
		if (flags&SPSTART) {
			longest = NULL;
			len = 0;
			for (; scan != NULL; scan = regnext(scan))
				if (OP(scan) == EXACTLY && ((int) strlen(OPERAND(scan))) >= len) {
					longest = OPERAND(scan);
					len = strlen(OPERAND(scan));
				}
			r->regmust = longest;
			r->regmlen = len;
		}
	}

	return(r);
}

/*
 - reg - regular expression, i.e. main body or parenthesized thing
 *
 * Caller must absorb opening parenthesis.
 *
 * Combining parenthesis handling with the base level of regular expression
 * is a trifle forced, but the need to tie the tails of the branches to what
 * follows makes it hard to avoid.
 */
static char *
reg(paren, flagp, rcstate)
int paren;			/* Parenthesized? */
int *flagp;
struct regcomp_state *rcstate;
{
	register char *ret;
	register char *br;
	register char *ender;
	register int parno = 0;
	int flags;

	*flagp = HASWIDTH;	/* Tentatively. */

	/* Make an OPEN node, if parenthesized. */
	if (paren) {
		if (rcstate->regnpar >= NSUBEXP)
			FAIL("too many ()");
		parno = rcstate->regnpar;
		rcstate->regnpar++;
		ret = regnode(OPEN+parno,rcstate);
	} else
		ret = NULL;

	/* Pick up the branches, linking them together. */
	br = regbranch(&flags,rcstate);
	if (br == NULL)
		return(NULL);
	if (ret != NULL)
		regtail(ret, br);	/* OPEN -> first. */
	else
		ret = br;
	if (!(flags&HASWIDTH))
		*flagp &= ~HASWIDTH;
	*flagp |= flags&SPSTART;
	while (*rcstate->regparse == '|') {
		rcstate->regparse++;
		br = regbranch(&flags,rcstate);
		if (br == NULL)
			return(NULL);
		regtail(ret, br);	/* BRANCH -> BRANCH. */
		if (!(flags&HASWIDTH))
			*flagp &= ~HASWIDTH;
		*flagp |= flags&SPSTART;
	}

	/* Make a closing node, and hook it on the end. */
	ender = regnode((paren) ? CLOSE+parno : END,rcstate);	
	regtail(ret, ender);

	/* Hook the tails of the branches to the closing node. */
	for (br = ret; br != NULL; br = regnext(br))
		regoptail(br, ender);

	/* Check for proper termination. */
	if (paren && *rcstate->regparse++ != ')') {
		FAIL("unmatched ()");
	} else if (!paren && *rcstate->regparse != '\0') {
		if (*rcstate->regparse == ')') {
			FAIL("unmatched ()");
		} else
			FAIL("junk on end");	/* "Can't happen". */
		/* NOTREACHED */
	}

	return(ret);
}

/*
 - regbranch - one alternative of an | operator
 *
 * Implements the concatenation operator.
 */
static char *
regbranch(flagp, rcstate)
int *flagp;
struct regcomp_state *rcstate;
{
	register char *ret;
	register char *chain;
	register char *latest;
	int flags;

	*flagp = WORST;		/* Tentatively. */

	ret = regnode(BRANCH,rcstate);
	chain = NULL;
	while (*rcstate->regparse != '\0' && *rcstate->regparse != '|' &&
				*rcstate->regparse != ')') {
		latest = regpiece(&flags, rcstate);
		if (latest == NULL)
			return(NULL);
		*flagp |= flags&HASWIDTH;
		if (chain == NULL)	/* First piece. */
			*flagp |= flags&SPSTART;
		else
			regtail(chain, latest);
		chain = latest;
	}
	if (chain == NULL)	/* Loop ran zero times. */
		(void) regnode(NOTHING,rcstate);

	return(ret);
}

/*
 - regpiece - something followed by possible [*+?]
 *
 * Note that the branching code sequences used for ? and the general cases
 * of * and + are somewhat optimized:  they use the same NOTHING node as
 * both the endmarker for their branch list and the body of the last branch.
 * It might seem that this node could be dispensed with entirely, but the
 * endmarker role is not redundant.
 */
static char *
regpiece(flagp, rcstate)
int *flagp;
struct regcomp_state *rcstate;
{
	register char *ret;
	register char op;
	register char *next;
	int flags;

	ret = regatom(&flags,rcstate);
	if (ret == NULL)
		return(NULL);

	op = *rcstate->regparse;
	if (!ISMULT(op)) {
		*flagp = flags;
		return(ret);
	}

	if (!(flags&HASWIDTH) && op != '?')
		FAIL("*+ operand could be empty");
	*flagp = (op != '+') ? (WORST|SPSTART) : (WORST|HASWIDTH);

	if (op == '*' && (flags&SIMPLE))
		reginsert(STAR, ret, rcstate);
	else if (op == '*') {
		/* Emit x* as (x&|), where & means "self". */
		reginsert(BRANCH, ret, rcstate);			/* Either x */
		regoptail(ret, regnode(BACK,rcstate));		/* and loop */
		regoptail(ret, ret);			/* back */
		regtail(ret, regnode(BRANCH,rcstate));		/* or */
		regtail(ret, regnode(NOTHING,rcstate));		/* null. */
	} else if (op == '+' && (flags&SIMPLE))
		reginsert(PLUS, ret, rcstate);
	else if (op == '+') {
		/* Emit x+ as x(&|), where & means "self". */
		next = regnode(BRANCH,rcstate);			/* Either */
		regtail(ret, next);
		regtail(regnode(BACK,rcstate), ret);		/* loop back */
		regtail(next, regnode(BRANCH,rcstate));		/* or */
		regtail(ret, regnode(NOTHING,rcstate));		/* null. */
	} else if (op == '?') {
		/* Emit x? as (x|) */
		reginsert(BRANCH, ret, rcstate);			/* Either x */
		regtail(ret, regnode(BRANCH,rcstate));		/* or */
		next = regnode(NOTHING,rcstate);		/* null. */
		regtail(ret, next);
		regoptail(ret, next);
	}
	rcstate->regparse++;
	if (ISMULT(*rcstate->regparse))
		FAIL("nested *?+");

	return(ret);
}

/*
 - regatom - the lowest level
 *
 * Optimization:  gobbles an entire sequence of ordinary characters so that
 * it can turn them into a single node, which is smaller to store and
 * faster to run.  Backslashed characters are exceptions, each becoming a
 * separate node; the code is simpler that way and it's not worth fixing.
 */
static char *
regatom(flagp, rcstate)
int *flagp;
struct regcomp_state *rcstate;
{
	register char *ret;
	int flags;

	*flagp = WORST;		/* Tentatively. */

	switch (*rcstate->regparse++) {
	case '^':
		ret = regnode(BOL,rcstate);
		break;
	case '$':
		ret = regnode(EOL,rcstate);
		break;
	case '.':
		ret = regnode(ANY,rcstate);
		*flagp |= HASWIDTH|SIMPLE;
		break;
	case '[': {
			register int clss;
			register int classend;

			if (*rcstate->regparse == '^') {	/* Complement of range. */
				ret = regnode(ANYBUT,rcstate);
				rcstate->regparse++;
			} else
				ret = regnode(ANYOF,rcstate);
			if (*rcstate->regparse == ']' || *rcstate->regparse == '-')
				regc(*rcstate->regparse++,rcstate);
			while (*rcstate->regparse != '\0' && *rcstate->regparse != ']') {
				if (*rcstate->regparse == '-') {
					rcstate->regparse++;
					if (*rcstate->regparse == ']' || *rcstate->regparse == '\0')
						regc('-',rcstate);
					else {
						clss = UCHARAT(rcstate->regparse-2)+1;
						classend = UCHARAT(rcstate->regparse);
						if (clss > classend+1)
							FAIL("invalid [] range");
						for (; clss <= classend; clss++)
							regc((char)clss,rcstate);
						rcstate->regparse++;
					}
				} else
					regc(*rcstate->regparse++,rcstate);
			}
			regc('\0',rcstate);
			if (*rcstate->regparse != ']')
				FAIL("unmatched []");
			rcstate->regparse++;
			*flagp |= HASWIDTH|SIMPLE;
		}
		break;
	case '(':
		ret = reg(1, &flags, rcstate);
		if (ret == NULL)
			return(NULL);
		*flagp |= flags&(HASWIDTH|SPSTART);
		break;
	case '\0':
	case '|':
	case ')':
		FAIL("internal urp");	/* Supposed to be caught earlier. */
		/* NOTREACHED */
	case '?':
	case '+':
	case '*':
		FAIL("?+* follows nothing");
		/* NOTREACHED */
	case '\\':
		if (*rcstate->regparse == '\0')
			FAIL("trailing \\");
		ret = regnode(EXACTLY,rcstate);
		regc(*rcstate->regparse++,rcstate);
		regc('\0',rcstate);
		*flagp |= HASWIDTH|SIMPLE;
		break;
	default: {
			register int len;
			register char ender;

			rcstate->regparse--;
			len = strcspn(rcstate->regparse, META);
			if (len <= 0)
				FAIL("internal disaster");
			ender = *(rcstate->regparse+len);
			if (len > 1 && ISMULT(ender))
				len--;		/* Back off clear of ?+* operand. */
			*flagp |= HASWIDTH;
			if (len == 1)
				*flagp |= SIMPLE;
			ret = regnode(EXACTLY,rcstate);
			while (len > 0) {
				regc(*rcstate->regparse++,rcstate);
				len--;
			}
			regc('\0',rcstate);
		}
		break;
	}

	return(ret);
}

/*
 - regnode - emit a node
 */
static char *			/* Location. */
regnode(op, rcstate)
int op;
struct regcomp_state *rcstate;
{
	register char *ret;
	register char *ptr;

	ret = rcstate->regcode;
	if (ret == &regdummy) {
		rcstate->regsize += 3;
		return(ret);
	}

	ptr = ret;
	*ptr++ = (char)op;
	*ptr++ = '\0';		/* Null "next" pointer. */
	*ptr++ = '\0';
	rcstate->regcode = ptr;

	return(ret);
}

/*
 - regc - emit (if appropriate) a byte of code
 */
static void
regc(b, rcstate)
int b;
struct regcomp_state *rcstate;
{
	if (rcstate->regcode != &regdummy)
		*rcstate->regcode++ = (char)b;
	else
		rcstate->regsize++;
}

/*
 - reginsert - insert an operator in front of already-emitted operand
 *
 * Means relocating the operand.
 */
static void
reginsert(op, opnd, rcstate)
int op;
char *opnd;
struct regcomp_state *rcstate;
{
	register char *src;
	register char *dst;
	register char *place;

	if (rcstate->regcode == &regdummy) {
		rcstate->regsize += 3;
		return;
	}

	src = rcstate->regcode;
	rcstate->regcode += 3;
	dst = rcstate->regcode;
	while (src > opnd)
		*--dst = *--src;

	place = opnd;		/* Op node, where operand used to be. */
	*place++ = (char)op;
	*place++ = '\0';
	*place = '\0';
}

/*
 - regtail - set the next-pointer at the end of a node chain
 */
static void
regtail(p, val)
char *p;
char *val;
{
	register char *scan;
	register char *temp;
	register int offset;

	if (p == &regdummy)
		return;

	/* Find last node. */
	scan = p;
	for (;;) {
		temp = regnext(scan);
		if (temp == NULL)
			break;
		scan = temp;
	}

	if (OP(scan) == BACK)
		offset = scan - val;
	else
		offset = val - scan;
	*(scan+1) = (char)((offset>>8)&0377);
	*(scan+2) = (char)(offset&0377);
}

/*
 - regoptail - regtail on operand of first argument; nop if operandless
 */
static void
regoptail(p, val)
char *p;
char *val;
{
	/* "Operandless" and "op != BRANCH" are synonymous in practice. */
	if (p == NULL || p == &regdummy || OP(p) != BRANCH)
		return;
	regtail(OPERAND(p), val);
}

/*
 * TclRegExec and friends
 */

/*
 * Global work variables for TclRegExec().
 */
struct regexec_state  {
    char *reginput;		/* String-input pointer. */
    char *regbol;		/* Beginning of input, for ^ check. */
    char **regstartp;	/* Pointer to startp array. */
    char **regendp;		/* Ditto for endp. */
};

/*
 * Forwards.
 */
static int 		regtry _ANSI_ARGS_((regexp *prog, char *string,
			    struct regexec_state *restate));
static int 		regmatch _ANSI_ARGS_((char *prog,
			    struct regexec_state *restate));
static int 		regrepeat _ANSI_ARGS_((char *p,
			    struct regexec_state *restate));

#ifdef DEBUG
int regnarrate = 0;
void regdump _ANSI_ARGS_((regexp *r));
static char *regprop _ANSI_ARGS_((char *op));
#endif

/*
 - TclRegExec - match a regexp against a string
 */
int
TclRegExec(prog, string, start)
register regexp *prog;
register char *string;
char *start;
{
	register char *s;
	struct regexec_state state;
	struct regexec_state *restate= &state;

	/* Be paranoid... */
	if (prog == NULL || string == NULL) {
		TclRegError("NULL parameter");
		return(0);
	}

	/* Check validity of program. */
	if (UCHARAT(prog->program) != MAGIC) {
		TclRegError("corrupted program");
		return(0);
	}

	/* If there is a "must appear" string, look for it. */
	if (prog->regmust != NULL) {
		s = string;
		while ((s = strchr(s, prog->regmust[0])) != NULL) {
			if (strncmp(s, prog->regmust, (size_t) prog->regmlen)
			    == 0)
				break;	/* Found it. */
			s++;
		}
		if (s == NULL)	/* Not present. */
			return(0);
	}

	/* Mark beginning of line for ^ . */
	restate->regbol = start;

	/* Simplest case:  anchored match need be tried only once. */
	if (prog->reganch)
		return(regtry(prog, string, restate));

	/* Messy cases:  unanchored match. */
	s = string;
	if (prog->regstart != '\0')
		/* We know what char it must start with. */
		while ((s = strchr(s, prog->regstart)) != NULL) {
			if (regtry(prog, s, restate))
				return(1);
			s++;
		}
	else
		/* We don't -- general case. */
		do {
			if (regtry(prog, s, restate))
				return(1);
		} while (*s++ != '\0');

	/* Failure. */
	return(0);
}

/*
 - regtry - try match at specific point
 */
static int			/* 0 failure, 1 success */
regtry(prog, string, restate)
regexp *prog;
char *string;
struct regexec_state *restate;
{
	register int i;
	register char **sp;
	register char **ep;

	restate->reginput = string;
	restate->regstartp = prog->startp;
	restate->regendp = prog->endp;

	sp = prog->startp;
	ep = prog->endp;
	for (i = NSUBEXP; i > 0; i--) {
		*sp++ = NULL;
		*ep++ = NULL;
	}
	if (regmatch(prog->program + 1,restate)) {
		prog->startp[0] = string;
		prog->endp[0] = restate->reginput;
		return(1);
	} else
		return(0);
}

/*
 - regmatch - main matching routine
 *
 * Conceptually the strategy is simple:  check to see whether the current
 * node matches, call self recursively to see whether the rest matches,
 * and then act accordingly.  In practice we make some effort to avoid
 * recursion, in particular by going through "ordinary" nodes (that don't
 * need to know whether the rest of the match failed) by a loop instead of
 * by recursion.
 */
static int			/* 0 failure, 1 success */
regmatch(prog, restate)
char *prog;
struct regexec_state *restate;
{
    register char *scan;	/* Current node. */
    char *next;		/* Next node. */

    scan = prog;
#ifdef DEBUG
    if (scan != NULL && regnarrate)
	fprintf(stderr, "%s(\n", regprop(scan));
#endif
    while (scan != NULL) {
#ifdef DEBUG
	if (regnarrate)
	    fprintf(stderr, "%s...\n", regprop(scan));
#endif
	next = regnext(scan);

	switch (OP(scan)) {
	    case BOL:
		if (restate->reginput != restate->regbol) {
		    return 0;
		}
		break;
	    case EOL:
		if (*restate->reginput != '\0') {
		    return 0;
		}
		break;
	    case ANY:
		if (*restate->reginput == '\0') {
		    return 0;
		}
		restate->reginput++;
		break;
	    case EXACTLY: {
		register int len;
		register char *opnd;

		opnd = OPERAND(scan);
		/* Inline the first character, for speed. */
		if (*opnd != *restate->reginput) {
		    return 0 ;
		}
		len = strlen(opnd);
		if (len > 1 && strncmp(opnd, restate->reginput, (size_t) len)
			!= 0) {
		    return 0;
		}
		restate->reginput += len;
		break;
	    }
	    case ANYOF:
		if (*restate->reginput == '\0'
			|| strchr(OPERAND(scan), *restate->reginput) == NULL) {
		    return 0;
		}
		restate->reginput++;
		break;
	    case ANYBUT:
		if (*restate->reginput == '\0'
			|| strchr(OPERAND(scan), *restate->reginput) != NULL) {
		    return 0;
		}
		restate->reginput++;
		break;
	    case NOTHING:
		break;
	    case BACK:
		break;
	    case OPEN+1:
	    case OPEN+2:
	    case OPEN+3:
	    case OPEN+4:
	    case OPEN+5:
	    case OPEN+6:
	    case OPEN+7:
	    case OPEN+8:
	    case OPEN+9: {
		register int no;
		register char *save;

	doOpen:
		no = OP(scan) - OPEN;
		save = restate->reginput;

		if (regmatch(next,restate)) {
		    /*
		     * Don't set startp if some later invocation of the
		     * same parentheses already has.
		     */
		    if (restate->regstartp[no] == NULL) {
			restate->regstartp[no] = save;
		    }
		    return 1;
		} else {
		    return 0;
		}
	    }
	    case CLOSE+1:
	    case CLOSE+2:
	    case CLOSE+3:
	    case CLOSE+4:
	    case CLOSE+5:
	    case CLOSE+6:
	    case CLOSE+7:
	    case CLOSE+8:
	    case CLOSE+9: {
		register int no;
		register char *save;

	doClose:
		no = OP(scan) - CLOSE;
		save = restate->reginput;

		if (regmatch(next,restate)) {
				/*
				 * Don't set endp if some later
				 * invocation of the same parentheses
				 * already has.
				 */
		    if (restate->regendp[no] == NULL)
			restate->regendp[no] = save;
		    return 1;
		} else {
		    return 0;
		}
	    }
	    case BRANCH: {
		register char *save;

		if (OP(next) != BRANCH) { /* No choice. */
		    next = OPERAND(scan); /* Avoid recursion. */
		} else {
		    do {
			save = restate->reginput;
			if (regmatch(OPERAND(scan),restate))
			    return(1);
			restate->reginput = save;
			scan = regnext(scan);
		    } while (scan != NULL && OP(scan) == BRANCH);
		    return 0;
		}
		break;
	    }
	    case STAR:
	    case PLUS: {
		register char nextch;
		register int no;
		register char *save;
		register int min;

		/*
		 * Lookahead to avoid useless match attempts
		 * when we know what character comes next.
		 */
		nextch = '\0';
		if (OP(next) == EXACTLY)
		    nextch = *OPERAND(next);
		min = (OP(scan) == STAR) ? 0 : 1;
		save = restate->reginput;
		no = regrepeat(OPERAND(scan),restate);
		while (no >= min) {
		    /* If it could work, try it. */
		    if (nextch == '\0' || *restate->reginput == nextch)
			if (regmatch(next,restate))
			    return(1);
		    /* Couldn't or didn't -- back up. */
		    no--;
		    restate->reginput = save + no;
		}
		return(0);
	    }
	    case END:
		return(1);	/* Success! */
	    default:
		if (OP(scan) > OPEN && OP(scan) < OPEN+NSUBEXP) {
		    goto doOpen;
		} else if (OP(scan) > CLOSE && OP(scan) < CLOSE+NSUBEXP) {
		    goto doClose;
		}
		TclRegError("memory corruption");
		return 0;
	}

	scan = next;
    }

    /*
     * We get here only if there's trouble -- normally "case END" is
     * the terminating point.
     */
    TclRegError("corrupted pointers");
    return(0);
}

/*
 - regrepeat - repeatedly match something simple, report how many
 */
static int
regrepeat(p, restate)
char *p;
struct regexec_state *restate;
{
	register int count = 0;
	register char *scan;
	register char *opnd;

	scan = restate->reginput;
	opnd = OPERAND(p);
	switch (OP(p)) {
	case ANY:
		count = strlen(scan);
		scan += count;
		break;
	case EXACTLY:
		while (*opnd == *scan) {
			count++;
			scan++;
		}
		break;
	case ANYOF:
		while (*scan != '\0' && strchr(opnd, *scan) != NULL) {
			count++;
			scan++;
		}
		break;
	case ANYBUT:
		while (*scan != '\0' && strchr(opnd, *scan) == NULL) {
			count++;
			scan++;
		}
		break;
	default:		/* Oh dear.  Called inappropriately. */
		TclRegError("internal foulup");
		count = 0;	/* Best compromise. */
		break;
	}
	restate->reginput = scan;

	return(count);
}

/*
 - regnext - dig the "next" pointer out of a node
 */
static char *
regnext(p)
register char *p;
{
	register int offset;

	if (p == &regdummy)
		return(NULL);

	offset = NEXT(p);
	if (offset == 0)
		return(NULL);

	if (OP(p) == BACK)
		return(p-offset);
	else
		return(p+offset);
}

#ifdef DEBUG

static char *regprop();

/*
 - regdump - dump a regexp onto stdout in vaguely comprehensible form
 */
void
regdump(r)
regexp *r;
{
	register char *s;
	register char op = EXACTLY;	/* Arbitrary non-END op. */
	register char *next;


	s = r->program + 1;
	while (op != END) {	/* While that wasn't END last time... */
		op = OP(s);
		printf("%2d%s", s-r->program, regprop(s));	/* Where, what. */
		next = regnext(s);
		if (next == NULL)		/* Next ptr. */
			printf("(0)");
		else 
			printf("(%d)", (s-r->program)+(next-s));
		s += 3;
		if (op == ANYOF || op == ANYBUT || op == EXACTLY) {
			/* Literal string, where present. */
			while (*s != '\0') {
				putchar(*s);
				s++;
			}
			s++;
		}
		putchar('\n');
	}

	/* Header fields of interest. */
	if (r->regstart != '\0')
		printf("start `%c' ", r->regstart);
	if (r->reganch)
		printf("anchored ");
	if (r->regmust != NULL)
		printf("must have \"%s\"", r->regmust);
	printf("\n");
}

/*
 - regprop - printable representation of opcode
 */
static char *
regprop(op)
char *op;
{
	register char *p;
	static char buf[50];

	(void) strcpy(buf, ":");

	switch (OP(op)) {
	case BOL:
		p = "BOL";
		break;
	case EOL:
		p = "EOL";
		break;
	case ANY:
		p = "ANY";
		break;
	case ANYOF:
		p = "ANYOF";
		break;
	case ANYBUT:
		p = "ANYBUT";
		break;
	case BRANCH:
		p = "BRANCH";
		break;
	case EXACTLY:
		p = "EXACTLY";
		break;
	case NOTHING:
		p = "NOTHING";
		break;
	case BACK:
		p = "BACK";
		break;
	case END:
		p = "END";
		break;
	case OPEN+1:
	case OPEN+2:
	case OPEN+3:
	case OPEN+4:
	case OPEN+5:
	case OPEN+6:
	case OPEN+7:
	case OPEN+8:
	case OPEN+9:
		sprintf(buf+strlen(buf), "OPEN%d", OP(op)-OPEN);
		p = NULL;
		break;
	case CLOSE+1:
	case CLOSE+2:
	case CLOSE+3:
	case CLOSE+4:
	case CLOSE+5:
	case CLOSE+6:
	case CLOSE+7:
	case CLOSE+8:
	case CLOSE+9:
		sprintf(buf+strlen(buf), "CLOSE%d", OP(op)-CLOSE);
		p = NULL;
		break;
	case STAR:
		p = "STAR";
		break;
	case PLUS:
		p = "PLUS";
		break;
	default:
		if (OP(op) > OPEN && OP(op) < OPEN+NSUBEXP) {
		    sprintf(buf+strlen(buf), "OPEN%d", OP(op)-OPEN);
		    p = NULL;
		    break;
		} else if (OP(op) > CLOSE && OP(op) < CLOSE+NSUBEXP) {
		    sprintf(buf+strlen(buf), "CLOSE%d", OP(op)-CLOSE);
		    p = NULL;
		} else {
		    TclRegError("corrupted opcode");
		}
		break;
	}
	if (p != NULL)
		(void) strcat(buf, p);
	return(buf);
}
#endif

/*
 * The following is provided for those people who do not have strcspn() in
 * their C libraries.  They should get off their butts and do something
 * about it; at least one public-domain implementation of those (highly
 * useful) string routines has been published on Usenet.
 */
#ifdef STRCSPN
/*
 * strcspn - find length of initial segment of s1 consisting entirely
 * of characters not from s2
 */

static int
strcspn(s1, s2)
char *s1;
char *s2;
{
	register char *scan1;
	register char *scan2;
	register int count;

	count = 0;
	for (scan1 = s1; *scan1 != '\0'; scan1++) {
		for (scan2 = s2; *scan2 != '\0';)	/* ++ moved down. */
			if (*scan1 == *scan2++)
				return(count);
		count++;
	}
	return(count);
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * TclRegError --
 *
 *	This procedure is invoked by the regexp code when an error
 *	occurs.  It saves the error message so it can be seen by the
 *	code that called Spencer's code.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The value of "string" is saved in "errMsg".
 *
 *----------------------------------------------------------------------
 */

void
exp_TclRegError(string)
    char *string;			/* Error message. */
{
    errMsg = string;
}

char *
TclGetRegError()
{
    return errMsg;
}

/*
 * end of regexp definitions and code
 */

/*
 * following stolen from tcl8.0.4/generic/tclPosixStr.c
 */

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ErrnoMsg --
 *
 *	Return a human-readable message corresponding to a given
 *	errno value.
 *
 * Results:
 *	The return value is the standard POSIX error message for
 *	errno.  This procedure is used instead of strerror because
 *	strerror returns slightly different values on different
 *	machines (e.g. different capitalizations), which cause
 *	problems for things such as regression tests.  This procedure
 *	provides messages for most standard errors, then it calls
 *	strerror for things it doesn't understand.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static
char *
Tcl_ErrnoMsg(err)
    int err;			/* Error number (such as in errno variable). */
{
    switch (err) {
#ifdef E2BIG
	case E2BIG: return "argument list too long";
#endif
#ifdef EACCES
	case EACCES: return "permission denied";
#endif
#ifdef EADDRINUSE
	case EADDRINUSE: return "address already in use";
#endif
#ifdef EADDRNOTAVAIL
	case EADDRNOTAVAIL: return "can't assign requested address";
#endif
#ifdef EADV
	case EADV: return "advertise error";
#endif
#ifdef EAFNOSUPPORT
	case EAFNOSUPPORT: return "address family not supported by protocol family";
#endif
#ifdef EAGAIN
	case EAGAIN: return "resource temporarily unavailable";
#endif
#ifdef EALIGN
	case EALIGN: return "EALIGN";
#endif
#if defined(EALREADY) && (!defined(EBUSY) || (EALREADY != EBUSY ))
	case EALREADY: return "operation already in progress";
#endif
#ifdef EBADE
	case EBADE: return "bad exchange descriptor";
#endif
#ifdef EBADF
	case EBADF: return "bad file number";
#endif
#ifdef EBADFD
	case EBADFD: return "file descriptor in bad state";
#endif
#ifdef EBADMSG
	case EBADMSG: return "not a data message";
#endif
#ifdef EBADR
	case EBADR: return "bad request descriptor";
#endif
#ifdef EBADRPC
	case EBADRPC: return "RPC structure is bad";
#endif
#ifdef EBADRQC
	case EBADRQC: return "bad request code";
#endif
#ifdef EBADSLT
	case EBADSLT: return "invalid slot";
#endif
#ifdef EBFONT
	case EBFONT: return "bad font file format";
#endif
#ifdef EBUSY
	case EBUSY: return "file busy";
#endif
#ifdef ECHILD
	case ECHILD: return "no children";
#endif
#ifdef ECHRNG
	case ECHRNG: return "channel number out of range";
#endif
#ifdef ECOMM
	case ECOMM: return "communication error on send";
#endif
#ifdef ECONNABORTED
	case ECONNABORTED: return "software caused connection abort";
#endif
#ifdef ECONNREFUSED
	case ECONNREFUSED: return "connection refused";
#endif
#ifdef ECONNRESET
	case ECONNRESET: return "connection reset by peer";
#endif
#if defined(EDEADLK) && (!defined(EWOULDBLOCK) || (EDEADLK != EWOULDBLOCK))
	case EDEADLK: return "resource deadlock avoided";
#endif
#if defined(EDEADLOCK) && (!defined(EDEADLK) || (EDEADLOCK != EDEADLK))
	case EDEADLOCK: return "resource deadlock avoided";
#endif
#ifdef EDESTADDRREQ
	case EDESTADDRREQ: return "destination address required";
#endif
#ifdef EDIRTY
	case EDIRTY: return "mounting a dirty fs w/o force";
#endif
#ifdef EDOM
	case EDOM: return "math argument out of range";
#endif
#ifdef EDOTDOT
	case EDOTDOT: return "cross mount point";
#endif
#ifdef EDQUOT
	case EDQUOT: return "disk quota exceeded";
#endif
#ifdef EDUPPKG
	case EDUPPKG: return "duplicate package name";
#endif
#ifdef EEXIST
	case EEXIST: return "file already exists";
#endif
#ifdef EFAULT
	case EFAULT: return "bad address in system call argument";
#endif
#ifdef EFBIG
	case EFBIG: return "file too large";
#endif
#ifdef EHOSTDOWN
	case EHOSTDOWN: return "host is down";
#endif
#ifdef EHOSTUNREACH
	case EHOSTUNREACH: return "host is unreachable";
#endif
#if defined(EIDRM) && (!defined(EINPROGRESS) || (EIDRM != EINPROGRESS))
	case EIDRM: return "identifier removed";
#endif
#ifdef EINIT
	case EINIT: return "initialization error";
#endif
#ifdef EINPROGRESS
	case EINPROGRESS: return "operation now in progress";
#endif
#ifdef EINTR
	case EINTR: return "interrupted system call";
#endif
#ifdef EINVAL
	case EINVAL: return "invalid argument";
#endif
#ifdef EIO
	case EIO: return "I/O error";
#endif
#ifdef EISCONN
	case EISCONN: return "socket is already connected";
#endif
#ifdef EISDIR
	case EISDIR: return "illegal operation on a directory";
#endif
#ifdef EISNAME
	case EISNAM: return "is a name file";
#endif
#ifdef ELBIN
	case ELBIN: return "ELBIN";
#endif
#ifdef EL2HLT
	case EL2HLT: return "level 2 halted";
#endif
#ifdef EL2NSYNC
	case EL2NSYNC: return "level 2 not synchronized";
#endif
#ifdef EL3HLT
	case EL3HLT: return "level 3 halted";
#endif
#ifdef EL3RST
	case EL3RST: return "level 3 reset";
#endif
#ifdef ELIBACC
	case ELIBACC: return "can not access a needed shared library";
#endif
#ifdef ELIBBAD
	case ELIBBAD: return "accessing a corrupted shared library";
#endif
#ifdef ELIBEXEC
	case ELIBEXEC: return "can not exec a shared library directly";
#endif
#ifdef ELIBMAX
	case ELIBMAX: return
		"attempting to link in more shared libraries than system limit";
#endif
#ifdef ELIBSCN
	case ELIBSCN: return ".lib section in a.out corrupted";
#endif
#ifdef ELNRNG
	case ELNRNG: return "link number out of range";
#endif
#if defined(ELOOP) && (!defined(ENOENT) || (ELOOP != ENOENT))
	case ELOOP: return "too many levels of symbolic links";
#endif
#ifdef EMFILE
	case EMFILE: return "too many open files";
#endif
#ifdef EMLINK
	case EMLINK: return "too many links";
#endif
#ifdef EMSGSIZE
	case EMSGSIZE: return "message too long";
#endif
#ifdef EMULTIHOP
	case EMULTIHOP: return "multihop attempted";
#endif
#ifdef ENAMETOOLONG
	case ENAMETOOLONG: return "file name too long";
#endif
#ifdef ENAVAIL
	case ENAVAIL: return "not available";
#endif
#ifdef ENET
	case ENET: return "ENET";
#endif
#ifdef ENETDOWN
	case ENETDOWN: return "network is down";
#endif
#ifdef ENETRESET
	case ENETRESET: return "network dropped connection on reset";
#endif
#ifdef ENETUNREACH
	case ENETUNREACH: return "network is unreachable";
#endif
#ifdef ENFILE
	case ENFILE: return "file table overflow";
#endif
#ifdef ENOANO
	case ENOANO: return "anode table overflow";
#endif
#if defined(ENOBUFS) && (!defined(ENOSR) || (ENOBUFS != ENOSR))
	case ENOBUFS: return "no buffer space available";
#endif
#ifdef ENOCSI
	case ENOCSI: return "no CSI structure available";
#endif
#if defined(ENODATA) && (!defined(ECONNREFUSED) || (ENODATA != ECONNREFUSED))
	case ENODATA: return "no data available";
#endif
#ifdef ENODEV
	case ENODEV: return "no such device";
#endif
#ifdef ENOENT
	case ENOENT: return "no such file or directory";
#endif
#ifdef ENOEXEC
	case ENOEXEC: return "exec format error";
#endif
#ifdef ENOLCK
	case ENOLCK: return "no locks available";
#endif
#ifdef ENOLINK
	case ENOLINK: return "link has be severed";
#endif
#ifdef ENOMEM
	case ENOMEM: return "not enough memory";
#endif
#ifdef ENOMSG
	case ENOMSG: return "no message of desired type";
#endif
#ifdef ENONET
	case ENONET: return "machine is not on the network";
#endif
#ifdef ENOPKG
	case ENOPKG: return "package not installed";
#endif
#ifdef ENOPROTOOPT
	case ENOPROTOOPT: return "bad proocol option";
#endif
#ifdef ENOSPC
	case ENOSPC: return "no space left on device";
#endif
#if defined(ENOSR) && (!defined(ENAMETOOLONG) || (ENAMETOOLONG != ENOSR))
	case ENOSR: return "out of stream resources";
#endif
#if defined(ENOSTR) && (!defined(ENOTTY) || (ENOTTY != ENOSTR))
	case ENOSTR: return "not a stream device";
#endif
#ifdef ENOSYM
	case ENOSYM: return "unresolved symbol name";
#endif
#ifdef ENOSYS
	case ENOSYS: return "function not implemented";
#endif
#ifdef ENOTBLK
	case ENOTBLK: return "block device required";
#endif
#ifdef ENOTCONN
	case ENOTCONN: return "socket is not connected";
#endif
#ifdef ENOTDIR
	case ENOTDIR: return "not a directory";
#endif
#if defined(ENOTEMPTY) && (!defined(EEXIST) || (ENOTEMPTY != EEXIST))
	case ENOTEMPTY: return "directory not empty";
#endif
#ifdef ENOTNAM
	case ENOTNAM: return "not a name file";
#endif
#ifdef ENOTSOCK
	case ENOTSOCK: return "socket operation on non-socket";
#endif
#ifdef ENOTSUP
	case ENOTSUP: return "operation not supported";
#endif
#ifdef ENOTTY
	case ENOTTY: return "inappropriate device for ioctl";
#endif
#ifdef ENOTUNIQ
	case ENOTUNIQ: return "name not unique on network";
#endif
#ifdef ENXIO
	case ENXIO: return "no such device or address";
#endif
#if defined(EOPNOTSUPP) &&  (!defined(ENOTSUP) || (ENOTSUP != EOPNOTSUPP))
	case EOPNOTSUPP: return "operation not supported on socket";
#endif
#ifdef EPERM
	case EPERM: return "not owner";
#endif
#if defined(EPFNOSUPPORT) && (!defined(ENOLCK) || (ENOLCK != EPFNOSUPPORT))
	case EPFNOSUPPORT: return "protocol family not supported";
#endif
#ifdef EPIPE
	case EPIPE: return "broken pipe";
#endif
#ifdef EPROCLIM
	case EPROCLIM: return "too many processes";
#endif
#ifdef EPROCUNAVAIL
	case EPROCUNAVAIL: return "bad procedure for program";
#endif
#ifdef EPROGMISMATCH
	case EPROGMISMATCH: return "program version wrong";
#endif
#ifdef EPROGUNAVAIL
	case EPROGUNAVAIL: return "RPC program not available";
#endif
#ifdef EPROTO
	case EPROTO: return "protocol error";
#endif
#ifdef EPROTONOSUPPORT
	case EPROTONOSUPPORT: return "protocol not suppored";
#endif
#ifdef EPROTOTYPE
	case EPROTOTYPE: return "protocol wrong type for socket";
#endif
#ifdef ERANGE
	case ERANGE: return "math result unrepresentable";
#endif
#if defined(EREFUSED) && (!defined(ECONNREFUSED) || (EREFUSED != ECONNREFUSED))
	case EREFUSED: return "EREFUSED";
#endif
#ifdef EREMCHG
	case EREMCHG: return "remote address changed";
#endif
#ifdef EREMDEV
	case EREMDEV: return "remote device";
#endif
#ifdef EREMOTE
	case EREMOTE: return "pathname hit remote file system";
#endif
#ifdef EREMOTEIO
	case EREMOTEIO: return "remote i/o error";
#endif
#ifdef EREMOTERELEASE
	case EREMOTERELEASE: return "EREMOTERELEASE";
#endif
#ifdef EROFS
	case EROFS: return "read-only file system";
#endif
#ifdef ERPCMISMATCH
	case ERPCMISMATCH: return "RPC version is wrong";
#endif
#ifdef ERREMOTE
	case ERREMOTE: return "object is remote";
#endif
#ifdef ESHUTDOWN
	case ESHUTDOWN: return "can't send afer socket shutdown";
#endif
#ifdef ESOCKTNOSUPPORT
	case ESOCKTNOSUPPORT: return "socket type not supported";
#endif
#ifdef ESPIPE
	case ESPIPE: return "invalid seek";
#endif
#ifdef ESRCH
	case ESRCH: return "no such process";
#endif
#ifdef ESRMNT
	case ESRMNT: return "srmount error";
#endif
#ifdef ESTALE
	case ESTALE: return "stale remote file handle";
#endif
#ifdef ESUCCESS
	case ESUCCESS: return "Error 0";
#endif
#if defined(ETIME) && (!defined(ELOOP) || (ETIME != ELOOP))
	case ETIME: return "timer expired";
#endif
#if defined(ETIMEDOUT) && (!defined(ENOSTR) || (ETIMEDOUT != ENOSTR))
	case ETIMEDOUT: return "connection timed out";
#endif
#ifdef ETOOMANYREFS
	case ETOOMANYREFS: return "too many references: can't splice";
#endif
#ifdef ETXTBSY
	case ETXTBSY: return "text file or pseudo-device busy";
#endif
#ifdef EUCLEAN
	case EUCLEAN: return "structure needs cleaning";
#endif
#ifdef EUNATCH
	case EUNATCH: return "protocol driver not attached";
#endif
#ifdef EUSERS
	case EUSERS: return "too many users";
#endif
#ifdef EVERSION
	case EVERSION: return "version mismatch";
#endif
#if defined(EWOULDBLOCK) && (!defined(EAGAIN) || (EWOULDBLOCK != EAGAIN))
	case EWOULDBLOCK: return "operation would block";
#endif
#ifdef EXDEV
	case EXDEV: return "cross-domain link";
#endif
#ifdef EXFULL
	case EXFULL: return "message tables full";
#endif
	default:
#ifdef NO_STRERROR
	    return "unknown POSIX error";
#else
	    return strerror(errno);
#endif
    }
}

/*
 * end of excerpt from tcl8.0.X/generic/tclPosixStr.c
 */

/*
 * stolen from exp_log.c - this function is called from the Expect library
 * but the one that the library supplies calls Tcl functions.  So we supply
 * our own.
 */

static
void
expDiagLogU(str)
     char *str;
{
  if (exp_is_debugging) {
    fprintf(stderr,str);
    if (exp_logfile) fprintf(exp_logfile,str);
  }
}

/*
 * expect-specific definitions and code
 */

#include "expect.h"
#include "exp_int.h"

/* exp_glob.c - expect functions for doing glob
 *
 * Based on Tcl's glob functions but modified to support anchors and to
 * return information about the possibility of future matches
 *
 * Modifications by: Don Libes, NIST, 2/6/90
 */

/* The following functions implement expect's glob-style string
 * matching Exp_StringMatch allow's implements the unanchored front
 * (or conversely the '^') feature.  Exp_StringMatch2 does the rest of
 * the work.
 */

/* Exp_StringMatch2 --
 *
 * Like Tcl_StringMatch except that
 * 1) returns number of characters matched, -1 if failed.
 *	(Can return 0 on patterns like "" or "$")
 * 2) does not require pattern to match to end of string
 * 3) much of code is stolen from Tcl_StringMatch
 * 4) front-anchor is assumed (Tcl_StringMatch retries for non-front-anchor)
 */
static
int
Exp_StringMatch2(string,pattern)
    register char *string;	/* String. */
    register char *pattern;	/* Pattern, which may contain
				 * special characters. */
{
    char c2;
    int match = 0;	/* # of chars matched */

    while (1) {
	/* If at end of pattern, success! */
	if (*pattern == 0) {
		return match;
	}

	/* If last pattern character is '$', verify that entire
	 * string has been matched.
	 */
	if ((*pattern == '$') && (pattern[1] == 0)) {
		if (*string == 0) return(match);
		else return(-1);		
	}

	/* Check for a "*" as the next pattern character.  It matches
	 * any substring.  We handle this by calling ourselves
	 * recursively for each postfix of string, until either we
	 * match or we reach the end of the string.
	 */
	
	if (*pattern == '*') {
	    int head_len;
	    char *tail;
	    pattern += 1;
	    if (*pattern == 0) {
		return(strlen(string)+match); /* DEL */
	    }
	    /* find longest match - switched to this on 12/31/93 */
	    head_len = strlen(string);	/* length before tail */
	    tail = string + head_len;
	    while (head_len >= 0) {
		int rc;

		if (-1 != (rc = Exp_StringMatch2(tail, pattern))) {
		    return rc + match + head_len;	/* DEL */
		}
		tail--;
		head_len--;
	    }
	    return -1;					/* DEL */
	}
    
	/*
	 * after this point, all patterns must match at least one
	 * character, so check this
	 */

	if (*string == 0) return -1;

	/* Check for a "?" as the next pattern character.  It matches
	 * any single character.
	 */

	if (*pattern == '?') {
	    goto thisCharOK;
	}

	/* Check for a "[" as the next pattern character.  It is followed
	 * by a list of characters that are acceptable, or by a range
	 * (two characters separated by "-").
	 */
	
	if (*pattern == '[') {
	    pattern += 1;
	    while (1) {
		if ((*pattern == ']') || (*pattern == 0)) {
		    return -1;			/* was 0; DEL */
		}
		if (*pattern == *string) {
		    break;
		}
		if (pattern[1] == '-') {
		    c2 = pattern[2];
		    if (c2 == 0) {
			return -1;		/* DEL */
		    }
		    if ((*pattern <= *string) && (c2 >= *string)) {
			break;
		    }
		    if ((*pattern >= *string) && (c2 <= *string)) {
			break;
		    }
		    pattern += 2;
		}
		pattern += 1;
	    }

	    while (*pattern != ']') {
		if (*pattern == 0) {
		    pattern--;
		    break;
	        }
		pattern += 1;
	    }
	    goto thisCharOK;
	}
    
	/* If the next pattern character is backslash, strip it off
	 * so we do exact matching on the character that follows.
	 */
	
	if (*pattern == '\\') {
	    pattern += 1;
	    if (*pattern == 0) {
		return -1;
	    }
	}

	/* There's no special character.  Just make sure that the next
	 * characters of each string match.
	 */
	
	if (*pattern != *string) {
	    return -1;
	}

	thisCharOK: pattern += 1;
	string += 1;
	match++;
    }
}


static
int	/* returns # of chars that matched */
Exp_StringMatch(string, pattern,offset)
char *string;
char *pattern;
int *offset;	/* offset from beginning of string where pattern matches */
{
	char *s;
	int sm;	/* count of chars matched or -1 */
	int caret = FALSE;
	int star = FALSE;

	*offset = 0;

	if (pattern[0] == '^') {
		caret = TRUE;
		pattern++;
	} else if (pattern[0] == '*') {
		star = TRUE;
	}

	/*
	 * test if pattern matches in initial position.
	 * This handles front-anchor and 1st iteration of non-front-anchor.
	 * Note that 1st iteration must be tried even if string is empty.
	 */

	sm = Exp_StringMatch2(string,pattern);
	if (sm >= 0) return(sm);

	if (caret) return -1;
	if (star) return -1;

	if (*string == '\0') return -1;

	for (s = string+1;*s;s++) {
 		sm = Exp_StringMatch2(s,pattern);
		if (sm != -1) {
			*offset = s-string;
			return(sm);
		}
	}
	return -1;
}


#define EXP_MATCH_MAX	2000
/* public */
char *exp_buffer = 0;
char *exp_buffer_end = 0;
char *exp_match = 0;
char *exp_match_end = 0;
int exp_match_max = EXP_MATCH_MAX;	/* bytes */
int exp_full_buffer = FALSE;		/* don't return on full buffer */
int exp_remove_nulls = TRUE;
int exp_timeout = 10;			/* seconds */
int exp_pty_timeout = 5;		/* seconds - see CRAY below */
int exp_autoallocpty = TRUE;		/* if TRUE, we do allocation */
int exp_pty[2];				/* master is [0], slave is [1] */
int exp_pid;
char *exp_stty_init = 0;		/* initial stty args */
int exp_ttycopy = TRUE;			/* copy tty parms from /dev/tty */
int exp_ttyinit = TRUE;			/* set tty parms to sane state */
int exp_console = FALSE;		/* redirect console */
void (*exp_child_exec_prelude)() = 0;
void (*exp_close_in_child)() = 0;

#ifdef HAVE_SIGLONGJMP
sigjmp_buf exp_readenv;		/* for interruptable read() */
#else
jmp_buf exp_readenv;		/* for interruptable read() */
#endif /* HAVE_SIGLONGJMP */

int exp_reading = FALSE;	/* whether we can longjmp or not */

int exp_is_debugging = FALSE;
FILE *exp_debugfile = 0;

FILE *exp_logfile = 0;
int exp_logfile_all = FALSE;	/* if TRUE, write log of all interactions */
int exp_loguser = TRUE;		/* if TRUE, user sees interactions on stdout */


char *exp_printify();
int exp_getptymaster();
int exp_getptyslave();

#define sysreturn(x)	return(errno = x, -1)

void exp_init_pty();

/*
   The following functions are linked from the Tcl library.  They
   don't cause anything else in the library to be dragged in, so it
   shouldn't cause any problems (e.g., bloat).

   The functions are relatively small but painful enough that I don't care
   to recode them.  You may, if you absolutely want to get rid of any
   vestiges of Tcl.
*/

static unsigned int bufsiz = 2*EXP_MATCH_MAX;

static struct f {
	int valid;

	char *buffer;		/* buffer of matchable chars */
	char *buffer_end;	/* one beyond end of matchable chars */
	char *match_end;	/* one beyond end of matched string */
	int msize;		/* size of allocate space */
				/* actual size is one larger for null */
} *fs = 0;

static int fd_alloc_max = -1;	/* max fd allocated */

/* translate fd or fp to fd */
static struct f *
fdfp2f(fd,fp)
int fd;
FILE *fp;
{
	if (fd == -1) return(fs + fileno(fp));
	else return(fs + fd);
}

static struct f *
fd_new(fd)
int fd;
{
	int i, low;
	struct f *fp;
	struct f *newfs;	/* temporary, so we don't lose old fs */

	if (fd > fd_alloc_max) {
		if (!fs) {	/* no fd's yet allocated */
			newfs = (struct f *)malloc(sizeof(struct f)*(fd+1));
			low = 0;
		} else {		/* enlarge fd table */
			newfs = (struct f *)realloc((char *)fs,sizeof(struct f)*(fd+1));
			low = fd_alloc_max+1;
		}
		fs = newfs;
		fd_alloc_max = fd;
		for (i = low; i <= fd_alloc_max; i++) { /* init new entries */
			fs[i].valid = FALSE;
		}
	}

	fp = fs+fd;

	if (!fp->valid) {
		/* initialize */
		fp->buffer = malloc((unsigned)(bufsiz+1));
		if (!fp->buffer) return 0;
		fp->msize = bufsiz;
		fp->valid = TRUE;
	}
	fp->buffer_end = fp->buffer;
	fp->match_end = fp->buffer;
	return fp;

}

static
void
exp_setpgrp()
{
#ifdef MIPS_BSD
    /* required on BSD side of MIPS OS <[email protected]> */
#   include <sysv/sys.s>
    syscall(SYS_setpgrp);
#endif

#ifdef SETPGRP_VOID
    (void) setpgrp();
#else
    (void) setpgrp(0,0);
#endif
}

/* returns fd of master side of pty */
int
exp_spawnv(file,argv)
char *file;
char *argv[];	/* some compiler complains about **argv? */
{
	int cc;
	int errorfd;	/* place to stash fileno(stderr) in child */
			/* while we're setting up new stderr */
	int ttyfd;
	int sync_fds[2];
	int sync2_fds[2];
	int status_pipe[2];
	int child_errno;
	char sync_byte;
#ifdef PTYTRAP_DIES
	int slave_write_ioctls = 1;
		/* by default, slave will be write-ioctled this many times */
#endif

	static int first_time = TRUE;

	if (first_time) {
		first_time = FALSE;
		exp_init_pty();
		exp_init_tty();
		expDiagLogPtrSet(expDiagLogU);
		expErrnoMsgSet(Tcl_ErrnoMsg);
	}

	if (!file || !argv) sysreturn(EINVAL);
	if (!argv[0] || strcmp(file,argv[0])) {
		exp_debuglog("expect: warning: file (%s) != argv[0] (%s)\n",
			file,
			argv[0]?argv[0]:"");
	}

#ifdef PTYTRAP_DIES
/* any extraneous ioctl's that occur in slave must be accounted for
when trapping, see below in child half of fork */
#if defined(TIOCSCTTY) && !defined(CIBAUD) && !defined(sun) && !defined(hp9000s300)
	slave_write_ioctls++;
#endif
#endif /*PTYTRAP_DIES*/

	if (exp_autoallocpty) {
		if (0 > (exp_pty[0] = exp_getptymaster())) sysreturn(ENODEV);
	}
	fcntl(exp_pty[0],F_SETFD,1);	/* close on exec */
#ifdef PTYTRAP_DIES
	exp_slave_control(exp_pty[0],1);*/
#endif

	if (!fd_new(exp_pty[0])) {
		errno = ENOMEM;
		return -1;
	}

	if (-1 == (pipe(sync_fds))) {
		return -1;
	}
	if (-1 == (pipe(sync2_fds))) {
		close(sync_fds[0]);
		close(sync_fds[1]);
		return -1;
	}

	if (-1 == pipe(status_pipe)) {
		close(sync_fds[0]);
		close(sync_fds[1]);
		close(sync2_fds[0]);
		close(sync2_fds[1]);
		return -1;
	}

	if ((exp_pid = fork()) == -1) return(-1);
	if (exp_pid) {
		/* parent */
		close(sync_fds[1]);
		close(sync2_fds[0]);
		close(status_pipe[1]);

		if (!exp_autoallocpty) close(exp_pty[1]);

#ifdef PTYTRAP_DIES
#ifdef HAVE_PTYTRAP
		if (exp_autoallocpty) {
			/* trap initial ioctls in a feeble attempt to not */
			/* block the initially.  If the process itself */
			/* ioctls /dev/tty, such blocks will be trapped */
			/* later during normal event processing */

			while (slave_write_ioctls) {
				int cc;

				cc = exp_wait_for_slave_open(exp_pty[0]);
#if defined(TIOCSCTTY) && !defined(CIBAUD) && !defined(sun) && !defined(hp9000s300)
				if (cc == TIOCSCTTY) slave_write_ioctls = 0;
#endif
				if (cc & IOC_IN) slave_write_ioctls--;
				else if (cc == -1) {
					printf("failed to trap slave pty");
					return -1;
				}
			}
		}
#endif
#endif /*PTYTRAP_DIES*/

		/*
		 * wait for slave to initialize pty before allowing
		 * user to send to it
		 */ 

		exp_debuglog("parent: waiting for sync byte\r\n");
		cc = read(sync_fds[0],&sync_byte,1);
		if (cc == -1) {
		  exp_errorlog("parent sync byte read: %s\r\n",Tcl_ErrnoMsg(errno));
		  return -1;
		}

		/* turn on detection of eof */
		exp_slave_control(exp_pty[0],1);

		/*
		 * tell slave to go on now now that we have initialized pty
		 */

		exp_debuglog("parent: telling child to go ahead\r\n");
		cc = write(sync2_fds[1]," ",1);
		if (cc == -1) {
		  exp_errorlog("parent sync byte write: %s\r\n",Tcl_ErrnoMsg(errno));
		  return -1;
		}

		exp_debuglog("parent: now unsynchronized from child\r\n");

		close(sync_fds[0]);
		close(sync2_fds[1]);

		/* see if child's exec worked */

	retry:
		switch (read(status_pipe[0],&child_errno,sizeof child_errno)) {
		case -1:
			if (errno == EINTR) goto retry;
			/* well it's not really the child's errno */
			/* but it can be treated that way */
			child_errno = errno;
			break;
		case 0:
			/* child's exec succeeded */
			child_errno = 0;
			break;
		default:
			/* child's exec failed; err contains exec's errno  */
			waitpid(exp_pid, NULL, 0);
			errno = child_errno;
			exp_pty[0] = -1;
		}
		close(status_pipe[0]);
		return(exp_pty[0]);
	}

	/*
	 * child process - do not return from here!  all errors must exit()
	 */

	close(sync_fds[0]);
	close(sync2_fds[1]);
	close(status_pipe[0]);
	fcntl(status_pipe[1],F_SETFD,1);	/* close on exec */

#ifdef CRAY
	(void) close(exp_pty[0]);
#endif

/* ultrix (at least 4.1-2) fails to obtain controlling tty if setsid */
/* is called.  setpgrp works though.  */
#if defined(POSIX) && !defined(ultrix)
#define DO_SETSID
#endif
#ifdef __convex__
#define DO_SETSID
#endif

#ifdef DO_SETSID
	setsid();
#else
#ifdef SYSV3
#ifndef CRAY
	exp_setpgrp();
#endif /* CRAY */
#else /* !SYSV3 */
	exp_setpgrp();

#ifdef TIOCNOTTY
	ttyfd = open("/dev/tty", O_RDWR);
	if (ttyfd >= 0) {
		(void) ioctl(ttyfd, TIOCNOTTY, (char *)0);
		(void) close(ttyfd);
	}
#endif /* TIOCNOTTY */

#endif /* SYSV3 */
#endif /* DO_SETSID */

	/* save error fd while we're setting up new one */
	errorfd = fcntl(2,F_DUPFD,3);
	/* and here is the macro to restore it */
#define restore_error_fd {close(2);fcntl(errorfd,F_DUPFD,2);}

	if (exp_autoallocpty) {

	    close(0);
	    close(1);
	    close(2);

	    /* since we closed fd 0, open of pty slave must return fd 0 */

	    if (0 > (exp_pty[1] = exp_getptyslave(exp_ttycopy,exp_ttyinit,
						exp_stty_init))) {
		restore_error_fd
		fprintf(stderr,"open(slave pty): %s\n",Tcl_ErrnoMsg(errno));
		exit(-1);
	    }
	    /* sanity check */
	    if (exp_pty[1] != 0) {
		restore_error_fd
		fprintf(stderr,"exp_getptyslave: slave = %d but expected 0\n",
								exp_pty[1]);
		exit(-1);
	    }
	} else {
		if (exp_pty[1] != 0) {
			close(0);	fcntl(exp_pty[1],F_DUPFD,0);
		}
		close(1);		fcntl(0,F_DUPFD,1);
		close(2);		fcntl(0,F_DUPFD,1);
		close(exp_pty[1]);
	}



/* The test for hpux may have to be more specific.  In particular, the */
/* code should be skipped on the hp9000s300 and hp9000s720 (but there */
/* is no documented define for the 720!) */

#if defined(TIOCSCTTY) && !defined(sun) && !defined(hpux)
	/* 4.3+BSD way to acquire controlling terminal */
	/* according to Stevens - Adv. Prog..., p 642 */
#ifdef __QNX__ /* posix in general */
	if (tcsetct(0, getpid()) == -1) {
	  restore_error_fd
	  expErrorLog("failed to get controlling terminal using TIOCSCTTY");
	  exit(-1);
	}
#else
	(void) ioctl(0,TIOCSCTTY,(char *)0);
	/* ignore return value - on some systems, it is defined but it
	 * fails and it doesn't seem to cause any problems.  Or maybe
	 * it works but returns a bogus code.  Noone seems to be able
	 * to explain this to me.  The systems are an assortment of
	 * different linux systems (and FreeBSD 2.5), RedHat 5.2 and
	 * Debian 2.0
	 */
#endif
#endif

#ifdef CRAY
 	(void) setsid();
 	(void) ioctl(0,TCSETCTTY,0);
 	(void) close(0);
 	if (open("/dev/tty", O_RDWR) < 0) {
		restore_error_fd
 		fprintf(stderr,"open(/dev/tty): %s\r\n",Tcl_ErrnoMsg(errno));
 		exit(-1);
 	}
 	(void) close(1);
 	(void) close(2);
 	(void) dup(0);
 	(void) dup(0);
	setptyutmp();	/* create a utmp entry */

	/* _CRAY2 code from Hal Peterson <[email protected]>, Cray Research, Inc. */
#ifdef _CRAY2
	/*
	 * Interpose a process between expect and the spawned child to
	 * keep the slave side of the pty open to allow time for expect
	 * to read the last output.  This is a workaround for an apparent
	 * bug in the Unicos pty driver on Cray-2's under Unicos 6.0 (at
	 * least).
	 */
	if ((pid = fork()) == -1) {
		restore_error_fd
		fprintf(stderr,"second fork: %s\r\n",Tcl_ErrnoMsg(errno));
		exit(-1);
	}

	if (pid) {
 		/* Intermediate process. */
		int status;
		int timeout;
		char *t;

		/* How long should we wait? */
		timeout = exp_pty_timeout;

		/* Let the spawned process run to completion. */
 		while (wait(&status) < 0 && errno == EINTR)
			/* empty body */;

		/* Wait for the pty to clear. */
		sleep(timeout);

		/* Duplicate the spawned process's status. */
		if (WIFSIGNALED(status))
			kill(getpid(), WTERMSIG(status));

		/* The kill may not have worked, but this will. */
 		exit(WEXITSTATUS(status));
	}
#endif /* _CRAY2 */
#endif /* CRAY */

	if (exp_console) {
#ifdef SRIOCSREDIR
		int fd;

		if ((fd = open("/dev/console", O_RDONLY)) == -1) {
			restore_error_fd
			fprintf(stderr, "spawn %s: cannot open console, check permissions of /dev/console\n",argv[0]);
			exit(-1);
		}
		if (ioctl(fd, SRIOCSREDIR, 0) == -1) {
			restore_error_fd
			fprintf(stderr, "spawn %s: cannot redirect console, check permissions of /dev/console\n",argv[0]);
		}
		close(fd);
#endif

#ifdef TIOCCONS
		int on = 1;
		if (ioctl(0,TIOCCONS,(char *)&on) == -1) {
			restore_error_fd
			fprintf(stderr, "spawn %s: cannot open console, check permissions of /dev/console\n",argv[0]);
			exit(-1);
		}
#endif /* TIOCCONS */
	}

	/* tell parent that we are done setting up pty */
	/* The actual char sent back is irrelevant. */

	/* exp_debuglog("child: telling parent that pty is initialized\r\n");*/
	cc = write(sync_fds[1]," ",1);
	if (cc == -1) {
		restore_error_fd
		fprintf(stderr,"child: sync byte write: %s\r\n",Tcl_ErrnoMsg(errno));
		exit(-1);
	}
	close(sync_fds[1]);

	/* wait for master to let us go on */
	cc = read(sync2_fds[0],&sync_byte,1);
	if (cc == -1) {
		restore_error_fd
		exp_errorlog("child: sync byte read: %s\r\n",Tcl_ErrnoMsg(errno));
		exit(-1);
	}
	close(sync2_fds[0]);

	/* exp_debuglog("child: now unsynchronized from parent\r\n"); */

	/* (possibly multiple) masters are closed automatically due to */
	/* earlier fcntl(,,CLOSE_ON_EXEC); */

	/* just in case, allow user to explicitly close other files */
	if (exp_close_in_child) (*exp_close_in_child)();

	/* allow user to do anything else to child */
	if (exp_child_exec_prelude) (*exp_child_exec_prelude)();

        (void) execvp(file,argv);

	/* Unfortunately, by now we've closed fd's to stderr, logfile
	 * and debugfile.  The only reasonable thing to do is to send
	 * *back the error as part of the program output.  This will
	 * be *picked up in an expect or interact command.
	 */

	write(status_pipe[1], &errno, sizeof errno);
	exit(-1);
	/*NOTREACHED*/
}

/* returns fd of master side of pty */
/*VARARGS*/
int
exp_spawnl TCL_VARARGS_DEF(char *,arg1)
/*exp_spawnl(va_alist)*/
/*va_dcl*/
{
	va_list args; /* problematic line here */
	int i;
	char *arg, **argv;

	arg = TCL_VARARGS_START(char *,arg1,args);
	/*va_start(args);*/
	for (i=1;;i++) {
		arg = va_arg(args,char *);
		if (!arg) break;
	}
	va_end(args);
	if (i == 0) sysreturn(EINVAL);
	if (!(argv = (char **)malloc((i+1)*sizeof(char *)))) sysreturn(ENOMEM);
	argv[0] = TCL_VARARGS_START(char *,arg1,args);
	/*va_start(args);*/
	for (i=1;;i++) {
		argv[i] = va_arg(args,char *);
		if (!argv[i]) break;
	}
	i = exp_spawnv(argv[0],argv+1);
	free((char *)argv);
	return(i);
}

/* allow user-provided fd to be passed to expect funcs */
int
exp_spawnfd(fd)
int fd;
{
	if (!fd_new(fd)) {
		errno = ENOMEM;
		return -1;
	}
	return fd;	
}

/* remove nulls from s.  Initially, the number of chars in s is c, */
/* not strlen(s).  This count does not include the trailing null. */
/* returns number of nulls removed. */
static int
rm_nulls(s,c)
char *s;
int c;
{
	char *s2 = s;	/* points to place in original string to put */
			/* next non-null character */
	int count = 0;
	int i;

	for (i=0;i<c;i++,s++) {
		if (0 == *s) {
			count++;
			continue;
		}
		if (count) *s2 = *s;
		s2++;
	}
	return(count);
}

static int i_read_errno;/* place to save errno, if i_read() == -1, so it
			   doesn't get overwritten before we get to read it */

/*ARGSUSED*/
static void
sigalarm_handler(n)
int n;			/* signal number, unused by us */
{
#ifdef REARM_SIG
	signal(SIGALRM,sigalarm_handler);
#endif

#ifdef HAVE_SIGLONGJMP
	siglongjmp(exp_readenv,1);
#else
	longjmp(exp_readenv,1);
#endif /* HAVE_SIGLONGJMP */
}

/* interruptable read */
static int
i_read(fd,fp,buffer,length,timeout)
int fd;
FILE *fp;
char *buffer;
int length;
int timeout;
{
	int cc = -2;

	/* since setjmp insists on returning 1 upon longjmp(,0), */
	/* longjmp(,2 (EXP_RESTART)) instead. */

	/* no need to set alarm if -1 (infinite) or 0 (poll with */
	/* guaranteed data) */

	if (timeout > 0) alarm(timeout);

	/* restart read if setjmp returns 0 (first time) or 2 (EXP_RESTART). */
	/* abort if setjmp returns 1 (EXP_ABORT). */
#ifdef HAVE_SIGLONGJMP
        if (EXP_ABORT != sigsetjmp(exp_readenv,1)) {
#else
	if (EXP_ABORT != setjmp(exp_readenv)) {
#endif /* HAVE_SIGLONGJMP */
		exp_reading = TRUE;
		if (fd == -1) {
			int c;
			c = getc(fp);
			if (c == EOF) {
/*fprintf(stderr,"<<EOF>>",c);fflush(stderr);*/
				if (feof(fp)) cc = 0;
				else cc = -1;
			} else {
/*fprintf(stderr,"<<%c>>",c);fflush(stderr);*/
				buffer[0] = c;
				cc = 1;
			}
		} else {
#ifndef HAVE_PTYTRAP
			cc = read(fd,buffer,length);
#else
#  include <sys/ptyio.h>

			fd_set rdrs;
			fd_set excep;

		restart:
			FD_ZERO(&rdrs);
			FD_ZERO(&excep);
			FD_SET(fd,&rdrs);
			FD_SET(fd,&excep);
			if (-1 == (cc = select(fd+1,
					 (SELECT_MASK_TYPE *)&rdrs,
					 (SELECT_MASK_TYPE *)0,
					 (SELECT_MASK_TYPE *)&excep,
					 (struct timeval *)0))) {
				/* window refreshes trigger EINTR, ignore */
				if (errno == EINTR) goto restart;
			}
			if (FD_ISSET(fd,&rdrs)) {
				cc = read(fd,buffer,length);
			} else if (FD_ISSET(fd,&excep)) {
				struct request_info ioctl_info;
				ioctl(fd,TIOCREQCHECK,&ioctl_info);
				if (ioctl_info.request == TIOCCLOSE) {
					cc = 0; /* indicate eof */
				} else {
					ioctl(fd, TIOCREQSET, &ioctl_info);
					/* presumably, we trapped an open here */
					goto restart;
				}
			}
#endif /* HAVE_PTYTRAP */
		}
#if 0
		/* can't get fread to return early! */
		else {
			if (!(cc = fread(buffer,1,length,fp))) {
				if (ferror(fp)) cc = -1;
			}
		}
#endif
		i_read_errno = errno;	/* errno can be overwritten by the */
					/* time we return */
	}
	exp_reading = FALSE;

	if (timeout > 0) alarm(0);
	return(cc);
}

/* I tried really hard to make the following two functions share the code */
/* that makes the ecase array, but I kept running into a brick wall when */
/* passing var args into the funcs and then again into a make_cases func */
/* I would very much appreciate it if someone showed me how to do it right */

/* takes triplets of args, with a final "exp_last" arg */
/* triplets are type, pattern, and then int to return */
/* returns negative value if error (or EOF/timeout) occurs */
/* some negative values can also have an associated errno */

/* the key internal variables that this function depends on are:
	exp_buffer
	exp_buffer_end
	exp_match_end
*/
static int
expectv(fd,fp,ecases)
int fd;
FILE *fp;
struct exp_case *ecases;
{
	int cc = 0;		/* number of chars returned in a single read */
	int buf_length;		/* numbers of chars in exp_buffer */
	int old_length;		/* old buf_length */
	int first_time = TRUE;	/* force old buffer to be tested before */
				/* additional reads */
	int polled = 0;		/* true if poll has caused read() to occur */

	struct exp_case *ec;	/* points to current ecase */

	time_t current_time;	/* current time (when we last looked)*/
	time_t end_time;	/* future time at which to give up */
	int remtime;		/* remaining time in timeout */

	struct f *f;
	int return_val;
	int sys_error = 0;
#define return_normally(x)	{return_val = x; goto cleanup;}
#define return_errno(x)	{sys_error = x; goto cleanup;}

	f = fdfp2f(fd,fp);
	if (!f) return_errno(ENOMEM);

	exp_buffer = f->buffer;
	exp_buffer_end = f->buffer_end;
	exp_match_end = f->match_end;

	buf_length = exp_buffer_end - exp_match_end;
	if (buf_length) {
		/*
		 * take end of previous match to end of buffer
		 * and copy to beginning of buffer
		 */
		memmove(exp_buffer,exp_match_end,buf_length);
	}			
	exp_buffer_end = exp_buffer + buf_length;
	*exp_buffer_end = '\0';

	if (!ecases) return_errno(EINVAL);

	/* compile if necessary */
	for (ec=ecases;ec->type != exp_end;ec++) {
		if ((ec->type == exp_regexp) && !ec->re) {
			TclRegError((char *)0);
			if (!(ec->re = TclRegComp(ec->pattern))) {
				fprintf(stderr,"regular expression %s is bad: %s",ec->pattern,TclGetRegError());
				return_errno(EINVAL);
			  }
		  }
	}

	/* get the latest buffer size.  Double the user input for two */
	/* reasons.  1) Need twice the space in case the match */
	/* straddles two bufferfuls, 2) easier to hack the division by */
	/* two when shifting the buffers later on */

	bufsiz = 2*exp_match_max;
	if (f->msize != bufsiz) {
		/* if truncated, forget about some data */
		if (buf_length > bufsiz) {
			/* copy end of buffer down */

			/* copy one less than what buffer can hold to avoid */
			/* triggering buffer-full handling code below */
			/* which will immediately dump the first half */
			/* of the buffer */
			memmove(exp_buffer,exp_buffer+(buf_length - bufsiz)+1,
				bufsiz-1);
			buf_length = bufsiz-1;
		}
		exp_buffer = realloc(exp_buffer,bufsiz+1);
		if (!exp_buffer) return_errno(ENOMEM);
		exp_buffer[buf_length] = '\0';
		exp_buffer_end = exp_buffer + buf_length;
		f->msize = bufsiz;
	}

	/* some systems (i.e., Solaris) require fp be flushed when switching */
	/* directions - do this again afterwards */
	if (fd == -1) fflush(fp);

	if (exp_timeout != -1) signal(SIGALRM,sigalarm_handler);

	/* remtime and current_time updated at bottom of loop */
	remtime = exp_timeout;

	time(&current_time);
	end_time = current_time + remtime;

	for (;;) {
		/* when buffer fills, copy second half over first and */
		/* continue, so we can do matches over multiple buffers */
		if (buf_length == bufsiz) {
			int first_half, second_half;

			if (exp_full_buffer) {
				exp_debuglog("expect: full buffer\r\n");
				exp_match = exp_buffer;
				exp_match_end = exp_buffer + buf_length;
				exp_buffer_end = exp_match_end;
				return_normally(EXP_FULLBUFFER);
			}
			first_half = bufsiz/2;
			second_half = bufsiz - first_half;

			memcpy(exp_buffer,exp_buffer+first_half,second_half);
			buf_length = second_half;
			exp_buffer_end = exp_buffer + second_half;
		}

		/*
		 * always check first if pattern is already in buffer
		 */
		if (first_time) {
			first_time = FALSE;
			goto after_read;
		}

		/*
		 * check for timeout
		 */
		if ((exp_timeout >= 0) && ((remtime < 0) || polled)) {
			exp_debuglog("expect: timeout\r\n");
			exp_match_end = exp_buffer;
			return_normally(EXP_TIMEOUT);
		}

		/*
		 * if timeout == 0, indicate a poll has
		 * occurred so that next time through loop causes timeout
		 */
		if (exp_timeout == 0) {
			polled = 1;
		}

		cc = i_read(fd,fp,
				exp_buffer_end,
				bufsiz - buf_length,
				remtime);

		if (cc == 0) {
			exp_debuglog("expect: eof\r\n");
			return_normally(EXP_EOF);	/* normal EOF */
		} else if (cc == -1) {			/* abnormal EOF */
			/* ptys produce EIO upon EOF - sigh */
			if (i_read_errno == EIO) {
				/* convert to EOF indication */
				exp_debuglog("expect: eof\r\n");
				return_normally(EXP_EOF);
			}
			exp_debuglog("expect: error (errno = %d)\r\n",i_read_errno);
			return_errno(i_read_errno);
		} else if (cc == -2) {
			exp_debuglog("expect: timeout\r\n");
			exp_match_end = exp_buffer;
			return_normally(EXP_TIMEOUT);
		}

		old_length = buf_length;
		buf_length += cc;
		exp_buffer_end += buf_length;

		if (exp_logfile_all || (exp_loguser && exp_logfile)) {
			fwrite(exp_buffer + old_length,1,cc,exp_logfile);
		}
		if (exp_loguser) fwrite(exp_buffer + old_length,1,cc,stdout);
		if (exp_debugfile) fwrite(exp_buffer + old_length,1,cc,exp_debugfile);

		/* if we wrote to any logs, flush them */
		if (exp_debugfile) fflush(exp_debugfile);
		if (exp_loguser) {
			fflush(stdout);
			if (exp_logfile) fflush(exp_logfile);
		}

		/* remove nulls from input, so we can use C-style strings */
		/* doing it here lets them be sent to the screen, just */
		/*  in case they are involved in formatting operations */
		if (exp_remove_nulls) {
			buf_length -= rm_nulls(exp_buffer + old_length, cc);
		}
		/* cc should be decremented as well, but since it will not */
		/* be used before being set again, there is no need */
		exp_buffer_end = exp_buffer + buf_length;
		*exp_buffer_end = '\0';
                exp_match_end = exp_buffer;

	after_read:
		exp_debuglog("expect: does {%s} match ",exp_printify(exp_buffer));
		/* pattern supplied */
		for (ec=ecases;ec->type != exp_end;ec++) {
			int matched = -1;

			exp_debuglog("{%s}? ",exp_printify(ec->pattern));
			if (ec->type == exp_glob) {
				int offset;
				matched = Exp_StringMatch(exp_buffer,ec->pattern,&offset);
				if (matched >= 0) {
					exp_match = exp_buffer + offset;
					exp_match_end = exp_match + matched;
				}
			} else if (ec->type == exp_exact) {
				char *p = strstr(exp_buffer,ec->pattern);
				if (p) {
					matched = 1;
					exp_match = p;
					exp_match_end = p + strlen(ec->pattern);
				}
			} else if (ec->type == exp_null) {
				char *p;

				for (p=exp_buffer;p<exp_buffer_end;p++) {
					if (*p == 0) {
						matched = 1;
						exp_match = p;
						exp_match_end = p+1;
					}
				}
			} else {
				TclRegError((char *)0);
				if (TclRegExec(ec->re,exp_buffer,exp_buffer)) {
					matched = 1;
					exp_match = ec->re->startp[0];
					exp_match_end = ec->re->endp[0];
				} else if (TclGetRegError()) {
			    		fprintf(stderr,"r.e. match (pattern %s) failed: %s",ec->pattern,TclGetRegError());
				}
			}

			if (matched != -1) {
				exp_debuglog("yes\nexp_buffer is {%s}\n",
						exp_printify(exp_buffer));
				return_normally(ec->value);
			} else exp_debuglog("no\n");
		}

		/*
		 * Update current time and remaining time.
		 * Don't bother if we are waiting forever or polling.
		 */
		if (exp_timeout > 0) {
			time(&current_time);
			remtime = end_time - current_time;
		}
	}
 cleanup:
	f->buffer     = exp_buffer;
	f->buffer_end = exp_buffer_end;
	f->match_end  = exp_match_end;

	/* some systems (i.e., Solaris) require fp be flushed when switching */
	/* directions - do this before as well */
	if (fd == -1) fflush(fp);

	if (sys_error) {
		errno = sys_error;
		return -1;
	}
	return return_val;
}

int
exp_fexpectv(fp,ecases)
FILE *fp;
struct exp_case *ecases;
{
	return(expectv(-1,fp,ecases));
}

int
exp_expectv(fd,ecases)
int fd;
struct exp_case *ecases;
{
	return(expectv(fd,(FILE *)0,ecases));
}

/*VARARGS*/
int
exp_expectl TCL_VARARGS_DEF(int,arg1)
/*exp_expectl(va_alist)*/
/*va_dcl*/
{
	va_list args;
	int fd;
	struct exp_case *ec, *ecases;
	int i;
	enum exp_type type;

	fd = TCL_VARARGS_START(int,arg1,args);
	/* va_start(args);*/
	/* fd = va_arg(args,int);*/
	/* first just count the arg sets */
	for (i=0;;i++) {
		type = va_arg(args,enum exp_type);
		if (type == exp_end) break;

		/* Ultrix 4.2 compiler refuses enumerations comparison!? */
		if ((int)type < 0 || (int)type >= (int)exp_bogus) {
			fprintf(stderr,"bad type (set %d) in exp_expectl\n",i);
			sysreturn(EINVAL);
		}

		va_arg(args,char *);		/* COMPUTED BUT NOT USED */
		if (type == exp_compiled) {
			va_arg(args,regexp *);	/* COMPUTED BUT NOT USED */
		}
		va_arg(args,int);		/* COMPUTED BUT NOT USED*/
	}
	va_end(args);

	if (!(ecases = (struct exp_case *)
				malloc((1+i)*sizeof(struct exp_case))))
		sysreturn(ENOMEM);

	/* now set up the actual cases */
	fd = TCL_VARARGS_START(int,arg1,args);
	/*va_start(args);*/
	/*va_arg(args,int);*/		/*COMPUTED BUT NOT USED*/
	for (ec=ecases;;ec++) {
		ec->type = va_arg(args,enum exp_type);
		if (ec->type == exp_end) break;
		ec->pattern = va_arg(args,char *);
		if (ec->type == exp_compiled) {
			ec->re = va_arg(args,regexp *);
		} else {
			ec->re = 0;
		}
		ec->value = va_arg(args,int);
	}
	va_end(args);
	i = expectv(fd,(FILE *)0,ecases);

	for (ec=ecases;ec->type != exp_end;ec++) {
		/* free only if regexp and we compiled it for user */
		if (ec->type == exp_regexp) {
			free((char *)ec->re);
		}
	}
	free((char *)ecases);
	return(i);
}

int
exp_fexpectl TCL_VARARGS_DEF(FILE *,arg1)
/*exp_fexpectl(va_alist)*/
/*va_dcl*/
{
	va_list args;
	FILE *fp;
	struct exp_case *ec, *ecases;
	int i;
	enum exp_type type;

	fp = TCL_VARARGS_START(FILE *,arg1,args);
	/*va_start(args);*/
	/*fp = va_arg(args,FILE *);*/
	/* first just count the arg-pairs */
	for (i=0;;i++) {
		type = va_arg(args,enum exp_type);
		if (type == exp_end) break;

		/* Ultrix 4.2 compiler refuses enumerations comparison!? */
		if ((int)type < 0 || (int)type >= (int)exp_bogus) {
			fprintf(stderr,"bad type (set %d) in exp_expectl\n",i);
			sysreturn(EINVAL);
		}

		va_arg(args,char *);		/* COMPUTED BUT NOT USED */
		if (type == exp_compiled) {
			va_arg(args,regexp *);	/* COMPUTED BUT NOT USED */
		}
		va_arg(args,int);		/* COMPUTED BUT NOT USED*/
	}
	va_end(args);

	if (!(ecases = (struct exp_case *)
					malloc((1+i)*sizeof(struct exp_case))))
		sysreturn(ENOMEM);

#if 0
	va_start(args);
	va_arg(args,FILE *);		/*COMPUTED, BUT NOT USED*/
#endif
	(void) TCL_VARARGS_START(FILE *,arg1,args);

	for (ec=ecases;;ec++) {
		ec->type = va_arg(args,enum exp_type);
		if (ec->type == exp_end) break;
		ec->pattern = va_arg(args,char *);
		if (ec->type == exp_compiled) {
			ec->re = va_arg(args,regexp *);
		} else {
			ec->re = 0;
		}
		ec->value = va_arg(args,int);
	}
	va_end(args);
	i = expectv(-1,fp,ecases);

	for (ec=ecases;ec->type != exp_end;ec++) {
		/* free only if regexp and we compiled it for user */
		if (ec->type == exp_regexp) {
			free((char *)ec->re);
		}
	}
	free((char *)ecases);
	return(i);
}

/* like popen(3) but works in both directions */
FILE *
exp_popen(program)
char *program;
{
	FILE *fp;
	int ec;

	if (0 > (ec = exp_spawnl("sh","sh","-c",program,(char *)0))) return(0);
	if (!(fp = fdopen(ec,"r+"))) return(0);
	setbuf(fp,(char *)0);
	return(fp);
}

int
exp_disconnect()
{
	int ttyfd;

#ifndef EALREADY
#define EALREADY 37
#endif

	/* presumably, no stderr, so don't bother with error message */
	if (exp_disconnected) sysreturn(EALREADY);
	exp_disconnected = TRUE;

	freopen("/dev/null","r",stdin);
	freopen("/dev/null","w",stdout);
	freopen("/dev/null","w",stderr);

#ifdef POSIX
	setsid();
#else
#ifdef SYSV3
	/* put process in our own pgrp, and lose controlling terminal */
	exp_setpgrp();
	signal(SIGHUP,SIG_IGN);
	if (fork()) exit(0);	/* first child exits (as per Stevens, */
	/* UNIX Network Programming, p. 79-80) */
	/* second child process continues as daemon */
#else /* !SYSV3 */
	exp_setpgrp();
/* Pyramid lacks this defn */
#ifdef TIOCNOTTY
	ttyfd = open("/dev/tty", O_RDWR);
	if (ttyfd >= 0) {
		/* zap controlling terminal if we had one */
		(void) ioctl(ttyfd, TIOCNOTTY, (char *)0);
		(void) close(ttyfd);
	}
#endif /* TIOCNOTTY */
#endif /* SYSV3 */
#endif /* POSIX */
	return(0);
}

/* send to log if open and debugging enabled */
/* send to stderr if debugging enabled */
/* use this function for recording unusual things in the log */
/*VARARGS*/
void
exp_debuglog TCL_VARARGS_DEF(char *,arg1)
{
    char *fmt;
    va_list args;

    fmt = TCL_VARARGS_START(char *,arg1,args);
    if (exp_debugfile) vfprintf(exp_debugfile,fmt,args);
    if (exp_is_debugging) {
	vfprintf(stderr,fmt,args);
	if (exp_logfile) vfprintf(exp_logfile,fmt,args);
    }

    va_end(args);
}


/* send to log if open */
/* send to stderr */
/* use this function for error conditions */
/*VARARGS*/
void
exp_errorlog TCL_VARARGS_DEF(char *,arg1)
{
    char *fmt;
    va_list args;
    
    fmt = TCL_VARARGS_START(char *,arg1,args);
    vfprintf(stderr,fmt,args);
    if (exp_debugfile) vfprintf(exp_debugfile,fmt,args);
    if (exp_logfile) vfprintf(exp_logfile,fmt,args);
    va_end(args);
}

#include <ctype.h>

char *
exp_printify(s)
char *s;
{
	static int destlen = 0;
	static char *dest = 0;
	char *d;		/* ptr into dest */
	unsigned int need;

	if (s == 0) return("<null>");

	/* worst case is every character takes 4 to printify */
	need = strlen(s)*4 + 1;
	if (need > destlen) {
		if (dest) ckfree(dest);
		dest = ckalloc(need);
		destlen = need;
	}

	for (d = dest;*s;s++) {
		if (*s == '\r') {
			strcpy(d,"\\r");		d += 2;
		} else if (*s == '\n') {
			strcpy(d,"\\n");		d += 2;
		} else if (*s == '\t') {
			strcpy(d,"\\t");		d += 2;
		} else if (isascii(*s) && isprint(*s)) {
			*d = *s;			d += 1;
		} else {
			sprintf(d,"\\x%02x",*s & 0xff);	d += 4;
		}
	}
	*d = '\0';
	return(dest);
}

#if OBSOLETE
/* exp_closetcl.c - close tcl files */

/* isolated in it's own file since it has hooks into Tcl and exp_clib user */
/* might like to avoid dragging it in */

#include "expect_cf.h"

void (*exp_close_in_child)() = 0;

void
exp_close_tcl_files() {
    /* I don't believe this function is used any longer, at least in
       the Expect program.*/
}
#endif /* OBSOLETE */

/* exp_command.c - the bulk of the Expect commands

Written by: Don Libes, NIST, 2/6/90

Design and implementation of this program was paid for by U.S. tax
dollars.  Therefore it is public domain.  However, the author and NIST
would appreciate credit if this program or parts of it are used.

*/

#include "expect_cf.h"

#include <stdio.h>
#include <sys/types.h>
/*#include <sys/time.h> seems to not be present on SVR3 systems */
/* and it's not used anyway as far as I can tell */

/* AIX insists that stropts.h be included before ioctl.h, because both */
/* define _IO but only ioctl.h checks first.  Oddly, they seem to be */
/* defined differently! */
#ifdef HAVE_STROPTS_H
#  include <sys/stropts.h>
#endif
#include <sys/ioctl.h>

#ifdef HAVE_SYS_FCNTL_H
#  include <sys/fcntl.h>
#else
#  include <fcntl.h>
#endif
#include <sys/file.h>
#include "exp_tty.h"

#include <errno.h>
#include <signal.h>

#if defined(SIGCLD) && !defined(SIGCHLD)
#define SIGCHLD SIGCLD
#endif

#ifdef HAVE_PTYTRAP
#include <sys/ptyio.h>
#endif

#ifdef CRAY
# ifndef TCSETCTTY
#  if defined(HAVE_TERMIOS)
#   include <termios.h>
#  else
#   include <termio.h>
#  endif
# endif
#endif

#ifdef HAVE_UNISTD_H
# include <unistd.h>
#endif

#include <math.h>		/* for log/pow computation in send -h */
#include <ctype.h>		/* all this for ispunct! */

#include "tclInt.h"		/* need OpenFile */
/*#include <varargs.h>		tclInt.h drags in varargs.h.  Since Pyramid */
/*				objects to including varargs.h twice, just */
/*				omit this one. */

#include "tcl.h"
#include "string.h"
#include "expect_tcl.h"
#include "exp_rename.h"
#include "exp_prog.h"
#include "exp_command.h"
#include "exp_log.h"
#include "exp_event.h"
#include "exp_pty.h"
#ifdef TCL_DEBUGGER
#include "tcldbg.h"
#endif

/*
 * These constants refer to the UTF string that encodes a null character.
 */

#define NULL_STRING "\300\200" /* hex C080 */
#define NULL_LENGTH 2

#define SPAWN_ID_VARNAME "spawn_id"

int exp_getptymaster();
int exp_getptyslave();

int exp_forked = FALSE;		/* whether we are child process */

/* the following are use to create reserved addresses, to be used as ClientData */
/* args to be used to tell commands how they were called. */
/* The actual values won't be used, only the addresses, but I give them */
/* values out of my irrational fear the compiler might collapse them all. */
static int sendCD_error = 2;	/* called as send_error */
static int sendCD_user = 3;	/* called as send_user */
static int sendCD_proc = 4;	/* called as send or send_spawn */
static int sendCD_tty = 6;	/* called as send_tty */

/*
 * expect_key is just a source for generating a unique stamp.  As each
 * expect/interact command begins, it generates a new key and marks all
 * the spawn ids of interest with it.  Then, if someone comes along and
 * marks them with yet a newer key, the old command will recognize this
 * reexamine the state of the spawned process.
 */
int expect_key = 0;

/*
 * exp_configure_count is incremented whenever a spawned process is closed
 * or an indirect list is modified.  This forces any (stack of) expect or
 * interact commands to reexamine the state of the world and adjust
 * accordingly.
 */
int exp_configure_count = 0;

#ifdef HAVE_PTYTRAP
/* slaveNames provides a mapping from the pty slave names to our */
/* spawn id entry.  This is needed only on HPs for stty, sigh. */
static Tcl_HashTable slaveNames;
#endif /* HAVE_PTYTRAP */

typedef struct ThreadSpecificData {
    /*
     * List of all exp channels currently open.  This is per thread and is
     * used to match up fd's to channels, which rarely occurs.
     */
    
    ExpState *stdinout;
    ExpState *stderrX;   /* grr....stderr is a macro */
    ExpState *devtty;
    ExpState *any; /* for any_spawn_id */

    Tcl_Channel *diagChannel;
    Tcl_DString diagDString;
    int diagEnabled;
} ThreadSpecificData;

static Tcl_ThreadDataKey dataKey;

#ifdef FULLTRAPS
static void
init_traps(traps)
RETSIGTYPE (*traps[])();
{
	int i;

	for (i=1;i<NSIG;i++) {
		traps[i] = SIG_ERR;
	}
}
#endif

/* Do not terminate format strings with \n!!! */
/*VARARGS*/
void
exp_error TCL_VARARGS_DEF(Tcl_Interp *,arg1)
/*exp_error(va_alist)*/
/*va_dcl*/
{
	Tcl_Interp *interp;
	char *fmt;
	va_list args;
	char buffer[2000];

	interp = TCL_VARARGS_START(Tcl_Interp *,arg1,args);
	fmt = va_arg(args,char *);
	vsprintf(buffer,fmt,args);
	Tcl_SetResult(interp,buffer,TCL_VOLATILE);
	va_end(args);
}

/* returns current ExpState or 0.  If 0, may be immediately followed by return TCL_ERROR. */
struct ExpState *
expStateCurrent(interp,opened,adjust,any)
Tcl_Interp *interp;
int opened;
int adjust;
int any;
{
    static char *user_spawn_id = "exp0";

    char *name = exp_get_var(interp,SPAWN_ID_VARNAME);
    if (!name) name = user_spawn_id;

    return expStateFromChannelName(interp,name,opened,adjust,any,SPAWN_ID_VARNAME);
}

ExpState *
expStateCheck(interp,esPtr,open,adjust,msg)
    Tcl_Interp *interp;
    ExpState *esPtr;
    int open;
    int adjust;
    char *msg;
{
    if (open && !esPtr->open) {
	exp_error(interp,"%s: spawn id %s not open",msg,esPtr->name);
	return(0);
    }
    if (adjust) expAdjust(esPtr);
    return esPtr;
}

ExpState *
expStateFromChannelName(interp,name,open,adjust,any,msg)
    Tcl_Interp *interp;
    char *name;
    int open;
    int adjust;
    char *msg;
{
    ExpState *esPtr;
    Tcl_Channel channel;
    char *chanName;

    if (any) {
	if (0 == strcmp(name,EXP_SPAWN_ID_ANY_LIT)) {
	    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
	    return tsdPtr->any;
	}
    }

    channel = Tcl_GetChannel(interp,name,(int *)0);
    if (!channel) return(0);

    chanName = Tcl_GetChannelName(channel);
    if (!isExpChannelName(chanName)) {
	exp_error(interp,"%s: %s is not an expect channel - use spawn -open to convert",msg,chanName);
	return(0);
    }

    esPtr = (ExpState *)Tcl_GetChannelInstanceData(channel);

    return expStateCheck(interp,esPtr,open,adjust,msg);
}

/* zero out the wait status field */
static void
exp_wait_zero(status)
WAIT_STATUS_TYPE *status;
{
	int i;

	for (i=0;i<sizeof(WAIT_STATUS_TYPE);i++) {
		((char *)status)[i] = 0;
	}
}

/* called just before an ExpState entry is about to be invalidated */
void
exp_state_prep_for_invalidation(interp,esPtr)
Tcl_Interp *interp;
ExpState *esPtr;
{
    exp_ecmd_remove_state_direct_and_indirect(interp,esPtr);

    exp_configure_count++;

    if (esPtr->fg_armed) {
	exp_event_disarm_fg(esPtr);
    }
}

/*ARGSUSED*/
void
exp_trap_on(master)
int master;
{
#ifdef HAVE_PTYTRAP
	if (master == -1) return;
	exp_slave_control(master,1);
#endif /* HAVE_PTYTRAP */
}

int
exp_trap_off(name)
char *name;
{
#ifdef HAVE_PTYTRAP
    ExpState *esPtr;
    int enable = 0;

    Tcl_HashEntry *entry = Tcl_FindHashEntry(&slaveNames,name);
    if (!entry) {
	expDiagLog("exp_trap_off: no entry found for %s\n",name);
	return -1;
    }

    esPtr = (ExpState *)Tcl_GetHashValue(entry);
    
    exp_slave_control(esPtr->fdin,0);

    return esPtr->fdin;
#else
    return name[0];	/* pacify lint, use arg and return something */
#endif
}

static
void
expBusy(esPtr)
     ExpState *esPtr;
{     
  int x = open("/dev/null",0);
  if (x != esPtr->fdin) {
    fcntl(x,F_DUPFD,esPtr->fdin);
    close(x);
  }
  expCloseOnExec(esPtr->fdin);
  esPtr->fdBusy = TRUE;
}

int
exp_close(interp,esPtr)
Tcl_Interp *interp;
ExpState *esPtr;
{
    if (0 == expStateCheck(interp,esPtr,1,0,"close")) return TCL_ERROR;
    esPtr->open = FALSE;

    /*
     * Ignore close errors from ptys.  Ptys on some systems return errors for
     * no evident reason.  Anyway, receiving an error upon pty-close doesn't
     * mean anything anyway as far as I know.  
     */

    close(esPtr->fdin);
    if (esPtr->fd_slave != EXP_NOFD) close(esPtr->fd_slave);
    if (esPtr->fdin != esPtr->fdout) close(esPtr->fdout);

    if (esPtr->channel_orig && !esPtr->leaveopen) {
	/*
	 * Ignore close errors from Tcl channels.  They indicate things
	 * like broken pipelines, etc, which don't affect our
	 * subsequent handling.
	 */
	Tcl_VarEval(interp,"close ",Tcl_GetChannelName(esPtr->channel_orig),
		(char *)0);
    }

#ifdef HAVE_PTYTRAP
    if (esPtr->slave_name) {
	Tcl_HashEntry *entry;
	
	entry = Tcl_FindHashEntry(&slaveNames,esPtr->slave_name);
	Tcl_DeleteHashEntry(entry);

	ckfree(esPtr->slave_name);
	esPtr->slave_name = 0;
    }
#endif

    exp_state_prep_for_invalidation(interp,esPtr);

    if (esPtr->user_waited) {
	if (esPtr->registered) {
	    Tcl_UnregisterChannel(interp,esPtr->channel);
	    /* at this point esPtr may have been freed so don't touch it
               any longer */
	}
    } else {
      expBusy(esPtr);
    }

    return(TCL_OK);
}

/* report whether this ExpState represents special spawn_id_any */
/* we need a separate function because spawn_id_any is thread-specific */
/* and can't be seen outside this file */
expStateAnyIs(esPtr)
    ExpState *esPtr;
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    return (esPtr == tsdPtr->any);
}

expDevttyIs(esPtr)
    ExpState *esPtr;
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    return (esPtr == tsdPtr->devtty);
}

int
expStdinoutIs(esPtr)
ExpState *esPtr;
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    return (tsdPtr->stdinout == esPtr);
}

ExpState *
expStdinoutGet()
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    return tsdPtr->stdinout;
}

ExpState *
expDevttyGet()
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    return tsdPtr->devtty;
}

void
exp_init_spawn_id_vars(interp)
Tcl_Interp *interp;
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    Tcl_SetVar(interp, "user_spawn_id", tsdPtr->stdinout->name,0);
    Tcl_SetVar(interp,"error_spawn_id",  tsdPtr->stderrX->name,0);
    Tcl_SetVar(interp,  "any_spawn_id",   EXP_SPAWN_ID_ANY_LIT,0);

    /* user_spawn_id is NOT /dev/tty which could (at least in theory
     * anyway) be later re-opened on a different fd, while stdin might
     * have been redirected away from /dev/tty
     */

    if (exp_dev_tty != -1) {
	Tcl_SetVar(interp,"tty_spawn_id",tsdPtr->devtty->name,0);
    }
}

void
exp_init_spawn_ids(interp)
    Tcl_Interp *interp;
{
    static ExpState any_placeholder;  /* can be shared process-wide */
    
    /* note whether 0,1,2 are connected to a terminal so that if we */
    /* disconnect, we can shut these down.  We would really like to */
    /* test if 0,1,2 are our controlling tty, but I don't know any */
    /* way to do that portably.  Anyway, the likelihood of anyone */
    /* disconnecting after redirecting to a non-controlling tty is */
    /* virtually zero. */

    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    tsdPtr->stdinout = expCreateChannel(interp,0,1,isatty(0)?exp_getpid:EXP_NOPID);
    tsdPtr->stdinout->keepForever = 1;
    /* hmm, now here's an example of a output-only descriptor!! */
    tsdPtr->stderrX = expCreateChannel(interp,2,2,isatty(2)?exp_getpid:EXP_NOPID);
    tsdPtr->stderrX->keepForever = 1;

    if (exp_dev_tty != -1) {
	tsdPtr->devtty = expCreateChannel(interp,exp_dev_tty,exp_dev_tty,exp_getpid);
	tsdPtr->devtty->keepForever = 1;
    }

    /* set up a dummy channel to give us something when we need to find out if
       people have passed us "any_spawn_id" */
    tsdPtr->any = &any_placeholder;
}

void
expCloseOnExec(fd)
int fd;
{
     (void) fcntl(fd,F_SETFD,1);
}

#define STTY_INIT	"stty_init"

#if 0
/*
 * DEBUGGING UTILITIES - DON'T DELETE */
static void
show_pgrp(fd,string)
int fd;
char *string;
{
	int pgrp;

	fprintf(stderr,"getting pgrp for %s\n",string);
	if (-1 == ioctl(fd,TIOCGETPGRP,&pgrp)) perror("TIOCGETPGRP");
	else fprintf(stderr,"%s pgrp = %d\n",string,pgrp);
	if (-1 == ioctl(fd,TIOCGPGRP,&pgrp)) perror("TIOCGPGRP");
	else fprintf(stderr,"%s pgrp = %d\n",string,pgrp);
	if (-1 == tcgetpgrp(fd,pgrp)) perror("tcgetpgrp");
	else fprintf(stderr,"%s pgrp = %d\n",string,pgrp);
}

static void
set_pgrp(fd)
int fd;
{
	int pgrp = getpgrp(0);
	if (-1 == ioctl(fd,TIOCSETPGRP,&pgrp)) perror("TIOCSETPGRP");
	if (-1 == ioctl(fd,TIOCSPGRP,&pgrp)) perror("TIOCSPGRP");
	if (-1 == tcsetpgrp(fd,pgrp)) perror("tcsetpgrp");
}
#endif

static
void
expSetpgrp()
{
#ifdef MIPS_BSD
    /* required on BSD side of MIPS OS <[email protected]> */
#   include <sysv/sys.s>
    syscall(SYS_setpgrp);
#endif

#ifdef SETPGRP_VOID
    (void) setpgrp();
#else
    (void) setpgrp(0,0);
#endif
}


/*ARGSUSED*/
static void
set_slave_name(esPtr,name)
ExpState *esPtr;
char *name;
{
#ifdef HAVE_PTYTRAP
	int newptr;
	Tcl_HashEntry *entry;

	/* save slave name */
	esPtr->slave_name = ckalloc(strlen(exp_pty_slave_name)+1);
	strcpy(esPtr->slave_name,exp_pty_slave_name);

	entry = Tcl_CreateHashEntry(&slaveNames,exp_pty_slave_name,&newptr);
	Tcl_SetHashValue(entry,(ClientData)esPtr);
#endif /* HAVE_PTYTRAP */
}

/* arguments are passed verbatim to execvp() */
/*ARGSUSED*/
static int
Exp_SpawnCmd(clientData,interp,argc,argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;
char **argv;
{
    ExpState *esPtr = 0;
    int slave;
    int pid;
    char **a;
    /* tell Saber to ignore non-use of ttyfd */
    /*SUPPRESS 591*/
    int errorfd;	/* place to stash fileno(stderr) in child */
			/* while we're setting up new stderr */
    int ttyfd;
    int master;
    int write_master;	/* write fd of Tcl-opened files */
    int ttyinit = TRUE;
    int ttycopy = TRUE;
    int echo = TRUE;
    int console = FALSE;
    int pty_only = FALSE;

#ifdef FULLTRAPS
				/* Allow user to reset signals in child */
				/* The following array contains indicates */
				/* whether sig should be DFL or IGN */
				/* ERR is used to indicate no initialization */
    RETSIGTYPE (*traps[NSIG])();
#endif
    int ignore[NSIG];		/* if true, signal in child is ignored */
				/* if false, signal gets default behavior */
    int i;			/* trusty overused temporary */

    char *argv0 = argv[0];
    char *chanName = 0;
    int leaveopen = FALSE;
    int rc, wc;
    char *stty_init;
    int slave_write_ioctls = 1;
		/* by default, slave will be write-ioctled this many times */
    int slave_opens = 3;
		/* by default, slave will be opened this many times */
		/* first comes from initial allocation */
		/* second comes from stty */
		/* third is our own signal that stty is done */

    int sync_fds[2];
    int sync2_fds[2];
    int status_pipe[2];
    int child_errno;
    char sync_byte;

    Tcl_Channel channel;
    Tcl_DString dstring;
    Tcl_DStringInit(&dstring);

#ifdef FULLTRAPS
    init_traps(&traps);
#endif
    /* don't ignore any signals in child by default */
    for (i=1;i<NSIG;i++) {
	ignore[i] = FALSE;
    }

    argc--; argv++;

    for (;argc>0;argc--,argv++) {
	if (streq(*argv,"-nottyinit")) {
	    ttyinit = FALSE;
	    slave_write_ioctls--;
	    slave_opens--;
	} else if (streq(*argv,"-nottycopy")) {
	    ttycopy = FALSE;
	} else if (streq(*argv,"-noecho")) {
	    echo = FALSE;
	} else if (streq(*argv,"-console")) {
	    console = TRUE;
	} else if (streq(*argv,"-pty")) {
	    pty_only = TRUE;
	} else if (streq(*argv,"-open")) {
	    if (argc < 2) {
		exp_error(interp,"usage: -open file-identifier");
		return TCL_ERROR;
	    }
	    chanName = argv[1];
	    argc--; argv++;
	} else if (streq(*argv,"-leaveopen")) {
	    if (argc < 2) {
		exp_error(interp,"usage: -open file-identifier");
		return TCL_ERROR;
	    }
	    chanName = argv[1];
	    leaveopen = TRUE;
	    argc--; argv++;
	} else if (streq(*argv,"-ignore")) {
	    int sig;

	    if (argc < 2) {
		exp_error(interp,"usage: -ignore signal");
		return TCL_ERROR;
	    }
	    sig = exp_string_to_signal(interp,argv[1]);
	    if (sig == -1) {
		exp_error(interp,"usage: -ignore %s: unknown signal name",argv[1]);
		return TCL_ERROR;
	    }
	    ignore[sig] = TRUE;
	    argc--; argv++;
#ifdef FULLTRAPS
	} else if (streq(*argv,"-trap")) {
	    /* argv[1] is action */
	    /* argv[2] is list of signals */

	    RETSIGTYPE (*sig_handler)();
	    int n;		/* number of signals in list */
	    char **list;	/* list of signals */
	    
	    if (argc < 3) {
		exp_error(interp,"usage: -trap siglist SIG_DFL or SIG_IGN");
		return TCL_ERROR;
	    }

	    if (0 == strcmp(argv[2],"SIG_DFL")) {
		sig_handler = SIG_DFL;
	    } else if (0 == strcmp(argv[2],"SIG_IGN")) {
		sig_handler = SIG_IGN;
	    } else {
		exp_error(interp,"usage: -trap siglist SIG_DFL or SIG_IGN");
		return TCL_ERROR;
	    }

	    if (TCL_OK != Tcl_SplitList(interp,argv[1],&n,&list)) {
		expErrorLogU(interp->result);
		expErrorLogU("\r\n");
		exp_error(interp,"usage: -trap {siglist} ...");
		return TCL_ERROR;
	    }
	    for (i=0;i<n;i++) {
		int sig = exp_string_to_signal(interp,list[i]);
		if (sig == -1) {
		    ckfree((char *)&list);
		    return TCL_ERROR;
		}
		traps[sig] = sig_handler;
	    }
	    ckfree((char *)&list);

	    argc--; argv++;
	    argc--; argv++;
#endif /*FULLTRAPS*/
	} else break;
    }

    if (chanName && (argc != 0)) {
	exp_error(interp,"usage: -[leave]open [fileXX]");
	return TCL_ERROR;
    }

    if (!pty_only && !chanName && (argc == 0)) {
	exp_error(interp,"usage: spawn [spawn-args] program [program-args]");
	return(TCL_ERROR);
    }

    stty_init = exp_get_var(interp,STTY_INIT);
    if (stty_init) {
	slave_write_ioctls++;
	slave_opens++;
    }

/* any extraneous ioctl's that occur in slave must be accounted for
when trapping, see below in child half of fork */
#if defined(TIOCSCTTY) && !defined(CIBAUD) && !defined(sun) && !defined(hp9000s300)
    slave_write_ioctls++;
    slave_opens++;
#endif

    exp_pty_slave_name = 0;
    
    Tcl_ReapDetachedProcs();

    if (!chanName) {
	if (echo) {
	    expStdoutLogU(argv0,0);
	    for (a = argv;*a;a++) {
		expStdoutLogU(" ",0);
		expStdoutLogU(*a,0);
	    }
	    expStdoutLogU("\r\n",0);
	}

	if (0 > (master = exp_getptymaster())) {
	    /*
	     * failed to allocate pty, try and figure out why
	     * so we can suggest to user what to do about it.
	     */

	    int testfd;
		
	    if (exp_pty_error) {
		exp_error(interp,"%s",exp_pty_error);
		return TCL_ERROR;
	    }

	    if (expChannelCountGet() > 10) {
		exp_error(interp,"The system only has a finite number of ptys and you have many of them in use.  The usual reason for this is that you forgot (or didn't know) to call \"wait\" after closing each of them.");
		return TCL_ERROR;
	    }

	    testfd = open("/",0);
	    close(testfd);

	    if (testfd != -1) {
		exp_error(interp,"The system has no more ptys.  Ask your system administrator to create more.");
	    } else {
		exp_error(interp,"- You have too many files are open.  Close some files or increase your per-process descriptor limit.");
	    }
	    return(TCL_ERROR);
	}

	/* ordinarily channel creation takes care of close-on-exec
	 * but because that will occur *after* fork, force close-on-exec
	 * now in this case.
	 */
	expCloseOnExec(master);

#define SPAWN_OUT "spawn_out"
	Tcl_SetVar2(interp,SPAWN_OUT,"slave,name",exp_pty_slave_name,0);

	if (pty_only) {
	  write_master = master;
	}
    } else {
	/*
	 * process "-open $channel"
	 */
	int mode;
	int rfd, wfd;
	
	if (echo) {
	    expStdoutLogU(argv0,0);
	    expStdoutLogU(" [open ...]\r\n",0);
	}
	if (!(channel = Tcl_GetChannel(interp,chanName,&mode))) {
	    return TCL_ERROR;
	}
	if (!mode) {
	    exp_error(interp,"channel is neither readable nor writable");
	    return TCL_ERROR;
	}
	if (mode & TCL_READABLE) {
	    if (TCL_ERROR == Tcl_GetChannelHandle(channel, TCL_READABLE, (ClientData) &rfd)) {
		return TCL_ERROR;
	    }
	}
	if (mode & TCL_WRITABLE) {
	    if (TCL_ERROR == Tcl_GetChannelHandle(channel, TCL_WRITABLE, (ClientData) &wfd)) {
		return TCL_ERROR;
	    }    
	}
	master = ((mode & TCL_READABLE)?rfd:wfd);

	/* make a new copy of file descriptor */
	if (-1 == (write_master = master = dup(master))) {
	    exp_error(interp,"fdopen: %s",Tcl_PosixError(interp));
	    return TCL_ERROR;
	}

	/* if writefilePtr is different, dup that too */
	if ((mode & TCL_READABLE) && (mode & TCL_WRITABLE) && (wfd != rfd)) {
	    if (-1 == (write_master = dup(wfd))) {
		exp_error(interp,"fdopen: %s",Tcl_PosixError(interp));
		return TCL_ERROR;
	    }
	}

	/*
	 * It would be convenient now to tell Tcl to close its
	 * file descriptor.  Alas, if involved in a pipeline, Tcl
	 * will be unable to complete a wait on the process.
	 * So simply remember that we meant to close it.  We will
	 * do so later in our own close routine.
	 */
    }
	
    if (chanName || pty_only) {
	esPtr = expCreateChannel(interp,master,write_master,EXP_NOPID);
	    
	if (chanName) {
	    esPtr->channel_orig = channel;
	    esPtr->leaveopen = leaveopen;
	}

	if (exp_pty_slave_name) set_slave_name(esPtr,exp_pty_slave_name);

	/* make it appear as if process has been waited for */
	esPtr->sys_waited = TRUE;
	exp_wait_zero(&esPtr->wait);

	/* tell user of new spawn id */
	Tcl_SetVar(interp,SPAWN_ID_VARNAME,esPtr->name,0);

	if (!chanName) {
	    char value[20];

	    /*
	     * open the slave side in the same process to support
	     * the -pty flag.
	     */

	    if (0 > (esPtr->fd_slave = exp_getptyslave(ttycopy,ttyinit,
		    stty_init))) {
		exp_error(interp,"open(slave pty): %s\r\n",Tcl_PosixError(interp));
		return TCL_ERROR;
	    }

	    exp_slave_control(master,1);
	    
	    sprintf(value,"%d",esPtr->fd_slave);
	    Tcl_SetVar2(interp,SPAWN_OUT,"slave,fd",value,0);
	}
	sprintf(interp->result,"%d",EXP_NOPID);
	expDiagLog("spawn: returns {%s}\r\n",interp->result);

	return TCL_OK;
    }

    if (NULL == (argv[0] = Tcl_TranslateFileName(interp,argv[0],&dstring))) {
	goto parent_error;
    }

    if (-1 == pipe(sync_fds)) {
	exp_error(interp,"too many programs spawned?  could not create pipe: %s",Tcl_PosixError(interp));
	goto parent_error;
    }

    if (-1 == pipe(sync2_fds)) {
	close(sync_fds[0]);
	close(sync_fds[1]);
	exp_error(interp,"too many programs spawned?  could not create pipe: %s",Tcl_PosixError(interp));
	goto parent_error;
    }

    if (-1 == pipe(status_pipe)) {
	close(sync_fds[0]);
	close(sync_fds[1]);
	close(sync2_fds[0]);
	close(sync2_fds[1]);
    }

    if ((pid = fork()) == -1) {
	exp_error(interp,"fork: %s",Tcl_PosixError(interp));
	goto parent_error;
    }

    if (pid) { /* parent */
	    close(sync_fds[1]);
	    close(sync2_fds[0]);
	    close(status_pipe[1]);

	    esPtr = expCreateChannel(interp,master,master,pid);

	    if (exp_pty_slave_name) set_slave_name(esPtr,exp_pty_slave_name);

#ifdef CRAY
	    setptypid(pid);
#endif

	    /*
	     * wait for slave to initialize pty before allowing
	     * user to send to it
	     */ 

	    expDiagLog("parent: waiting for sync byte\r\n");
	    while (((rc = read(sync_fds[0],&sync_byte,1)) < 0) && (errno == EINTR)) {
		/* empty */;
	    }
	    if (rc == -1) {
		expErrorLogU("parent: sync byte read: ");
		expErrorLogU(Tcl_ErrnoMsg(errno));
		expErrorLogU("\r\n");
		exit(-1);
	    }

	    /* turn on detection of eof */
	    exp_slave_control(master,1);

	    /*
	     * tell slave to go on now now that we have initialized pty
	     */

	    expDiagLog("parent: telling child to go ahead\r\n");
	    wc = write(sync2_fds[1]," ",1);
	    if (wc == -1) {
		expErrorLog("parent: sync byte write: %s\r\n",Tcl_ErrnoMsg(errno));
		exit(-1);
	    }

	    expDiagLog("parent: now unsynchronized from child\r\n");
	    close(sync_fds[0]);
	    close(sync2_fds[1]);

	    /* see if child's exec worked */
	retry:
	    switch (read(status_pipe[0],&child_errno,sizeof child_errno)) {
		case -1:
		    if (errno == EINTR) goto retry;
		    /* well it's not really the child's errno */
		    /* but it can be treated that way */
		    child_errno = errno;
		    break;
		case 0:
		    /* child's exec succeeded */
		    child_errno = 0;
		    break;
		default:
		    /* child's exec failed; err contains exec's errno  */
		    waitpid(pid, NULL, 0);
		    /* in order to get Tcl to set errorcode, we must */
		    /* hand set errno */
		    errno = child_errno;
		    exp_error(interp, "couldn't execute \"%s\": %s",
			    argv[0],Tcl_PosixError(interp));
		    goto parent_error;
	    }
	    close(status_pipe[0]);

	    /* tell user of new spawn id */
	    Tcl_SetVar(interp,SPAWN_ID_VARNAME,esPtr->name,0);

	    sprintf(interp->result,"%d",pid);
	    expDiagLog("spawn: returns {%s}\r\n",interp->result);

	    Tcl_DStringFree(&dstring);
	    return(TCL_OK);
	}

	/* child process - do not return from here!  all errors must exit() */

	close(sync_fds[0]);
	close(sync2_fds[1]);
	close(status_pipe[0]);
	expCloseOnExec(status_pipe[1]);

	if (exp_dev_tty != -1) {
		close(exp_dev_tty);
		exp_dev_tty = -1;
	}

#ifdef CRAY
	(void) close(master);
#endif

/* ultrix (at least 4.1-2) fails to obtain controlling tty if setsid */
/* is called.  setpgrp works though.  */
#if defined(POSIX) && !defined(ultrix)
#define DO_SETSID
#endif
#ifdef __convex__
#define DO_SETSID
#endif

#ifdef DO_SETSID
	setsid();
#else
#ifdef SYSV3
#ifndef CRAY
	expSetpgrp();
#endif /* CRAY */
#else /* !SYSV3 */
	expSetpgrp();

/* Pyramid lacks this defn */
#ifdef TIOCNOTTY
	ttyfd = open("/dev/tty", O_RDWR);
	if (ttyfd >= 0) {
		(void) ioctl(ttyfd, TIOCNOTTY, (char *)0);
		(void) close(ttyfd);
	}
#endif /* TIOCNOTTY */

#endif /* SYSV3 */
#endif /* DO_SETSID */

	/* save stderr elsewhere to avoid BSD4.4 bogosity that warns */
	/* if stty finds dev(stderr) != dev(stdout) */

	/* save error fd while we're setting up new one */
	errorfd = fcntl(2,F_DUPFD,3);
	/* and here is the macro to restore it */
#define restore_error_fd {close(2);fcntl(errorfd,F_DUPFD,2);}

	close(0);
	close(1);
	close(2);

	/* since we closed fd 0, open of pty slave must return fd 0 */

	/* since exp_getptyslave may have to run stty, (some of which work on fd */
	/* 0 and some of which work on 1) do the dup's inside exp_getptyslave. */

	if (0 > (slave = exp_getptyslave(ttycopy,ttyinit,stty_init))) {
		restore_error_fd

		if (exp_pty_error) {
			expErrorLog("open(slave pty): %s\r\n",exp_pty_error);
		} else {
			expErrorLog("open(slave pty): %s\r\n",Tcl_ErrnoMsg(errno));
		}
		exit(-1);
	}
	/* sanity check */
	if (slave != 0) {
		restore_error_fd
		expErrorLog("exp_getptyslave: slave = %d but expected 0\n",slave);
		exit(-1);
	}

/* The test for hpux may have to be more specific.  In particular, the */
/* code should be skipped on the hp9000s300 and hp9000s720 (but there */
/* is no documented define for the 720!) */

/*#if defined(TIOCSCTTY) && !defined(CIBAUD) && !defined(sun) && !defined(hpux)*/
#if defined(TIOCSCTTY) && !defined(sun) && !defined(hpux)
	/* 4.3+BSD way to acquire controlling terminal */
	/* according to Stevens - Adv. Prog..., p 642 */
	/* Oops, it appears that the CIBAUD is on Linux also */
	/* so let's try without... */
#ifdef __QNX__
	if (tcsetct(0, getpid()) == -1) {
	  restore_error_fd
	  expErrorLog("failed to get controlling terminal using TIOCSCTTY");
	  exit(-1);
	}
#else
	(void) ioctl(0,TIOCSCTTY,(char *)0);
	/* ignore return value - on some systems, it is defined but it
	 * fails and it doesn't seem to cause any problems.  Or maybe
	 * it works but returns a bogus code.  Noone seems to be able
	 * to explain this to me.  The systems are an assortment of
	 * different linux systems (and FreeBSD 2.5), RedHat 5.2 and
	 * Debian 2.0
	 */
#endif
#endif

#ifdef CRAY
 	(void) setsid();
 	(void) ioctl(0,TCSETCTTY,0);
 	(void) close(0);
 	if (open("/dev/tty", O_RDWR) < 0) {
		restore_error_fd
 		expErrorLog("open(/dev/tty): %s\r\n",Tcl_ErrnoMsg(errno));
 		exit(-1);
 	}
 	(void) close(1);
 	(void) close(2);
 	(void) dup(0);
 	(void) dup(0);
	setptyutmp();	/* create a utmp entry */

	/* _CRAY2 code from Hal Peterson <[email protected]>, Cray Research, Inc. */
#ifdef _CRAY2
	/*
	 * Interpose a process between expect and the spawned child to
	 * keep the slave side of the pty open to allow time for expect
	 * to read the last output.  This is a workaround for an apparent
	 * bug in the Unicos pty driver on Cray-2's under Unicos 6.0 (at
	 * least).
	 */
	if ((pid = fork()) == -1) {
		restore_error_fd
		expErrorLog("second fork: %s\r\n",Tcl_ErrnoMsg(errno));
		exit(-1);
	}

	if (pid) {
 		/* Intermediate process. */
		int status;
		int timeout;
		char *t;

		/* How long should we wait? */
		if (t = exp_get_var(interp,"pty_timeout"))
			timeout = atoi(t);
		else if (t = exp_get_var(interp,"timeout"))
			timeout = atoi(t)/2;
		else
			timeout = 5;

		/* Let the spawned process run to completion. */
 		while (wait(&status) < 0 && errno == EINTR)
			/* empty body */;

		/* Wait for the pty to clear. */
		sleep(timeout);

		/* Duplicate the spawned process's status. */
		if (WIFSIGNALED(status))
			kill(getpid(), WTERMSIG(status));

		/* The kill may not have worked, but this will. */
 		exit(WEXITSTATUS(status));
	}
#endif /* _CRAY2 */
#endif /* CRAY */

	if (console) exp_console_set();

#ifdef FULLTRAPS
	for (i=1;i<NSIG;i++) {
		if (traps[i] != SIG_ERR) {
			signal(i,traps[i]);
		}
	}
#endif /* FULLTRAPS */

	for (i=1;i<NSIG;i++) {
		signal(i,ignore[i]?SIG_IGN:SIG_DFL);
	}

	/*
	 * avoid fflush of cmdfile, logfile, & diagfile since this screws up
	 * the parents seek ptr.  There is no portable way to fclose a shared
	 * read-stream!!!!
	 */

	/* (possibly multiple) masters are closed automatically due to */
	/* earlier fcntl(,,CLOSE_ON_EXEC); */

	/* tell parent that we are done setting up pty */
	/* The actual char sent back is irrelevant. */

	/* expDiagLog("child: telling parent that pty is initialized\r\n");*/
	wc = write(sync_fds[1]," ",1);
	if (wc == -1) {
		restore_error_fd
		expErrorLog("child: sync byte write: %s\r\n",Tcl_ErrnoMsg(errno));
		exit(-1);
	}
	close(sync_fds[1]);

	/* wait for master to let us go on */
	while (((rc = read(sync2_fds[0],&sync_byte,1)) < 0) && (errno == EINTR)) {
		/* empty */;
	}

	if (rc == -1) {
		restore_error_fd
		expErrorLog("child: sync byte read: %s\r\n",Tcl_ErrnoMsg(errno));
		exit(-1);
	}
	close(sync2_fds[0]);

	/* expDiagLog("child: now unsynchronized from parent\r\n"); */

        (void) execvp(argv[0],argv);

	/* Alas, by now we've closed fd's to stderr, logfile and diagfile.
	 * The only reasonable thing to do is to send back the error as part of
	 * the program output.  This will be picked up in an expect or interact
	 * command.
	 */

	/* if exec failed, communicate the reason back to the parent */
	write(status_pipe[1], &errno, sizeof errno);
	exit(-1);
	/*NOTREACHED*/
parent_error:
    Tcl_DStringFree(&dstring);
    if (esPtr) {
        exp_close(interp,esPtr);
	waitpid(esPtr->pid,&esPtr->wait,0);
	if (esPtr->registered) {
	    Tcl_UnregisterChannel(interp,esPtr->channel);
	}
    }
    return TCL_ERROR;
}

/*ARGSUSED*/
static int
Exp_ExpPidCmd(clientData,interp,argc,argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;
char **argv;
{
    char *chanName = 0;
    ExpState *esPtr = 0;

    argc--; argv++;

    for (;argc>0;argc--,argv++) {
	if (streq(*argv,"-i")) {
	    argc--; argv++;
	    if (!*argv) goto usage;
	    chanName = *argv;
	} else goto usage;
    }

    if (chanName) {
	if (!(esPtr = expStateFromChannelName(interp,chanName,0,0,0,"exp_pid"))) return TCL_ERROR;
    } else {
	if (!(esPtr = expStateCurrent(interp,0,0,0))) return TCL_ERROR;
    }
    
    sprintf(interp->result,"%d",esPtr->pid);
    return TCL_OK;
  usage:
    exp_error(interp,"usage: -i spawn_id");
    return TCL_ERROR;
}

/*ARGSUSED*/
static int
Exp_GetpidDeprecatedCmd(clientData, interp, argc, argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;
char **argv;
{
	expDiagLog("getpid is deprecated, use pid\r\n");
	sprintf(interp->result,"%d",getpid());
	return(TCL_OK);
}

/*ARGSUSED*/
static int
Exp_SleepCmd(clientData,interp,argc,argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;
char **argv;
{
	argc--; argv++;

	if (argc != 1) {
		exp_error(interp,"must have one arg: seconds");
		return TCL_ERROR;
	}

	return(exp_dsleep(interp,(double)atof(*argv)));
}

/* if this works, exact_write should disappear and function should
   call Tcl_WriteChars directly */
static int
exact_write(esPtr,buffer,rembytes) /* INTL */
ExpState *esPtr;
char *buffer;
int rembytes;
{
    Tcl_WriteChars(esPtr->channel,buffer,rembytes);
    return(0);
}

struct slow_arg {
    int size;
    double time;
};

/* returns 0 for success, -1 for failure */
static int
get_slow_args(interp,x)
Tcl_Interp *interp;
struct slow_arg *x;
{
	int sc;		/* return from scanf */
	char *s = exp_get_var(interp,"send_slow");
	if (!s) {
		exp_error(interp,"send -s: send_slow has no value");
		return(-1);
	}
	if (2 != (sc = sscanf(s,"%d %lf",&x->size,&x->time))) {
		exp_error(interp,"send -s: found %d value(s) in send_slow but need 2",sc);
		return(-1);
	}
	if (x->size <= 0) {
		exp_error(interp,"send -s: size (%d) in send_slow must be positive", x->size);
		return(-1);
	}
	if (x->time <= 0) {
		exp_error(interp,"send -s: time (%f) in send_slow must be larger",x->time);
		return(-1);
	}
	return(0);
}

/* returns 0 for success, -1 for failure, pos. for Tcl return value */
static int
slow_write(interp,esPtr,buffer,rembytes,arg) /* INTL */
Tcl_Interp *interp;
ExpState *esPtr;
char *buffer;
int rembytes;
struct slow_arg *arg;
{
	int rc;

	while (rembytes > 0) {
		int len;
		
		len = (arg->size<rembytes?arg->size:rembytes);
		if (0 > exact_write(esPtr,buffer,len)) return(-1);
		rembytes -= arg->size;
		buffer += arg->size;

		/* skip sleep after last write */
		if (rembytes > 0) {
			rc = exp_dsleep(interp,arg->time);
			if (rc>0) return rc;
		}
	}
	return(0);
}

struct human_arg {
	float alpha;		/* average interarrival time in seconds */
	float alpha_eow;	/* as above but for eow transitions */
	float c;		/* shape */
	float min, max;
};

/* returns -1 if error, 0 if success */
static int
get_human_args(interp,x)
Tcl_Interp *interp;
struct human_arg *x;
{
	int sc;		/* return from scanf */
	char *s = exp_get_var(interp,"send_human");

	if (!s) {
		exp_error(interp,"send -h: send_human has no value");
		return(-1);
	}
	if (5 != (sc = sscanf(s,"%f %f %f %f %f",
			&x->alpha,&x->alpha_eow,&x->c,&x->min,&x->max))) {
		if (sc == EOF) sc = 0;	/* make up for overloaded return */
		exp_error(interp,"send -h: found %d value(s) in send_human but need 5",sc);
		return(-1);
	}
	if (x->alpha < 0 || x->alpha_eow < 0) {
		exp_error(interp,"send -h: average interarrival times (%f %f) must be non-negative in send_human", x->alpha,x->alpha_eow);
		return(-1);
	}
	if (x->c <= 0) {
		exp_error(interp,"send -h: variability (%f) in send_human must be positive",x->c);
		return(-1);
	}
	x->c = 1/x->c;

	if (x->min < 0) {
		exp_error(interp,"send -h: minimum (%f) in send_human must be non-negative",x->min);
		return(-1);
	}
	if (x->max < 0) {
		exp_error(interp,"send -h: maximum (%f) in send_human must be non-negative",x->max);
		return(-1);
	}
	if (x->max < x->min) {
		exp_error(interp,"send -h: maximum (%f) must be >= minimum (%f) in send_human",x->max,x->min);
		return(-1);
	}
	return(0);
}

/* Compute random numbers from 0 to 1, for expect's send -h */
/* This implementation sacrifices beauty for portability */
static float
unit_random()
{
	/* current implementation is pathetic but works */
	/* 99991 is largest prime in my CRC - can't hurt, eh? */
	return((float)(1+(rand()%99991))/99991.0);
}

void
exp_init_unit_random()
{
	srand(getpid());
}

/* This function is my implementation of the Weibull distribution. */
/* I've added a max time and an "alpha_eow" that captures the slight */
/* but noticable change in human typists when hitting end-of-word */
/* transitions. */
/* returns 0 for success, -1 for failure, pos. for Tcl return value */
static int
human_write(interp,esPtr,buffer,arg) /* INTL */
Tcl_Interp *interp;
ExpState *esPtr;
char *buffer;
struct human_arg *arg;
{
    char *sp;
    int size;
    float t;
    float alpha;
    int wc;
    int in_word = TRUE;
    Tcl_UniChar ch;

    expDiagLog("human_write: avg_arr=%f/%f  1/shape=%f  min=%f  max=%f\r\n",
	    arg->alpha,arg->alpha_eow,arg->c,arg->min,arg->max);

    for (sp = buffer;*sp;sp += size) {
	size = Tcl_UtfToUniChar(sp, &ch);
	/* use the end-of-word alpha at eow transitions */
	if (in_word && (Tcl_UniCharIsPunct(ch) || Tcl_UniCharIsSpace(ch)))
	    alpha = arg->alpha_eow;
	else alpha = arg->alpha;
	in_word = !(Tcl_UniCharIsPunct(ch) || Tcl_UniCharIsSpace(ch));

	t = alpha * pow(-log((double)unit_random()),arg->c);

	/* enforce min and max times */
	if (t<arg->min) t = arg->min;
	else if (t>arg->max) t = arg->max;

		/* skip sleep before writing first character */
	if (sp != buffer) {
	    wc = exp_dsleep(interp,(double)t);
	    if (wc > 0) return wc;
	}

	wc = Tcl_WriteChars(esPtr->channel, sp, size);
	if (0 > wc) return(wc);
    }
    return(0);
}

struct exp_i *exp_i_pool = 0;
struct exp_state_list *exp_state_list_pool = 0;

#define EXP_I_INIT_COUNT	10
#define EXP_FD_INIT_COUNT	10

struct exp_i *
exp_new_i()
{
	int n;
	struct exp_i *i;

	if (!exp_i_pool) {
		/* none avail, generate some new ones */
		exp_i_pool = i = (struct exp_i *)ckalloc(
			EXP_I_INIT_COUNT * sizeof(struct exp_i));
		for (n=0;n<EXP_I_INIT_COUNT-1;n++,i++) {
			i->next = i+1;
		}
		i->next = 0;
	}

	/* now that we've made some, unlink one and give to user */

	i = exp_i_pool;
	exp_i_pool = exp_i_pool->next;
	i->value = 0;
	i->variable = 0;
	i->state_list = 0;
	i->ecount = 0;
	i->next = 0;
	return i;
}

struct exp_state_list *
exp_new_state(esPtr)
ExpState *esPtr;
{
    int n;
    struct exp_state_list *fd;

    if (!exp_state_list_pool) {
	/* none avail, generate some new ones */
	exp_state_list_pool = fd = (struct exp_state_list *)ckalloc(
	    EXP_FD_INIT_COUNT * sizeof(struct exp_state_list));
	for (n=0;n<EXP_FD_INIT_COUNT-1;n++,fd++) {
	    fd->next = fd+1;
	}
	fd->next = 0;
    }

    /* now that we've made some, unlink one and give to user */

    fd = exp_state_list_pool;
    exp_state_list_pool = exp_state_list_pool->next;
    fd->esPtr = esPtr;
    /* fd->next is assumed to be changed by caller */
    return fd;
}

void
exp_free_state(fd_first)
struct exp_state_list *fd_first;
{
	struct exp_state_list *fd, *penultimate;

	if (!fd_first) return;

	/* link entire chain back in at once by first finding last pointer */
	/* making that point back to pool, and then resetting pool to this */

	/* run to end */
	for (fd = fd_first;fd;fd=fd->next) {
		penultimate = fd;
	}
	penultimate->next = exp_state_list_pool;
	exp_state_list_pool = fd_first;
}

/* free a single fd */
void
exp_free_state_single(fd)
struct exp_state_list *fd;
{
	fd->next = exp_state_list_pool;
	exp_state_list_pool = fd;
}

void
exp_free_i(interp,i,updateproc)
Tcl_Interp *interp;
struct exp_i *i;
Tcl_VarTraceProc *updateproc;	/* proc to invoke if indirect is written */
{
	if (i->next) exp_free_i(interp,i->next,updateproc);

	exp_free_state(i->state_list);

	if (i->direct == EXP_INDIRECT) {
		Tcl_UntraceVar(interp,i->variable,
			TCL_GLOBAL_ONLY|TCL_TRACE_WRITES,
			updateproc,(ClientData)i);
	}

	/* here's the long form
	   if duration & direct	free(var)  free(val)
		PERM	  DIR	    		1
		PERM	  INDIR	    1		1
		TMP	  DIR
		TMP	  INDIR			1
	   Also if i->variable was a bogus variable name, i->value might not be
	   set, so test i->value to protect this
	   TMP in this case does NOT mean from the "expect" command.  Rather
	   it means "an implicit spawn id from any expect or expect_XXX
	   command".  In other words, there was no variable name provided.
	*/
	if (i->value
	   && (((i->direct == EXP_DIRECT) && (i->duration == EXP_PERMANENT))
		|| ((i->direct == EXP_INDIRECT) && (i->duration == EXP_TEMPORARY)))) {
		ckfree(i->value);
	} else if (i->duration == EXP_PERMANENT) {
		if (i->value) ckfree(i->value);
		if (i->variable) ckfree(i->variable);
	}

	i->next = exp_i_pool;
	exp_i_pool = i;
}

/* generate a descriptor for a "-i" flag */
/* cannot fail */
struct exp_i *
exp_new_i_complex(interp,arg,duration,updateproc)
Tcl_Interp *interp;
char *arg;		/* spawn id list or a variable containing a list */
int duration;		/* if we have to copy the args */
			/* should only need do this in expect_before/after */
Tcl_VarTraceProc *updateproc;	/* proc to invoke if indirect is written */
{
	struct exp_i *i;
	char **stringp;

	i = exp_new_i();

	i->direct = (isExpChannelName(arg)?EXP_DIRECT:EXP_INDIRECT);
#if OBSOLETE
	i->direct = (isdigit(arg[0]) || (arg[0] == '-'))?EXP_DIRECT:EXP_INDIRECT;
#endif
	if (i->direct == EXP_DIRECT) {
		stringp = &i->value;
	} else {
		stringp = &i->variable;
	}

	i->duration = duration;
	if (duration == EXP_PERMANENT) {
		*stringp = ckalloc(strlen(arg)+1);
		strcpy(*stringp,arg);
	} else {
		*stringp = arg;
	}

	i->state_list = 0;
	exp_i_update(interp,i);

	/* if indirect, ask Tcl to tell us when variable is modified */

	if (i->direct == EXP_INDIRECT) {
		Tcl_TraceVar(interp, i->variable,
			TCL_GLOBAL_ONLY|TCL_TRACE_WRITES,
			updateproc, (ClientData) i);
	}

	return i;
}

void
exp_i_add_state(i,esPtr)
struct exp_i *i;
ExpState *esPtr;
{
	struct exp_state_list *new_state;

	new_state = exp_new_state(esPtr);
	new_state->next = i->state_list;
	i->state_list = new_state;
}

/* this routine assumes i->esPtr is meaningful */
static void
exp_i_parse_states(interp,i) /* INTL */
Tcl_Interp *interp;
struct exp_i *i;
{
    struct ExpState *esPtr;
    char *p = i->value;
    int argc;
    char **argv;
    int j;

    if (Tcl_SplitList(NULL, p, &argc, &argv) != TCL_OK) goto error;

    for (j = 0; j < argc; j++) {
        esPtr = expStateFromChannelName(interp,argv[j],1,0,0,"");
	if (!esPtr) goto error;
	exp_i_add_state(i,esPtr);
    }
    ckfree((char*)argv);
    return;
error:
    expDiagLogU("exp_i_parse_states: ");
    expDiagLogU(Tcl_GetStringResult(interp));
    return;
}
	
/* updates a single exp_i struct */
void
exp_i_update(interp,i)
Tcl_Interp *interp;
struct exp_i *i;
{
  char *p;	/* string representation of list of spawn ids */

  if (i->direct == EXP_INDIRECT) {
    p = Tcl_GetVar(interp,i->variable,TCL_GLOBAL_ONLY);
    if (!p) {
      p = "";
      /* *really* big variable names could blow up expDiagLog! */
      expDiagLog("warning: indirect variable %s undefined",i->variable);
    }
    
    if (i->value) {
      if (streq(p,i->value)) return;
      
      /* replace new value with old */
      ckfree(i->value);
    }
    i->value = ckalloc(strlen(p)+1);
    strcpy(i->value,p);

    exp_free_state(i->state_list);
    i->state_list = 0;
  } else {
    /* no free, because this should only be called on */
    /* "direct" i's once */
    i->state_list = 0;
  }
  exp_i_parse_states(interp, i);
  return;
}

struct exp_i *
exp_new_i_simple(esPtr,duration)
ExpState *esPtr;
int duration;		/* if we have to copy the args */
			/* should only need do this in expect_before/after */
{
	struct exp_i *i;

	i = exp_new_i();

	i->direct = EXP_DIRECT;
	i->duration = duration;

	exp_i_add_state(i,esPtr);

	return i;
}

/*ARGSUSED*/
static int
Exp_SendLogCmd(clientData, interp, argc, argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;
char **argv;
{
	argv++;
	argc--;
	if (argc) {
		if (streq(*argv,"--")) {
			argc--; argv++;
		}
	}

	if (argc != 1) {
		exp_error(interp,"usage: send [args] string");
		return TCL_ERROR;
	}

	expLogDiagU(*argv);
	return(TCL_OK);
}


/* I've rewritten this to be unbuffered.  I did this so you could shove */
/* large files through "send".  If you are concerned about efficiency */
/* you should quote all your send args to make them one single argument. */
/*ARGSUSED*/
static int
Exp_SendObjCmd(clientData, interp, objc, objv) /* INTL */
ClientData clientData;
Tcl_Interp *interp;
int objc;
Tcl_Obj *CONST objv[];
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    ExpState *esPtr = 0;
    int rc; 	/* final result of this procedure */
    struct human_arg human_args;
    struct slow_arg slow_args;
#define SEND_STYLE_STRING_MASK	0x07	/* mask to detect a real string arg */
#define SEND_STYLE_PLAIN	0x01
#define SEND_STYLE_HUMAN	0x02
#define SEND_STYLE_SLOW		0x04
#define SEND_STYLE_ZERO		0x10
#define SEND_STYLE_BREAK	0x20
    int send_style = SEND_STYLE_PLAIN;
    int want_cooked = TRUE;
    char *string;		/* string to send */
    int len = -1;		/* length of string to send */
    int zeros;		/* count of how many ascii zeros to send */

    char *chanName = 0;
    struct exp_state_list *state_list;
    struct exp_i *i;
    int j;

    static char *options[] = {
	"-i", "-h", "-s", "-null", "-0", "-raw", "-break", "--", (char *)0
    };
    enum options {
	SEND_SPAWNID, SEND_HUMAN, SEND_SLOW, SEND_NULL, SEND_ZERO,
	SEND_RAW, SEND_BREAK, SEND_LAST
    };

    for (j = 1; j < objc; j++) {
	char *name;
	int index;

	name = Tcl_GetString(objv[j]);
	if (name[0] != '-') {
	    break;
	}
	if (Tcl_GetIndexFromObj(interp, objv[j], options, "flag", 0,
		&index) != TCL_OK) {
	    return TCL_ERROR;
	}
	switch ((enum options) index) {
	    case SEND_SPAWNID:
		j++;
		chanName = Tcl_GetString(objv[j]);
		break;

	    case SEND_LAST:
		j++;
		goto getString;

	    case SEND_HUMAN:
		if (-1 == get_human_args(interp,&human_args))
		    return(TCL_ERROR);
		send_style = SEND_STYLE_HUMAN;
		break;

	    case SEND_SLOW:
		if (-1 == get_slow_args(interp,&slow_args))
		    return(TCL_ERROR);
		send_style = SEND_STYLE_SLOW;
		break;

	    case SEND_NULL:
	    case SEND_ZERO:
		j++;
		if (j >= objc) {
		    zeros = 1;
		} else if (Tcl_GetIntFromObj(interp, objv[j], &zeros)
			!= TCL_OK) {
		    return TCL_ERROR;
		}
		if (zeros < 1) return TCL_OK;
		send_style = SEND_STYLE_ZERO;
		string = "<zero(s)>";
		break;

	    case SEND_RAW:
		want_cooked = FALSE;
		break;

	    case SEND_BREAK:
		send_style = SEND_STYLE_BREAK;
		string = "<break>";
		break;
	}
    }

    if (send_style & SEND_STYLE_STRING_MASK) {
	if (j != objc-1) {
	    exp_error(interp,"usage: send [args] string");
	    return TCL_ERROR;
	}
getString:
	string = Tcl_GetStringFromObj(objv[j], &len);
    } else {
	len = strlen(string);
    }

    if (clientData == &sendCD_user) esPtr = tsdPtr->stdinout;
    else if (clientData == &sendCD_error) esPtr = tsdPtr->stderrX;
    else if (clientData == &sendCD_tty) esPtr = tsdPtr->devtty;
    else if (!chanName) {
	/* we want to check if it is open */
	/* but since stdin could be closed, we have to first */
	/* get the fd and then convert it from 0 to 1 if necessary */
	if (!(esPtr = expStateCurrent(interp,0,0,0))) return(TCL_ERROR);
    }

    if (esPtr) {
	i = exp_new_i_simple(esPtr,EXP_TEMPORARY);
    } else {
	i = exp_new_i_complex(interp,chanName,FALSE,(Tcl_VarTraceProc *)0);
    }

#define send_to_stderr	(clientData == &sendCD_error)
#define send_to_proc	(clientData == &sendCD_proc)
#define send_to_user	((clientData == &sendCD_user) || \
			 (clientData == &sendCD_tty))

    if (send_to_proc) {
	want_cooked = FALSE;
	expDiagLogU("send: sending \"");
	expDiagLogU(expPrintify(string));
	expDiagLogU("\" to {");
	/* if closing brace doesn't appear, that's because an error */
	/* was encountered before we could send it */
    } else {
	expLogDiagU(string);
    }

    for (state_list=i->state_list;state_list;state_list=state_list->next) {
	esPtr = state_list->esPtr;

	if (send_to_proc) {
	    expDiagLog(" %s ",esPtr->name);
	}

	/* check validity of each - i.e., are they open */
	if (0 == expStateCheck(interp,esPtr,1,0,"send")) {
	    rc = TCL_ERROR;
	    goto finish;
	}
	if (want_cooked) string = exp_cook(string,&len);

	switch (send_style) {
	    case SEND_STYLE_PLAIN:
		rc = exact_write(esPtr,string,len);
		break;
	    case SEND_STYLE_SLOW:
		rc = slow_write(interp,esPtr,string,len,&slow_args);
		break;
	    case SEND_STYLE_HUMAN:
		rc = human_write(interp,esPtr,string,&human_args);
		break;
	    case SEND_STYLE_ZERO:
		for (;zeros>0;zeros--) {
		    rc = Tcl_WriteChars(esPtr->channel,
			    NULL_STRING, NULL_LENGTH);
		}
		/* catching error on last write is sufficient */
		rc = ((rc==1) ? 0 : -1);   /* normal is 1 not 0 */
		break;
	    case SEND_STYLE_BREAK:
		exp_tty_break(interp,esPtr->fdout);
		rc = 0;
		break;
	}

	if (rc != 0) {
	    if (rc == -1) {
		exp_error(interp,"write(spawn_id=%d): %s",esPtr->fdout,Tcl_PosixError(interp));
		rc = TCL_ERROR;
	    }
	    goto finish;
	}
    }
    if (send_to_proc) expDiagLogU("}\r\n");

    rc = TCL_OK;
 finish:
    exp_free_i(interp,i,(Tcl_VarTraceProc *)0);
    return rc;
}

/*ARGSUSED*/
static int
Exp_LogFileCmd(clientData, interp, argc, argv)
    ClientData clientData;
    Tcl_Interp *interp;
    int argc;
    char **argv;
{
    static char resultbuf[1000];
    char *chanName = 0;
    int leaveOpen = FALSE;
    int logAll = FALSE;
    int append = TRUE;
    char *filename = 0;

    argv++;
    argc--;
    for (;argc>0;argc--,argv++) {
	if (streq(*argv,"-open")) {
	    if (!argv[1]) goto usage_error;
	    chanName = argv[1];
	    argc--; argv++;
	} else if (streq(*argv,"-leaveopen")) {
	    if (!argv[1]) goto usage_error;
	    chanName = argv[1];
	    leaveOpen = TRUE;
	    argc--; argv++;
	} else if (streq(*argv,"-a")) {
	    logAll = TRUE;
	} else if (streq(*argv,"-info")) {
	    resultbuf[0] = '\0';
	    if (expLogChannelGet()) {
		if (expLogAllGet()) strcat(resultbuf,"-a ");
		if (!expLogAppendGet()) strcat(resultbuf,"-noappend ");
		if (expLogFilenameGet()) {
		    strcat(resultbuf,expLogFilenameGet());
		} else {
		    if (expLogLeaveOpenGet()) {
			strcat(resultbuf,"-leaveopen ");
		    }
		    strcat(resultbuf,Tcl_GetChannelName(expLogChannelGet()));
		}
		Tcl_SetResult(interp,resultbuf,TCL_STATIC);
	    }
	    return TCL_OK;
	} else if (streq(*argv,"-noappend")) {
	    append = FALSE;
	} else break;
    }
    
    if (argc == 1) {
	filename = argv[0];
    } else if (argc > 1) {
	/* too many arguments */
	goto usage_error;
    } 
    
    if (chanName && filename) {
	goto usage_error;
    }

    /* check if user merely wants to change logAll (-a) */
    if (expLogChannelGet() && (chanName || filename)) {
	if (filename && (0 == strcmp(filename,expLogFilenameGet()))) {
	    expLogAllSet(logAll);
	    return TCL_OK;
	} else if (chanName && (0 == strcmp(filename,Tcl_GetChannelName(expLogChannelGet())))) {
	    expLogAllSet(logAll);
	    return TCL_OK;
	} else {
	    exp_error(interp,"cannot start logging without first stopping logging");
	    return TCL_ERROR;
	}
    }

    if (filename) {
	if (TCL_ERROR == expLogChannelOpen(interp,filename,append)) {
	    return TCL_ERROR;
	}
    } else if (chanName) {
	if (TCL_ERROR == expLogChannelSet(interp,chanName)) {
	    return TCL_ERROR;
	}
    } else {
	expLogChannelClose(interp);
	if (logAll) {
	    exp_error(interp,"cannot use -a without a file or channel");
	    return TCL_ERROR;
	}
    }
    expLogAllSet(logAll);
    expLogLeaveOpenSet(leaveOpen);

    return TCL_OK;

 usage_error:
    exp_error(interp,"usage: log_file [-info] [-noappend] [[-a] file] [-[leave]open [open ...]]");
    return TCL_ERROR;
}

/*ARGSUSED*/
static int
Exp_LogUserCmd(clientData, interp, argc, argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;
char **argv;
{
    int old_loguser = expLogUserGet();

    if (argc == 0 || (argc == 2 && streq(argv[1],"-info"))) {
	/* do nothing */
    } else if (argc == 2) {
	expLogUserSet(atoi(argv[1]));
    } else {
	exp_error(interp,"usage: [-info|1|0]");
    }

    sprintf(interp->result,"%d",old_loguser);

    return(TCL_OK);
}

#ifdef TCL_DEBUGGER
/*ARGSUSED*/
static int
Exp_DebugCmd(clientData, interp, argc, argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;
char **argv;
{
    int now = FALSE;	/* soon if FALSE, now if TRUE */
    int exp_tcl_debugger_was_available = exp_tcl_debugger_available;

    if (argc > 3) goto usage;

    if (argc == 1) {
	sprintf(interp->result,"%d",exp_tcl_debugger_available);
	return TCL_OK;
    }

    argv++;

    while (*argv) {
	if (streq(*argv,"-now")) {
	    now = TRUE;
	    argv++;
	}
	else break;
    }

    if (!*argv) {
	if (now) {
	    Dbg_On(interp,1);
	    exp_tcl_debugger_available = 1;
	} else {
	    goto usage;
	}
    } else if (streq(*argv,"0")) {
	Dbg_Off(interp);
	exp_tcl_debugger_available = 0;
    } else {
	Dbg_On(interp,now);
	exp_tcl_debugger_available = 1;
    }
    sprintf(interp->result,"%d",exp_tcl_debugger_was_available);
    return(TCL_OK);
 usage:
    exp_error(interp,"usage: [[-now] 1|0]");
    return TCL_ERROR;
}
#endif


/*ARGSUSED*/
static int
Exp_ExpInternalCmd(clientData, interp, argc, argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;
char **argv;
{
    int newChannel = FALSE;
    Tcl_Channel oldChannel;
    static char resultbuf[1000];

    if ((argc > 1) && streq(argv[1],"-info")) {
	resultbuf[0] = '\0';
	oldChannel = expDiagChannelGet();
	if (oldChannel) {
	    sprintf(resultbuf,"-f %s ",expDiagFilename());
	}
	strcat(resultbuf,expDiagToStderrGet()?"1":"0");
	Tcl_SetResult(interp,resultbuf,TCL_STATIC);
	return TCL_OK;
    }

    argv++;
    argc--;

    while (argc) {
	if (!streq(*argv,"-f")) break;
	argc--;argv++;
	if (argc < 1) goto usage;
	expDiagChannelClose(interp);
	if (TCL_OK != expDiagChannelOpen(interp,argv[0])) {
	    return TCL_ERROR;
	}
	newChannel = TRUE;
	argc--;argv++;
    }

    if (argc != 1) goto usage;
    
    /* if no -f given, close file */
    if (!newChannel) {
	expDiagChannelClose(interp);
    }
    expDiagToStderrSet(atoi(*argv));
    return(TCL_OK);
 usage:
    exp_error(interp,"usage: [-f file] 0|1");
    return TCL_ERROR;
}

char *exp_onexit_action = 0;

/*ARGSUSED*/
static int
Exp_ExitCmd(clientData, interp, argc, argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;
char **argv;
{
	int value = 0;

	argv++;

	if (*argv) {
		if (exp_flageq(*argv,"-onexit",3)) {
			argv++;
			if (*argv) {
				int len = strlen(*argv);
				if (exp_onexit_action)
					ckfree(exp_onexit_action);
				exp_onexit_action = ckalloc(len + 1);
				strcpy(exp_onexit_action,*argv);
			} else if (exp_onexit_action) {
				Tcl_AppendResult(interp,exp_onexit_action,(char *)0);
			}
			return TCL_OK;
		} else if (exp_flageq(*argv,"-noexit",3)) {
			argv++;
			exp_exit_handlers((ClientData)interp);
			return TCL_OK;
		}
	}

	if (*argv) {
		if (Tcl_GetInt(interp, *argv, &value) != TCL_OK) {
			return TCL_ERROR;
		}
	}

	Tcl_Exit(value);
	/*NOTREACHED*/
}

/*ARGSUSED*/
static int
Exp_CloseObjCmd(clientData, interp, objc, objv)
ClientData clientData;
Tcl_Interp *interp;
int objc;
Tcl_Obj *CONST objv[];	/* Argument objects. */
{
    int onexec_flag = FALSE;	/* true if -onexec seen */
    int close_onexec;
    int slave_flag = FALSE;
    ExpState *esPtr = 0;
    char *chanName = 0;

    int objc_orig = objc;
    Tcl_Obj *CONST *objv_orig = objv;

    objc--; objv++;

    for (;objc>0;objc--,objv++) {
	if (streq("-i",Tcl_GetString(*objv))) {
	    objc--; objv++;
	    if (objc == 0) {
		exp_error(interp,"usage: -i spawn_id");
		return(TCL_ERROR);
	    }
	    chanName = Tcl_GetString(*objv);
	} else if (streq(Tcl_GetString(*objv),"-slave")) {
	    slave_flag = TRUE;
	} else if (streq(Tcl_GetString(*objv),"-onexec")) {
	    objc--; objv++;
	    if (objc == 0) {
		exp_error(interp,"usage: -onexec 0|1");
		return(TCL_ERROR);
	    }
	    onexec_flag = TRUE;
	    close_onexec = atoi(Tcl_GetString(*objv));
	} else break;
    }

    if (objc) {
	/* doesn't look like our format, it must be a Tcl-style file */
	/* handle.  Lucky that formats are easily distinguishable. */
	/* Historical note: we used "close"  long before there was a */
	/* Tcl builtin by the same name. */

	Tcl_CmdInfo info;
	Tcl_ResetResult(interp);
	if (0 == Tcl_GetCommandInfo(interp,"close",&info)) {
	    info.clientData = 0;
	}
	return(Tcl_CloseObjCmd(info.clientData,interp,objc_orig,objv_orig));
    }

    if (chanName) {
	if (!(esPtr = expStateFromChannelName(interp,chanName,1,0,0,"close"))) return TCL_ERROR;
    } else {
	if (!(esPtr = expStateCurrent(interp,1,0,0))) return TCL_ERROR;
    }

    if (slave_flag) {
	if (esPtr->fd_slave != EXP_NOFD) {
	    close(esPtr->fd_slave);
	    esPtr->fd_slave = EXP_NOFD;

	    exp_slave_control(esPtr->fdin,1);

	    return TCL_OK;
	} else {
	    exp_error(interp,"no such slave");
	    return TCL_ERROR;
	}
    }

    if (onexec_flag) {
	/* heck, don't even bother to check if fd is open or a real */
	/* spawn id, nothing else depends on it */
	fcntl(esPtr->fdin,F_SETFD,close_onexec);
	return TCL_OK;
    }

    return(exp_close(interp,esPtr));
}

/*ARGSUSED*/
static void
tcl_tracer(clientData,interp,level,command,cmdProc,cmdClientData,argc,argv)
ClientData clientData;
Tcl_Interp *interp;
int level;
char *command;
int (*cmdProc)();
ClientData cmdClientData;
int argc;
char *argv[];
{
	int i;

	/* come out on stderr, by using expErrorLog */
	expErrorLog("%2d",level);
	for (i = 0;i<level;i++) expErrorLogU("  ");
	expErrorLogU(command);
	expErrorLogU("\r\n");
}

/*ARGSUSED*/
static int
Exp_StraceCmd(clientData, interp, argc, argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;
char **argv;
{
	static int trace_level = 0;
	static Tcl_Trace trace_handle;

	if (argc > 1 && streq(argv[1],"-info")) {
		sprintf(interp->result,"%d",trace_level);
		return TCL_OK;
	}

	if (argc != 2) {
		exp_error(interp,"usage: trace level");
		return(TCL_ERROR);
	}
	/* tracing already in effect, undo it */
	if (trace_level > 0) Tcl_DeleteTrace(interp,trace_handle);

	/* get and save new trace level */
	trace_level = atoi(argv[1]);
	if (trace_level > 0)
		trace_handle = Tcl_CreateTrace(interp,
				trace_level,tcl_tracer,(ClientData)0);
	return(TCL_OK);
}

/* following defn's are stolen from tclUnix.h */

/*
 * The type of the status returned by wait varies from UNIX system
 * to UNIX system.  The macro below defines it:
 */

#if 0
#ifndef NO_UNION_WAIT
#   define WAIT_STATUS_TYPE union wait
#else
#   define WAIT_STATUS_TYPE int
#endif
#endif /* 0 */

/*
 * following definitions stolen from tclUnix.h
 * (should have been made public!)

 * Supply definitions for macros to query wait status, if not already
 * defined in header files above.
 */

#if 0
#ifndef WIFEXITED
#   define WIFEXITED(stat)  (((*((int *) &(stat))) & 0xff) == 0)
#endif

#ifndef WEXITSTATUS
#   define WEXITSTATUS(stat) (((*((int *) &(stat))) >> 8) & 0xff)
#endif

#ifndef WIFSIGNALED
#   define WIFSIGNALED(stat) (((*((int *) &(stat)))) && ((*((int *) &(stat))) == ((*((int *) &(stat))) & 0x00ff)))
#endif

#ifndef WTERMSIG
#   define WTERMSIG(stat)    ((*((int *) &(stat))) & 0x7f)
#endif

#ifndef WIFSTOPPED
#   define WIFSTOPPED(stat)  (((*((int *) &(stat))) & 0xff) == 0177)
#endif

#ifndef WSTOPSIG
#   define WSTOPSIG(stat)    (((*((int *) &(stat))) >> 8) & 0xff)
#endif
#endif /* 0 */

/* end of stolen definitions */

/* Describe the processes created with Expect's fork.
This allows us to wait on them later.

This is maintained as a linked list.  As additional procs are forked,
new links are added.  As procs disappear, links are marked so that we
can reuse them later.
*/

struct forked_proc {
	int pid;
	WAIT_STATUS_TYPE wait_status;
	enum {not_in_use, wait_done, wait_not_done} link_status;
	struct forked_proc *next;
} *forked_proc_base = 0;

void
fork_clear_all()
{
	struct forked_proc *f;

	for (f=forked_proc_base;f;f=f->next) {
		f->link_status = not_in_use;
	}
}

void
fork_init(f,pid)
struct forked_proc *f;
int pid;
{
	f->pid = pid;
	f->link_status = wait_not_done;
}

/* make an entry for a new proc */
void
fork_add(pid)
int pid;
{
	struct forked_proc *f;

	for (f=forked_proc_base;f;f=f->next) {
		if (f->link_status == not_in_use) break;
	}

	/* add new entry to the front of the list */
	if (!f) {
		f = (struct forked_proc *)ckalloc(sizeof(struct forked_proc));
		f->next = forked_proc_base;
		forked_proc_base = f;
	}
	fork_init(f,pid);
}

/* Provide a last-chance guess for this if not defined already */
#ifndef WNOHANG
#define WNOHANG WNOHANG_BACKUP_VALUE
#endif

/* wait returns are a hodgepodge of things
 If wait fails, something seriously has gone wrong, for example:
   bogus arguments (i.e., incorrect, bogus spawn id)
   no children to wait on
   async event failed
 If wait succeeeds, something happened on a particular pid
   3rd arg is 0 if successfully reaped (if signal, additional fields supplied)
   3rd arg is -1 if unsuccessfully reaped (additional fields supplied)
*/
/*ARGSUSED*/
static int
Exp_WaitCmd(clientData, interp, argc, argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;
char **argv;
{
    char *chanName = 0;
    struct ExpState *esPtr;
    struct forked_proc *fp = 0;	/* handle to a pure forked proc */
    struct ExpState esTmp;	/* temporary memory for either f or fp */
    char spawn_id[20];

    int nowait = FALSE;
    int result = 0;		/* 0 means child was successfully waited on */
				/* -1 means an error occurred */
				/* -2 means no eligible children to wait on */
#define NO_CHILD -2

    argv++;
    argc--;
    for (;argc>0;argc--,argv++) {
	if (streq(*argv,"-i")) {
	    argc--; argv++;
	    if (argc==0) {
		exp_error(interp,"usage: -i spawn_id");
		return(TCL_ERROR);
	    }
	    chanName = *argv;
	} else if (streq(*argv,"-nowait")) {
	    nowait = TRUE;
	}
    }

    if (!chanName) {
	if (!(esPtr = expStateCurrent(interp,0,0,1))) return TCL_ERROR;
    } else {
	if (!(esPtr = expStateFromChannelName(interp,chanName,0,0,1,"wait")))
	    return TCL_ERROR;
    }

    if (!expStateAnyIs(esPtr)) {
	/* check if waited on already */
	/* things opened by "open" or set with -nowait */
	/* are marked sys_waited already */
	if (!esPtr->sys_waited) {
	    if (nowait) {
		/* should probably generate an error */
		/* if SIGCHLD is trapped. */

		/* pass to Tcl, so it can do wait */
		/* in background */
		Tcl_DetachPids(1,(Tcl_Pid *)&esPtr->pid);
		exp_wait_zero(&esPtr->wait);
	    } else {
		while (1) {
		    if (Tcl_AsyncReady()) {
			int rc = Tcl_AsyncInvoke(interp,TCL_OK);
			if (rc != TCL_OK) return(rc);
		    }

		    result = waitpid(esPtr->pid,&esPtr->wait,0);
		    if (result == esPtr->pid) break;
		    if (result == -1) {
			if (errno == EINTR) continue;
			else break;
		    }
		}
	    }
	}

	/*
	 * Now have Tcl reap anything we just detached. 
	 * This also allows procs user has created with "exec &"
	 * and and associated with an "exec &" process to be reaped.
	 */
	
	Tcl_ReapDetachedProcs();
	exp_rearm_sigchld(interp); /* new */

	strcpy(spawn_id,esPtr->name);
    } else {
	/* wait for any of our own spawned processes */
	/* we call waitpid rather than wait to avoid running into */
	/* someone else's processes.  Yes, according to Ousterhout */
	/* this is the best way to do it. */

	int waited_on_forked_process = 0;

	esPtr = expWaitOnAny();
	if (!esPtr) {
	    /* if it's not a spawned process, maybe its a forked process */
	    for (fp=forked_proc_base;fp;fp=fp->next) {
		if (fp->link_status == not_in_use) continue;
	restart:
		result = waitpid(fp->pid,&fp->wait_status,WNOHANG);
		if (result == fp->pid) {
		    waited_on_forked_process = 1;
		    break;
		}
		if (result == 0) continue;	/* busy, try next */
		if (result == -1) {
		    if (errno == EINTR) goto restart;
		    else break;
		}
	    }

	    if (waited_on_forked_process) {
		/*
		 * The literal spawn id in the return value from wait appears
		 * as a -1 to indicate a forked process was waited on.  
		 */
		strcpy(spawn_id,"-1");
	    } else {
		result = NO_CHILD;	/* no children */
		Tcl_ReapDetachedProcs();
	    }
	    exp_rearm_sigchld(interp);
	}
    }

    /*  sigh, wedge forked_proc into an ExpState structure so we don't
     *  have to rewrite remaining code (too much)
     */
    if (fp) {
	esPtr = &esTmp;
	esPtr->pid = fp->pid;
	esPtr->wait = fp->wait_status;
    }

    /* non-portable assumption that pid_t can be printed with %d */

    if (result == -1) {
	sprintf(interp->result,"%d %s -1 %d POSIX %s %s",
		esPtr->pid,spawn_id,errno,Tcl_ErrnoId(),Tcl_ErrnoMsg(errno));
	result = TCL_OK;
    } else if (result == NO_CHILD) {
	exp_error(interp,"no children");
	return TCL_ERROR;
    } else {
	sprintf(interp->result,"%d %s 0 %d",
		esPtr->pid,spawn_id,WEXITSTATUS(esPtr->wait));
	if (WIFSIGNALED(esPtr->wait)) {
	    Tcl_AppendElement(interp,"CHILDKILLED");
	    Tcl_AppendElement(interp,Tcl_SignalId((int)(WTERMSIG(esPtr->wait))));
	    Tcl_AppendElement(interp,Tcl_SignalMsg((int) (WTERMSIG(esPtr->wait))));
	} else if (WIFSTOPPED(esPtr->wait)) {
	    Tcl_AppendElement(interp,"CHILDSUSP");
	    Tcl_AppendElement(interp,Tcl_SignalId((int) (WSTOPSIG(esPtr->wait))));
	    Tcl_AppendElement(interp,Tcl_SignalMsg((int) (WSTOPSIG(esPtr->wait))));
	}
    }
			
    if (fp) {
	fp->link_status = not_in_use;
	return ((result == -1)?TCL_ERROR:TCL_OK);		
    }

    esPtr->sys_waited = TRUE;
    esPtr->user_waited = TRUE;

    /* if user has already called close, forget about this entry entirely */
    if (!esPtr->open) {
      if (esPtr->registered) {
	Tcl_UnregisterChannel(interp,esPtr->channel);
      }
    }

    return ((result == -1)?TCL_ERROR:TCL_OK);
}

/*ARGSUSED*/
static int
Exp_ForkCmd(clientData, interp, argc, argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;
char **argv;
{
	int rc;
	if (argc > 1) {
		exp_error(interp,"usage: fork");
		return(TCL_ERROR);
	}

	rc = fork();
	if (rc == -1) {
		exp_error(interp,"fork: %s",Tcl_PosixError(interp));
		return TCL_ERROR;
	} else if (rc == 0) {
		/* child */
		exp_forked = TRUE;
		exp_getpid = getpid();
		fork_clear_all();
	} else {
		/* parent */
		fork_add(rc);
	}

	/* both child and parent follow remainder of code */
	sprintf(interp->result,"%d",rc);
	expDiagLog("fork: returns {%s}\r\n",interp->result);
	return(TCL_OK);
}

/*ARGSUSED*/
static int
Exp_DisconnectCmd(clientData, interp, argc, argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;
char **argv;
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    

    /* tell CenterLine to ignore non-use of ttyfd */
    /*SUPPRESS 591*/
    int ttyfd;

    if (argc > 1) {
	exp_error(interp,"usage: disconnect");
	return(TCL_ERROR);
    }

    if (exp_disconnected) {
	exp_error(interp,"already disconnected");
	return(TCL_ERROR);
    }
    if (!exp_forked) {
	exp_error(interp,"can only disconnect child process");
	return(TCL_ERROR);
    }
    exp_disconnected = TRUE;

    /* ignore hangup signals generated by testing ptys in getptymaster */
    /* and other places */
    signal(SIGHUP,SIG_IGN);

    /* reopen prevents confusion between send/expect_user */
    /* accidentally mapping to a real spawned process after a disconnect */

    /* if we're in a child that's about to be disconnected from the
       controlling tty, close and reopen 0, 1, and 2 but associated
       with /dev/null.  This prevents send and expect_user doing
       special things if newly spawned processes accidentally
       get allocated 0, 1, and 2.
    */
	   
    if (isatty(0)) {
	ExpState *stdinout = tsdPtr->stdinout;
	if (stdinout->valid) {
	    exp_close(interp,stdinout);
	    if (stdinout->registered) {
		Tcl_UnregisterChannel(interp,stdinout->channel);
	    }
	}
	open("/dev/null",0);
	open("/dev/null",1);
	/* tsdPtr->stdinout = expCreateChannel(interp,0,1,EXP_NOPID);*/
	/* tsdPtr->stdinout->keepForever = 1;*/
	}
    if (isatty(2)) {
	ExpState *devtty = tsdPtr->devtty;
	
	/* reopen stderr saves error checking in error/log routines. */
	if (devtty->valid) {
	    exp_close(interp,devtty);
	    if (devtty->registered) {
		Tcl_UnregisterChannel(interp,devtty->channel);
	    }
	}
	open("/dev/null",1);
	/* tsdPtr->devtty = expCreateChannel(interp,2,2,EXP_NOPID);*/
	/* tsdPtr->devtty->keepForever = 1;*/
    }

    Tcl_UnsetVar(interp,"tty_spawn_id",TCL_GLOBAL_ONLY);

#ifdef DO_SETSID
    setsid();
#else
#ifdef SYSV3
    /* put process in our own pgrp, and lose controlling terminal */
#ifdef sysV88
    /* With setpgrp first, child ends up with closed stdio */
    /* according to Dave Schmitt <[email protected]> */
    if (fork()) exit(0);
    expSetpgrp();
#else
    expSetpgrp();
    /*signal(SIGHUP,SIG_IGN); moved out to above */
    if (fork()) exit(0);	/* first child exits (as per Stevens, */
    /* UNIX Network Programming, p. 79-80) */
    /* second child process continues as daemon */
#endif
#else /* !SYSV3 */
    expSetpgrp();

/* Pyramid lacks this defn */
#ifdef TIOCNOTTY
    ttyfd = open("/dev/tty", O_RDWR);
    if (ttyfd >= 0) {
	/* zap controlling terminal if we had one */
	(void) ioctl(ttyfd, TIOCNOTTY, (char *)0);
	(void) close(ttyfd);
    }
#endif /* TIOCNOTTY */

#endif /* SYSV3 */
#endif /* DO_SETSID */
    return(TCL_OK);
}

/*ARGSUSED*/
static int
Exp_OverlayCmd(clientData, interp, argc, argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;
char **argv;
{
	int newfd, oldfd;
	int dash_name = 0;
	char *command;

	argc--; argv++;
	while (argc) {
		if (*argv[0] != '-') break;	/* not a flag */
		if (streq(*argv,"-")) {		/* - by itself */
			argc--; argv++;
			dash_name = 1;
			continue;
		}
		newfd = atoi(argv[0]+1);
		argc--; argv++;
		if (argc == 0) {
			exp_error(interp,"overlay -# requires additional argument");
			return(TCL_ERROR);
		}
		oldfd = atoi(argv[0]);
		argc--; argv++;
		expDiagLog("overlay: mapping fd %d to %d\r\n",oldfd,newfd);
		if (oldfd != newfd) (void) dup2(oldfd,newfd);
		else expDiagLog("warning: overlay: old fd == new fd (%d)\r\n",oldfd);
	}
	if (argc == 0) {
		exp_error(interp,"need program name");
		return(TCL_ERROR);
	}
	command = argv[0];
	if (dash_name) {
		argv[0] = ckalloc(1+strlen(command));
		sprintf(argv[0],"-%s",command);
	}

	signal(SIGINT, SIG_DFL);
	signal(SIGQUIT, SIG_DFL);
        (void) execvp(command,argv);
	exp_error(interp,"execvp(%s): %s\r\n",argv[0],Tcl_PosixError(interp));
	return(TCL_ERROR);
}

/*ARGSUSED*/
int
Exp_InterpreterObjCmd(clientData, interp, objc, objv)
ClientData clientData;
Tcl_Interp *interp;
int objc;
Tcl_Obj *CONST objv[];		/* Argument objects. */
{
    Tcl_Obj *eofObj = 0;
    int i;
    int index;
    int rc;

    static char *options[] = {
	"-eof", (char *)0
    };
    enum options {
	FLAG_EOF
    };

    for (i = 1; i < objc; i++) {
	if (Tcl_GetIndexFromObj(interp, objv[i], options, "flag", 0,
				&index) != TCL_OK) {
	    return TCL_ERROR;
	}
	switch ((enum options) index) {
	case FLAG_EOF:
	    i++;
	    if (i >= objc) {
		Tcl_WrongNumArgs(interp, 1, objv,"-eof cmd");
		return TCL_ERROR;
	    }
	    eofObj = objv[i];
	    Tcl_IncrRefCount(eofObj);
	    break;
	}
    }

    /* errors and ok, are caught by exp_interpreter() and discarded */
    /* to return TCL_OK, type "return" */
    rc = exp_interpreter(interp,eofObj);
    if (eofObj) Tcl_DecrRefCount(eofObj);
    return rc;
}

/* this command supercede's Tcl's builtin CONTINUE command */
/*ARGSUSED*/
int
Exp_ExpContinueCmd(clientData, interp, argc, argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;
char **argv;
{
    if (argc == 1) {
	return EXP_CONTINUE;
    } else if ((argc == 2) && (0 == strcmp(argv[1],"-continue_timer"))) {
	return EXP_CONTINUE_TIMER;
    }

    exp_error(interp,"usage: exp_continue [-continue_timer]\n");
    return(TCL_ERROR);
}

/* most of this is directly from Tcl's definition for return */
/*ARGSUSED*/
int
Exp_InterReturnObjCmd(clientData, interp, objc, objv)
ClientData clientData;
Tcl_Interp *interp;
int objc;
Tcl_Obj *CONST objv[];
{
    /* let Tcl's return command worry about args */
    /* if successful (i.e., TCL_RETURN is returned) */
    /* modify the result, so that we will handle it specially */

    int result = Tcl_ReturnObjCmd(clientData,interp,objc,objv);
    if (result == TCL_RETURN)
        result = EXP_TCL_RETURN;
    return result;
}

/*ARGSUSED*/
int
Exp_OpenCmd(clientData, interp, argc, argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;
char **argv;
{
    ExpState *esPtr;
    char *chanName = 0;
    int newfd;
    int leaveopen = FALSE;
    Tcl_Channel channel;

    argc--; argv++;

    for (;argc>0;argc--,argv++) {
	if (streq(*argv,"-i")) {
	    argc--; argv++;
	    if (!*argv) {
		exp_error(interp,"usage: -i spawn_id");
		return TCL_ERROR;
	    }
	    chanName = *argv;
	} else if (streq(*argv,"-leaveopen")) {
	    leaveopen = TRUE;
	    argc--; argv++;
	} else break;
    }

    if (!chanName) {
	if (!(esPtr = expStateCurrent(interp,1,0,0))) return TCL_ERROR;
    } else {
	if (!(esPtr = expStateFromChannelName(interp,chanName,1,0,0,"exp_open")))
return TCL_ERROR;
    }

    /* make a new copy of file descriptor */
    if (-1 == (newfd = dup(esPtr->fdin))) {
	exp_error(interp,"dup: %s",Tcl_PosixError(interp));
	return TCL_ERROR;
    }

    if (!leaveopen) {
	/* remove from Expect's memory in anticipation of passing to Tcl */
	if (esPtr->pid != EXP_NOPID) {
	    Tcl_DetachPids(1,(Tcl_Pid *)&esPtr->pid);
	    esPtr->pid = EXP_NOPID;
	    esPtr->sys_waited = esPtr->user_waited = TRUE;
	}
	exp_close(interp,esPtr);
    }

    /*
     * Tcl's MakeFileChannel only allows us to pass a single file descriptor
     * but that shouldn't be a problem in practice since all of the channels
     * that Expect generates only have one fd.  Of course, this code won't
     * work if someone creates a pipeline, then passes it to spawn, and then
     * again to exp_open.  For that to work, Tcl would need a new API.
     * Oh, and we're also being rather cavalier with the permissions here,
     * but they're likely to be right for the same reasons.
     */
    channel = Tcl_MakeFileChannel((ClientData)newfd,TCL_READABLE|TCL_WRITABLE);
    Tcl_RegisterChannel(interp, channel);
    Tcl_AppendResult(interp, Tcl_GetChannelName(channel), (char *) NULL);
    return TCL_OK;
}

/* return 1 if a string is substring of a flag */
/* this version is the code used by the macro that everyone calls */
int
exp_flageq_code(flag,string,minlen)
char *flag;
char *string;
int minlen;		/* at least this many chars must match */
{
	for (;*flag;flag++,string++,minlen--) {
		if (*string == '\0') break;
		if (*string != *flag) return 0;
	}
	if (*string == '\0' && minlen <= 0) return 1;
	return 0;
}

void
exp_create_commands(interp,c)
Tcl_Interp *interp;
struct exp_cmd_data *c;
{
	Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp);
	Namespace *currNsPtr   = (Namespace *) Tcl_GetCurrentNamespace(interp);
	char cmdnamebuf[80];

	for (;c->name;c++) {
		/* if already defined, don't redefine */
		if ((c->flags & EXP_REDEFINE) ||
		    !(Tcl_FindHashEntry(&globalNsPtr->cmdTable,c->name) ||
		      Tcl_FindHashEntry(&currNsPtr->cmdTable,c->name))) {
			if (c->objproc)
				Tcl_CreateObjCommand(interp,c->name,
						     c->objproc,c->data,exp_deleteObjProc);
			else
				Tcl_CreateCommand(interp,c->name,c->proc,
						  c->data,exp_deleteProc);
		}
		if (!(c->name[0] == 'e' &&
		      c->name[1] == 'x' &&
		      c->name[2] == 'p')
		    && !(c->flags & EXP_NOPREFIX)) {
			sprintf(cmdnamebuf,"exp_%s",c->name);
			if (c->objproc)
				Tcl_CreateObjCommand(interp,cmdnamebuf,c->objproc,c->data,
						     exp_deleteObjProc);
			else
				Tcl_CreateCommand(interp,cmdnamebuf,c->proc,
						  c->data,exp_deleteProc);
		}
	}
}

static struct exp_cmd_data cmd_data[]  = {
{"close",	Exp_CloseObjCmd,	0,	0,	EXP_REDEFINE},
#ifdef TCL_DEBUGGER
{"debug",	exp_proc(Exp_DebugCmd),	0,	0},
#endif
{"exp_internal",exp_proc(Exp_ExpInternalCmd),	0,	0},
{"disconnect",	exp_proc(Exp_DisconnectCmd),	0,	0},
{"exit",	exp_proc(Exp_ExitCmd),	0,	EXP_REDEFINE},
{"exp_continue",exp_proc(Exp_ExpContinueCmd),0,	0},
{"fork",	exp_proc(Exp_ForkCmd),	0,	0},
{"exp_pid",	exp_proc(Exp_ExpPidCmd),	0,	0},
{"getpid",	exp_proc(Exp_GetpidDeprecatedCmd),0,	0},
{"interpreter",	Exp_InterpreterObjCmd,	0,	0,	0},
{"log_file",	exp_proc(Exp_LogFileCmd),	0,	0},
{"log_user",	exp_proc(Exp_LogUserCmd),	0,	0},
{"exp_open",	exp_proc(Exp_OpenCmd),	0,	0},
{"overlay",	exp_proc(Exp_OverlayCmd),	0,	0},
{"inter_return",Exp_InterReturnObjCmd,	0,	0,	0},
{"send",	Exp_SendObjCmd,		0,	(ClientData)&sendCD_proc,0},
{"send_error",	Exp_SendObjCmd,		0,	(ClientData)&sendCD_error,0},
{"send_log",	exp_proc(Exp_SendLogCmd),	0,	0},
{"send_tty",	Exp_SendObjCmd,		0,	(ClientData)&sendCD_tty,0},
{"send_user",	Exp_SendObjCmd,		0,	(ClientData)&sendCD_user,0},
{"sleep",	exp_proc(Exp_SleepCmd),	0,	0},
{"spawn",	exp_proc(Exp_SpawnCmd),	0,	0},
{"strace",	exp_proc(Exp_StraceCmd),	0,	0},
{"wait",	exp_proc(Exp_WaitCmd),	0,	0},
{0}};

void
exp_init_most_cmds(interp)
Tcl_Interp *interp;
{
    exp_create_commands(interp,cmd_data);

#ifdef HAVE_PTYTRAP
    Tcl_InitHashTable(&slaveNames,TCL_STRING_KEYS);
#endif /* HAVE_PTYTRAP */
}