diff options
| -rw-r--r-- | ChangeLog | 10 | ||||
| -rw-r--r-- | generic/tclExecute.c | 178 | ||||
| -rw-r--r-- | generic/tclInt.h | 147 | ||||
| -rw-r--r-- | generic/tclObj.c | 65 | ||||
| -rw-r--r-- | generic/tclStringObj.c | 5 |
5 files changed, 267 insertions, 138 deletions
@@ -1,3 +1,13 @@ +2005-04-01 Miguel Sofer <msofer@users.sf.net> + + * generic/tclExecute.c: + * generic/tclInt.h: + * generic/tclObj.c: + * generic/tclStringObj.c: defined new internal macros for creating + and setting frequently used obj types (int,long, wideInt, double, + string). Changed TEBC to use eg 'TclNewIntObj(objPtr, i)' to avoid + the function call in 'objPtr = Tcl_NewIntObj(i)' + 2005-03-31 Miguel Sofer <msofer@users.sf.net> * generic/tclExecute.c (INST_JUMP_TRUE/FALSE): replaced diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 86ea4b5..78446c0 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -11,7 +11,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.173 2005/03/31 19:10:53 msofer Exp $ + * RCS: @(#) $Id: tclExecute.c,v 1.174 2005/04/01 15:17:21 msofer Exp $ */ #include "tclInt.h" @@ -779,7 +779,7 @@ Tcl_ExprObj(interp, objPtr, resultPtrPtr) * Initialized to avoid compiler warning. */ AuxData *auxDataPtr; LiteralEntry *entryPtr; - Tcl_Obj *saveObjPtr; + Tcl_Obj *saveObjPtr, *resultPtr; char *string; int length, i, result; @@ -790,22 +790,26 @@ Tcl_ExprObj(interp, objPtr, resultPtrPtr) string = Tcl_GetStringFromObj(objPtr, &length); if (length == 1) { if (*string == '0') { - *resultPtrPtr = Tcl_NewLongObj(0); - Tcl_IncrRefCount(*resultPtrPtr); + TclNewLongObj(resultPtr, 0); + Tcl_IncrRefCount(resultPtr); + *resultPtrPtr = resultPtr; return TCL_OK; } else if (*string == '1') { - *resultPtrPtr = Tcl_NewLongObj(1); - Tcl_IncrRefCount(*resultPtrPtr); + TclNewLongObj(resultPtr, 1); + Tcl_IncrRefCount(resultPtr); + *resultPtrPtr = resultPtr; return TCL_OK; } } else if ((length == 2) && (*string == '!')) { if (*(string+1) == '0') { - *resultPtrPtr = Tcl_NewLongObj(1); - Tcl_IncrRefCount(*resultPtrPtr); + TclNewLongObj(resultPtr, 1); + Tcl_IncrRefCount(resultPtr); + *resultPtrPtr = resultPtr; return TCL_OK; } else if (*(string+1) == '1') { - *resultPtrPtr = Tcl_NewLongObj(0); - Tcl_IncrRefCount(*resultPtrPtr); + TclNewLongObj(resultPtr, 0); + Tcl_IncrRefCount(resultPtr); + *resultPtrPtr = resultPtr; return TCL_OK; } } @@ -2385,12 +2389,12 @@ TclExecuteByteCode(interp, codePtr) i += objPtr->internalRep.longValue; if (Tcl_IsShared(objPtr)) { - objResultPtr = Tcl_NewLongObj(i); + TclNewLongObj(objResultPtr, i); TclDecrRefCount(objPtr); Tcl_IncrRefCount(objResultPtr); varPtr->value.objPtr = objResultPtr; } else { - Tcl_SetLongObj(objPtr, i); + TclSetLongObj(objPtr, i); objResultPtr = objPtr; } goto doneIncr; @@ -2402,12 +2406,12 @@ TclExecuteByteCode(interp, codePtr) w += objPtr->internalRep.wideValue; if (Tcl_IsShared(objPtr)) { - objResultPtr = Tcl_NewWideIntObj(w); + TclNewWideIntObj(objResultPtr, w); TclDecrRefCount(objPtr); Tcl_IncrRefCount(objResultPtr); varPtr->value.objPtr = objResultPtr; } else { - Tcl_SetWideIntObj(objPtr, w); + TclSetWideIntObj(objPtr, w); objResultPtr = objPtr; } goto doneIncr; @@ -2634,12 +2638,12 @@ TclExecuteByteCode(interp, codePtr) iResult = (i1 && i2); } if (Tcl_IsShared(valuePtr)) { - objResultPtr = Tcl_NewLongObj(iResult); + TclNewLongObj(objResultPtr, iResult); TRACE(("%.20s %.20s => %d\n", O2S(valuePtr), O2S(value2Ptr), iResult)); NEXT_INST_F(1, 2, 1); } else { /* reuse the valuePtr object */ TRACE(("%.20s %.20s => %d\n", O2S(valuePtr), O2S(value2Ptr), iResult)); - Tcl_SetLongObj(valuePtr, iResult); + TclSetLongObj(valuePtr, iResult); NEXT_INST_F(1, 1, 0); } } @@ -2676,7 +2680,7 @@ TclExecuteByteCode(interp, codePtr) Tcl_GetObjResult(interp)); goto checkForCatch; } - objResultPtr = Tcl_NewIntObj(length); + TclNewIntObj(objResultPtr, length); TRACE(("%.20s => %d\n", O2S(valuePtr), length)); NEXT_INST_F(1, 1, 1); } @@ -3020,7 +3024,7 @@ TclExecuteByteCode(interp, codePtr) NEXT_INST_F((found ? TclGetInt4AtPtr(pc+1) : 5), 2, 0); } #endif - objResultPtr = Tcl_NewBooleanObj(found); + TclNewIntObj(objResultPtr, found); NEXT_INST_F(0, 2, 1); } @@ -3089,7 +3093,7 @@ TclExecuteByteCode(interp, codePtr) NEXT_INST_F((iResult? TclGetInt4AtPtr(pc+1) : 5), 2, 0); } #endif - objResultPtr = Tcl_NewIntObj(iResult); + TclNewIntObj(objResultPtr, iResult); NEXT_INST_F(0, 2, 1); } @@ -3163,7 +3167,7 @@ TclExecuteByteCode(interp, codePtr) iResult = 1; } - objResultPtr = Tcl_NewIntObj(iResult); + TclNewIntObj(objResultPtr, iResult); TRACE(("%.20s %.20s => %d\n", O2S(valuePtr), O2S(value2Ptr), iResult)); NEXT_INST_F(1, 2, 1); } @@ -3180,7 +3184,7 @@ TclExecuteByteCode(interp, codePtr) } else { length = Tcl_GetCharLength(valuePtr); } - objResultPtr = Tcl_NewIntObj(length); + TclNewIntObj(objResultPtr, length); TRACE(("%.20s => %d\n", O2S(valuePtr), length)); NEXT_INST_F(1, 1, 1); } @@ -3284,10 +3288,10 @@ TclExecuteByteCode(interp, codePtr) TRACE(("%.20s %.20s => %d\n", O2S(valuePtr), O2S(value2Ptr), match)); if (Tcl_IsShared(value2Ptr)) { - objResultPtr = Tcl_NewIntObj(match); + TclNewIntObj(objResultPtr, match); NEXT_INST_F(2, 2, 1); } else { /* reuse the valuePtr object */ - Tcl_SetIntObj(value2Ptr, match); + TclSetIntObj(value2Ptr, match); NEXT_INST_F(2, 1, 0); } } @@ -3568,7 +3572,7 @@ TclExecuteByteCode(interp, codePtr) NEXT_INST_F((iResult? TclGetInt4AtPtr(pc+1) : 5), 2, 0); } #endif - objResultPtr = Tcl_NewIntObj(iResult); + TclNewIntObj(objResultPtr, iResult); NEXT_INST_F(0, 2, 1); } @@ -3859,20 +3863,20 @@ TclExecuteByteCode(interp, codePtr) if (Tcl_IsShared(valuePtr)) { if (doWide) { - objResultPtr = Tcl_NewWideIntObj(wResult); + TclNewWideIntObj(objResultPtr, wResult); TRACE((LLD" "LLD" => "LLD"\n", w, w2, wResult)); } else { - objResultPtr = Tcl_NewLongObj(iResult); + TclNewLongObj(objResultPtr, iResult); TRACE(("%ld %ld => %ld\n", i, i2, iResult)); } NEXT_INST_F(1, 2, 1); } else { /* reuse the valuePtr object */ if (doWide) { TRACE((LLD" "LLD" => "LLD"\n", w, w2, wResult)); - Tcl_SetWideIntObj(valuePtr, wResult); + TclSetWideIntObj(valuePtr, wResult); } else { TRACE(("%ld %ld => %ld\n", i, i2, iResult)); - Tcl_SetLongObj(valuePtr, iResult); + TclSetLongObj(valuePtr, iResult); } NEXT_INST_F(1, 1, 0); } @@ -4130,26 +4134,26 @@ TclExecuteByteCode(interp, codePtr) if (Tcl_IsShared(valuePtr)) { if (doDouble) { - objResultPtr = Tcl_NewDoubleObj(dResult); + TclNewDoubleObj(objResultPtr, dResult); TRACE(("%.6g %.6g => %.6g\n", d1, d2, dResult)); } else if (doWide) { - objResultPtr = Tcl_NewWideIntObj(wResult); + TclNewWideIntObj(objResultPtr, wResult); TRACE((LLD" "LLD" => "LLD"\n", w, w2, wResult)); } else { - objResultPtr = Tcl_NewLongObj(iResult); + TclNewLongObj(objResultPtr, iResult); TRACE(("%ld %ld => %ld\n", i, i2, iResult)); } NEXT_INST_F(1, 2, 1); } else { /* reuse the valuePtr object */ if (doDouble) { /* NB: stack top is off by 1 */ TRACE(("%.6g %.6g => %.6g\n", d1, d2, dResult)); - Tcl_SetDoubleObj(valuePtr, dResult); + TclSetDoubleObj(valuePtr, dResult); } else if (doWide) { TRACE((LLD" "LLD" => "LLD"\n", w, w2, wResult)); - Tcl_SetWideIntObj(valuePtr, wResult); + TclSetWideIntObj(valuePtr, wResult); } else { TRACE(("%ld %ld => %ld\n", i, i2, iResult)); - Tcl_SetLongObj(valuePtr, iResult); + TclSetLongObj(valuePtr, iResult); } NEXT_INST_F(1, 1, 0); } @@ -4210,19 +4214,19 @@ TclExecuteByteCode(interp, codePtr) if (Tcl_IsShared(valuePtr)) { if (tPtr == &tclIntType) { - objResultPtr = Tcl_NewLongObj(valuePtr->internalRep.longValue); + TclNewLongObj(objResultPtr, valuePtr->internalRep.longValue); } else if (tPtr == &tclWideIntType) { Tcl_WideInt w; TclGetWide(w,valuePtr); - objResultPtr = Tcl_NewWideIntObj(w); + TclNewWideIntObj(objResultPtr, w); } else { - objResultPtr = Tcl_NewDoubleObj(valuePtr->internalRep.doubleValue); + TclNewDoubleObj(objResultPtr, valuePtr->internalRep.doubleValue); } TRACE_WITH_OBJ(("%s => ", O2S(objResultPtr)), objResultPtr); NEXT_INST_F(1, 1, 1); } else { - Tcl_InvalidateStringRep(valuePtr); + TclInvalidateStringRep(valuePtr); TRACE_WITH_OBJ(("%s => ", O2S(valuePtr)), valuePtr); NEXT_INST_F(1, 0, 0); } @@ -4294,27 +4298,27 @@ TclExecuteByteCode(interp, codePtr) */ if ((tPtr == &tclIntType) || (tPtr == &tclBooleanType)) { i = valuePtr->internalRep.longValue; - objResultPtr = Tcl_NewLongObj( + TclNewLongObj(objResultPtr, (*pc == INST_UMINUS)? -i : !i); TRACE_WITH_OBJ(("%ld => ", i), objResultPtr); } else if (tPtr == &tclWideIntType) { TclGetWide(w,valuePtr); if (*pc == INST_UMINUS) { - objResultPtr = Tcl_NewWideIntObj(-w); + TclNewWideIntObj(objResultPtr, -w); } else { - objResultPtr = Tcl_NewLongObj(w == W0); + TclNewLongObj(objResultPtr, (w == W0)); } TRACE_WITH_OBJ((LLD" => ", w), objResultPtr); } else { d = valuePtr->internalRep.doubleValue; if (*pc == INST_UMINUS) { - objResultPtr = Tcl_NewDoubleObj(-d); + TclNewDoubleObj(objResultPtr, -d); } else { /* * Should be able to use "!d", but apparently * some compilers can't handle it. */ - objResultPtr = Tcl_NewLongObj((d==0.0)? 1 : 0); + TclNewLongObj(objResultPtr, ((d==0.0)? 1 : 0)); } TRACE_WITH_OBJ(("%.6g => ", d), objResultPtr); } @@ -4325,27 +4329,27 @@ TclExecuteByteCode(interp, codePtr) */ if ((tPtr == &tclIntType) || (tPtr == &tclBooleanType)) { i = valuePtr->internalRep.longValue; - Tcl_SetLongObj(valuePtr, + TclSetLongObj(valuePtr, (*pc == INST_UMINUS)? -i : !i); TRACE_WITH_OBJ(("%ld => ", i), valuePtr); } else if (tPtr == &tclWideIntType) { TclGetWide(w,valuePtr); if (*pc == INST_UMINUS) { - Tcl_SetWideIntObj(valuePtr, -w); + TclSetWideIntObj(valuePtr, -w); } else { - Tcl_SetLongObj(valuePtr, w == W0); + TclSetLongObj(valuePtr, w == W0); } TRACE_WITH_OBJ((LLD" => ", w), valuePtr); } else { d = valuePtr->internalRep.doubleValue; if (*pc == INST_UMINUS) { - Tcl_SetDoubleObj(valuePtr, -d); + TclSetDoubleObj(valuePtr, -d); } else { /* * Should be able to use "!d", but apparently * some compilers can't handle it. */ - Tcl_SetLongObj(valuePtr, (d==0.0)? 1 : 0); + TclSetLongObj(valuePtr, (d==0.0)? 1 : 0); } TRACE_WITH_OBJ(("%.6g => ", d), valuePtr); } @@ -4382,28 +4386,28 @@ TclExecuteByteCode(interp, codePtr) if (valuePtr->typePtr == &tclWideIntType) { TclGetWide(w,valuePtr); if (Tcl_IsShared(valuePtr)) { - objResultPtr = Tcl_NewWideIntObj(~w); + TclNewWideIntObj(objResultPtr, ~w); TRACE(("0x%llx => (%llu)\n", w, ~w)); NEXT_INST_F(1, 1, 1); } else { /* * valuePtr is unshared. Modify it directly. */ - Tcl_SetWideIntObj(valuePtr, ~w); + TclSetWideIntObj(valuePtr, ~w); TRACE(("0x%llx => (%llu)\n", w, ~w)); NEXT_INST_F(1, 0, 0); } } else { i = valuePtr->internalRep.longValue; if (Tcl_IsShared(valuePtr)) { - objResultPtr = Tcl_NewLongObj(~i); + TclNewLongObj(objResultPtr, ~i); TRACE(("0x%lx => (%lu)\n", i, ~i)); NEXT_INST_F(1, 1, 1); } else { /* * valuePtr is unshared. Modify it directly. */ - Tcl_SetLongObj(valuePtr, ~i); + TclSetLongObj(valuePtr, ~i); TRACE(("0x%lx => (%lu)\n", i, ~i)); NEXT_INST_F(1, 0, 0); } @@ -4535,13 +4539,13 @@ TclExecuteByteCode(interp, codePtr) needNew = 1; if (tPtr == &tclIntType) { i = valuePtr->internalRep.longValue; - objResultPtr = Tcl_NewLongObj(i); + TclNewLongObj(objResultPtr, i); } else if (tPtr == &tclWideIntType) { TclGetWide(w,valuePtr); - objResultPtr = Tcl_NewWideIntObj(w); + TclNewWideIntObj(objResultPtr, w); } else { d = valuePtr->internalRep.doubleValue; - objResultPtr = Tcl_NewDoubleObj(d); + TclNewDoubleObj(objResultPtr, d); } tPtr = objResultPtr->typePtr; } @@ -4610,10 +4614,10 @@ TclExecuteByteCode(interp, codePtr) oldValuePtr = iterVarPtr->value.objPtr; if (oldValuePtr == NULL) { - iterVarPtr->value.objPtr = Tcl_NewLongObj(-1); + TclNewLongObj(iterVarPtr->value.objPtr, -1); Tcl_IncrRefCount(iterVarPtr->value.objPtr); } else { - Tcl_SetLongObj(oldValuePtr, -1); + TclSetLongObj(oldValuePtr, -1); } TclSetVarScalar(iterVarPtr); TclClearVarUndefined(iterVarPtr); @@ -4664,7 +4668,7 @@ TclExecuteByteCode(interp, codePtr) iterVarPtr = &(compiledLocals[infoPtr->loopCtTemp]); valuePtr = iterVarPtr->value.objPtr; iterNum = (valuePtr->internalRep.longValue + 1); - Tcl_SetLongObj(valuePtr, iterNum); + TclSetLongObj(valuePtr, iterNum); /* * Check whether all value lists are exhausted and we should @@ -4809,7 +4813,7 @@ TclExecuteByteCode(interp, codePtr) NEXT_INST_F(1, 0, -1); case INST_PUSH_RETURN_CODE: - objResultPtr = Tcl_NewLongObj(result); + TclNewLongObj(objResultPtr, result); TRACE(("=> %u\n", result)); NEXT_INST_F(1, 0, 1); @@ -5644,7 +5648,7 @@ ExprUnaryFunc(interp, tosPtr, clientData) * takes one double argument and returns a * double result. */ { - register Tcl_Obj *valuePtr; + register Tcl_Obj *valuePtr, *resPtr; double d, dResult; double (*func) _ANSI_ARGS_((double)) = @@ -5674,7 +5678,8 @@ ExprUnaryFunc(interp, tosPtr, clientData) * Push a Tcl object holding the result. */ - PUSH_OBJECT(Tcl_NewDoubleObj(dResult)); + TclNewDoubleObj(resPtr, dResult); + PUSH_OBJECT(resPtr); TclDecrRefCount(valuePtr); return TCL_OK; } @@ -5688,7 +5693,7 @@ ExprBinaryFunc(interp, tosPtr, clientData) * takes two double arguments and * returns a double result. */ { - register Tcl_Obj *valuePtr, *value2Ptr; + register Tcl_Obj *valuePtr, *value2Ptr, *resPtr; double d1, d2, dResult; double (*func) _ANSI_ARGS_((double, double)) @@ -5721,7 +5726,8 @@ ExprBinaryFunc(interp, tosPtr, clientData) * Push a Tcl object holding the result. */ - PUSH_OBJECT(Tcl_NewDoubleObj(dResult)); + TclNewDoubleObj(resPtr, dResult); + PUSH_OBJECT(resPtr); TclDecrRefCount(valuePtr); TclDecrRefCount(value2Ptr); return TCL_OK; @@ -5734,7 +5740,7 @@ ExprAbsFunc(interp, tosPtr, clientData) Tcl_Obj **tosPtr; /* Points to top of evaluation stack. */ ClientData clientData; /* Ignored. */ { - register Tcl_Obj *valuePtr; + register Tcl_Obj *valuePtr, *resPtr; long i, iResult; double d, dResult; @@ -5765,7 +5771,8 @@ ExprAbsFunc(interp, tosPtr, clientData) } else { iResult = i; } - PUSH_OBJECT(Tcl_NewLongObj(iResult)); + TclNewLongObj(resPtr, iResult); + PUSH_OBJECT(resPtr); } else if (valuePtr->typePtr == &tclWideIntType) { Tcl_WideInt wResult, w; TclGetWide(w,valuePtr); @@ -5781,7 +5788,8 @@ ExprAbsFunc(interp, tosPtr, clientData) } else { wResult = w; } - PUSH_OBJECT(Tcl_NewWideIntObj(wResult)); + TclNewWideIntObj(resPtr, wResult); + PUSH_OBJECT(resPtr); } else { d = valuePtr->internalRep.doubleValue; if (d < 0.0) { @@ -5793,7 +5801,8 @@ ExprAbsFunc(interp, tosPtr, clientData) TclExprFloatError(interp, dResult); return TCL_ERROR; } - PUSH_OBJECT(Tcl_NewDoubleObj(dResult)); + TclNewDoubleObj(resPtr, dResult); + PUSH_OBJECT(resPtr); } TclDecrRefCount(valuePtr); @@ -5807,7 +5816,7 @@ ExprDoubleFunc(interp, tosPtr, clientData) Tcl_Obj **tosPtr; /* Points to top of evaluation stack. */ ClientData clientData; /* Ignored. */ { - register Tcl_Obj *valuePtr; + register Tcl_Obj *valuePtr, *resPtr; double dResult; /* @@ -5826,7 +5835,8 @@ ExprDoubleFunc(interp, tosPtr, clientData) * Push a Tcl object with the result. */ - PUSH_OBJECT(Tcl_NewDoubleObj(dResult)); + TclNewDoubleObj(resPtr, dResult); + PUSH_OBJECT(resPtr); TclDecrRefCount(valuePtr); return TCL_OK; @@ -5839,7 +5849,7 @@ ExprIntFunc(interp, tosPtr, clientData) Tcl_Obj **tosPtr; /* Points to top of evaluation stack. */ ClientData clientData; /* Ignored. */ { - register Tcl_Obj *valuePtr; + register Tcl_Obj *valuePtr, *resPtr; long iResult; double d; @@ -5884,7 +5894,8 @@ ExprIntFunc(interp, tosPtr, clientData) * Push a Tcl object with the result. */ - PUSH_OBJECT(Tcl_NewLongObj(iResult)); + TclNewLongObj(resPtr, iResult); + PUSH_OBJECT(resPtr); TclDecrRefCount(valuePtr); return TCL_OK; } @@ -5896,7 +5907,7 @@ ExprWideFunc(interp, tosPtr, clientData) Tcl_Obj **tosPtr; /* Points to top of evaluation stack. */ ClientData clientData; /* Ignored. */ { - register Tcl_Obj *valuePtr; + register Tcl_Obj *valuePtr, *resPtr; Tcl_WideInt wResult; double d; @@ -5941,7 +5952,8 @@ ExprWideFunc(interp, tosPtr, clientData) * Push a Tcl object with the result. */ - PUSH_OBJECT(Tcl_NewWideIntObj(wResult)); + TclNewWideIntObj(resPtr, wResult); + PUSH_OBJECT(resPtr); TclDecrRefCount(valuePtr); return TCL_OK; } @@ -5957,7 +5969,8 @@ ExprRandFunc(interp, tosPtr, clientData) double dResult; long tmp; /* Algorithm assumes at least 32 bits. * Only long guarantees that. See below. */ - + Tcl_Obj *resPtr; + if (!(iPtr->flags & RAND_SEED_INITIALIZED)) { iPtr->flags |= RAND_SEED_INITIALIZED; @@ -6028,7 +6041,8 @@ ExprRandFunc(interp, tosPtr, clientData) * Push a Tcl object with the result. */ - PUSH_OBJECT(Tcl_NewDoubleObj(dResult)); + TclNewDoubleObj(resPtr, dResult); + PUSH_OBJECT(resPtr); return TCL_OK; } @@ -6062,17 +6076,17 @@ ExprRoundFunc(interp, tosPtr, clientData) if (d <= Tcl_WideAsDouble(LLONG_MIN)-0.5) { goto tooLarge; } else if (d <= (((double) (long) LONG_MIN) - 0.5)) { - resPtr = Tcl_NewWideIntObj(Tcl_DoubleAsWide(d - 0.5)); + TclNewWideIntObj(resPtr, Tcl_DoubleAsWide(d - 0.5)); } else { - resPtr = Tcl_NewLongObj((long) (d - 0.5)); + TclNewLongObj(resPtr, (long) (d - 0.5)); } } else { if (d >= Tcl_WideAsDouble(LLONG_MAX)+0.5) { goto tooLarge; } else if (d >= (((double) LONG_MAX + 0.5))) { - resPtr = Tcl_NewWideIntObj(Tcl_DoubleAsWide(d + 0.5)); + TclNewWideIntObj(resPtr, Tcl_DoubleAsWide(d + 0.5)); } else { - resPtr = Tcl_NewLongObj((long) (d + 0.5)); + TclNewLongObj(resPtr, (long) (d + 0.5)); } } @@ -6298,16 +6312,16 @@ ExprCallMathFunc(interp, objc, objv) */ if (funcResult.type == TCL_INT) { - objv[0] = Tcl_NewLongObj(funcResult.intValue); + TclNewLongObj(objv[0], funcResult.intValue); } else if (funcResult.type == TCL_WIDE_INT) { - objv[0] = Tcl_NewWideIntObj(funcResult.wideValue); + TclNewWideIntObj(objv[0], funcResult.wideValue); } else { d = funcResult.doubleValue; if (IS_NAN(d) || IS_INF(d)) { TclExprFloatError(interp, d); return TCL_ERROR; } - objv[0] = Tcl_NewDoubleObj(d); + TclNewDoubleObj(objv[0], d); } Tcl_IncrRefCount(objv[0]); diff --git a/generic/tclInt.h b/generic/tclInt.h index 9ba94e5..756fdee 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -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: tclInt.h,v 1.216 2005/03/25 00:35:03 dgp Exp $ + * RCS: @(#) $Id: tclInt.h,v 1.217 2005/04/01 15:17:24 msofer Exp $ */ #ifndef _TCLINT @@ -2651,6 +2651,9 @@ MODULE_SCOPE void TclDbInitNewObj _ANSI_ARGS_((Tcl_Obj *objPtr)); * * MODULE_SCOPE void TclInitStringRep _ANSI_ARGS_(( * Tcl_Obj *objPtr, char *bytePtr, int len)); + * + * This macro should only be called on an unshared objPtr where + * objPtr->typePtr->freeIntRepProc == NULL *---------------------------------------------------------------- */ @@ -2700,6 +2703,24 @@ MODULE_SCOPE void TclDbInitNewObj _ANSI_ARGS_((Tcl_Obj *objPtr)); /* *---------------------------------------------------------------- + * Macro used by the Tcl core to clean out an object's string + * representation. The ANSI C "prototype" for this macro is: + * + * MODULE_SCOPE void TclInvalidateStringRep _ANSI_ARGS_((Tcl_Obj *objPtr)); + *---------------------------------------------------------------- + */ + +#define TclInvalidateStringRep(objPtr) \ + if (objPtr->bytes != NULL) { \ + if (objPtr->bytes != tclEmptyStringRep) {\ + ckfree((char *) objPtr->bytes);\ + }\ + objPtr->bytes = NULL;\ + }\ + + +/* + *---------------------------------------------------------------- * Macro used by the Tcl core to get a Tcl_WideInt value out of * a Tcl_Obj of the "wideInt" type. Different implementation on * different platforms depending whether TCL_WIDE_INT_IS_LONG. @@ -2772,6 +2793,130 @@ MODULE_SCOPE void TclDbInitNewObj _ANSI_ARGS_((Tcl_Obj *objPtr)); (nsPtr)->exportLookupEpoch++; \ } +/* + *---------------------------------------------------------------- + * Macros used by the Tcl core to set a Tcl_Obj's numeric representation + * avoiding the corresponding function calls in time critical parts of the + * core. They should only be called on unshared objects. The ANSI C + * "prototypes" for these macros are: + * + * MODULE_SCOPE void TclSetIntObj _ANSI_ARGS_((Tcl_Obj *objPtr, + * int intValue)); + * MODULE_SCOPE void TclSetLongObj _ANSI_ARGS_((Tcl_Obj *objPtr, + * long longValue)); + * MODULE_SCOPE void TclSetBooleanObj _ANSI_ARGS_((Tcl_Obj *objPtr, + * long boolValue)); + * MODULE_SCOPE void TclSetWideIntObj _ANSI_ARGS_((Tcl_Obj *objPtr, + * Tcl_WideInt w)); + * MODULE_SCOPE void TclSetDoubleObj _ANSI_ARGS_((Tcl_Obj *objPtr, + * double d)); + * + *---------------------------------------------------------------- + */ + +#define TclSetIntObj(objPtr, i) \ + TclInvalidateStringRep(objPtr);\ + TclFreeIntRep(objPtr); \ + (objPtr)->internalRep.longValue = (long)(i); \ + (objPtr)->typePtr = &tclIntType + +#define TclSetLongObj(objPtr, l) \ + TclSetIntObj((objPtr), (l)) + +#define TclSetBooleanObj(objPtr, b) \ + TclSetIntObj((objPtr), ((b)? 1 : 0));\ + (objPtr)->typePtr = &tclBooleanType + +#define TclSetWideIntObj(objPtr, w) \ + TclInvalidateStringRep(objPtr);\ + TclFreeIntRep(objPtr); \ + (objPtr)->internalRep.wideValue = (Tcl_WideInt)(w); \ + (objPtr)->typePtr = &tclWideIntType + +#define TclSetDoubleObj(objPtr, d) \ + TclInvalidateStringRep(objPtr);\ + TclFreeIntRep(objPtr); \ + (objPtr)->internalRep.doubleValue = (double)(d); \ + (objPtr)->typePtr = &tclDoubleType + +/* + *---------------------------------------------------------------- + * Macros used by the Tcl core to create and initialise objects of + * standard 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 _ANSI_ARGS_((Tcl_Obj *objPtr, + * int i)); + * MODULE_SCOPE void TclNewLongObj _ANSI_ARGS_((Tcl_Obj *objPtr, + * long l)); + * MODULE_SCOPE void TclNewBooleanObj _ANSI_ARGS_((Tcl_Obj *objPtr, + * int b)); + * MODULE_SCOPE void TclNewWideObj _ANSI_ARGS_((Tcl_Obj *objPtr, + * Tcl_WideInt w)); + * MODULE_SCOPE void TclNewDoubleObj _ANSI_ARGS_((Tcl_Obj *objPtr), + * double d); + * MODULE_SCOPE void TclNewStringObj _ANSI_ARGS_((Tcl_Obj *objPtr) + * char *s, int len); + * + *---------------------------------------------------------------- + */ +#ifndef TCL_MEM_DEBUG +#define TclNewIntObj(objPtr, i) \ + TclIncrObjsAllocated(); \ + TclAllocObjStorage(objPtr); \ + (objPtr)->refCount = 0; \ + (objPtr)->bytes = NULL; \ + (objPtr)->internalRep.longValue = (long)(i); \ + (objPtr)->typePtr = &tclIntType + +#define TclNewLongObj(objPtr, l) \ + TclNewIntObj((objPtr), (l)) + +#define TclNewBooleanObj(objPtr, b) \ + TclNewIntObj((objPtr), ((b)? 1 : 0));\ + (objPtr)->typePtr = &tclBooleanType + +#define TclNewWideIntObj(objPtr, w) \ + TclIncrObjsAllocated(); \ + TclAllocObjStorage(objPtr); \ + (objPtr)->refCount = 0; \ + (objPtr)->bytes = NULL; \ + (objPtr)->internalRep.wideValue = (Tcl_WideInt)(w); \ + (objPtr)->typePtr = &tclWideIntType + +#define TclNewDoubleObj(objPtr, d) \ + TclIncrObjsAllocated(); \ + TclAllocObjStorage(objPtr); \ + (objPtr)->refCount = 0; \ + (objPtr)->bytes = NULL; \ + (objPtr)->internalRep.doubleValue = (double)(d); \ + (objPtr)->typePtr = &tclDoubleType + +#define TclNewStringObj(objPtr, s, len) \ + TclNewObj(objPtr); \ + TclInitStringRep((objPtr), (s), (len)) + +#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 TclNewWideIntObj(objPtr, w)\ + (objPtr) = Tcl_NewWideIntObj(w) + +#define TclNewDoubleObj(objPtr, d) \ + (objPtr) = Tcl_NewDoubleObj(d) + +#define TclNewStringObj(objPtr, s, len) \ + (objPtr) = Tcl_NewStringObj((s), (len)) +#endif /* TCL_MEM_DEBUG */ + #include "tclPort.h" #include "tclIntDecls.h" #include "tclIntPlatDecls.h" diff --git a/generic/tclObj.c b/generic/tclObj.c index a847e0f..70a1ae8 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclObj.c,v 1.73 2004/12/12 23:16:23 msofer Exp $ + * RCS: @(#) $Id: tclObj.c,v 1.74 2005/04/01 15:17:25 msofer Exp $ */ #include "tclInt.h" @@ -990,13 +990,9 @@ Tcl_InvalidateStringRep(objPtr) register Tcl_Obj *objPtr; /* Object whose string rep byte pointer * should be freed. */ { - if (objPtr->bytes != NULL) { - if (objPtr->bytes != tclEmptyStringRep) { - ckfree((char *) objPtr->bytes); - } - objPtr->bytes = NULL; - } + TclInvalidateStringRep(objPtr); } + /* *---------------------------------------------------------------------- @@ -1039,11 +1035,7 @@ Tcl_NewBooleanObj(boolValue) { register Tcl_Obj *objPtr; - TclNewObj(objPtr); - objPtr->bytes = NULL; - - objPtr->internalRep.longValue = (boolValue? 1 : 0); - objPtr->typePtr = &tclBooleanType; + TclNewBooleanObj(objPtr, boolValue); return objPtr; } #endif /* TCL_MEM_DEBUG */ @@ -1135,10 +1127,7 @@ Tcl_SetBooleanObj(objPtr, boolValue) Tcl_Panic("Tcl_SetBooleanObj called with shared object"); } - TclFreeIntRep(objPtr); - objPtr->internalRep.longValue = (boolValue? 1 : 0); - objPtr->typePtr = &tclBooleanType; - Tcl_InvalidateStringRep(objPtr); + TclSetBooleanObj(objPtr, boolValue); } /* @@ -1494,11 +1483,7 @@ Tcl_NewDoubleObj(dblValue) { register Tcl_Obj *objPtr; - TclNewObj(objPtr); - objPtr->bytes = NULL; - - objPtr->internalRep.doubleValue = dblValue; - objPtr->typePtr = &tclDoubleType; + TclNewDoubleObj(objPtr, dblValue); return objPtr; } #endif /* if TCL_MEM_DEBUG */ @@ -1590,10 +1575,7 @@ Tcl_SetDoubleObj(objPtr, dblValue) Tcl_Panic("Tcl_SetDoubleObj called with shared object"); } - TclFreeIntRep(objPtr); - objPtr->internalRep.doubleValue = dblValue; - objPtr->typePtr = &tclDoubleType; - Tcl_InvalidateStringRep(objPtr); + TclSetDoubleObj(objPtr, dblValue); } /* @@ -1811,11 +1793,7 @@ Tcl_NewIntObj(intValue) { register Tcl_Obj *objPtr; - TclNewObj(objPtr); - objPtr->bytes = NULL; - - objPtr->internalRep.longValue = (long)intValue; - objPtr->typePtr = &tclIntType; + TclNewIntObj(objPtr, intValue); return objPtr; } #endif /* if TCL_MEM_DEBUG */ @@ -1847,10 +1825,7 @@ Tcl_SetIntObj(objPtr, intValue) Tcl_Panic("Tcl_SetIntObj called with shared object"); } - TclFreeIntRep(objPtr); - objPtr->internalRep.longValue = (long) intValue; - objPtr->typePtr = &tclIntType; - Tcl_InvalidateStringRep(objPtr); + TclSetIntObj(objPtr, intValue); } /* @@ -2189,11 +2164,7 @@ Tcl_NewLongObj(longValue) { register Tcl_Obj *objPtr; - TclNewObj(objPtr); - objPtr->bytes = NULL; - - objPtr->internalRep.longValue = longValue; - objPtr->typePtr = &tclIntType; + TclNewLongObj(objPtr, longValue); return objPtr; } #endif /* if TCL_MEM_DEBUG */ @@ -2295,10 +2266,7 @@ Tcl_SetLongObj(objPtr, longValue) Tcl_Panic("Tcl_SetLongObj called with shared object"); } - TclFreeIntRep(objPtr); - objPtr->internalRep.longValue = longValue; - objPtr->typePtr = &tclIntType; - Tcl_InvalidateStringRep(objPtr); + TclSetLongObj(objPtr, longValue); } /* @@ -2565,11 +2533,7 @@ Tcl_NewWideIntObj(wideValue) { register Tcl_Obj *objPtr; - TclNewObj(objPtr); - objPtr->bytes = NULL; - - objPtr->internalRep.wideValue = wideValue; - objPtr->typePtr = &tclWideIntType; + TclNewWideIntObj(objPtr, wideValue); return objPtr; } #endif /* if TCL_MEM_DEBUG */ @@ -2674,10 +2638,7 @@ Tcl_SetWideIntObj(objPtr, wideValue) Tcl_Panic("Tcl_SetWideIntObj called with shared object"); } - TclFreeIntRep(objPtr); - objPtr->internalRep.wideValue = wideValue; - objPtr->typePtr = &tclWideIntType; - Tcl_InvalidateStringRep(objPtr); + TclSetWideIntObj(objPtr, wideValue); } /* diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index 6ed3570..9d01456 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -33,7 +33,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclStringObj.c,v 1.35 2004/09/29 22:17:29 dkf Exp $ */ + * RCS: @(#) $Id: tclStringObj.c,v 1.36 2005/04/01 15:17:26 msofer Exp $ */ #include "tclInt.h" @@ -208,8 +208,7 @@ Tcl_NewStringObj(bytes, length) if (length < 0) { length = (bytes? strlen(bytes) : 0); } - TclNewObj(objPtr); - TclInitStringRep(objPtr, bytes, length); + TclNewStringObj(objPtr, bytes, length); return objPtr; } #endif /* TCL_MEM_DEBUG */ |