* Side effects: *	None. * *---------------------------------------------------------------------- */voidTcl_RegExpGetInfo(regexp, infoPtr)    Tcl_RegExp regexp;		/* Pattern from which to get subexpressions. */    Tcl_RegExpInfo *infoPtr;	/* Match information is stored here.  */{    TclRegexp *regexpPtr = (TclRegexp *) regexp;    infoPtr->nsubs = regexpPtr->re.re_nsub;    infoPtr->matches = (Tcl_RegExpIndices *) regexpPtr->matches;    infoPtr->extendStart = regexpPtr->details.rm_extend.rm_so;}/* *---------------------------------------------------------------------- * * Tcl_GetRegExpFromObj -- * *	Compile a regular expression into a form suitable for fast *	matching.  This procedure caches the result in a Tcl_Obj. * * Results: *	The return value is a pointer to the compiled form of string, *	suitable for passing to Tcl_RegExpExec.  If an error occurred *	while compiling the pattern, then NULL is returned and an error *	message is left in the interp's result. * * Side effects: *	Updates the native rep of the Tcl_Obj. * *---------------------------------------------------------------------- */Tcl_RegExpTcl_GetRegExpFromObj(interp, objPtr, flags)    Tcl_Interp *interp;		/* For use in error reporting, and to access				 * the interp regexp cache. */    Tcl_Obj *objPtr;		/* Object whose string rep contains regular				 * expression pattern.  Internal rep will be				 * changed to compiled form of this regular				 * expression. */    int flags;			/* Regular expression compilation flags. */{    int length;    Tcl_ObjType *typePtr;    TclRegexp *regexpPtr;    char *pattern;    typePtr = objPtr->typePtr;    regexpPtr = (TclRegexp *) objPtr->internalRep.otherValuePtr;    if ((typePtr != &tclRegexpType) || (regexpPtr->flags != flags)) {	pattern = Tcl_GetStringFromObj(objPtr, &length);	regexpPtr = CompileRegexp(interp, pattern, length, flags);	if (regexpPtr == NULL) {	    return NULL;	}	/*	 * Add a reference to the regexp so it will persist even if it is	 * pushed out of the current thread's regexp cache.  This reference	 * will be removed when the object's internal rep is freed.	 */	regexpPtr->refCount++;	/*	 * Free the old representation and set our type.	 */	if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {	    (*typePtr->freeIntRepProc)(objPtr);	}	objPtr->internalRep.otherValuePtr = (VOID *) regexpPtr;	objPtr->typePtr = &tclRegexpType;    }    return (Tcl_RegExp) regexpPtr;}/* *---------------------------------------------------------------------- * * TclRegAbout -- * *	Return information about a compiled regular expression. * * Results: *	The return value is -1 for failure, 0 for success, although at *	the moment there's nothing that could fail.  On success, a list *	is left in the interp's result:  first element is the subexpression *	count, second is a list of re_info bit names. * * Side effects: *	None. * *---------------------------------------------------------------------- */intTclRegAbout(interp, re)    Tcl_Interp *interp;		/* For use in variable assignment. */    Tcl_RegExp re;		/* The compiled regular expression. */{    TclRegexp *regexpPtr = (TclRegexp *)re;    char buf[TCL_INTEGER_SPACE];    static struct infoname {	int bit;	char *text;    } infonames[] = {	{REG_UBACKREF,		"REG_UBACKREF"},	{REG_ULOOKAHEAD,	"REG_ULOOKAHEAD"},	{REG_UBOUNDS,		"REG_UBOUNDS"},	{REG_UBRACES,		"REG_UBRACES"},	{REG_UBSALNUM,		"REG_UBSALNUM"},	{REG_UPBOTCH,		"REG_UPBOTCH"},	{REG_UBBS,		"REG_UBBS"},	{REG_UNONPOSIX,		"REG_UNONPOSIX"},	{REG_UUNSPEC,		"REG_UUNSPEC"},	{REG_UUNPORT,		"REG_UUNPORT"},	{REG_ULOCALE,		"REG_ULOCALE"},	{REG_UEMPTYMATCH,	"REG_UEMPTYMATCH"},	{REG_UIMPOSSIBLE,	"REG_UIMPOSSIBLE"},	{REG_USHORTEST,		"REG_USHORTEST"},	{0,			""}    };    struct infoname *inf;    int n;    Tcl_ResetResult(interp);    sprintf(buf, "%u", (unsigned)(regexpPtr->re.re_nsub));    Tcl_AppendElement(interp, buf);    /*     * Must count bits before generating list, because we must know     * whether {} are needed before we start appending names.     */    n = 0;    for (inf = infonames; inf->bit != 0; inf++) {	if (regexpPtr->re.re_info&inf->bit) {	    n++;	}    }    if (n != 1) {	Tcl_AppendResult(interp, " {", NULL);    }    for (inf = infonames; inf->bit != 0; inf++) {	if (regexpPtr->re.re_info&inf->bit) {	    Tcl_AppendElement(interp, inf->text);	}    }    if (n != 1) {	Tcl_AppendResult(interp, "}", NULL);    }    return 0;}/* *---------------------------------------------------------------------- * * TclRegError -- * *	Generate an error message based on the regexp status code. * * Results: *	Places an error in the interpreter. * * Side effects: *	Sets errorCode as well. * *---------------------------------------------------------------------- */voidTclRegError(interp, msg, status)    Tcl_Interp *interp;		/* Interpreter for error reporting. */    CONST char *msg;		/* Message to prepend to error. */    int status;			/* Status code to report. */{    char buf[100];		/* ample in practice */    char cbuf[100];		/* lots in practice */    size_t n;    char *p;    Tcl_ResetResult(interp);    n = TclReError(status, (regex_t *)NULL, buf, sizeof(buf));    p = (n > sizeof(buf)) ? "..." : "";    Tcl_AppendResult(interp, msg, buf, p, NULL);    sprintf(cbuf, "%d", status);    (VOID) TclReError(REG_ITOA, (regex_t *)NULL, cbuf, sizeof(cbuf));    Tcl_SetErrorCode(interp, "REGEXP", cbuf, buf, NULL);}/* *---------------------------------------------------------------------- * * FreeRegexpInternalRep -- * *	Deallocate the storage associated with a regexp object's internal *	representation. * * Results: *	None. * * Side effects: *	Frees the compiled regular expression. * *---------------------------------------------------------------------- */static voidFreeRegexpInternalRep(objPtr)    Tcl_Obj *objPtr;		/* Regexp object with internal rep to free. */{    TclRegexp *regexpRepPtr = (TclRegexp *) objPtr->internalRep.otherValuePtr;    /*     * If this is the last reference to the regexp, free it.     */    if (--(regexpRepPtr->refCount) <= 0) {	FreeRegexp(regexpRepPtr);    }}/* *---------------------------------------------------------------------- * * DupRegexpInternalRep -- * *	We copy the reference to the compiled regexp and bump its *	reference count. * * Results: *	None. * * Side effects: *	Increments the reference count of the regexp. * *---------------------------------------------------------------------- */static voidDupRegexpInternalRep(srcPtr, copyPtr)    Tcl_Obj *srcPtr;		/* Object with internal rep to copy. */    Tcl_Obj *copyPtr;		/* Object with internal rep to set. */{    TclRegexp *regexpPtr = (TclRegexp *) srcPtr->internalRep.otherValuePtr;    regexpPtr->refCount++;    copyPtr->internalRep.otherValuePtr = srcPtr->internalRep.otherValuePtr;    copyPtr->typePtr = &tclRegexpType;}/* *---------------------------------------------------------------------- * * SetRegexpFromAny -- * *	Attempt to generate a compiled regular expression for the Tcl object *	"objPtr". * * Results: *	The return value is TCL_OK or TCL_ERROR. If an error occurs during *	conversion, an error message is left in the interpreter's result *	unless "interp" is NULL. * * Side effects: *	If no error occurs, a regular expression is stored as "objPtr"s *	internal representation. * *---------------------------------------------------------------------- */static intSetRegexpFromAny(interp, objPtr)    Tcl_Interp *interp;		/* Used for error reporting if not NULL. */    Tcl_Obj *objPtr;		/* The object to convert. */{    if (Tcl_GetRegExpFromObj(interp, objPtr, REG_ADVANCED) == NULL) {	return TCL_ERROR;    }    return TCL_OK;}/* *--------------------------------------------------------------------------- * * CompileRegexp -- * *	Attempt to compile the given regexp pattern.  If the compiled *	regular expression can be found in the per-thread cache, it *	will be used instead of compiling a new copy. * * Results: *	The return value is a pointer to a newly allocated TclRegexp *	that represents the compiled pattern, or NULL if the pattern *	could not be compiled.  If NULL is returned, an error message is *	left in the interp's result. * * Side effects: *	The thread-local regexp cache is updated and a new TclRegexp may *	be allocated. * *---------------------------------------------------------------------- */static TclRegexp *CompileRegexp(interp, string, length, flags)    Tcl_Interp *interp;		/* Used for error reporting if not NULL. */    CONST char *string;		/* The regexp to compile (UTF-8). */    int length;			/* The length of the string in bytes. */    int flags;			/* Compilation flags. */{    TclRegexp *regexpPtr;    CONST Tcl_UniChar *uniString;    int numChars;    Tcl_DString stringBuf;    int status, i;    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);     if (!tsdPtr->initialized) {	tsdPtr->initialized = 1;	Tcl_CreateThreadExitHandler(FinalizeRegexp, NULL);    }    /*     * This routine maintains a second-level regular expression cache in     * addition to the per-object regexp cache.  The per-thread cache is needed     * to handle the case where for various reasons the object is lost between     * invocations of the regexp command, but the literal pattern is the same.     */    /*     * Check the per-thread compiled regexp cache.  We can only reuse     * a regexp if it has the same pattern and the same flags.     */    for (i = 0; (i < NUM_REGEXPS) && (tsdPtr->patterns[i] != NULL); i++) {	if ((length == tsdPtr->patLengths[i])		&& (tsdPtr->regexps[i]->flags == flags)		&& (strcmp(string, tsdPtr->patterns[i]) == 0)) {	    /*	     * Move the matched pattern to the first slot in the	     * cache and shift the other patterns down one position.	     */	    if (i != 0) {		int j;		char *cachedString;		cachedString = tsdPtr->patterns[i];		regexpPtr = tsdPtr->regexps[i];		for (j = i-1; j >= 0; j--) {		    tsdPtr->patterns[j+1] = tsdPtr->patterns[j];		    tsdPtr->patLengths[j+1] = tsdPtr->patLengths[j];		    tsdPtr->regexps[j+1] = tsdPtr->regexps[j];		}		tsdPtr->patterns[0] = cachedString;		tsdPtr->patLengths[0] = length;		tsdPtr->regexps[0] = regexpPtr;	    }	    return tsdPtr->regexps[0];	}    }    /*     * This is a new expression, so compile it and add it to the cache.     */        regexpPtr = (TclRegexp *) ckalloc(sizeof(TclRegexp));    regexpPtr->objPtr = NULL;    regexpPtr->string = NULL;    regexpPtr->details.rm_extend.rm_so = -1;    regexpPtr->details.rm_extend.rm_eo = -1;    /*     * Get the up-to-date string representation and map to unicode.     */    Tcl_DStringInit(&stringBuf);    uniString = Tcl_UtfToUniCharDString(string, length, &stringBuf);    numChars = Tcl_DStringLength(&stringBuf) / sizeof(Tcl_UniChar);    /*     * Compile the string and check for errors.     */    regexpPtr->flags = flags;    status = TclReComp(&regexpPtr->re, uniString, (size_t) numChars, flags);    Tcl_DStringFree(&stringBuf);    if (status != REG_OKAY) {	/*	 * Clean up and report errors in the interpreter, if possible.	 */	ckfree((char *)regexpPtr);	if (interp) {	    TclRegError(interp,		    "couldn't compile regular expression pattern: ",		    status);	}	return NULL;    }    /*     * Allocate enough space for all of the subexpressions, plus one     * extra for the entire pattern.     */    regexpPtr->matches = (regmatch_t *) ckalloc(	    sizeof(regmatch_t) * (regexpPtr->re.re_nsub + 1));    /*     * Initialize the refcount to one initially, since it is in the cache.     */    regexpPtr->refCount = 1;    /*     * Free the last regexp, if necessary, and make room at the head of the     * list for the new regexp.     */    if (tsdPtr->patterns[NUM_REGEXPS-1] != NULL) {	TclRegexp *oldRegexpPtr = tsdPtr->regexps[NUM_REGEXPS-1];	if (--(oldRegexpPtr->refCount) <= 0) {	    FreeRegexp(oldRegexpPtr);	}	ckfree(tsdPtr->patterns[NUM_REGEXPS-1]);    }    for (i = NUM_REGEXPS - 2; i >= 0; i--) {	tsdPtr->patterns[i+1] = tsdPtr->patterns[i];	tsdPtr->patLengths[i+1] = tsdPtr->patLengths[i];	tsdPtr->regexps[i+1] = tsdPtr->regexps[i];    }    tsdPtr->patterns[0] = (char *) ckalloc((unsigned) (length+1));    strcpy(tsdPtr->patterns[0], string);    tsdPtr->patLengths[0] = length;    tsdPtr->regexps[0] = regexpPtr;    return regexpPtr;}/* *---------------------------------------------------------------------- * * FreeRegexp -- * *	Release the storage associated with a TclRegexp. * * Results: *	None. * * Side effects: *	None. * *---------------------------------------------------------------------- */static voidFreeRegexp(regexpPtr)    TclRegexp *regexpPtr;	/* Compiled regular expression to free. */{    TclReFree(&regexpPtr->re);    if (regexpPtr->matches) {	ckfree((char *) regexpPtr->matches);    }    ckfree((char *) regexpPtr);}/* *---------------------------------------------------------------------- * * FinalizeRegexp -- * *	Release the storage associated with the per-thread regexp *	cache. * * Results: *	None. * * Side effects: *	None. * *---------------------------------------------------------------------- */static voidFinalizeRegexp(clientData)    ClientData clientData;	/* Not used. */{    int i;    TclRegexp *regexpPtr;    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);    for (i = 0; (i < NUM_REGEXPS) && (tsdPtr->patterns[i] != NULL); i++) {	regexpPtr = tsdPtr->regexps[i];	if (--(regexpPtr->refCount) <= 0) {	    FreeRegexp(regexpPtr);	}	ckfree(tsdPtr->patterns[i]);    }}