Tcl Source Code

by \fBTcl_GetRegExpFromObj\fR or \fBTcl_RegExpCompile\fR.
.AP char *start in
If \fItext\fR is just a portion of some other string, this argument
identifies the beginning of the larger string.
If it is not the same as \fItext\fR, then no
.QW \fB^\fR
matches will be allowed.
.AP int index in
.AP size_t index in
Specifies which range is desired:  0 means the range of the entire
match, 1 or greater means the range that matched a parenthesized
sub-expression.
.AP "const char" **startPtr out
The address of the first character in the range is stored here, or
NULL if there is no such range.
.AP "const char" **endPtr out
The address of the character just after the last one in the range
is stored here, or NULL if there is no such range.
.AP int cflags in
OR-ed combination of the compilation flags \fBTCL_REG_ADVANCED\fR,
\fBTCL_REG_EXTENDED\fR, \fBTCL_REG_BASIC\fR, \fBTCL_REG_EXPANDED\fR,
\fBTCL_REG_QUOTE\fR, \fBTCL_REG_NOCASE\fR, \fBTCL_REG_NEWLINE\fR,
\fBTCL_REG_NLSTOP\fR, \fBTCL_REG_NLANCH\fR, \fBTCL_REG_NOSUB\fR, and
\fBTCL_REG_CANMATCH\fR. See below for more information.
.AP int offset in
.AP size_t offset in
The character offset into the text where matching should begin.
The value of the offset has no impact on \fB^\fR matches.  This
behavior is controlled by \fIeflags\fR.
.AP int nmatches in
.AP size_t nmatches in
The number of matching subexpressions that should be remembered for
later use.  If this value is 0, then no subexpression match
information will be computed.  If the value is \-1, then
information will be computed.  If the value is TCL_INDEX_NONE, then
all of the matching subexpressions will be remembered.  Any other
value will be taken as the maximum number of subexpressions to
remember.
.AP int eflags in
OR-ed combination of the execution flags \fBTCL_REG_NOTBOL\fR and
\fBTCL_REG_NOTEOL\fR. See below for more information.
.AP Tcl_RegExpInfo *infoPtr out

\fBTcl_RegExpGetInfo\fR retrieves information about the last match
performed with a given regular expression \fIregexp\fR.  The
\fIinfoPtr\fR argument contains a pointer to a structure that is
defined as follows:
.PP
.CS
typedef struct Tcl_RegExpInfo {
    int \fInsubs\fR;
    size_t \fInsubs\fR;
    Tcl_RegExpIndices *\fImatches\fR;
    long \fIextendStart\fR;
    size_t \fIextendStart\fR;
} \fBTcl_RegExpInfo\fR;
.CE
.PP
The \fInsubs\fR field contains a count of the number of parenthesized
subexpressions within the regular expression.  If the \fBTCL_REG_NOSUB\fR
was used, then this value will be zero.  The \fImatches\fR field
points to an array of \fInsubs\fR+1 values that indicate the bounds of each
subexpression matched.  The first element in the array refers to the
range matched by the entire regular expression, and subsequent elements
refer to the parenthesized subexpressions in the order that they
appear in the pattern.  Each element is a structure that is defined as
follows:
.PP
.CS
typedef struct Tcl_RegExpIndices {
    long \fIstart\fR;
    long \fIend\fR;
    size_t \fIstart\fR;
    size_t \fIend\fR;
} \fBTcl_RegExpIndices\fR;
.CE
.PP
The \fIstart\fR and \fIend\fR values are Unicode character indices
relative to the offset location within \fIobjPtr\fR where matching began.
The \fIstart\fR index identifies the first character of the matched
subexpression.  The \fIend\fR index identifies the first character

