summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
Diffstat (limited to 'generic')
-rw-r--r--generic/tclExecute.c178
-rw-r--r--generic/tclInt.h147
-rw-r--r--generic/tclObj.c65
-rw-r--r--generic/tclStringObj.c5
4 files changed, 257 insertions, 138 deletions
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 */
generated by cgit v0.12 at 2024-11-18 17:51:57 (GMT)