Index: TODO =================================================================== diff -u -r7da6935c42353b2c30c05619eeb958f5701186b7 -r19c84744084963110f84f4ce28fbf55714c79635 --- TODO (.../TODO) (revision 7da6935c42353b2c30c05619eeb958f5701186b7) +++ TODO (.../TODO) (revision 19c84744084963110f84f4ce28fbf55714c79635) @@ -5637,6 +5637,16 @@ - Refactor trace and debug output to deliver lists. This makes it easier to postprocess the results from Tcl. +Profile trace enhancements: +- add optional argument "-builtins" to nsf::__profile_trace + to trace a selected list of builtins. Every element of the + list passed to "-builtins" might contain a cmd name and + optionally a maximum number of arguments to be shown + (typically 0 or 1) +- generalized NsfReplaceCommand* logic to become more general + usable (e.g. for the builtins mechanism of nsf::__profile_trace) + + ======================================================================== TODO: - maybe use as well "$obj eval $cmd" for valuechangedcmd Index: generic/nsf.c =================================================================== diff -u -r55c89d7890cc910efd0909b70b074ebf896ce55f -r19c84744084963110f84f4ce28fbf55714c79635 --- generic/nsf.c (.../nsf.c) (revision 55c89d7890cc910efd0909b70b074ebf896ce55f) +++ generic/nsf.c (.../nsf.c) (revision 19c84744084963110f84f4ce28fbf55714c79635) @@ -24163,17 +24163,21 @@ {-argName "-enable" -required 1 -nrargs 1 -type boolean} {-argName "-verbose" -required 0 -nrargs 1 -type boolean} {-argName "-dontsave" -required 0 -nrargs 1 -type boolean} + {-argName "-builtins" -required 0 -nrargs 1 -type tclobj} } */ -static int NsfProfileTraceStub(Tcl_Interp *interp, int withEnable, int withVerbose, int withDontsave) +static int NsfProfileTraceStub(Tcl_Interp *interp, + int withEnable, int withVerbose, int withDontsave, + Tcl_Obj *builtins) NSF_nonnull(1); static int -NsfProfileTraceStub(Tcl_Interp *interp, int withEnable, int withVerbose, int withDontsave) { +NsfProfileTraceStub(Tcl_Interp *interp, int withEnable, int withVerbose, int withDontsave, Tcl_Obj *builtins) { + assert(interp != NULL); #if defined(NSF_PROFILE) - NsfProfileTrace(interp, withEnable, withVerbose, withDontsave); + NsfProfileTrace(interp, withEnable, withVerbose, withDontsave, builtins); #endif return TCL_OK; } @@ -24729,6 +24733,17 @@ assert(interp != NULL); +#if defined(NSF_PROFILE) + /* + * Check, if profile trace is still running. If so, delete it here. + * Interestingly, NsfLog() seems to be unavaliable at this place. + */ + if (RUNTIME_STATE(interp)->doTrace == 1) { + NsfLog(interp, NSF_LOG_WARN, "tracing is still running, deactivate due to cleanup"); + NsfProfileTrace(interp, 0, 0, 0, NULL); + } +#endif + #if defined(NSF_STACKCHECK) {NsfRuntimeState *rst = RUNTIME_STATE(interp); Index: generic/nsfAPI.decls =================================================================== diff -u -r55c89d7890cc910efd0909b70b074ebf896ce55f -r19c84744084963110f84f4ce28fbf55714c79635 --- generic/nsfAPI.decls (.../nsfAPI.decls) (revision 55c89d7890cc910efd0909b70b074ebf896ce55f) +++ generic/nsfAPI.decls (.../nsfAPI.decls) (revision 19c84744084963110f84f4ce28fbf55714c79635) @@ -61,6 +61,7 @@ {-argName "-enable" -required 1 -nrargs 1 -type boolean} {-argName "-verbose" -required 0 -nrargs 1 -type boolean} {-argName "-dontsave" -required 0 -nrargs 1 -type boolean} + {-argName "-builtins" -required 0 -nrargs 1 -type tclobj} } cmd __unset_unknown_args NsfUnsetUnknownArgsCmd {} Index: generic/nsfAPI.h =================================================================== diff -u -r55c89d7890cc910efd0909b70b074ebf896ce55f -r19c84744084963110f84f4ce28fbf55714c79635 --- generic/nsfAPI.h (.../nsfAPI.h) (revision 55c89d7890cc910efd0909b70b074ebf896ce55f) +++ generic/nsfAPI.h (.../nsfAPI.h) (revision 19c84744084963110f84f4ce28fbf55714c79635) @@ -646,7 +646,7 @@ NSF_nonnull(1); static int NsfProfileGetDataStub(Tcl_Interp *interp) NSF_nonnull(1); -static int NsfProfileTraceStub(Tcl_Interp *interp, int withEnable, int withVerbose, int withDontsave) +static int NsfProfileTraceStub(Tcl_Interp *interp, int withEnable, int withVerbose, int withDontsave, Tcl_Obj *withBuiltins) NSF_nonnull(1); static int NsfRelationGetCmd(Tcl_Interp *interp, NsfObject *object, int type) NSF_nonnull(1) NSF_nonnull(2); @@ -2301,9 +2301,10 @@ int withEnable = (int )PTR2INT(pc.clientData[0]); int withVerbose = (int )PTR2INT(pc.clientData[1]); int withDontsave = (int )PTR2INT(pc.clientData[2]); + Tcl_Obj *withBuiltins = (Tcl_Obj *)pc.clientData[3]; assert(pc.status == 0); - return NsfProfileTraceStub(interp, withEnable, withVerbose, withDontsave); + return NsfProfileTraceStub(interp, withEnable, withVerbose, withDontsave, withBuiltins); } else { @@ -3736,10 +3737,11 @@ {"::nsf::__profile_get", NsfProfileGetDataStubStub, 0, { {NULL, 0, 0, NULL, NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL}} }, -{"::nsf::__profile_trace", NsfProfileTraceStubStub, 3, { +{"::nsf::__profile_trace", NsfProfileTraceStubStub, 4, { {"-enable", NSF_ARG_REQUIRED, 1, Nsf_ConvertTo_Boolean, NULL,NULL,"boolean",NULL,NULL,NULL,NULL,NULL}, {"-verbose", 0, 1, Nsf_ConvertTo_Boolean, NULL,NULL,"boolean",NULL,NULL,NULL,NULL,NULL}, - {"-dontsave", 0, 1, Nsf_ConvertTo_Boolean, NULL,NULL,"boolean",NULL,NULL,NULL,NULL,NULL}} + {"-dontsave", 0, 1, Nsf_ConvertTo_Boolean, NULL,NULL,"boolean",NULL,NULL,NULL,NULL,NULL}, + {"-builtins", 0, 1, Nsf_ConvertTo_Tclobj, NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL}} }, {"::nsf::relation::get", NsfRelationGetCmdStub, 2, { {"object", NSF_ARG_REQUIRED, 1, Nsf_ConvertTo_Object, NULL,NULL,"object",NULL,NULL,NULL,NULL,NULL}, Index: generic/nsfInt.h =================================================================== diff -u -r55c89d7890cc910efd0909b70b074ebf896ce55f -r19c84744084963110f84f4ce28fbf55714c79635 --- generic/nsfInt.h (.../nsfInt.h) (revision 55c89d7890cc910efd0909b70b074ebf896ce55f) +++ generic/nsfInt.h (.../nsfInt.h) (revision 19c84744084963110f84f4ce28fbf55714c79635) @@ -309,8 +309,8 @@ MEM_COUNT_ALLOC("INCR_REF_COUNT-" name,(A)); Tcl_IncrRefCount((A)) #define ObjStr(obj) ((obj)->bytes) ? ((obj)->bytes) : Tcl_GetString(obj) -#define ClassName(cl) (((cl) ? ObjStr((cl)->object.cmdName) : "NULL")) -#define ObjectName(obj) (((obj) ? ObjStr((obj)->cmdName) : "NULL")) +#define ClassName(cl) (((cl) != NULL) ? ObjStr((cl)->object.cmdName) : "NULL") +#define ObjectName(obj) (((obj) != NULL) ? ObjStr((obj)->cmdName) : "NULL") #ifdef OBJDELETION_TRACE # define PRINTOBJ(ctx,obj) \ @@ -737,6 +737,7 @@ typedef struct NsfShadowTclCommandInfo { TclObjCmdProcType proc; ClientData clientData; + int nrArgs; } NsfShadowTclCommandInfo; typedef enum {SHADOW_LOAD=1, SHADOW_UNLOAD=0, SHADOW_REFETCH=2} NsfShadowOperations; @@ -754,8 +755,16 @@ Tcl_Obj *NsfMethodObj(NsfObject *object, int methodIdx) nonnull(1); +int NsfReplaceCommandCleanup(Tcl_Interp *interp, Tcl_Obj *nameObj, NsfShadowTclCommandInfo *ti) + nonnull(1) nonnull(2) nonnull(3); +int NsfReplaceCommand(Tcl_Interp *interp, Tcl_Obj *nameObj, + Tcl_ObjCmdProc *nsfReplacementProc, + ClientData cd, + NsfShadowTclCommandInfo *ti) + nonnull(1) nonnull(2) nonnull(5); + /* * Next Scripting CallStack */ @@ -852,7 +861,8 @@ int depth; int verbose; int inmemory; - + Tcl_Obj *shadowedObjs; + NsfShadowTclCommandInfo *shadowedTi; } NsfProfile; # define NSF_PROFILE_TIME_DATA struct timeval profile_trt @@ -990,13 +1000,13 @@ #if defined(NSF_PROFILE) EXTERN void NsfProfileRecordMethodData(Tcl_Interp* interp, NsfCallStackContent *cscPtr) nonnull(1) nonnull(2); -EXTERN void NsfProfileRecordProcData(Tcl_Interp *interp, char *methodName, long startSec, long startUsec) +EXTERN void NsfProfileRecordProcData(Tcl_Interp *interp, const char *methodName, long startSec, long startUsec) nonnull(1) nonnull(2); EXTERN void NsfProfileInit(Tcl_Interp *interp) nonnull(1); EXTERN void NsfProfileFree(Tcl_Interp *interp) nonnull(1); EXTERN void NsfProfileClearData(Tcl_Interp *interp) nonnull(1); EXTERN void NsfProfileGetData(Tcl_Interp *interp) nonnull(1); -EXTERN int NsfProfileTrace(Tcl_Interp *interp, int withEnable, int withVerbose, int withInmemory); +EXTERN int NsfProfileTrace(Tcl_Interp *interp, int withEnable, int withVerbose, int withInmemory, Tcl_Obj *builtins); EXTERN void NsfProfileObjectLabel(Tcl_DString *dsPtr, NsfObject *obj, NsfClass *cl, const char *methodName) nonnull(1) nonnull(2) nonnull(4); Index: generic/nsfProfile.c =================================================================== diff -u -rf1ac62ff371d4943fb3dc55c547a80cb47146b97 -r19c84744084963110f84f4ce28fbf55714c79635 --- generic/nsfProfile.c (.../nsfProfile.c) (revision f1ac62ff371d4943fb3dc55c547a80cb47146b97) +++ generic/nsfProfile.c (.../nsfProfile.c) (revision 19c84744084963110f84f4ce28fbf55714c79635) @@ -45,9 +45,6 @@ } NsfProfileData; - - - /* *---------------------------------------------------------------------- * NsfProfileFillTable -- @@ -63,10 +60,10 @@ * *---------------------------------------------------------------------- */ -static void NsfProfileFillTable(Tcl_HashTable *table, char *keyStr, double totalMicroSec) nonnull(1) nonnull(2); +static void NsfProfileFillTable(Tcl_HashTable *table, const char *keyStr, double totalMicroSec) nonnull(1) nonnull(2); static void -NsfProfileFillTable(Tcl_HashTable *table, char *keyStr, double totalMicroSec) { +NsfProfileFillTable(Tcl_HashTable *table, const char *keyStr, double totalMicroSec) { NsfProfileData *value; Tcl_HashEntry *hPtr; int isNew; @@ -89,6 +86,114 @@ /* *---------------------------------------------------------------------- + * Nsf_ProfileFilterObjCmd -- + * + * Stub command to include C-level commands in profile traces. + * + * Results: + * Tcl result code + * + * Side effects: + * Perform tracing + * + *---------------------------------------------------------------------- + */ +static int +Nsf_ProfileFilterObjCmd(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { + int result; + NsfShadowTclCommandInfo *ti; + struct timeval start; + const char *fullMethodName, *label; + Tcl_DString ds; + + assert(cd); + + fullMethodName = ObjStr(objv[0]); + ti = (NsfShadowTclCommandInfo *)cd; + + if (ti->nrArgs == 0 || objc < 2) { + label = fullMethodName; + } else { + int i, nrArgs = objc; + + if (nrArgs > ti->nrArgs) { + nrArgs = ti->nrArgs; + } + + Tcl_DStringInit(&ds); + Tcl_DStringAppend(&ds, fullMethodName, -1); + for (i = 1; i<=nrArgs; i++) { + Tcl_DStringAppend(&ds, " ", 1); + Tcl_DStringAppend(&ds, ObjStr(objv[i]), -1); + } + label = ds.string; + } + + NsfProfileTraceCallAppend(interp, label); + + gettimeofday(&start, NULL); + result = Tcl_NRCallObjProc(interp, ti->proc, ti->clientData, objc, objv); + NsfProfileRecordProcData(interp, label, start.tv_sec, start.tv_usec); + + if (label != fullMethodName) { + Tcl_DStringFree(&ds); + } + return result; +} + +/* + *---------------------------------------------------------------------- + * GetPair -- + * + * Split a Tcl_Obj into a nameObj and an integer value, if possible + * + * Results: + * Tcl result + * + * Side effects: + * Produce warnings for error cases, when "verbose" is on. + * + *---------------------------------------------------------------------- + */ +static int +GetPair(Tcl_Interp *interp, Tcl_Obj *objPtr, int verbose, Tcl_Obj **nameObjPtr, int *nrArgsPtr) + nonnull(1) nonnull(2) nonnull(4) nonnull(5); + +static int +GetPair(Tcl_Interp *interp, Tcl_Obj *objPtr, int verbose, Tcl_Obj **nameObjPtr, int *nrArgsPtr) { + int result = TCL_OK, oc; + Tcl_Obj **ov; + + if (Tcl_ListObjGetElements(interp, objPtr, &oc, &ov) != TCL_OK) { + if (verbose) { + NsfLog(interp, NSF_LOG_WARN, "invalid list element '%s'", ObjStr(objPtr)); + result = TCL_ERROR; + } + } else { + if (oc == 1) { + *nameObjPtr = ov[0]; + } else if (oc == 2) { + if (Tcl_GetIntFromObj(interp, ov[1], nrArgsPtr) == TCL_OK) { + *nameObjPtr = ov[0]; + } else { + if (verbose) { + NsfLog(interp, NSF_LOG_WARN, "second element of '%s' must be an integer", ObjStr(objPtr)); + result = TCL_ERROR; + } + } + } else { + if (verbose) { + NsfLog(interp, NSF_LOG_WARN, "list element '%s' not a valid pair", ObjStr(objPtr)); + result = TCL_ERROR; + } + } + } + + return result; +} + +/* + *---------------------------------------------------------------------- * NsfProfileTrace -- * * Function callable via tcl to control trace behavior. @@ -103,12 +208,12 @@ * *---------------------------------------------------------------------- */ - int -NsfProfileTrace(Tcl_Interp *interp, int withEnable, int withVerbose, int withDontsave) { +NsfProfileTrace(Tcl_Interp *interp, int withEnable, int withVerbose, int withDontsave, Tcl_Obj *builtinObjs) { NsfRuntimeState *rst; - NsfProfile *profilePtr; - int oldProfileState; + NsfProfile *profilePtr; + int oldProfileState, oc; + Tcl_Obj **ov; assert(interp != NULL); @@ -121,6 +226,70 @@ /* * Turn automically profiling on&off, when trace is turned on/off */ + if (withEnable == 1) { + if (rst->doProfile == 1) { + NsfLog(interp, NSF_LOG_WARN, "tracing is already active"); + } else { + /* + * Activate profile trace. + */ + if (builtinObjs != NULL) { + /* + * A list of cammands was provided + */ + if (Tcl_ListObjGetElements(interp, builtinObjs, &oc, &ov) != TCL_OK) { + NsfLog(interp, NSF_LOG_WARN, "argument '%s' is not a list of commands", ObjStr(builtinObjs)); + } else { + NsfShadowTclCommandInfo *ti = NEW_ARRAY(NsfShadowTclCommandInfo, oc); + int i; + + for (i = 0; i < oc; i++) { + int nrArgs = 0; + Tcl_Obj *nameObj = NULL; + + if (GetPair(interp, ov[i], 1, &nameObj, &nrArgs) == TCL_OK) { + ti[i].nrArgs = nrArgs; + if (NsfReplaceCommand(interp, nameObj, Nsf_ProfileFilterObjCmd, &ti[i], &ti[i]) != TCL_OK) { + NsfLog(interp, NSF_LOG_WARN, "List element '%s' is not a command", ObjStr(nameObj)); + } + } + } + INCR_REF_COUNT(builtinObjs); + profilePtr->shadowedObjs = builtinObjs; + profilePtr->shadowedTi = ti; + } + } + } + } else { + /* + * Deactivate profile trace. + */ + if (profilePtr->shadowedObjs != NULL) { + + if (Tcl_ListObjGetElements(interp, profilePtr->shadowedObjs, &oc, &ov) != TCL_OK) { + NsfLog(interp, NSF_LOG_WARN, "shadowed objects are apparently not a list"); + } else { + int i; + + for (i = 0; i < oc; i++) { + int nrArgs = 0; + Tcl_Obj *nameObj = NULL; + + if (GetPair(interp, ov[i], 0, &nameObj, &nrArgs) == TCL_OK) { + NsfReplaceCommandCleanup(interp, nameObj, &profilePtr->shadowedTi[i]); + } + } + } + INCR_REF_COUNT(profilePtr->shadowedObjs); + + FREE(NsfShadowTclCommandInfo*, profilePtr->shadowedTi); + profilePtr->shadowedTi = NULL; + profilePtr->shadowedObjs = NULL; + fprintf(stderr, "freed profile information\n"); + } + + } + rst->doProfile = withEnable; profilePtr->verbose = withVerbose; @@ -159,7 +328,7 @@ savedResultObj = Tcl_GetObjResult(interp); INCR_REF_COUNT(savedResultObj); - NsfLog(interp, NSF_LOG_NOTICE, line); + NsfLog(interp, NSF_LOG_NOTICE, "%s", line); Tcl_SetObjResult(interp, savedResultObj); DECR_REF_COUNT(savedResultObj); @@ -247,8 +416,6 @@ assert(obj != NULL); assert(methodName != NULL); - Tcl_DStringInit(dsPtr); - Tcl_DStringAppend(dsPtr, ObjectName(obj), -1); Tcl_DStringAppend(dsPtr, " ", 1); Tcl_DStringAppend(dsPtr, ClassName(obj->cl), -1); @@ -261,8 +428,6 @@ assert(obj != NULL); assert(methodName != NULL); - Tcl_DStringInit(dsPtr); - if (cl != NULL) { Tcl_DStringAppend(dsPtr, ObjStr(cl->object.cmdName), -1); Tcl_DStringAppend(dsPtr, " ", 1); @@ -296,8 +461,9 @@ Tcl_DString ds, traceLabel; Tcl_DStringInit(&ds); - Tcl_DStringInit(&traceLabel); NsfProfileObjectLabel(&ds, object, cl, methodName); + + Tcl_DStringInit(&traceLabel); Tcl_DStringAppendElement(&traceLabel, Tcl_DStringValue(&ds)); Tcl_DStringAppend(&traceLabel, " ", 1); @@ -325,9 +491,9 @@ totalMicroSec = (trt.tv_sec - callTime->tv_sec) * 1000000 + (trt.tv_usec - callTime->tv_usec); Tcl_DStringInit(&ds); + NsfProfileObjectLabel(&ds, object, cl, methodName); Tcl_DStringInit(&traceLabel); - NsfProfileObjectLabel(&ds, object, cl, methodName); Tcl_DStringAppendElement(&traceLabel, Tcl_DStringValue(&ds)); Tcl_DStringAppend(&traceLabel, " ", 1); @@ -381,6 +547,7 @@ return; } + Tcl_DStringInit(&objectKey); NsfProfileObjectLabel(&objectKey, obj, NULL, cscPtr->methodName); Tcl_DStringInit(&methodInfo); @@ -447,7 +614,7 @@ *---------------------------------------------------------------------- */ void -NsfProfileRecordProcData(Tcl_Interp *interp, char *methodName, long startSec, long startUsec) { +NsfProfileRecordProcData(Tcl_Interp *interp, const char *methodName, long startSec, long startUsec) { NsfRuntimeState *rst = RUNTIME_STATE(interp); NsfProfile *profilePtr = &rst->profile; double totalMicroSec; Index: generic/nsfShadow.c =================================================================== diff -u -rdbd95b0155c23213b81125e318b0691cb75f66f5 -r19c84744084963110f84f4ce28fbf55714c79635 --- generic/nsfShadow.c (.../nsfShadow.c) (revision dbd95b0155c23213b81125e318b0691cb75f66f5) +++ generic/nsfShadow.c (.../nsfShadow.c) (revision 19c84744084963110f84f4ce28fbf55714c79635) @@ -54,21 +54,25 @@ * *---------------------------------------------------------------------- */ -static int NsfReplaceCommandCleanup(Tcl_Interp *interp, NsfGlobalNames name) nonnull(1); -static int -NsfReplaceCommandCleanup(Tcl_Interp *interp, NsfGlobalNames name) { - Tcl_Command cmd; - int result = TCL_OK; - NsfShadowTclCommandInfo *ti = &RUNTIME_STATE(interp)->tclCommands[name-NSF_EXPR]; +int +NsfReplaceCommandCleanup(Tcl_Interp *interp, Tcl_Obj *nameObj, NsfShadowTclCommandInfo *ti) { + Tcl_Command cmd; + int result = TCL_OK; assert(interp != NULL); + assert(nameObj != NULL); + assert(ti != NULL); /*fprintf(stderr," cleanup for %s ti=%p in %p\n", NsfGlobalStrings[name], ti, interp);*/ - cmd = Tcl_GetCommandFromObj(interp, NsfGlobalObjs[name]); + cmd = Tcl_GetCommandFromObj(interp, nameObj); if (cmd != NULL) { Tcl_Command_objProc(cmd) = ti->proc; + if (ti->clientData != NULL) { + Tcl_Command_objClientData(cmd) = ti->clientData; + } ti->proc = NULL; + ti->clientData = NULL; } else { result = TCL_ERROR; } @@ -91,17 +95,21 @@ * *---------------------------------------------------------------------- */ -static void NsfReplaceCommandCheck(Tcl_Interp *interp, NsfGlobalNames name, Tcl_ObjCmdProc *proc) nonnull(1) nonnull(3); +static void NsfReplaceCommandCheck(Tcl_Interp *interp, Tcl_Obj *nameObj, Tcl_ObjCmdProc *proc, + NsfShadowTclCommandInfo *ti) + nonnull(1) nonnull(2) nonnull(3) nonnull(4); static void -NsfReplaceCommandCheck(Tcl_Interp *interp, NsfGlobalNames name, Tcl_ObjCmdProc *proc) { - NsfShadowTclCommandInfo *ti = &RUNTIME_STATE(interp)->tclCommands[name-NSF_EXPR]; +NsfReplaceCommandCheck(Tcl_Interp *interp, Tcl_Obj *nameObj, Tcl_ObjCmdProc *proc, + NsfShadowTclCommandInfo *ti) { Tcl_Command cmd; assert(interp != NULL); + assert(nameObj != NULL); assert(proc != NULL); + assert(ti != NULL); - cmd = Tcl_GetCommandFromObj(interp, NsfGlobalObjs[name]); + cmd = Tcl_GetCommandFromObj(interp, nameObj); if (cmd != NULL && ti->proc && Tcl_Command_objProc(cmd) != proc) { /* @@ -116,7 +124,7 @@ /* *---------------------------------------------------------------------- - * NsfReplaceCommandCheck -- + * NsfReplaceCommand -- * * Lookup the objProc of a Tcl command and keep it around for * efficient calling. Replace the objProc optionally with a newly @@ -130,37 +138,34 @@ * *---------------------------------------------------------------------- */ -static int NsfReplaceCommand(Tcl_Interp *interp, NsfGlobalNames name, - Tcl_ObjCmdProc *nsfReplacementProc, int pass) nonnull(1); - -static int -NsfReplaceCommand(Tcl_Interp *interp, NsfGlobalNames name, - Tcl_ObjCmdProc *nsfReplacementProc, int pass) { +int +NsfReplaceCommand(Tcl_Interp *interp, Tcl_Obj *nameObj, + Tcl_ObjCmdProc *nsfReplacementProc, + ClientData cd, + NsfShadowTclCommandInfo *ti) { Tcl_Command cmd; - NsfShadowTclCommandInfo *ti = &RUNTIME_STATE(interp)->tclCommands[name-NSF_EXPR]; int result = TCL_OK; assert(interp != NULL); + assert(nameObj != NULL); + assert(ti != NULL); - /*fprintf(stderr,"NsfReplaceCommand %d\n", name);*/ - cmd = Tcl_GetCommandFromObj(interp, NsfGlobalObjs[name]); + /* fprintf(stderr,"NsfReplaceCommand %s\n", ObjStr(nameObj)); */ + cmd = Tcl_GetCommandFromObj(interp, nameObj); if (cmd == NULL) { result = TCL_ERROR; } else { Tcl_ObjCmdProc *objProc = Tcl_Command_objProc(cmd); if (nsfReplacementProc != objProc) { - if (pass == 0) { /* setting values on first pass (must be locked here) */ - ti->proc = objProc; - ti->clientData = Tcl_Command_objClientData(cmd); - } else if (ti->proc != objProc) { - /*fprintf(stderr, "we have to refetch command for %s\n", NsfGlobalStrings[name]);*/ - ti->proc = objProc; - ti->clientData = Tcl_Command_objClientData(cmd); - } + ti->proc = objProc; + ti->clientData = Tcl_Command_objClientData(cmd); if (nsfReplacementProc != NULL) { Tcl_Command_objProc(cmd) = nsfReplacementProc; } + if (cd != NULL) { + Tcl_Command_objClientData(cmd) = cd; + } } } return result; @@ -394,47 +399,51 @@ * *---------------------------------------------------------------------- */ +#define CMD_INFO(rst, name) &(rst)->tclCommands[(name)-NSF_EXPR] + int NsfShadowTclCommands(Tcl_Interp *interp, NsfShadowOperations load) { int rc = TCL_OK; + NsfRuntimeState *rst = RUNTIME_STATE(interp); + assert(interp != NULL); if (load == SHADOW_LOAD) { - int initialized = (RUNTIME_STATE(interp)->tclCommands != NULL); - assert(initialized == 0); - RUNTIME_STATE(interp)->tclCommands = - NEW_ARRAY(NsfShadowTclCommandInfo, NSF_RENAME - NSF_EXPR + 1); + assert(rst->tclCommands == NULL); + rst->tclCommands = NEW_ARRAY(NsfShadowTclCommandInfo, NSF_RENAME - NSF_EXPR + 1); - /*fprintf(stderr, "+++ load tcl commands %d %d\n", load, initialized);*/ - #ifdef USE_TCL_STUBS - /* no commands are overloaded, these are only used for calling - e.g. Tcl_ExprObjCmd(), Tcl_IncrObjCmd() and Tcl_SubstObjCmd(), - which are not available in though the stub table */ - rc |= NsfReplaceCommand(interp, NSF_EXPR, NULL, initialized); + /* + * When the third argument of NsfReplaceCommand is NULL, the commands are + * not overloaded. However, we use this mechanism to call Tcl commands + * (Tcl_ExprObjCmd(), Tcl_IncrObjCmd() and Tcl_SubstObjCmd()), which cannot be + * called not available in though the stub table. + */ + rc |= NsfReplaceCommand(interp, NsfGlobalObjs[NSF_EXPR], NULL, NULL, CMD_INFO(rst, NSF_EXPR)); #endif - rc |= NsfReplaceCommand(interp, NSF_FORMAT, NULL, initialized); - rc |= NsfReplaceCommand(interp, NSF_INTERP, NULL, initialized); - rc |= NsfReplaceCommand(interp, NSF_STRING_IS, NULL, initialized); + rc |= NsfReplaceCommand(interp, NsfGlobalObjs[NSF_FORMAT], NULL, NULL, CMD_INFO(rst, NSF_FORMAT)); + rc |= NsfReplaceCommand(interp, NsfGlobalObjs[NSF_INTERP], NULL, NULL, CMD_INFO(rst, NSF_INTERP)); + rc |= NsfReplaceCommand(interp, NsfGlobalObjs[NSF_STRING_IS], NULL, NULL, CMD_INFO(rst, NSF_STRING_IS)); /* for the following commands, we have to add our own semantics */ - rc |= NsfReplaceCommand(interp, NSF_INFO_BODY, Nsf_InfoBodyObjCmd, initialized); - rc |= NsfReplaceCommand(interp, NSF_INFO_FRAME, Nsf_InfoFrameObjCmd, initialized); - rc |= NsfReplaceCommand(interp, NSF_RENAME, Nsf_RenameObjCmd, initialized); + rc |= NsfReplaceCommand(interp, NsfGlobalObjs[NSF_INFO_BODY], Nsf_InfoBodyObjCmd, NULL, CMD_INFO(rst, NSF_INFO_BODY)); + rc |= NsfReplaceCommand(interp, NsfGlobalObjs[NSF_INFO_FRAME], Nsf_InfoFrameObjCmd, NULL, CMD_INFO(rst, NSF_INFO_FRAME)); + rc |= NsfReplaceCommand(interp, NsfGlobalObjs[NSF_RENAME], Nsf_RenameObjCmd, NULL, CMD_INFO(rst, NSF_RENAME)); } else if (load == SHADOW_REFETCH) { - NsfReplaceCommandCheck(interp, NSF_INFO_BODY, Nsf_InfoFrameObjCmd); - NsfReplaceCommandCheck(interp, NSF_INFO_FRAME, Nsf_InfoFrameObjCmd); - NsfReplaceCommandCheck(interp, NSF_RENAME, Nsf_RenameObjCmd); + NsfReplaceCommandCheck(interp, NsfGlobalObjs[NSF_INFO_BODY], Nsf_InfoFrameObjCmd, CMD_INFO(rst, NSF_INFO_BODY)); + NsfReplaceCommandCheck(interp, NsfGlobalObjs[NSF_INFO_FRAME], Nsf_InfoFrameObjCmd, CMD_INFO(rst, NSF_INFO_FRAME)); + NsfReplaceCommandCheck(interp, NsfGlobalObjs[NSF_RENAME], Nsf_RenameObjCmd, CMD_INFO(rst, NSF_RENAME)); } else { - NsfReplaceCommandCleanup(interp, NSF_INFO_BODY); - NsfReplaceCommandCleanup(interp, NSF_INFO_FRAME); - NsfReplaceCommandCleanup(interp, NSF_RENAME); + NsfReplaceCommandCleanup(interp, NsfGlobalObjs[NSF_INFO_BODY], CMD_INFO(rst, NSF_INFO_BODY)); + NsfReplaceCommandCleanup(interp, NsfGlobalObjs[NSF_INFO_FRAME],CMD_INFO(rst, NSF_INFO_FRAME)); + NsfReplaceCommandCleanup(interp, NsfGlobalObjs[NSF_RENAME], CMD_INFO(rst, NSF_RENAME)); - FREE(NsfShadowTclCommandInfo*, RUNTIME_STATE(interp)->tclCommands); - RUNTIME_STATE(interp)->tclCommands = NULL; + FREE(NsfShadowTclCommandInfo*, rst->tclCommands); + rst->tclCommands = NULL; } + return rc; }