tclregexp.c

tcl是工具命令语言

 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_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_RegExp
Tcl_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.
 *
 *----------------------------------------------------------------------
 */

int
TclRegAbout(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.
 *
 *----------------------------------------------------------------------
 */

void
TclRegError(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 void
FreeRegexpInternalRep(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 void
DupRegexpInternalRep(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 int
SetRegexpFromAny(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 void
FreeRegexp(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 void
FinalizeRegexp(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]);
    }
}