specified character (not byte) \fIindex\fR in the UTF-8 string
\fIsrc\fR.  The source string must contain at least \fIindex\fR
characters.
.PP
\fBTcl_UtfAtIndex\fR returns a pointer to the specified character (not
byte) \fIindex\fR in the UTF-8 string \fIsrc\fR.  The source string must
contain at least \fIindex\fR characters.  This is equivalent to calling
\fBTcl_UtfNext\fR \fIindex\fR times.  If \fIindex\fR is TCL_AUTO_LENGTH,
\fBTcl_UtfNext\fR \fIindex\fR times.  If \fIindex\fR is TCL_INDEX_NONE,
the return pointer points to the first character in the source string.
.PP
\fBTcl_UtfBackslash\fR is a utility procedure used by several of the Tcl
commands.  It parses a backslash sequence and stores the properly formed
UTF-8 character represented by the backslash sequence in the output
buffer \fIdst\fR.  At most \fBTCL_UTF_MAX\fR bytes are stored in the buffer.
\fBTcl_UtfBackslash\fR modifies \fI*readPtr\fR to contain the number

    v->cv = NULL;
    v->cv2 = NULL;
    v->lacons = NULL;
    v->nlacons = 0;
    v->spaceused = 0;
    re->re_magic = REMAGIC;
    re->re_info = 0;		/* bits get set during parse */
    re->re_csize = sizeof(chr);
    re->re_guts = NULL;
    re->re_fns = (void*)(&functions);

    /*
     * More complex setup, malloced things.
     */

    g = (struct guts *) re->re_guts;
    if (g->magic != GUTSMAGIC) {
	fprintf(f, "bad guts magic number (0x%x not 0x%x)\n",
		g->magic, GUTSMAGIC);
    }

    fprintf(f, "\n\n\n========= DUMP ==========\n");
    fprintf(f, "nsub %d, info 0%lo, csize %d, ntree %d\n",
	    (int) re->re_nsub, re->re_info, re->re_csize, g->ntree);
    fprintf(f, "nsub %" TCL_Z_MODIFIER "d, info 0%lo, ntree %d\n",
	    re->re_nsub, re->re_info, g->ntree);

    dumpcolors(&g->cmap, f);
    if (!NULLCNFA(g->search)) {
	fprintf(f, "\nsearch:\n");
	dumpcnfa(&g->search, f);
    }
    for (i = 1; i < g->nlacons; i++) {

/*
 * other interface types
 */

/* the biggie, a compiled RE (or rather, a front end to same) */
typedef struct {
    int re_magic;		/* magic number */
    size_t re_nsub;		/* number of subexpressions */
    long re_info;		/* information about RE */
    size_t re_nsub;		/* number of subexpressions */
#define	REG_UBACKREF		000001
#define	REG_ULOOKAHEAD		000002
#define	REG_UBOUNDS		000004
#define	REG_UBRACES		000010
#define	REG_UBSALNUM		000020
#define	REG_UPBOTCH		000040
#define	REG_UBBS		000100
#define	REG_UNONPOSIX		000200
#define	REG_UUNSPEC		000400
#define	REG_UUNPORT		001000
#define	REG_ULOCALE		002000
#define	REG_UEMPTYMATCH		004000
#define	REG_UIMPOSSIBLE		010000
#define	REG_USHORTEST		020000
    int re_csize;		/* sizeof(character) */
    char *re_endp;		/* backward compatibility kludge */
    /* the rest is opaque pointers to hidden innards */
    char *re_guts;		/* `char *' is more portable than `void *' */
    char *re_fns;
} regex_t;

/* result reporting (may acquire more fields later) */
typedef struct {
    long rm_so;		/* start of substring */
    long rm_eo;		/* end of substring */
    size_t rm_so;		/* start of substring */
    size_t rm_eo;		/* end of substring */
} regmatch_t;

/* supplementary control and reporting */
typedef struct {
    regmatch_t rm_extend;	/* see REG_EXPECT */
} rm_detail_t;

     * Sanity checks.
     */

    if (re == NULL || string == NULL || re->re_magic != REMAGIC) {
	FreeVars(v);
	return REG_INVARG;
    }
    if (re->re_csize != sizeof(chr)) {
	FreeVars(v);
	return REG_MIXED;
    }

    /*
     * Setup.
     */

    v->re = re;
    v->g = (struct guts *)re->re_guts;

    assert(t->op == 'b');
    assert(n >= 0);
    assert((size_t)n < v->nmatch);

    MDEBUG(("cbackref n%d %d{%d-%d}\n", t->id, n, min, max));

    /* get the backreferenced string */
    if (v->pmatch[n].rm_so == -1) {
    if (v->pmatch[n].rm_so == (size_t)-1) {
	return REG_NOMATCH;
    }
    brstring = v->start + v->pmatch[n].rm_so;
    brlen = v->pmatch[n].rm_eo - v->pmatch[n].rm_so;

    /* special cases for zero-length strings */
    if (brlen == 0) {

/*
 * Structures filled in by Tcl_RegExpInfo. Note that all offset values are
 * relative to the start of the match string, not the beginning of the entire
 * string.
 */

typedef struct Tcl_RegExpIndices {
    long start;			/* Character offset of first character in
    size_t start;			/* Character offset of first character in
				 * match. */
    long end;			/* Character offset of first character after
    size_t end;			/* Character offset of first character after
				 * the match. */
} Tcl_RegExpIndices;

typedef struct Tcl_RegExpInfo {
    int nsubs;			/* Number of subexpressions in the compiled
    size_t nsubs;			/* Number of subexpressions in the compiled
				 * expression. */
    Tcl_RegExpIndices *matches;	/* Array of nsubs match offset pairs. */
    long extendStart;		/* The offset at which a subsequent match
    size_t extendStart;		/* The offset at which a subsequent match
				 * might begin. */
    long reserved;		/* Reserved for later use. */
} Tcl_RegExpInfo;

/*
 * Picky compilers complain if this typdef doesn't appear before the struct's
 * reference in tclDecls.h.
 */

/*
 * Constants for special size_t-typed values, see TIP #494
 */

#define TCL_IO_FAILURE	((size_t)-1)
#define TCL_AUTO_LENGTH	((size_t)-1)
#define TCL_INDEX_NONE  ((size_t)-1)

/*
 *----------------------------------------------------------------------------
 * Single public declaration for NRE.
 */

typedef int (Tcl_NRPostProc) (void *data[], Tcl_Interp *interp,

int
Tcl_RegexpObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    size_t offset;
    size_t offset, stringLength, matchLength, cflags, eflags;
    int i, indices, match, about, all, doinline, numMatchesSaved;
    int cflags, eflags, stringLength, matchLength;
    Tcl_RegExp regExpr;
    Tcl_Obj *objPtr, *startIndex = NULL, *resultPtr = NULL;
    Tcl_RegExpInfo info;
    static const char *const options[] = {
	"-all",		"-about",	"-indices",	"-inline",
	"-expanded",	"-line",	"-linestop",	"-lineanchor",
	"-nocase",	"-start",	"--",		NULL

	 * considered the start of the line. If for example the pattern {^} is
	 * passed and -start is positive, then the pattern will not match the
	 * start of the string unless the previous character is a newline.
	 */

	if (offset == TCL_INDEX_START) {
	    eflags = 0;
	} else if (offset + 1 > (size_t)stringLength + 1) {
	} else if (offset + 1 > stringLength + 1) {
	    eflags = TCL_REG_NOTBOL;
	} else if (Tcl_GetUniChar(objPtr, offset-1) == '\n') {
	    eflags = 0;
	} else {
	    eflags = TCL_REG_NOTBOL;
	}

		resultPtr = Tcl_NewObj();
	    }
	}
	for (i = 0; i < objc; i++) {
	    Tcl_Obj *newPtr;

	    if (indices) {
		int start, end;
		size_t start, end;
		Tcl_Obj *objs[2];

		/*
		 * Only adjust the match area if there was a match for that
		 * area. (Scriptics Bug 4391/SF Bug #219232)
		 */

		if (i <= info.nsubs && info.matches[i].start >= 0) {
		if (i <= (int)info.nsubs && info.matches[i].start != TCL_INDEX_NONE) {
		    start = offset + info.matches[i].start;
		    end = offset + info.matches[i].end;

		    /*
		     * Adjust index so it refers to the last character in the
		     * match instead of the first character after the match.
		     */

		    if ((size_t)end + 1 >= offset + 1) {
		    if (end + 1 >= offset + 1) {
			end--;
		    }
		} else {
		    start = -1;
		    end = -1;
		    start = TCL_INDEX_NONE;
		    end = TCL_INDEX_NONE;
		}

		objs[0] = Tcl_NewWideIntObj(start);
		objs[1] = Tcl_NewWideIntObj(end);
		objs[0] = TclNewWideIntObjFromSize(start);
		objs[1] = TclNewWideIntObjFromSize(end);

		newPtr = Tcl_NewListObj(2, objs);
	    } else {
		if (i <= info.nsubs) {
		if (i <= (int)info.nsubs) {
		    newPtr = Tcl_GetRange(objPtr,
			    offset + info.matches[i].start,
			    offset + info.matches[i].end - 1);
		} else {
		    newPtr = Tcl_NewObj();
		}
	    }

	 * these cases we always want to bump the index up one.
	 */

	if (matchLength == 0) {
	    offset++;
	}
	all++;
	if (offset + 1 >= (size_t)stringLength + 1) {
	if (offset + 1 >= stringLength + 1) {
	    break;
	}
    }

    /*
     * Set the interpreter's object result to an integer object with value 1
     * if -all wasn't specified, otherwise it's all-1 (the number of times

int
Tcl_RegsubObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int idx, result, cflags, all, numMatches;
    size_t wlen, wsublen = 0, offset;
    int start, end, subStart, subEnd, match, command, numParts;
    int result, cflags, all, match, command, numParts;
    size_t idx, wlen, wsublen = 0, offset, numMatches;
    size_t start, end, subStart, subEnd;
    Tcl_RegExp regExpr;
    Tcl_RegExpInfo info;
    Tcl_Obj *resultPtr, *subPtr, *objPtr, *startIndex = NULL;
    Tcl_UniChar ch, *wsrc, *wfirstChar, *wstring, *wsubspec = 0, *wend;

    static const char *const options[] = {
	"-all",		"-command",	"-expanded",	"-line",

    cflags = TCL_REG_ADVANCED;
    all = 0;
    offset = TCL_INDEX_START;
    command = 0;
    resultPtr = NULL;

    for (idx = 1; idx < objc; idx++) {
    for (idx = 1; idx < (size_t)objc; idx++) {
	const char *name;
	int index;

	name = TclGetString(objv[idx]);
	if (name[0] != '-') {
	    break;
	}

	    cflags |= TCL_REG_NLSTOP;
	    break;
	case REGSUB_LINEANCHOR:
	    cflags |= TCL_REG_NLANCH;
	    break;
	case REGSUB_START: {
	    size_t temp;
	    if (++idx >= objc) {
	    if (++idx >= (size_t)objc) {
		goto endOfForLoop;
	    }
	    if (TclGetIntForIndexM(interp, objv[idx], TCL_INDEX_START, &temp) != TCL_OK) {
		goto optionError;
	    }
	    if (startIndex) {
		Tcl_DecrRefCount(startIndex);
	    }
	    startIndex = objv[idx];
	    Tcl_IncrRefCount(startIndex);
	    break;
	}
	case REGSUB_LAST:
	    idx++;
	    goto endOfForLoop;
	}
    }

  endOfForLoop:
    if (objc-idx < 3 || objc-idx > 4) {
    if ((size_t)objc < idx + 3 || (size_t)objc > idx + 4) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"?-option ...? exp string subSpec ?varName?");
    optionError:
	if (startIndex) {
	    Tcl_DecrRefCount(startIndex);
	}
	return TCL_ERROR;

	    Tcl_ListObjAppendElement(NULL, listPtr, objPtr);
	    stringPtr = p + 1;
	}
	TclNewStringObj(objPtr, stringPtr, end - stringPtr);
	Tcl_ListObjAppendElement(NULL, listPtr, objPtr);
    } else {
	const char *element, *p, *splitEnd;
	int splitLen;
	size_t splitLen;
	Tcl_UniChar splitChar = 0;

	/*
	 * Normal case: split on any of a given set of characters. Discard
	 * instances of the split characters.
	 */

static int
StringMapCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    size_t length1, length2;
    size_t length1, length2,  mapElemc, index;
    int mapElemc, index;
    int nocase = 0, mapWithDict = 0, copySource = 0;
    Tcl_Obj **mapElemv, *sourceObj, *resultPtr;
    Tcl_UniChar *ustring1, *ustring2, *p, *end;
    int (*strCmpFn)(const Tcl_UniChar*, const Tcl_UniChar*, size_t);

    if (objc < 3 || objc > 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "?-nocase? charMap string");

	Tcl_DictSearch search;

	/*
	 * We know the type exactly, so all dict operations will succeed for
	 * sure. This shortens this code quite a bit.
	 */

	Tcl_DictObjSize(interp, objv[objc-2], &mapElemc);
	if (mapElemc == 0) {
	Tcl_DictObjSize(interp, objv[objc-2], &i);
	if (i == 0) {
	    /*
	     * Empty charMap, just return whatever string was given.
	     */

	    Tcl_SetObjResult(interp, objv[objc-1]);
	    return TCL_OK;
	}

	mapElemc *= 2;
	mapElemc = 2 * i;
	mapWithDict = 1;

	/*
	 * Copy the dictionary out into an array; that's the easiest way to
	 * adapt this code...
	 */

	mapElemv = TclStackAlloc(interp, sizeof(Tcl_Obj *) * mapElemc);
	Tcl_DictObjFirst(interp, objv[objc-2], &search, mapElemv+0,
		mapElemv+1, &done);
	for (i=2 ; i<mapElemc ; i+=2) {
	    Tcl_DictObjNext(&search, mapElemv+i, mapElemv+i+1, &done);
	for (index=2 ; index<mapElemc ; index+=2) {
	    Tcl_DictObjNext(&search, mapElemv+index, mapElemv+index+1, &done);
	}
	Tcl_DictObjDone(&search);
    } else {
	int i;
	if (TclListObjGetElements(interp, objv[objc-2], &mapElemc,
	if (TclListObjGetElements(interp, objv[objc-2], &i,
		&mapElemv) != TCL_OK) {
	    return TCL_ERROR;
	}
	mapElemc = i;
	if (mapElemc == 0) {
	    /*
	     * empty charMap, just return whatever string was given.
	     */

	    Tcl_SetObjResult(interp, objv[objc-1]);
	    return TCL_OK;

int
TclNRSwitchObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int i,j, index, mode, foundmode, splitObjs, numMatchesSaved;
    int i, index, mode, foundmode, splitObjs, numMatchesSaved;
    int noCase;
    size_t patternLength;
    size_t patternLength, j;
    const char *pattern;
    Tcl_Obj *stringObj, *indexVarObj, *matchVarObj;
    Tcl_Obj *const *savedObjv = objv;
    Tcl_RegExp regExpr = NULL;
    Interp *iPtr = (Interp *) interp;
    int pc = 0;
    int bidx = 0;		/* Index of body argument. */

	    TclNewObj(indicesObj);
	}

	for (j=0 ; j<=info.nsubs ; j++) {
	    if (indexVarObj != NULL) {
		Tcl_Obj *rangeObjAry[2];

		if (info.matches[j].end > 0) {
		    rangeObjAry[0] = Tcl_NewWideIntObj(info.matches[j].start);
		    rangeObjAry[1] = Tcl_NewWideIntObj(info.matches[j].end-1);
		if (info.matches[j].end + 1 > 1) {
		    rangeObjAry[0] = TclNewWideIntObjFromSize(info.matches[j].start);
		    rangeObjAry[1] = TclNewWideIntObjFromSize(info.matches[j].end-1);
		} else {
		    rangeObjAry[0] = rangeObjAry[1] = Tcl_NewWideIntObj(-1);
		}

		/*
		 * Never fails; the object is always clean at this point.
		 */

	    for (k=0; k < objc; k++) {
		ctxPtr->line[k] = -1;
	    }
	}
    }

    for (j = i + 1; ; j += 2) {
	if (j >= objc) {
	if (j >= (size_t)objc) {
	    /*
	     * This shouldn't happen since we've checked that the last body is
	     * not a continuation...
	     */

	    Tcl_Panic("fall-out when searching for body to match pattern");
	}

     * exist, enlarge the array if necessary to make room. If the name exists,
     * free its old entry.
     */

    Tcl_MutexLock(&envMutex);
    index = TclpFindVariable(name, &length);

    if (index == TCL_AUTO_LENGTH) {
    if (index == TCL_INDEX_NONE) {
#ifndef USE_PUTENV
	/*
	 * We need to handle the case where the environment may be changed
	 * outside our control. ourEnvironSize is only valid if the current
	 * environment is the one we allocated. [Bug 979640]
	 */

    /*
     * Watch out for versions of putenv that copy the string (e.g. VC++). In
     * this case we need to free the string immediately. Otherwise update the
     * string in the cache.
     */

    if ((index != TCL_AUTO_LENGTH) && (environ[index] == p)) {
    if ((index != TCL_INDEX_NONE) && (environ[index] == p)) {
	ReplaceString(oldValue, p);
#ifdef HAVE_PUTENV_THAT_COPIES
    } else {
	/*
	 * This putenv() copies instead of taking ownership.
	 */

# Added for Tcl 8.2

declare 150 {
    int TclRegAbout(Tcl_Interp *interp, Tcl_RegExp re)
}
declare 151 {
    void TclRegExpRangeUniChar(Tcl_RegExp re, size_t index, int *startPtr,
	    int *endPtr)
    void TclRegExpRangeUniChar(Tcl_RegExp re, size_t index, size_t *startPtr,
	    size_t *endPtr)
}
declare 152 {
    void TclSetLibraryPath(Tcl_Obj *pathPtr)
}
declare 153 {
    Tcl_Obj *TclGetLibraryPath(void)
}

MODULE_SCOPE int	TclIndexEncode(Tcl_Interp *interp, Tcl_Obj *objPtr,
			    size_t before, size_t after, int *indexPtr);
MODULE_SCOPE size_t	TclIndexDecode(int encoded, size_t endValue);

/* Constants used in index value encoding routines. */
#define TCL_INDEX_END           ((size_t)-2)
#define TCL_INDEX_NONE          ((size_t)-1) /* Index out of range or END+1 */
#define TCL_INDEX_START         ((size_t)0)

/*
 *----------------------------------------------------------------
 * Macros used by the Tcl core to create and release Tcl objects.
 * TclNewObj(objPtr) creates a new object denoting an empty string.
 * TclDecrRefCount(objPtr) decrements the object's reference count, and frees

 */

#if (!defined(TCL_WIDE_INT_IS_LONG) || (LONG_MAX > UINT_MAX)) && (SIZE_MAX <= UINT_MAX)
#   define TclWideIntFromSize(value)	(((Tcl_WideInt)(((size_t)(value))+1))-1)
#   define TclNewWideIntObjFromSize(value) \
	Tcl_NewWideIntObj(TclWideIntFromSize(value))
#else
#   define TclWideIntFromSize(value)	(value)
#   define TclWideIntFromSize(value)	((Tcl_WideInt)(value))
#   define TclNewWideIntObjFromSize Tcl_NewWideIntObj
#endif

/*
 * Support for Clang Static Analyzer <http://clang-analyzer.llvm.org>
 */

EXTERN TclHandle	TclHandlePreserve(TclHandle handle);
/* 149 */
EXTERN void		TclHandleRelease(TclHandle handle);
/* 150 */
EXTERN int		TclRegAbout(Tcl_Interp *interp, Tcl_RegExp re);
/* 151 */
EXTERN void		TclRegExpRangeUniChar(Tcl_RegExp re, size_t index,
				int *startPtr, int *endPtr);
				size_t *startPtr, size_t *endPtr);
/* 152 */
EXTERN void		TclSetLibraryPath(Tcl_Obj *pathPtr);
/* 153 */
EXTERN Tcl_Obj *	TclGetLibraryPath(void);
/* Slot 154 is reserved */
/* Slot 155 is reserved */
/* 156 */

    void (*tclHideLiteral) (Tcl_Interp *interp, struct CompileEnv *envPtr, int index); /* 144 */
    const struct AuxDataType * (*tclGetAuxDataType) (const char *typeName); /* 145 */
    TclHandle (*tclHandleCreate) (void *ptr); /* 146 */
    void (*tclHandleFree) (TclHandle handle); /* 147 */
    TclHandle (*tclHandlePreserve) (TclHandle handle); /* 148 */
    void (*tclHandleRelease) (TclHandle handle); /* 149 */
    int (*tclRegAbout) (Tcl_Interp *interp, Tcl_RegExp re); /* 150 */
    void (*tclRegExpRangeUniChar) (Tcl_RegExp re, size_t index, int *startPtr, int *endPtr); /* 151 */
    void (*tclRegExpRangeUniChar) (Tcl_RegExp re, size_t index, size_t *startPtr, size_t *endPtr); /* 151 */
    void (*tclSetLibraryPath) (Tcl_Obj *pathPtr); /* 152 */
    Tcl_Obj * (*tclGetLibraryPath) (void); /* 153 */
    void (*reserved154)(void);
    void (*reserved155)(void);
    void (*tclRegError) (Tcl_Interp *interp, const char *msg, int status); /* 156 */
    Var * (*tclVarTraceExists) (Tcl_Interp *interp, const char *varName); /* 157 */
    void (*reserved158)(void);

				 * in (sub-)range here. */
{
    TclRegexp *regexpPtr = (TclRegexp *) re;
    const char *string;

    if (index > regexpPtr->re.re_nsub) {
	*startPtr = *endPtr = NULL;
    } else if (regexpPtr->matches[index].rm_so == -1) {
    } else if (regexpPtr->matches[index].rm_so == (size_t)-1) {
	*startPtr = *endPtr = NULL;
    } else {
	if (regexpPtr->objPtr) {
	    string = TclGetString(regexpPtr->objPtr);
	} else {
	    string = regexpPtr->string;
	}

void
TclRegExpRangeUniChar(
    Tcl_RegExp re,		/* Compiled regular expression that has been
				 * passed to Tcl_RegExpExec. */
    size_t index,			/* 0 means give the range of the entire match,
				 * > 0 means give the range of a matching
				 * subrange, -1 means the range of the
				 * subrange, TCL_INDEX_NONE means the range of the
				 * rm_extend field. */
    int *startPtr,		/* Store address of first character in
    size_t *startPtr,		/* Store address of first character in
				 * (sub-)range here. */
    int *endPtr)		/* Store address of character just after last
    size_t *endPtr)		/* Store address of character just after last
				 * in (sub-)range here. */
{
    TclRegexp *regexpPtr = (TclRegexp *) re;

    if ((regexpPtr->flags&REG_EXPECT) && index == TCL_AUTO_LENGTH) {
    if ((regexpPtr->flags&REG_EXPECT) && (index == TCL_INDEX_NONE)) {
	*startPtr = regexpPtr->details.rm_extend.rm_so;
	*endPtr = regexpPtr->details.rm_extend.rm_eo;
    } else if (index > regexpPtr->re.re_nsub) {
	*startPtr = -1;
	*endPtr = -1;
    } else if (index + 1 > regexpPtr->re.re_nsub + 1) {
	*startPtr = TCL_INDEX_NONE;
	*endPtr = TCL_INDEX_NONE;
    } else {
	*startPtr = regexpPtr->matches[index].rm_so;
	*endPtr = regexpPtr->matches[index].rm_eo;
    }
}

/*

     * Assume that there will never be more than INT_MAX subexpressions. This
     * is a pretty reasonable assumption; the RE engine doesn't scale _that_
     * well and Tcl has other limits that constrain things as well...
     */

    resultObj = Tcl_NewObj();
    Tcl_ListObjAppendElement(NULL, resultObj,
	    Tcl_NewWideIntObj((Tcl_WideInt) regexpPtr->re.re_nsub));
	    TclNewWideIntObjFromSize(regexpPtr->re.re_nsub));

    /*
     * Now append a list of all the bit-flags set for the RE.
     */

    TclNewObj(infoObj);
    for (inf=infonames ; inf->bit != 0 ; inf++) {

     * "TCL STRING GROWTH ALGORITHM" comment at the top of this file for an
     * explanation of this growth algorithm.
     */

    numChars = stringPtr->numChars + appendNumChars;

    if (numChars > stringPtr->maxChars) {
	size_t offset = TCL_AUTO_LENGTH;
	size_t index = TCL_INDEX_NONE;

	/*
	 * Protect against case where unicode points into the existing
	 * stringPtr->unicode array. Force it to follow any relocations due to
	 * the reallocs below.
	 */

	if (unicode && unicode >= stringPtr->unicode
		&& unicode <= stringPtr->unicode + stringPtr->maxChars) {
	    offset = unicode - stringPtr->unicode;
	    index = unicode - stringPtr->unicode;
	}

	GrowUnicodeBuffer(objPtr, numChars);
	stringPtr = GET_STRING(objPtr);

	/*
	 * Relocate unicode if needed; see above.
	 */

	if (offset != TCL_AUTO_LENGTH) {
	    unicode = stringPtr->unicode + offset;
	if (index != TCL_INDEX_NONE) {
	    unicode = stringPtr->unicode + index;
	}
    }

    /*
     * Copy the new string onto the end of the old string, then add the
     * trailing null.
     */

static int		TestregexpObjCmd(void *dummy,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
static int		TestreturnObjCmd(void *dummy,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
static void		TestregexpXflags(const char *string,
			    int length, int *cflagsPtr, int *eflagsPtr);
			    size_t length, int *cflagsPtr, int *eflagsPtr);
static int		TestsaveresultCmd(void *dummy,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
static void		TestsaveresultFree(void *blockPtr);
static int		TestsetassocdataCmd(void *dummy,
			    Tcl_Interp *interp, int argc, const char **argv);
static int		TestsetCmd(void *dummy,

	 * value 0.
	 */

	Tcl_SetIntObj(Tcl_GetObjResult(interp), 0);
	if (objc > 2 && (cflags&REG_EXPECT) && indices) {
	    const char *varName;
	    const char *value;
	    int start, end;
	    size_t start, end;
	    char resinfo[TCL_INTEGER_SPACE * 2];

	    varName = Tcl_GetString(objv[2]);
	    TclRegExpRangeUniChar(regExpr, -1, &start, &end);
	    sprintf(resinfo, "%d %d", start, end-1);
	    sprintf(resinfo, "%" TCL_LL_MODIFIER "d %" TCL_LL_MODIFIER "d", TclWideIntFromSize(start), TclWideIntFromSize(end-1));
	    value = Tcl_SetVar2(interp, varName, NULL, resinfo, 0);
	    if (value == NULL) {
		Tcl_AppendResult(interp, "couldn't set variable \"",
			varName, "\"", NULL);
		return TCL_ERROR;
	    }
	} else if (cflags & TCL_REG_CANMATCH) {
	    const char *varName;
	    const char *value;
	    char resinfo[TCL_INTEGER_SPACE * 2];

	    Tcl_RegExpGetInfo(regExpr, &info);
	    varName = Tcl_GetString(objv[2]);
	    sprintf(resinfo, "%ld", info.extendStart);
	    sprintf(resinfo, "%" TCL_LL_MODIFIER "d", TclWideIntFromSize(info.extendStart));
	    value = Tcl_SetVar2(interp, varName, NULL, resinfo, 0);
	    if (value == NULL) {
		Tcl_AppendResult(interp, "couldn't set variable \"",
			varName, "\"", NULL);
		return TCL_ERROR;
	    }
	}
	return TCL_OK;
    }

    /*
     * If additional variable names have been specified, return
     * index information in those variables.
     */

    objc -= 2;
    objv += 2;

    Tcl_RegExpGetInfo(regExpr, &info);
    for (i = 0; i < objc; i++) {
	int start, end;
	size_t start, end;
	Tcl_Obj *newPtr, *varPtr, *valuePtr;

	varPtr = objv[i];
	ii = ((cflags&REG_EXPECT) && i == objc-1) ? TCL_INDEX_NONE : (size_t)i;
	if (indices) {
	    Tcl_Obj *objs[2];

	    if (ii == TCL_INDEX_NONE) {
		TclRegExpRangeUniChar(regExpr, ii, &start, &end);
	    } else if (ii > (size_t)info.nsubs) {
		start = -1;
		end = -1;
	    } else if (ii > info.nsubs) {
		start = TCL_INDEX_NONE;
		end = TCL_INDEX_NONE;
	    } else {
		start = info.matches[ii].start;
		end = info.matches[ii].end;
	    }

	    /*
	     * Adjust index so it refers to the last character in the match
	     * instead of the first character after the match.
	     */

	    if (end >= 0) {
	    if (end != TCL_INDEX_NONE) {
		end--;
	    }

	    objs[0] = Tcl_NewWideIntObj(start);
	    objs[1] = Tcl_NewWideIntObj(end);
	    objs[0] = TclNewWideIntObjFromSize(start);
	    objs[1] = TclNewWideIntObjFromSize(end);

	    newPtr = Tcl_NewListObj(2, objs);
	} else {
	    if (ii == TCL_INDEX_NONE) {
		TclRegExpRangeUniChar(regExpr, ii, &start, &end);
		newPtr = Tcl_GetRange(objPtr, start, end);
	    } else if (ii > (size_t)info.nsubs) {
	    } else if (ii > info.nsubs) {
		newPtr = Tcl_NewObj();
	    } else {
		newPtr = Tcl_GetRange(objPtr, info.matches[ii].start,
			info.matches[ii].end - 1);
	    }
	}
	valuePtr = Tcl_ObjSetVar2(interp, varPtr, NULL, newPtr, TCL_LEAVE_ERR_MSG);

 *
 *----------------------------------------------------------------------
 */

static void
TestregexpXflags(
    const char *string,	/* The string of flags. */
    int length,			/* The length of the string in bytes. */
    size_t length,			/* The length of the string in bytes. */
    int *cflagsPtr,		/* compile flags word */
    int *eflagsPtr)		/* exec flags word */
{
    size_t i;
    int i, cflags, eflags;
    int cflags, eflags;

    cflags = *cflagsPtr;
    eflags = *eflagsPtr;
    for (i = 0; i < length; i++) {
	switch (string[i]) {
	case 'a':
	    cflags |= REG_ADVF;

    register size_t index)		/* The position of the desired character. */
{
    Tcl_UniChar ch = 0;
#if TCL_UTF_MAX <= 4
    size_t len = 0;
#endif

    if (index != TCL_AUTO_LENGTH) {
    if (index != TCL_INDEX_NONE) {
	while (index--) {
#if TCL_UTF_MAX <= 4
	    src += (len = TclUtfToUniChar(src, &ch));
#else
	    src += TclUtfToUniChar(src, &ch);
#endif
	}

 *
 *----------------------------------------------------------------------
 */

char *
Tcl_DStringAppend(
    Tcl_DString *dsPtr,		/* Structure describing dynamic string. */
    const char *bytes,		/* String to append. If length is -1 then this
				 * must be null-terminated. */
    const char *bytes,		/* String to append. If length is
				 * TCL_AUTO_LENGTH then this must be null-terminated. */
    size_t length)			/* Number of bytes from "bytes" to append. If
				 * -1, then append all of bytes, up to null
				 * TCL_AUTO_LENGTH, then append all of bytes, up to null
				 * at end. */
{
    size_t newSize;

    if (length == TCL_AUTO_LENGTH) {
	length = strlen(bytes);
    }

	dsPtr->spaceAvl = newSize * 2;
	if (dsPtr->string == dsPtr->staticSpace) {
	    char *newString = Tcl_Alloc(dsPtr->spaceAvl);

	    memcpy(newString, dsPtr->string, dsPtr->length);
	    dsPtr->string = newString;
	} else {
	    size_t offset = TCL_AUTO_LENGTH;
	    size_t index = TCL_INDEX_NONE;

	    /* See [16896d49fd] */
	    if (bytes >= dsPtr->string
		    && bytes <= dsPtr->string + dsPtr->length) {
		offset = bytes - dsPtr->string;
		index = bytes - dsPtr->string;
	    }

	    dsPtr->string = Tcl_Realloc(dsPtr->string, dsPtr->spaceAvl);

	    if (offset != TCL_AUTO_LENGTH) {
		bytes = dsPtr->string + offset;
	    if (index != TCL_INDEX_NONE) {
		bytes = dsPtr->string + index;
	    }
	}
    }

    /*
     * Copy the new string into the buffer at the end of the old one.
     */