diff options
author | Miguel Sofer <miguel.sofer@gmail.com> | 2008-07-18 23:29:41 (GMT) |
---|---|---|
committer | Miguel Sofer <miguel.sofer@gmail.com> | 2008-07-18 23:29:41 (GMT) |
commit | 05ee62d96f55adfce2725b9746b6c8b0557989ee (patch) | |
tree | 280786ed54f598938301797f6f922caec6fa26b5 /generic | |
parent | 7c31170f9b9f73628665a5656daddd8002c771f7 (diff) | |
download | tcl-05ee62d96f55adfce2725b9746b6c8b0557989ee.zip tcl-05ee62d96f55adfce2725b9746b6c8b0557989ee.tar.gz tcl-05ee62d96f55adfce2725b9746b6c8b0557989ee.tar.bz2 |
new TclNRAddCallback macro for internal use instead of the public
Tcl_NRAddCallback
Diffstat (limited to 'generic')
-rw-r--r-- | generic/tclBasic.c | 32 | ||||
-rw-r--r-- | generic/tclDictObj.c | 7 | ||||
-rw-r--r-- | generic/tclExecute.c | 4 | ||||
-rw-r--r-- | generic/tclInterp.c | 5 | ||||
-rw-r--r-- | generic/tclNRE.h | 28 | ||||
-rw-r--r-- | generic/tclNamesp.c | 9 | ||||
-rw-r--r-- | generic/tclOO.c | 8 | ||||
-rw-r--r-- | generic/tclOOBasic.c | 10 | ||||
-rw-r--r-- | generic/tclOOCall.c | 8 | ||||
-rw-r--r-- | generic/tclOOInt.h | 3 | ||||
-rw-r--r-- | generic/tclOOMethod.c | 4 | ||||
-rw-r--r-- | generic/tclProc.c | 6 |
12 files changed, 70 insertions, 54 deletions
diff --git a/generic/tclBasic.c b/generic/tclBasic.c index b52ff39..eb35aaf 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -16,7 +16,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclBasic.c,v 1.315 2008/07/18 13:46:43 msofer Exp $ + * RCS: @(#) $Id: tclBasic.c,v 1.316 2008/07/18 23:29:41 msofer Exp $ */ #include "tclInt.h" @@ -4304,7 +4304,7 @@ TEOV_PushExceptionHandlers( * Error messages */ - Tcl_NRAddCallback(interp, TEOV_Error, INT2PTR(objc), + TclNRAddCallback(interp, TEOV_Error, INT2PTR(objc), (ClientData) objv, NULL,NULL); } @@ -4313,7 +4313,7 @@ TEOV_PushExceptionHandlers( * No CONTINUE or BREAK at level 0, manage RETURN */ - Tcl_NRAddCallback(interp, TEOV_Exception, NULL, NULL, NULL, NULL); + TclNRAddCallback(interp, TEOV_Exception, NULL, NULL, NULL, NULL); } } @@ -4328,7 +4328,7 @@ TEOV_SwitchVarFrame( * restore things at the end. */ - Tcl_NRAddCallback(interp, TEOV_RestoreVarFrame, iPtr->varFramePtr, NULL, + TclNRAddCallback(interp, TEOV_RestoreVarFrame, iPtr->varFramePtr, NULL, NULL, NULL); iPtr->varFramePtr = iPtr->rootFramePtr; } @@ -4545,7 +4545,7 @@ TEOV_RunEnterTraces( * Command was found: push a record to schedule the leave traces. */ - Tcl_NRAddCallback(interp, TEOV_RunLeaveTraces, INT2PTR(traceCode), + TclNRAddCallback(interp, TEOV_RunLeaveTraces, INT2PTR(traceCode), commandPtr, cmdPtr, NULL); cmdPtr->refCount++; } else { @@ -5388,7 +5388,7 @@ TclNREvalObjEx( iPtr->cmdFramePtr = eoFramePtr; - Tcl_NRAddCallback(interp, TEOEx_ListCallback, objPtr, eoFramePtr, + TclNRAddCallback(interp, TEOEx_ListCallback, objPtr, eoFramePtr, copyPtr, NULL); return Tcl_NREvalObj(interp, objPtr, flags); } @@ -5411,7 +5411,7 @@ TclNREvalObjEx( savedVarFramePtr = iPtr->varFramePtr; iPtr->varFramePtr = iPtr->rootFramePtr; } - Tcl_NRAddCallback(interp, TEOEx_ByteCodeCallback, savedVarFramePtr, + TclNRAddCallback(interp, TEOEx_ByteCodeCallback, savedVarFramePtr, objPtr, INT2PTR(allowExceptions), NULL); newCodePtr = TclCompileObj(interp, objPtr, invoker, word); @@ -7643,24 +7643,10 @@ Tcl_NRAddCallback( ClientData data2, ClientData data3) { - TEOV_record *recordPtr; - TEOV_callback *callbackPtr; - - if (!postProcPtr) { + if (!(postProcPtr)) { Tcl_Panic("Adding a callback without and objProc?!"); } - - recordPtr = TOP_RECORD(interp); - TclSmallAlloc(sizeof(TEOV_callback), callbackPtr); - - callbackPtr->procPtr = postProcPtr; - callbackPtr->data[0] = data0; - callbackPtr->data[1] = data1; - callbackPtr->data[2] = data2; - callbackPtr->data[3] = data3; - - callbackPtr->nextPtr = recordPtr->callbackPtr; - recordPtr->callbackPtr = callbackPtr; + TclNRAddCallback(interp, postProcPtr, data0, data1, data2, data3); } TEOV_record * diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c index 5b47c22..b75c92c 100644 --- a/generic/tclDictObj.c +++ b/generic/tclDictObj.c @@ -9,11 +9,12 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclDictObj.c,v 1.63 2008/07/18 13:46:43 msofer Exp $ + * RCS: @(#) $Id: tclDictObj.c,v 1.64 2008/07/18 23:29:42 msofer Exp $ */ #include "tclInt.h" #include "tommath.h" +#include "tclNRE.h" /* * Forward declaration. @@ -2932,7 +2933,7 @@ DictUpdateCmd( objPtr = Tcl_NewListObj(objc-3, objv+2); Tcl_IncrRefCount(objPtr); Tcl_IncrRefCount(objv[1]); - Tcl_NRAddCallback(interp, FinalizeDictUpdate, objv[1], objPtr, NULL,NULL); + TclNRAddCallback(interp, FinalizeDictUpdate, objv[1], objPtr, NULL,NULL); return TclNREvalObjEx(interp, objv[objc-1], 0, iPtr->cmdFramePtr, objc-1); } @@ -3111,7 +3112,7 @@ DictWithCmd( Tcl_IncrRefCount(pathPtr); } Tcl_IncrRefCount(objv[1]); - Tcl_NRAddCallback(interp, FinalizeDictWith, objv[1], keysPtr, pathPtr, + TclNRAddCallback(interp, FinalizeDictWith, objv[1], keysPtr, pathPtr, NULL); return TclNREvalObjEx(interp, objv[objc-1], 0, iPtr->cmdFramePtr, objc-1); diff --git a/generic/tclExecute.c b/generic/tclExecute.c index dd09802..7b9ae49 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -14,7 +14,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclExecute.c,v 1.381 2008/07/18 13:46:43 msofer Exp $ + * RCS: @(#) $Id: tclExecute.c,v 1.382 2008/07/18 23:29:43 msofer Exp $ */ #include "tclInt.h" @@ -7796,7 +7796,7 @@ TclExecuteByteCode( rootPtr = TOP_RECORD(iPtr); PUSH_RECORD(iPtr, recordPtr); - Tcl_NRAddCallback(interp, TailcallFromTebc, tailObjPtr, lookupNsPtr, NULL, NULL); + TclNRAddCallback(interp, TailcallFromTebc, tailObjPtr, lookupNsPtr, NULL, NULL); /* Now swap them! */ recordPtr->nextPtr = rootPtr->nextPtr; diff --git a/generic/tclInterp.c b/generic/tclInterp.c index 358d85c..4412aa8 100644 --- a/generic/tclInterp.c +++ b/generic/tclInterp.c @@ -10,10 +10,11 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclInterp.c,v 1.89 2008/07/18 13:46:45 msofer Exp $ + * RCS: @(#) $Id: tclInterp.c,v 1.90 2008/07/18 23:29:44 msofer Exp $ */ #include "tclInt.h" +#include "tclNRE.h" /* * A pointer to a string that holds an initialization script that if non-NULL @@ -1805,7 +1806,7 @@ AliasNRCmd( */ if (isRootEnsemble) { - Tcl_NRAddCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL, NULL); + TclNRAddCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL, NULL); } return TclNREvalCmd(interp, listPtr, flags); } diff --git a/generic/tclNRE.h b/generic/tclNRE.h index 0d13d3a..08ddcd5 100644 --- a/generic/tclNRE.h +++ b/generic/tclNRE.h @@ -11,7 +11,7 @@ * this file, and for a DISCLAIMER OF ALL WARRANTIES. * * // FIXME: RCS numbering? - * RCS: @(#) $Id: tclNRE.h,v 1.3 2008/07/18 13:46:46 msofer Exp $ + * RCS: @(#) $Id: tclNRE.h,v 1.4 2008/07/18 23:29:44 msofer Exp $ */ @@ -171,6 +171,32 @@ typedef struct TEOV_record { #define TEBC_DO_EXEC 1 /* MUST NOT be 0 */ #define TEBC_DO_TAILCALL 2 +#define TclNRAddCallback(\ + interp,\ + postProcPtr,\ + data0,\ + data1,\ + data2,\ + data3) \ + { \ + TEOV_record *recordPtr; \ + TEOV_callback *callbackPtr; \ + \ + recordPtr = TOP_RECORD(interp); \ + TclSmallAlloc(sizeof(TEOV_callback), callbackPtr); \ + \ + callbackPtr->procPtr = (postProcPtr); \ + callbackPtr->data[0] = (data0); \ + callbackPtr->data[1] = (data1); \ + callbackPtr->data[2] = (data2); \ + callbackPtr->data[3] = (data3); \ + \ + callbackPtr->nextPtr = recordPtr->callbackPtr; \ + recordPtr->callbackPtr = callbackPtr; \ + } + + + /* * These are only used by TEOV; here for ease of ref. They should move to * tclBasic.c later on. diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c index f541a1e..b7cd491 100644 --- a/generic/tclNamesp.c +++ b/generic/tclNamesp.c @@ -23,10 +23,11 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclNamesp.c,v 1.167 2008/07/18 13:46:46 msofer Exp $ + * RCS: @(#) $Id: tclNamesp.c,v 1.168 2008/07/18 23:29:44 msofer Exp $ */ #include "tclInt.h" +#include "tclNRE.h" /* * Thread-local storage used to avoid having a global lock on data that is not @@ -3332,7 +3333,7 @@ NamespaceEvalCmd( * TIP #280: Make invoking context available to eval'd script. */ - Tcl_NRAddCallback(interp, NsEval_Callback, namespacePtr, "eval", + TclNRAddCallback(interp, NsEval_Callback, namespacePtr, "eval", NULL, NULL); return TclNREvalObjEx(interp, objPtr, 0, iPtr->cmdFramePtr, 3); } @@ -3778,7 +3779,7 @@ NamespaceInscopeCmd( Tcl_DecrRefCount(listPtr); /* We're done with the list object. */ } - Tcl_NRAddCallback(interp, NsEval_Callback, namespacePtr, "inscope", + TclNRAddCallback(interp, NsEval_Callback, namespacePtr, "inscope", NULL, NULL); return TclNREvalObjEx(interp, cmdObjPtr, 0, NULL, 0); } @@ -6263,7 +6264,7 @@ NsEnsembleImplementationCmdNR( iPtr->ensembleRewrite.sourceObjs = objv; iPtr->ensembleRewrite.numRemovedObjs = 2; iPtr->ensembleRewrite.numInsertedObjs = prefixObjc; - Tcl_NRAddCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL, + TclNRAddCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL, NULL); } else { register int ni = iPtr->ensembleRewrite.numInsertedObjs; diff --git a/generic/tclOO.c b/generic/tclOO.c index 7280172..6f078e4 100644 --- a/generic/tclOO.c +++ b/generic/tclOO.c @@ -8,7 +8,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclOO.c,v 1.12 2008/07/18 17:23:56 dkf Exp $ + * RCS: @(#) $Id: tclOO.c,v 1.13 2008/07/18 23:29:44 msofer Exp $ */ #ifdef HAVE_CONFIG_H @@ -1358,7 +1358,7 @@ TclNRNewObjectInstance( * Fire off the constructors non-recursively. */ - Tcl_NRAddCallback(interp, FinalizeAlloc, contextPtr, oPtr, state, + TclNRAddCallback(interp, FinalizeAlloc, contextPtr, oPtr, state, objectPtr); return TclOOInvokeContext(contextPtr, interp, objc, objv); } @@ -2075,7 +2075,7 @@ TclOOObjectCmdCore( */ AddRef(oPtr); - Tcl_NRAddCallback(interp, FinalizeObjectCall, contextPtr,oPtr, NULL,NULL); + TclNRAddCallback(interp, FinalizeObjectCall, contextPtr,oPtr, NULL,NULL); return TclOOInvokeContext(contextPtr, interp, objc, objv); } @@ -2215,7 +2215,7 @@ TclNRObjectContextInvokeNext( * all) come through the same code. */ - Tcl_NRAddCallback(interp, FinalizeNext, contextPtr, + TclNRAddCallback(interp, FinalizeNext, contextPtr, INT2PTR(contextPtr->index), INT2PTR(contextPtr->skip), NULL); contextPtr->index++; contextPtr->skip = skip; diff --git a/generic/tclOOBasic.c b/generic/tclOOBasic.c index cb717ee..2adf547 100644 --- a/generic/tclOOBasic.c +++ b/generic/tclOOBasic.c @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclOOBasic.c,v 1.6 2008/07/18 17:23:57 dkf Exp $ + * RCS: @(#) $Id: tclOOBasic.c,v 1.7 2008/07/18 23:29:44 msofer Exp $ */ #ifdef HAVE_CONFIG_H @@ -32,7 +32,7 @@ static int RestoreFrame(ClientData data[], * * AddCreateCallback, FinalizeConstruction -- * - * Special version of Tcl_NRAddCallback that allows the caller to splice + * Special version of TclNRAddCallback that allows the caller to splice * the object created later on. Always calls FinalizeConstruction, which * converts the object into its name and stores that in the interpreter * result. This is shared by all the construction methods (create, @@ -51,7 +51,7 @@ AddConstructionFinalizer( { TEOV_record *recordPtr; - Tcl_NRAddCallback(interp, FinalizeConstruction, NULL, NULL, NULL, NULL); + TclNRAddCallback(interp, FinalizeConstruction, NULL, NULL, NULL, NULL); recordPtr = TOP_RECORD(interp); return (Tcl_Object *) &recordPtr->callbackPtr->data[0]; } @@ -346,7 +346,7 @@ TclOO_Object_Eval( * the script completes. */ - Tcl_NRAddCallback(interp, FinalizeEval, object, NULL, NULL, NULL); + TclNRAddCallback(interp, FinalizeEval, object, NULL, NULL, NULL); return TclNREvalObjEx(interp, scriptPtr, flags, invoker, skip); } @@ -659,7 +659,7 @@ TclOONextObjCmd( * that this is like [uplevel 1] and not [eval]. */ - Tcl_NRAddCallback(interp, RestoreFrame, framePtr, NULL, NULL, NULL); + TclNRAddCallback(interp, RestoreFrame, framePtr, NULL, NULL, NULL); iPtr->varFramePtr = framePtr->callerVarPtr; return TclNRObjectContextInvokeNext(interp, context, objc, objv, 1); } diff --git a/generic/tclOOCall.c b/generic/tclOOCall.c index 8686ee4..e517d28 100644 --- a/generic/tclOOCall.c +++ b/generic/tclOOCall.c @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclOOCall.c,v 1.9 2008/07/18 13:46:46 msofer Exp $ + * RCS: @(#) $Id: tclOOCall.c,v 1.10 2008/07/18 23:29:44 msofer Exp $ */ #ifdef HAVE_CONFIG_H @@ -277,7 +277,7 @@ TclOOInvokeContext( * this call is finished. */ - Tcl_NRAddCallback(interp, FinalizeMethodRefs, contextPtr, NULL, NULL, + TclNRAddCallback(interp, FinalizeMethodRefs, contextPtr, NULL, NULL, NULL); } @@ -286,9 +286,9 @@ TclOOInvokeContext( */ if (contextPtr->oPtr->flags & FILTER_HANDLING) { - Tcl_NRAddCallback(interp, SetFilterFlags, contextPtr, NULL,NULL,NULL); + TclNRAddCallback(interp, SetFilterFlags, contextPtr, NULL,NULL,NULL); } else { - Tcl_NRAddCallback(interp, ResetFilterFlags,contextPtr,NULL,NULL,NULL); + TclNRAddCallback(interp, ResetFilterFlags,contextPtr,NULL,NULL,NULL); } if (isFilter || contextPtr->callPtr->flags & FILTER_HANDLING) { contextPtr->oPtr->flags |= FILTER_HANDLING; diff --git a/generic/tclOOInt.h b/generic/tclOOInt.h index 66dfca5..fa7d80e 100644 --- a/generic/tclOOInt.h +++ b/generic/tclOOInt.h @@ -9,11 +9,12 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclOOInt.h,v 1.4 2008/07/18 17:23:57 dkf Exp $ + * RCS: @(#) $Id: tclOOInt.h,v 1.5 2008/07/18 23:29:44 msofer Exp $ */ #include <tclInt.h> #include "tclOO.h" +#include "tclNRE.h" /* * Forward declarations. diff --git a/generic/tclOOMethod.c b/generic/tclOOMethod.c index 7ef07e2..3afe314 100644 --- a/generic/tclOOMethod.c +++ b/generic/tclOOMethod.c @@ -8,7 +8,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclOOMethod.c,v 1.7 2008/07/18 13:46:46 msofer Exp $ + * RCS: @(#) $Id: tclOOMethod.c,v 1.8 2008/07/18 23:29:44 msofer Exp $ */ #ifdef HAVE_CONFIG_H @@ -682,7 +682,7 @@ InvokeProcedureMethod( * Now invoke the body of the method. */ - Tcl_NRAddCallback(interp, FinalizePMCall, pmPtr, context, fdPtr, NULL); + TclNRAddCallback(interp, FinalizePMCall, pmPtr, context, fdPtr, NULL); return TclNRInterpProcCore(interp, fdPtr->nameObj, Tcl_ObjectContextSkippedArgs(context), fdPtr->errProc); } diff --git a/generic/tclProc.c b/generic/tclProc.c index 7816b5c..ddfb43b 100644 --- a/generic/tclProc.c +++ b/generic/tclProc.c @@ -12,7 +12,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclProc.c,v 1.147 2008/07/18 13:46:47 msofer Exp $ + * RCS: @(#) $Id: tclProc.c,v 1.148 2008/07/18 23:29:45 msofer Exp $ */ #include "tclInt.h" @@ -966,7 +966,7 @@ TclNRUplevelObjCmd( objPtr = Tcl_ConcatObj(objc, objv); } - Tcl_NRAddCallback(interp, Uplevel_Callback, savedVarFramePtr, NULL, NULL, + TclNRAddCallback(interp, Uplevel_Callback, savedVarFramePtr, NULL, NULL, NULL); return TclNREvalObjEx(interp, objPtr, 0, NULL, 0); } @@ -1622,7 +1622,7 @@ Tcl_NRBC( recordPtr->type = TCL_NR_BC_TYPE; recordPtr->data.codePtr = codePtr; - Tcl_NRAddCallback(interp, postProcPtr, procNameObj, errorProc, NULL, + TclNRAddCallback(interp, postProcPtr, procNameObj, errorProc, NULL, NULL); return TCL_OK; } |