diff options
author | dkf <donal.k.fellows@manchester.ac.uk> | 2017-02-17 06:08:18 (GMT) |
---|---|---|
committer | dkf <donal.k.fellows@manchester.ac.uk> | 2017-02-17 06:08:18 (GMT) |
commit | 203058f02d4fbfde79ae5a95f9648f61681a36fa (patch) | |
tree | ac32fde49c111fec80b54fc74426a566062dece9 /generic/tclCmdMZ.c | |
parent | 293d30f0a2a4756db591e83e93eae24681e0ec7a (diff) | |
download | tcl-203058f02d4fbfde79ae5a95f9648f61681a36fa.zip tcl-203058f02d4fbfde79ae5a95f9648f61681a36fa.tar.gz tcl-203058f02d4fbfde79ae5a95f9648f61681a36fa.tar.bz2 |
Switch to using command prefixes properly. This is quite a bit faster.
Diffstat (limited to 'generic/tclCmdMZ.c')
-rw-r--r-- | generic/tclCmdMZ.c | 63 |
1 files changed, 46 insertions, 17 deletions
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index ffae8b2..d6d0152 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -487,11 +487,11 @@ Tcl_RegsubObjCmd( Tcl_Obj *const objv[]) /* Argument objects. */ { int idx, result, cflags, all, wlen, wsublen, numMatches, offset; - int start, end, subStart, subEnd, match, command; + int start, end, subStart, subEnd, match, command, numParts, numArgs; Tcl_RegExp regExpr; Tcl_RegExpInfo info; Tcl_Obj *resultPtr, *subPtr, *objPtr, *startIndex = NULL; - Tcl_Obj **args = NULL, *parts[2], *cmdObj; + Tcl_Obj **args = NULL, **parts; Tcl_UniChar ch, *wsrc, *wfirstChar, *wstring, *wsubspec, *wend; static const char *const options[] = { @@ -666,6 +666,20 @@ Tcl_RegsubObjCmd( return TCL_ERROR; } + if (command) { + /* + * In command-prefix mode, we require that the third non-option + * argument be a list, so we enforce that here. Afterwards, we fetch + * the RE compilation again in case objv[0] and objv[2] are the same + * object. (If they aren't, that's cheap to do.) + */ + + if (Tcl_ListObjLength(interp, objv[2], &numParts) != TCL_OK) { + return TCL_ERROR; + } + regExpr = Tcl_GetRegExpFromObj(interp, objv[0], cflags); + } + /* * Make sure to avoid problems where the objects are shared. This can * cause RegExpObj <> UnicodeObj shimmering that causes data corruption. @@ -683,7 +697,9 @@ Tcl_RegsubObjCmd( } else { subPtr = objv[2]; } - wsubspec = Tcl_GetUnicodeFromObj(subPtr, &wsublen); + if (!command) { + wsubspec = Tcl_GetUnicodeFromObj(subPtr, &wsublen); + } result = TCL_OK; @@ -742,34 +758,47 @@ Tcl_RegsubObjCmd( Tcl_AppendUnicodeToObj(resultPtr, wstring + offset, start); /* - * In -command mode, the substitutions are added as quoted arguments - * to the subSpec to form a command, that is then executed and the - * result used as the string to substitute in. + * In command-prefix mode, the substitutions are added as quoted + * arguments to the subSpec to form a command, that is then executed + * and the result used as the string to substitute in. Actually, + * everything is passed through Tcl_EvalObjv, as that's much faster. */ if (command) { if (args == NULL) { - args = ckalloc(sizeof(Tcl_Obj*) * (info.nsubs + 1)); + Tcl_ListObjGetElements(interp, subPtr, &numParts, &parts); + numArgs = numParts + info.nsubs + 1; + args = ckalloc(sizeof(Tcl_Obj*) * numArgs); + memcpy(args, parts, sizeof(Tcl_Obj*) * numParts); } for (idx = 0 ; idx <= info.nsubs ; idx++) { subStart = info.matches[idx].start; subEnd = info.matches[idx].end; if ((subStart >= 0) && (subEnd >= 0)) { - args[idx] = Tcl_NewUnicodeObj( + args[idx + numParts] = Tcl_NewUnicodeObj( wstring + offset + subStart, subEnd - subStart); } else { - args[idx] = Tcl_NewObj(); + args[idx + numParts] = Tcl_NewObj(); } + Tcl_IncrRefCount(args[idx + numParts]); + } + + /* + * At this point, we're locally holding the references to the + * argument words we added for this time round the loop, and the + * subPtr is holding the references to the words that the user + * supplied directly. None are zero-refcount, which is important + * because Tcl_EvalObjv is "hairy monster" in terms of refcount + * handling, being able to optionally add references to any of its + * argument words. We'll drop the local refs immediately + * afterwarsds; subPtr is handled in the main exit stanza. + */ + + result = Tcl_EvalObjv(interp, numArgs, args, 0); + for (idx = 0 ; idx <= info.nsubs ; idx++) { + TclDecrRefCount(args[idx + numParts]); } - parts[0] = subPtr; - parts[1] = Tcl_NewListObj(info.nsubs+1, args); - cmdObj = Tcl_ConcatObj(2, parts); - Tcl_IncrRefCount(cmdObj); - Tcl_DecrRefCount(parts[1]); - - result = Tcl_EvalObjEx(interp, cmdObj, TCL_EVAL_DIRECT); - Tcl_DecrRefCount(cmdObj); if (result != TCL_OK) { if (result == TCL_ERROR) { Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( |