diff options
author | jan.nijtmans <nijtmans@users.sourceforge.net> | 2012-12-29 16:37:24 (GMT) |
---|---|---|
committer | jan.nijtmans <nijtmans@users.sourceforge.net> | 2012-12-29 16:37:24 (GMT) |
commit | 966be36ee6065e15f37fb0caf8d334ba12f3fe7c (patch) | |
tree | b8998935790c095140608d9be27f58c0258ba9a7 | |
parent | 6fce81dac5a1631e6c8b8e03b5ae7c8493c9c935 (diff) | |
download | tcl-966be36ee6065e15f37fb0caf8d334ba12f3fe7c.zip tcl-966be36ee6065e15f37fb0caf8d334ba12f3fe7c.tar.gz tcl-966be36ee6065e15f37fb0caf8d334ba12f3fe7c.tar.bz2 |
Implement Tcl_SaveResult/Tcl_DiscardResult/Tcl_RestoreResult as macronovem_saveresult_as_macro
-rw-r--r-- | generic/tcl.decls | 25 | ||||
-rw-r--r-- | generic/tcl.h | 27 | ||||
-rw-r--r-- | generic/tclDecls.h | 26 | ||||
-rw-r--r-- | generic/tclResult.c | 100 | ||||
-rw-r--r-- | generic/tclStubInit.c | 6 |
5 files changed, 45 insertions, 139 deletions
diff --git a/generic/tcl.decls b/generic/tcl.decls index fe1d763..3b680b1 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -783,7 +783,7 @@ declare 218 { declare 219 { int Tcl_ScanCountedElement(const char *src, int length, int *flagPtr) } -# Removed in Tcl 9 +# Removed in 9.0 #declare 220 { # int Tcl_SeekOld(Tcl_Channel chan, int offset, int mode) #} @@ -871,7 +871,7 @@ declare 244 { declare 245 { int Tcl_StringMatch(const char *str, const char *pattern) } -# Removed in Tcl 9 +# Removed in 9.0 #declare 246 { # int Tcl_TellOld(Tcl_Channel chan) #} @@ -1050,9 +1050,10 @@ declare 288 { declare 289 { void Tcl_DeleteThreadExitHandler(Tcl_ExitProc *proc, ClientData clientData) } -declare 290 { - void Tcl_DiscardResult(Tcl_SavedResult *statePtr) -} +# Removed in 9.0 +#declare 290 { +# void Tcl_DiscardResult(Tcl_Obj **statePtr) +#} declare 291 { int Tcl_EvalEx(Tcl_Interp *interp, const char *script, int numBytes, int flags) @@ -1133,12 +1134,14 @@ declare 313 { int Tcl_ReadChars(Tcl_Channel channel, Tcl_Obj *objPtr, int charsToRead, int appendFlag) } -declare 314 { - void Tcl_RestoreResult(Tcl_Interp *interp, Tcl_SavedResult *statePtr) -} -declare 315 { - void Tcl_SaveResult(Tcl_Interp *interp, Tcl_SavedResult *statePtr) -} +# Removed in 9.0 +#declare 314 { +# void Tcl_RestoreResult(Tcl_Interp *interp, Tcl_Obj **statePtr) +#} +# Removed in 9.0 +#declare 315 { +# void Tcl_SaveResult(Tcl_Interp *interp, Tcl_Obj **statePtr) +#} declare 316 { int Tcl_SetSystemEncoding(Tcl_Interp *interp, const char *name) } diff --git a/generic/tcl.h b/generic/tcl.h index cc3efaf..f398be5 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -690,14 +690,25 @@ int Tcl_IsShared(Tcl_Obj *objPtr); /* *---------------------------------------------------------------------------- - * The following structure contains the state needed by Tcl_SaveResult. No-one - * outside of Tcl should access any of these fields. This structure is - * typically allocated on the stack. - */ - -typedef struct Tcl_SavedResult { - Tcl_Obj *objResultPtr; -} Tcl_SavedResult; + * The following macros and defines contain the Tcl8 implementations of + * Tcl_SaveResult/Tcl_DiscardResult/Tcl_RestoreResult. They should not + * be used for new code, but the equivalence is easy enough to keep them. + */ + +#define Tcl_SavedResult Tcl_Obj * +#define Tcl_SaveResult(interp, statePtr) \ + do { \ + Tcl_IncrRefCount((*(statePtr) = Tcl_GetObjResult(interp))); \ + Tcl_SetObjResult((interp), Tcl_NewObj()); \ + } while(0) +#define Tcl_DiscardResult(statePtr) Tcl_DecrRefCount(*statePtr) +#define Tcl_RestoreResult(interp, statePtr) \ + do { \ + Tcl_Obj *_statePtr = *(statePtr); \ + Tcl_ResetResult(interp); \ + Tcl_SetObjResult(interp, _statePtr); \ + Tcl_DecrRefCount(_statePtr); \ + } while(0) /* *---------------------------------------------------------------------------- diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 0770e98..ac0fb1e 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -828,8 +828,7 @@ TCLAPI void Tcl_CreateThreadExitHandler(Tcl_ExitProc *proc, /* 289 */ TCLAPI void Tcl_DeleteThreadExitHandler(Tcl_ExitProc *proc, ClientData clientData); -/* 290 */ -TCLAPI void Tcl_DiscardResult(Tcl_SavedResult *statePtr); +/* Slot 290 is reserved */ /* 291 */ TCLAPI int Tcl_EvalEx(Tcl_Interp *interp, const char *script, int numBytes, int flags); @@ -893,12 +892,8 @@ TCLAPI int Tcl_NumUtfChars(const char *src, int length); /* 313 */ TCLAPI int Tcl_ReadChars(Tcl_Channel channel, Tcl_Obj *objPtr, int charsToRead, int appendFlag); -/* 314 */ -TCLAPI void Tcl_RestoreResult(Tcl_Interp *interp, - Tcl_SavedResult *statePtr); -/* 315 */ -TCLAPI void Tcl_SaveResult(Tcl_Interp *interp, - Tcl_SavedResult *statePtr); +/* Slot 314 is reserved */ +/* Slot 315 is reserved */ /* 316 */ TCLAPI int Tcl_SetSystemEncoding(Tcl_Interp *interp, const char *name); @@ -2091,7 +2086,7 @@ typedef struct TclStubs { Tcl_Encoding (*tcl_CreateEncoding) (const Tcl_EncodingType *typePtr); /* 287 */ void (*tcl_CreateThreadExitHandler) (Tcl_ExitProc *proc, ClientData clientData); /* 288 */ void (*tcl_DeleteThreadExitHandler) (Tcl_ExitProc *proc, ClientData clientData); /* 289 */ - void (*tcl_DiscardResult) (Tcl_SavedResult *statePtr); /* 290 */ + void (*reserved290)(void); int (*tcl_EvalEx) (Tcl_Interp *interp, const char *script, int numBytes, int flags); /* 291 */ int (*tcl_EvalObjv) (Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int flags); /* 292 */ int (*tcl_EvalObjEx) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); /* 293 */ @@ -2115,8 +2110,8 @@ typedef struct TclStubs { void (*tcl_ConditionWait) (Tcl_Condition *condPtr, Tcl_Mutex *mutexPtr, const Tcl_Time *timePtr); /* 311 */ int (*tcl_NumUtfChars) (const char *src, int length); /* 312 */ int (*tcl_ReadChars) (Tcl_Channel channel, Tcl_Obj *objPtr, int charsToRead, int appendFlag); /* 313 */ - void (*tcl_RestoreResult) (Tcl_Interp *interp, Tcl_SavedResult *statePtr); /* 314 */ - void (*tcl_SaveResult) (Tcl_Interp *interp, Tcl_SavedResult *statePtr); /* 315 */ + void (*reserved314)(void); + void (*reserved315)(void); int (*tcl_SetSystemEncoding) (Tcl_Interp *interp, const char *name); /* 316 */ Tcl_Obj * (*tcl_SetVar2Ex) (Tcl_Interp *interp, const char *part1, const char *part2, Tcl_Obj *newValuePtr, int flags); /* 317 */ void (*tcl_ThreadAlert) (Tcl_ThreadId threadId); /* 318 */ @@ -3034,8 +3029,7 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_CreateThreadExitHandler) /* 288 */ #define Tcl_DeleteThreadExitHandler \ (tclStubsPtr->tcl_DeleteThreadExitHandler) /* 289 */ -#define Tcl_DiscardResult \ - (tclStubsPtr->tcl_DiscardResult) /* 290 */ +/* Slot 290 is reserved */ #define Tcl_EvalEx \ (tclStubsPtr->tcl_EvalEx) /* 291 */ #define Tcl_EvalObjv \ @@ -3082,10 +3076,8 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_NumUtfChars) /* 312 */ #define Tcl_ReadChars \ (tclStubsPtr->tcl_ReadChars) /* 313 */ -#define Tcl_RestoreResult \ - (tclStubsPtr->tcl_RestoreResult) /* 314 */ -#define Tcl_SaveResult \ - (tclStubsPtr->tcl_SaveResult) /* 315 */ +/* Slot 314 is reserved */ +/* Slot 315 is reserved */ #define Tcl_SetSystemEncoding \ (tclStubsPtr->tcl_SetSystemEncoding) /* 316 */ #define Tcl_SetVar2Ex \ diff --git a/generic/tclResult.c b/generic/tclResult.c index 1a73288..6e7d790 100644 --- a/generic/tclResult.c +++ b/generic/tclResult.c @@ -210,106 +210,6 @@ Tcl_DiscardInterpState( /* *---------------------------------------------------------------------- * - * Tcl_SaveResult -- - * - * Takes a snapshot of the current result state of the interpreter. The - * snapshot can be restored at any point by Tcl_RestoreResult. Note that - * this routine does not preserve the errorCode, errorInfo, or flags - * fields so it should not be used if an error is in progress. - * - * Once a snapshot is saved, it must be restored by calling - * Tcl_RestoreResult, or discarded by calling Tcl_DiscardResult. - * - * Results: - * None. - * - * Side effects: - * Resets the interpreter result. - * - *---------------------------------------------------------------------- - */ - -void -Tcl_SaveResult( - Tcl_Interp *interp, /* Interpreter to save. */ - Tcl_SavedResult *statePtr) /* Pointer to state structure. */ -{ - Interp *iPtr = (Interp *) interp; - - /* - * Move the result object into the save state. Note that we don't need to - * change its refcount because we're moving it, not adding a new - * reference. Put an empty object into the interpreter. - */ - - statePtr->objResultPtr = iPtr->objResultPtr; - iPtr->objResultPtr = Tcl_NewObj(); - Tcl_IncrRefCount(iPtr->objResultPtr); -} - -/* - *---------------------------------------------------------------------- - * - * Tcl_RestoreResult -- - * - * Restores the state of the interpreter to a snapshot taken by - * Tcl_SaveResult. After this call, the token for the interpreter state - * is no longer valid. - * - * Results: - * None. - * - * Side effects: - * Restores the interpreter result. - * - *---------------------------------------------------------------------- - */ - -void -Tcl_RestoreResult( - Tcl_Interp *interp, /* Interpreter being restored. */ - Tcl_SavedResult *statePtr) /* State returned by Tcl_SaveResult. */ -{ - Interp *iPtr = (Interp *) interp; - - Tcl_ResetResult(interp); - - /* - * Restore the object result. - */ - - Tcl_DecrRefCount(iPtr->objResultPtr); - iPtr->objResultPtr = statePtr->objResultPtr; -} - -/* - *---------------------------------------------------------------------- - * - * Tcl_DiscardResult -- - * - * Frees the memory associated with an interpreter snapshot taken by - * Tcl_SaveResult. If the snapshot is not restored, this function must be - * called to discard it, or the memory will be lost. - * - * Results: - * None. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -void -Tcl_DiscardResult( - Tcl_SavedResult *statePtr) /* State returned by Tcl_SaveResult. */ -{ - TclDecrRefCount(statePtr->objResultPtr); -} - -/* - *---------------------------------------------------------------------- - * * Tcl_SetResult -- * * Arrange for "result" to be the Tcl return value. diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index 50fc6de..9112806 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -960,7 +960,7 @@ const TclStubs tclStubs = { Tcl_CreateEncoding, /* 287 */ Tcl_CreateThreadExitHandler, /* 288 */ Tcl_DeleteThreadExitHandler, /* 289 */ - Tcl_DiscardResult, /* 290 */ + 0, /* 290 */ Tcl_EvalEx, /* 291 */ Tcl_EvalObjv, /* 292 */ Tcl_EvalObjEx, /* 293 */ @@ -984,8 +984,8 @@ const TclStubs tclStubs = { Tcl_ConditionWait, /* 311 */ Tcl_NumUtfChars, /* 312 */ Tcl_ReadChars, /* 313 */ - Tcl_RestoreResult, /* 314 */ - Tcl_SaveResult, /* 315 */ + 0, /* 314 */ + 0, /* 315 */ Tcl_SetSystemEncoding, /* 316 */ Tcl_SetVar2Ex, /* 317 */ Tcl_ThreadAlert, /* 318 */ |