diff options
Diffstat (limited to 'generic')
| -rw-r--r-- | generic/regc_nfa.c | 4 | ||||
| -rw-r--r-- | generic/tcl.decls | 51 | ||||
| -rw-r--r-- | generic/tcl.h | 3 | ||||
| -rw-r--r-- | generic/tclBasic.c | 65 | ||||
| -rw-r--r-- | generic/tclCmdMZ.c | 2 | ||||
| -rw-r--r-- | generic/tclDecls.h | 72 | ||||
| -rw-r--r-- | generic/tclExecute.c | 20 | ||||
| -rw-r--r-- | generic/tclInt.h | 30 | ||||
| -rw-r--r-- | generic/tclObj.c | 219 | ||||
| -rw-r--r-- | generic/tclStubInit.c | 16 | ||||
| -rw-r--r-- | generic/tclZlib.c | 2 |
11 files changed, 89 insertions, 395 deletions
diff --git a/generic/regc_nfa.c b/generic/regc_nfa.c index 4fb3ea6..2c2397f 100644 --- a/generic/regc_nfa.c +++ b/generic/regc_nfa.c @@ -759,7 +759,9 @@ duptraverse( * Arbitrary depth limit. Needs tuning, but this value is sufficient to * make all normal tests (not reg-33.14) pass. */ -#define DUPTRAVERSE_MAX_DEPTH 500 +#ifndef DUPTRAVERSE_MAX_DEPTH +#define DUPTRAVERSE_MAX_DEPTH 700 +#endif if (depth++ > DUPTRAVERSE_MAX_DEPTH) { NERR(REG_ESPACE); diff --git a/generic/tcl.decls b/generic/tcl.decls index c7686a1..06a8dac 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -104,9 +104,10 @@ declare 20 { declare 21 { int Tcl_DbIsShared(Tcl_Obj *objPtr, const char *file, int line) } -declare 22 { - Tcl_Obj *Tcl_DbNewBooleanObj(int boolValue, const char *file, int line) -} +# Removed in 9.0: +#declare 22 { +# Tcl_Obj *Tcl_DbNewBooleanObj(int boolValue, const char *file, int line) +#} declare 23 { Tcl_Obj *Tcl_DbNewByteArrayObj(const unsigned char *bytes, int length, const char *file, int line) @@ -199,18 +200,20 @@ declare 48 { int Tcl_ListObjReplace(Tcl_Interp *interp, Tcl_Obj *listPtr, int first, int count, int objc, Tcl_Obj *const objv[]) } -declare 49 { - Tcl_Obj *Tcl_NewBooleanObj(int boolValue) -} +# Removed in 9.0: +#declare 49 { +# Tcl_Obj *Tcl_NewBooleanObj(int boolValue) +#} declare 50 { Tcl_Obj *Tcl_NewByteArrayObj(const unsigned char *bytes, int length) } declare 51 { Tcl_Obj *Tcl_NewDoubleObj(double doubleValue) } -declare 52 { - Tcl_Obj *Tcl_NewIntObj(int intValue) -} +# Removed in 9.0: +#declare 52 { +# Tcl_Obj *Tcl_NewIntObj(int intValue) +#} declare 53 { Tcl_Obj *Tcl_NewListObj(int objc, Tcl_Obj *const objv[]) } @@ -223,9 +226,10 @@ declare 55 { declare 56 { Tcl_Obj *Tcl_NewStringObj(const char *bytes, int length) } -declare 57 { - void Tcl_SetBooleanObj(Tcl_Obj *objPtr, int boolValue) -} +# Removed from 9.0: +#declare 57 { +# void Tcl_SetBooleanObj(Tcl_Obj *objPtr, int boolValue) +#} declare 58 { unsigned char *Tcl_SetByteArrayLength(Tcl_Obj *objPtr, int length) } @@ -236,9 +240,10 @@ declare 59 { declare 60 { void Tcl_SetDoubleObj(Tcl_Obj *objPtr, double doubleValue) } -declare 61 { - void Tcl_SetIntObj(Tcl_Obj *objPtr, int intValue) -} +# Removed in 9.0: +#declare 61 { +# void Tcl_SetIntObj(Tcl_Obj *objPtr, int intValue) +#} declare 62 { void Tcl_SetListObj(Tcl_Obj *objPtr, int objc, Tcl_Obj *const objv[]) } @@ -251,13 +256,15 @@ declare 64 { declare 65 { void Tcl_SetStringObj(Tcl_Obj *objPtr, const char *bytes, int length) } -declare 66 { - void Tcl_AddErrorInfo(Tcl_Interp *interp, const char *message) -} -declare 67 { - void Tcl_AddObjErrorInfo(Tcl_Interp *interp, const char *message, - int length) -} +# Removed in 9.0: +#declare 66 { +# void Tcl_AddErrorInfo(Tcl_Interp *interp, const char *message) +#} +# Removed in 9.0: +#declare 67 { +# void Tcl_AddObjErrorInfo(Tcl_Interp *interp, const char *message, +# int length) +#} declare 68 { void Tcl_AllowExceptions(Tcl_Interp *interp) } diff --git a/generic/tcl.h b/generic/tcl.h index cf0b2728a..a46699d 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -2343,9 +2343,6 @@ TCLAPI void Tcl_GetMemoryInfo(Tcl_DString *dsPtr); # undef Tcl_NewDoubleObj # define Tcl_NewDoubleObj(val) \ Tcl_DbNewDoubleObj(val, __FILE__, __LINE__) -# undef Tcl_NewIntObj -# define Tcl_NewIntObj(val) \ - Tcl_DbNewLongObj(val, __FILE__, __LINE__) # undef Tcl_NewListObj # define Tcl_NewListObj(objc, objv) \ Tcl_DbNewListObj(objc, objv, __FILE__, __LINE__) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index b13ef18..d31777e 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -6202,72 +6202,10 @@ Tcl_AppendObjToErrorInfo( Tcl_Obj *objPtr) /* Message to record. */ { int length; + register Interp *iPtr = (Interp *) interp; const char *message = TclGetStringFromObj(objPtr, &length); Tcl_IncrRefCount(objPtr); - Tcl_AddObjErrorInfo(interp, message, length); - Tcl_DecrRefCount(objPtr); -} - -/* - *---------------------------------------------------------------------- - * - * Tcl_AddErrorInfo -- - * - * Add information to the errorInfo field that describes the current - * error. - * - * Results: - * None. - * - * Side effects: - * The contents of message are appended to the errorInfo field. If we are - * just starting to log an error, errorInfo is initialized from the error - * message in the interpreter's result. - * - *---------------------------------------------------------------------- - */ - -void -Tcl_AddErrorInfo( - Tcl_Interp *interp, /* Interpreter to which error information - * pertains. */ - const char *message) /* Message to record. */ -{ - Tcl_AddObjErrorInfo(interp, message, -1); -} - -/* - *---------------------------------------------------------------------- - * - * Tcl_AddObjErrorInfo -- - * - * Add information to the errorInfo field that describes the current - * error. This routine differs from Tcl_AddErrorInfo by taking a byte - * pointer and length. - * - * Results: - * None. - * - * Side effects: - * "length" bytes from "message" are appended to the errorInfo field. If - * "length" is negative, use bytes up to the first NULL byte. If we are - * just starting to log an error, errorInfo is initialized from the error - * message in the interpreter's result. - * - *---------------------------------------------------------------------- - */ - -void -Tcl_AddObjErrorInfo( - Tcl_Interp *interp, /* Interpreter to which error information - * pertains. */ - const char *message, /* Points to the first byte of an array of - * bytes of the message. */ - int length) /* The number of bytes in the message. If < 0, - * then append all bytes up to a NULL byte. */ -{ - register Interp *iPtr = (Interp *) interp; /* * If we are just starting to log an error, errorInfo is initialized from @@ -6295,6 +6233,7 @@ Tcl_AddObjErrorInfo( } Tcl_AppendToObj(iPtr->errorInfo, message, length); } + Tcl_DecrRefCount(objPtr); } /* diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index 56777e1..592c3a4 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -4265,7 +4265,7 @@ TclNRTryObjCmd( } info[0] = objv[i]; /* type */ - TclNewIntObj(info[1], code); /* returnCode */ + TclNewLongObj(info[1], code); /* returnCode */ if (info[2] == NULL) { /* errorCodePrefix */ TclNewObj(info[2]); } diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 058e1a9..c3095f0 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -94,9 +94,7 @@ TCLAPI void Tcl_DbIncrRefCount(Tcl_Obj *objPtr, const char *file, /* 21 */ TCLAPI int Tcl_DbIsShared(Tcl_Obj *objPtr, const char *file, int line); -/* 22 */ -TCLAPI Tcl_Obj * Tcl_DbNewBooleanObj(int boolValue, const char *file, - int line); +/* Slot 22 is reserved */ /* 23 */ TCLAPI Tcl_Obj * Tcl_DbNewByteArrayObj(const unsigned char *bytes, int length, const char *file, int line); @@ -170,15 +168,13 @@ TCLAPI int Tcl_ListObjLength(Tcl_Interp *interp, TCLAPI int Tcl_ListObjReplace(Tcl_Interp *interp, Tcl_Obj *listPtr, int first, int count, int objc, Tcl_Obj *const objv[]); -/* 49 */ -TCLAPI Tcl_Obj * Tcl_NewBooleanObj(int boolValue); +/* Slot 49 is reserved */ /* 50 */ TCLAPI Tcl_Obj * Tcl_NewByteArrayObj(const unsigned char *bytes, int length); /* 51 */ TCLAPI Tcl_Obj * Tcl_NewDoubleObj(double doubleValue); -/* 52 */ -TCLAPI Tcl_Obj * Tcl_NewIntObj(int intValue); +/* Slot 52 is reserved */ /* 53 */ TCLAPI Tcl_Obj * Tcl_NewListObj(int objc, Tcl_Obj *const objv[]); /* 54 */ @@ -187,8 +183,7 @@ TCLAPI Tcl_Obj * Tcl_NewLongObj(long longValue); TCLAPI Tcl_Obj * Tcl_NewObj(void); /* 56 */ TCLAPI Tcl_Obj * Tcl_NewStringObj(const char *bytes, int length); -/* 57 */ -TCLAPI void Tcl_SetBooleanObj(Tcl_Obj *objPtr, int boolValue); +/* Slot 57 is reserved */ /* 58 */ TCLAPI unsigned char * Tcl_SetByteArrayLength(Tcl_Obj *objPtr, int length); /* 59 */ @@ -196,8 +191,7 @@ TCLAPI void Tcl_SetByteArrayObj(Tcl_Obj *objPtr, const unsigned char *bytes, int length); /* 60 */ TCLAPI void Tcl_SetDoubleObj(Tcl_Obj *objPtr, double doubleValue); -/* 61 */ -TCLAPI void Tcl_SetIntObj(Tcl_Obj *objPtr, int intValue); +/* Slot 61 is reserved */ /* 62 */ TCLAPI void Tcl_SetListObj(Tcl_Obj *objPtr, int objc, Tcl_Obj *const objv[]); @@ -208,12 +202,8 @@ TCLAPI void Tcl_SetObjLength(Tcl_Obj *objPtr, int length); /* 65 */ TCLAPI void Tcl_SetStringObj(Tcl_Obj *objPtr, const char *bytes, int length); -/* 66 */ -TCLAPI void Tcl_AddErrorInfo(Tcl_Interp *interp, - const char *message); -/* 67 */ -TCLAPI void Tcl_AddObjErrorInfo(Tcl_Interp *interp, - const char *message, int length); +/* Slot 66 is reserved */ +/* Slot 67 is reserved */ /* 68 */ TCLAPI void Tcl_AllowExceptions(Tcl_Interp *interp); /* 69 */ @@ -1806,7 +1796,7 @@ typedef struct TclStubs { void (*tcl_DbDecrRefCount) (Tcl_Obj *objPtr, const char *file, int line); /* 19 */ void (*tcl_DbIncrRefCount) (Tcl_Obj *objPtr, const char *file, int line); /* 20 */ int (*tcl_DbIsShared) (Tcl_Obj *objPtr, const char *file, int line); /* 21 */ - Tcl_Obj * (*tcl_DbNewBooleanObj) (int boolValue, const char *file, int line); /* 22 */ + void (*reserved22)(void); Tcl_Obj * (*tcl_DbNewByteArrayObj) (const unsigned char *bytes, int length, const char *file, int line); /* 23 */ Tcl_Obj * (*tcl_DbNewDoubleObj) (double doubleValue, const char *file, int line); /* 24 */ Tcl_Obj * (*tcl_DbNewListObj) (int objc, Tcl_Obj *const *objv, const char *file, int line); /* 25 */ @@ -1833,25 +1823,25 @@ typedef struct TclStubs { int (*tcl_ListObjIndex) (Tcl_Interp *interp, Tcl_Obj *listPtr, int index, Tcl_Obj **objPtrPtr); /* 46 */ int (*tcl_ListObjLength) (Tcl_Interp *interp, Tcl_Obj *listPtr, int *lengthPtr); /* 47 */ int (*tcl_ListObjReplace) (Tcl_Interp *interp, Tcl_Obj *listPtr, int first, int count, int objc, Tcl_Obj *const objv[]); /* 48 */ - Tcl_Obj * (*tcl_NewBooleanObj) (int boolValue); /* 49 */ + void (*reserved49)(void); Tcl_Obj * (*tcl_NewByteArrayObj) (const unsigned char *bytes, int length); /* 50 */ Tcl_Obj * (*tcl_NewDoubleObj) (double doubleValue); /* 51 */ - Tcl_Obj * (*tcl_NewIntObj) (int intValue); /* 52 */ + void (*reserved52)(void); Tcl_Obj * (*tcl_NewListObj) (int objc, Tcl_Obj *const objv[]); /* 53 */ Tcl_Obj * (*tcl_NewLongObj) (long longValue); /* 54 */ Tcl_Obj * (*tcl_NewObj) (void); /* 55 */ Tcl_Obj * (*tcl_NewStringObj) (const char *bytes, int length); /* 56 */ - void (*tcl_SetBooleanObj) (Tcl_Obj *objPtr, int boolValue); /* 57 */ + void (*reserved57)(void); unsigned char * (*tcl_SetByteArrayLength) (Tcl_Obj *objPtr, int length); /* 58 */ void (*tcl_SetByteArrayObj) (Tcl_Obj *objPtr, const unsigned char *bytes, int length); /* 59 */ void (*tcl_SetDoubleObj) (Tcl_Obj *objPtr, double doubleValue); /* 60 */ - void (*tcl_SetIntObj) (Tcl_Obj *objPtr, int intValue); /* 61 */ + void (*reserved61)(void); void (*tcl_SetListObj) (Tcl_Obj *objPtr, int objc, Tcl_Obj *const objv[]); /* 62 */ void (*tcl_SetLongObj) (Tcl_Obj *objPtr, long longValue); /* 63 */ void (*tcl_SetObjLength) (Tcl_Obj *objPtr, int length); /* 64 */ void (*tcl_SetStringObj) (Tcl_Obj *objPtr, const char *bytes, int length); /* 65 */ - void (*tcl_AddErrorInfo) (Tcl_Interp *interp, const char *message); /* 66 */ - void (*tcl_AddObjErrorInfo) (Tcl_Interp *interp, const char *message, int length); /* 67 */ + void (*reserved66)(void); + void (*reserved67)(void); void (*tcl_AllowExceptions) (Tcl_Interp *interp); /* 68 */ void (*tcl_AppendElement) (Tcl_Interp *interp, const char *element); /* 69 */ void (*tcl_AppendResult) (Tcl_Interp *interp, ...); /* 70 */ @@ -2495,8 +2485,7 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_DbIncrRefCount) /* 20 */ #define Tcl_DbIsShared \ (tclStubsPtr->tcl_DbIsShared) /* 21 */ -#define Tcl_DbNewBooleanObj \ - (tclStubsPtr->tcl_DbNewBooleanObj) /* 22 */ +/* Slot 22 is reserved */ #define Tcl_DbNewByteArrayObj \ (tclStubsPtr->tcl_DbNewByteArrayObj) /* 23 */ #define Tcl_DbNewDoubleObj \ @@ -2548,14 +2537,12 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_ListObjLength) /* 47 */ #define Tcl_ListObjReplace \ (tclStubsPtr->tcl_ListObjReplace) /* 48 */ -#define Tcl_NewBooleanObj \ - (tclStubsPtr->tcl_NewBooleanObj) /* 49 */ +/* Slot 49 is reserved */ #define Tcl_NewByteArrayObj \ (tclStubsPtr->tcl_NewByteArrayObj) /* 50 */ #define Tcl_NewDoubleObj \ (tclStubsPtr->tcl_NewDoubleObj) /* 51 */ -#define Tcl_NewIntObj \ - (tclStubsPtr->tcl_NewIntObj) /* 52 */ +/* Slot 52 is reserved */ #define Tcl_NewListObj \ (tclStubsPtr->tcl_NewListObj) /* 53 */ #define Tcl_NewLongObj \ @@ -2564,16 +2551,14 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_NewObj) /* 55 */ #define Tcl_NewStringObj \ (tclStubsPtr->tcl_NewStringObj) /* 56 */ -#define Tcl_SetBooleanObj \ - (tclStubsPtr->tcl_SetBooleanObj) /* 57 */ +/* Slot 57 is reserved */ #define Tcl_SetByteArrayLength \ (tclStubsPtr->tcl_SetByteArrayLength) /* 58 */ #define Tcl_SetByteArrayObj \ (tclStubsPtr->tcl_SetByteArrayObj) /* 59 */ #define Tcl_SetDoubleObj \ (tclStubsPtr->tcl_SetDoubleObj) /* 60 */ -#define Tcl_SetIntObj \ - (tclStubsPtr->tcl_SetIntObj) /* 61 */ +/* Slot 61 is reserved */ #define Tcl_SetListObj \ (tclStubsPtr->tcl_SetListObj) /* 62 */ #define Tcl_SetLongObj \ @@ -2582,10 +2567,8 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_SetObjLength) /* 64 */ #define Tcl_SetStringObj \ (tclStubsPtr->tcl_SetStringObj) /* 65 */ -#define Tcl_AddErrorInfo \ - (tclStubsPtr->tcl_AddErrorInfo) /* 66 */ -#define Tcl_AddObjErrorInfo \ - (tclStubsPtr->tcl_AddObjErrorInfo) /* 67 */ +/* Slot 66 is reserved */ +/* Slot 67 is reserved */ #define Tcl_AllowExceptions \ (tclStubsPtr->tcl_AllowExceptions) /* 68 */ #define Tcl_AppendElement \ @@ -3739,6 +3722,19 @@ TCLAPI void Tcl_MainExW(int argc, wchar_t **argv, #define Tcl_GetIndexFromObj(interp, objPtr, tablePtr, msg, flags, indexPtr) \ Tcl_GetIndexFromObjStruct((interp), (objPtr), (tablePtr), \ sizeof(char *), (msg), (flags), (indexPtr)) +#define Tcl_NewIntObj Tcl_NewLongObj +#define Tcl_SetIntObj Tcl_SetLongObj +#define Tcl_NewBooleanObj(boolValue) \ + Tcl_NewLongObj((boolValue)!=0) +#define Tcl_DbNewBooleanObj(boolValue, file, line) \ + Tcl_DbNewLongObj((boolValue)!=0, file, line) +#define Tcl_SetBooleanObj(objPtr, boolValue) \ + Tcl_SetLongObj((objPtr), (boolValue)!=0) +#define Tcl_AddErrorInfo(interp, message) \ + Tcl_AppendObjToErrorInfo((interp), Tcl_NewStringObj((message), -1)) +#define Tcl_AddObjErrorInfo(interp, message, length) \ + Tcl_AppendObjToErrorInfo((interp), Tcl_NewStringObj((message), length)) + /* * Deprecated Tcl procedures: */ diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 707b55b..b872bd9 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -812,9 +812,9 @@ TclCreateExecEnv( + (size_t) (size-1) * sizeof(Tcl_Obj *)); eePtr->execStackPtr = esPtr; - TclNewBooleanObj(eePtr->constants[0], 0); + TclNewLongObj(eePtr->constants[0], 0); Tcl_IncrRefCount(eePtr->constants[0]); - TclNewBooleanObj(eePtr->constants[1], 1); + TclNewLongObj(eePtr->constants[1], 1); Tcl_IncrRefCount(eePtr->constants[1]); eePtr->interp = interp; eePtr->callbackPtr = NULL; @@ -4164,7 +4164,7 @@ TEBCresume( NEXT_INST_F(1, 0, 1); } case INST_INFO_LEVEL_NUM: - TclNewIntObj(objResultPtr, iPtr->varFramePtr->level); + TclNewLongObj(objResultPtr, iPtr->varFramePtr->level); TRACE_WITH_OBJ(("=> "), objResultPtr); NEXT_INST_F(1, 0, 1); case INST_INFO_LEVEL_ARGS: { @@ -4293,7 +4293,7 @@ TEBCresume( Tcl_GetObjResult(interp)); goto gotError; } - TclNewIntObj(objResultPtr, length); + TclNewLongObj(objResultPtr, length); TRACE(("%.20s => %d\n", O2S(valuePtr), length)); NEXT_INST_F(1, 1, 1); @@ -4760,7 +4760,7 @@ TEBCresume( } } if (match < 0) { - TclNewIntObj(objResultPtr, -1); + TclNewLongObj(objResultPtr, -1); } else { objResultPtr = TCONST(match > 0); } @@ -4771,7 +4771,7 @@ TEBCresume( case INST_STR_LEN: valuePtr = OBJ_AT_TOS; length = Tcl_GetCharLength(valuePtr); - TclNewIntObj(objResultPtr, length); + TclNewLongObj(objResultPtr, length); TRACE(("%.20s => %d\n", O2S(valuePtr), length)); NEXT_INST_F(1, 1, 1); @@ -4959,7 +4959,7 @@ TEBCresume( TRACE(("%.20s %.20s => %d\n", O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), match)); - TclNewIntObj(objResultPtr, match); + TclNewLongObj(objResultPtr, match); NEXT_INST_F(1, 2, 1); case INST_STR_FIND_LAST: @@ -4980,7 +4980,7 @@ TEBCresume( TRACE(("%.20s %.20s => %d\n", O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), match)); - TclNewIntObj(objResultPtr, match); + TclNewLongObj(objResultPtr, match); NEXT_INST_F(1, 2, 1); } @@ -5320,7 +5320,7 @@ TEBCresume( if (l1 > 0L) { objResultPtr = TCONST(0); } else { - TclNewIntObj(objResultPtr, -1); + TclNewLongObj(objResultPtr, -1); } TRACE(("%s\n", O2S(objResultPtr))); NEXT_INST_F(1, 2, 1); @@ -6002,7 +6002,7 @@ TEBCresume( NEXT_INST_F(1, 0, -1); case INST_PUSH_RETURN_CODE: - TclNewIntObj(objResultPtr, result); + TclNewLongObj(objResultPtr, result); TRACE(("=> %u\n", result)); NEXT_INST_F(1, 0, 1); diff --git a/generic/tclInt.h b/generic/tclInt.h index 68f8233..4a5c821 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -4428,15 +4428,13 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit; * core. They should only be called on unshared objects. The ANSI C * "prototypes" for these macros are: * - * MODULE_SCOPE void TclSetIntObj(Tcl_Obj *objPtr, int intValue); * MODULE_SCOPE void TclSetLongObj(Tcl_Obj *objPtr, long longValue); - * MODULE_SCOPE void TclSetBooleanObj(Tcl_Obj *objPtr, long boolValue); * MODULE_SCOPE void TclSetWideIntObj(Tcl_Obj *objPtr, Tcl_WideInt w); * MODULE_SCOPE void TclSetDoubleObj(Tcl_Obj *objPtr, double d); *---------------------------------------------------------------- */ -#define TclSetIntObj(objPtr, i) \ +#define TclSetLongObj(objPtr, i) \ do { \ TclInvalidateStringRep(objPtr); \ TclFreeIntRep(objPtr); \ @@ -4444,9 +4442,6 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit; (objPtr)->typePtr = &tclIntType; \ } while (0) -#define TclSetLongObj(objPtr, l) \ - TclSetIntObj((objPtr), (l)) - /* * NOTE: There is to be no such thing as a "pure" boolean. Boolean values set * programmatically go straight to being "int" Tcl_Obj's, with value 0 or 1. @@ -4454,9 +4449,6 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit; * value of strings like: "yes", "no", "true", "false", "on", "off". */ -#define TclSetBooleanObj(objPtr, b) \ - TclSetIntObj((objPtr), ((b)? 1 : 0)); - #ifndef NO_WIDE_TYPE #define TclSetWideIntObj(objPtr, w) \ do { \ @@ -4481,9 +4473,7 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit; * types, avoiding the corresponding function calls in time critical parts of * the core. The ANSI C "prototypes" for these macros are: * - * MODULE_SCOPE void TclNewIntObj(Tcl_Obj *objPtr, int i); * MODULE_SCOPE void TclNewLongObj(Tcl_Obj *objPtr, long l); - * MODULE_SCOPE void TclNewBooleanObj(Tcl_Obj *objPtr, int b); * MODULE_SCOPE void TclNewWideObj(Tcl_Obj *objPtr, Tcl_WideInt w); * MODULE_SCOPE void TclNewDoubleObj(Tcl_Obj *objPtr, double d); * MODULE_SCOPE void TclNewStringObj(Tcl_Obj *objPtr, char *s, int len); @@ -4493,7 +4483,7 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit; */ #ifndef TCL_MEM_DEBUG -#define TclNewIntObj(objPtr, i) \ +#define TclNewLongObj(objPtr, i) \ do { \ TclIncrObjsAllocated(); \ TclAllocObjStorage(objPtr); \ @@ -4504,16 +4494,6 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit; TCL_DTRACE_OBJ_CREATE(objPtr); \ } while (0) -#define TclNewLongObj(objPtr, l) \ - TclNewIntObj((objPtr), (l)) - -/* - * NOTE: There is to be no such thing as a "pure" boolean. - * See comment above TclSetBooleanObj macro above. - */ -#define TclNewBooleanObj(objPtr, b) \ - TclNewIntObj((objPtr), ((b)? 1 : 0)) - #define TclNewDoubleObj(objPtr, d) \ do { \ TclIncrObjsAllocated(); \ @@ -4536,15 +4516,9 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit; } while (0) #else /* TCL_MEM_DEBUG */ -#define TclNewIntObj(objPtr, i) \ - (objPtr) = Tcl_NewIntObj(i) - #define TclNewLongObj(objPtr, l) \ (objPtr) = Tcl_NewLongObj(l) -#define TclNewBooleanObj(objPtr, b) \ - (objPtr) = Tcl_NewBooleanObj(b) - #define TclNewDoubleObj(objPtr, d) \ (objPtr) = Tcl_NewDoubleObj(d) diff --git a/generic/tclObj.c b/generic/tclObj.c index e5f1050..5c8ff47 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -1708,142 +1708,6 @@ Tcl_InvalidateStringRep( /* *---------------------------------------------------------------------- * - * Tcl_NewBooleanObj -- - * - * This function is normally called when not debugging: i.e., when - * TCL_MEM_DEBUG is not defined. It creates a new Tcl_Obj and - * initializes it from the argument boolean value. A nonzero "boolValue" - * is coerced to 1. - * - * When TCL_MEM_DEBUG is defined, this function just returns the result - * of calling the debugging version Tcl_DbNewBooleanObj. - * - * Results: - * The newly created object is returned. This object will have an invalid - * string representation. The returned object has ref count 0. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -#ifdef TCL_MEM_DEBUG -#undef Tcl_NewBooleanObj - -Tcl_Obj * -Tcl_NewBooleanObj( - register int boolValue) /* Boolean used to initialize new object. */ -{ - return Tcl_DbNewBooleanObj(boolValue, "unknown", 0); -} - -#else /* if not TCL_MEM_DEBUG */ - -Tcl_Obj * -Tcl_NewBooleanObj( - register int boolValue) /* Boolean used to initialize new object. */ -{ - register Tcl_Obj *objPtr; - - TclNewBooleanObj(objPtr, boolValue); - return objPtr; -} -#endif /* TCL_MEM_DEBUG */ - -/* - *---------------------------------------------------------------------- - * - * Tcl_DbNewBooleanObj -- - * - * This function is normally called when debugging: i.e., when - * TCL_MEM_DEBUG is defined. It creates new boolean objects. It is the - * same as the Tcl_NewBooleanObj function above except that it calls - * Tcl_DbCkalloc directly with the file name and line number from its - * caller. This simplifies debugging since then the [memory active] - * command will report the correct file name and line number when - * reporting objects that haven't been freed. - * - * When TCL_MEM_DEBUG is not defined, this function just returns the - * result of calling Tcl_NewBooleanObj. - * - * Results: - * The newly created object is returned. This object will have an invalid - * string representation. The returned object has ref count 0. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -#ifdef TCL_MEM_DEBUG - -Tcl_Obj * -Tcl_DbNewBooleanObj( - register int boolValue, /* Boolean used to initialize new object. */ - const char *file, /* The name of the source file calling this - * function; used for debugging. */ - int line) /* Line number in the source file; used for - * debugging. */ -{ - register Tcl_Obj *objPtr; - - TclDbNewObj(objPtr, file, line); - objPtr->bytes = NULL; - - objPtr->internalRep.longValue = (boolValue? 1 : 0); - objPtr->typePtr = &tclIntType; - return objPtr; -} - -#else /* if not TCL_MEM_DEBUG */ - -Tcl_Obj * -Tcl_DbNewBooleanObj( - register int boolValue, /* Boolean used to initialize new object. */ - const char *file, /* The name of the source file calling this - * function; used for debugging. */ - int line) /* Line number in the source file; used for - * debugging. */ -{ - return Tcl_NewBooleanObj(boolValue); -} -#endif /* TCL_MEM_DEBUG */ - -/* - *---------------------------------------------------------------------- - * - * Tcl_SetBooleanObj -- - * - * Modify an object to be a boolean object and to have the specified - * boolean value. A nonzero "boolValue" is coerced to 1. - * - * Results: - * None. - * - * Side effects: - * The object's old string rep, if any, is freed. Also, any old internal - * rep is freed. - * - *---------------------------------------------------------------------- - */ - -void -Tcl_SetBooleanObj( - register Tcl_Obj *objPtr, /* Object whose internal rep to init. */ - register int boolValue) /* Boolean used to set object's value. */ -{ - if (Tcl_IsShared(objPtr)) { - Tcl_Panic("%s called with shared object", "Tcl_SetBooleanObj"); - } - - TclSetBooleanObj(objPtr, boolValue); -} - -/* - *---------------------------------------------------------------------- - * * Tcl_GetBooleanFromObj -- * * Attempt to return a boolean from the Tcl object "objPtr". This @@ -2361,89 +2225,6 @@ UpdateStringOfDouble( /* *---------------------------------------------------------------------- * - * Tcl_NewIntObj -- - * - * If a client is compiled with TCL_MEM_DEBUG defined, calls to - * Tcl_NewIntObj to create a new integer object end up calling the - * debugging function Tcl_DbNewLongObj instead. - * - * Otherwise, if the client is compiled without TCL_MEM_DEBUG defined, - * calls to Tcl_NewIntObj result in a call to one of the two - * Tcl_NewIntObj implementations below. We provide two implementations so - * that the Tcl core can be compiled to do memory debugging of the core - * even if a client does not request it for itself. - * - * Integer and long integer objects share the same "integer" type - * implementation. We store all integers as longs and Tcl_GetIntFromObj - * checks whether the current value of the long can be represented by an - * int. - * - * Results: - * The newly created object is returned. This object will have an invalid - * string representation. The returned object has ref count 0. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -#ifdef TCL_MEM_DEBUG -#undef Tcl_NewIntObj - -Tcl_Obj * -Tcl_NewIntObj( - register int intValue) /* Int used to initialize the new object. */ -{ - return Tcl_DbNewLongObj((long)intValue, "unknown", 0); -} - -#else /* if not TCL_MEM_DEBUG */ - -Tcl_Obj * -Tcl_NewIntObj( - register int intValue) /* Int used to initialize the new object. */ -{ - register Tcl_Obj *objPtr; - - TclNewIntObj(objPtr, intValue); - return objPtr; -} -#endif /* if TCL_MEM_DEBUG */ - -/* - *---------------------------------------------------------------------- - * - * Tcl_SetIntObj -- - * - * Modify an object to be an integer and to have the specified integer - * value. - * - * Results: - * None. - * - * Side effects: - * The object's old string rep, if any, is freed. Also, any old internal - * rep is freed. - * - *---------------------------------------------------------------------- - */ - -void -Tcl_SetIntObj( - register Tcl_Obj *objPtr, /* Object whose internal rep to init. */ - register int intValue) /* Integer used to set object's value. */ -{ - if (Tcl_IsShared(objPtr)) { - Tcl_Panic("%s called with shared object", "Tcl_SetIntObj"); - } - - TclSetIntObj(objPtr, intValue); -} - -/* - *---------------------------------------------------------------------- - * * Tcl_GetIntFromObj -- * * Attempt to return an int from the Tcl object "objPtr". If the object diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index 7a4b0c0..ef9a445 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -25,10 +25,8 @@ #undef Tcl_Alloc #undef Tcl_Free #undef Tcl_Realloc -#undef Tcl_NewBooleanObj #undef Tcl_NewByteArrayObj #undef Tcl_NewDoubleObj -#undef Tcl_NewIntObj #undef Tcl_NewListObj #undef Tcl_NewLongObj #undef Tcl_NewObj @@ -676,7 +674,7 @@ const TclStubs tclStubs = { Tcl_DbDecrRefCount, /* 19 */ Tcl_DbIncrRefCount, /* 20 */ Tcl_DbIsShared, /* 21 */ - Tcl_DbNewBooleanObj, /* 22 */ + 0, /* 22 */ Tcl_DbNewByteArrayObj, /* 23 */ Tcl_DbNewDoubleObj, /* 24 */ Tcl_DbNewListObj, /* 25 */ @@ -703,25 +701,25 @@ const TclStubs tclStubs = { Tcl_ListObjIndex, /* 46 */ Tcl_ListObjLength, /* 47 */ Tcl_ListObjReplace, /* 48 */ - Tcl_NewBooleanObj, /* 49 */ + 0, /* 49 */ Tcl_NewByteArrayObj, /* 50 */ Tcl_NewDoubleObj, /* 51 */ - Tcl_NewIntObj, /* 52 */ + 0, /* 52 */ Tcl_NewListObj, /* 53 */ Tcl_NewLongObj, /* 54 */ Tcl_NewObj, /* 55 */ Tcl_NewStringObj, /* 56 */ - Tcl_SetBooleanObj, /* 57 */ + 0, /* 57 */ Tcl_SetByteArrayLength, /* 58 */ Tcl_SetByteArrayObj, /* 59 */ Tcl_SetDoubleObj, /* 60 */ - Tcl_SetIntObj, /* 61 */ + 0, /* 61 */ Tcl_SetListObj, /* 62 */ Tcl_SetLongObj, /* 63 */ Tcl_SetObjLength, /* 64 */ Tcl_SetStringObj, /* 65 */ - Tcl_AddErrorInfo, /* 66 */ - Tcl_AddObjErrorInfo, /* 67 */ + 0, /* 66 */ + 0, /* 67 */ Tcl_AllowExceptions, /* 68 */ Tcl_AppendElement, /* 69 */ Tcl_AppendResult, /* 70 */ diff --git a/generic/tclZlib.c b/generic/tclZlib.c index ea3b9cc..5873a76 100644 --- a/generic/tclZlib.c +++ b/generic/tclZlib.c @@ -371,7 +371,7 @@ ConvertErrorToList( default: TclNewLiteralStringObj(objv[2], "UNKNOWN"); - TclNewIntObj(objv[3], code); + TclNewLongObj(objv[3], code); return Tcl_NewListObj(4, objv); } } |