Attachment "patch.txt" to
ticket [441372ffff]
added by
msofer
2001-07-15 07:51:16.
? patch.txt
Index: ChangeLog
===================================================================
RCS file: /cvsroot/tcl/tcl/ChangeLog,v
retrieving revision 1.494
diff -r1.494 ChangeLog
0a1,7
> 2001-07-14 Miguel Sofer <[email protected]>
>
> * generic/tclExecute.c:
> * generic/tclInt.h: Introduced constant objects 0, 1, -1, {}
> in the execution environment to avoid many creation/deletion of
> objects.
>
Index: generic/tclExecute.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclExecute.c,v
retrieving revision 1.26
diff -r1.26 tclExecute.c
407a408,416
> eePtr->zero = Tcl_NewLongObj(0);
> Tcl_IncrRefCount(eePtr->zero);
> eePtr->one = Tcl_NewLongObj(1);
> Tcl_IncrRefCount(eePtr->one);
> eePtr->mone = Tcl_NewLongObj(-1);
> Tcl_IncrRefCount(eePtr->mone);
> eePtr->empty = Tcl_NewObj();
> Tcl_IncrRefCount(eePtr->empty);
>
441a451,454
> Tcl_DecrRefCount(eePtr->zero);
> Tcl_DecrRefCount(eePtr->one);
> Tcl_DecrRefCount(eePtr->mone);
> Tcl_DecrRefCount(eePtr->empty);
1967,1970d1979
< /*
< * Reuse the valuePtr object already on stack if possible.
< */
<
1976,1985c1985,1989
< if (Tcl_IsShared(valuePtr)) {
< PUSH_OBJECT(Tcl_NewLongObj(iResult));
< TRACE(("%.20s %.20s => %d\n",
< O2S(valuePtr), O2S(value2Ptr), iResult));
< TclDecrRefCount(valuePtr);
< } else { /* reuse the valuePtr object */
< TRACE(("%.20s %.20s => %d\n",
< O2S(valuePtr), O2S(value2Ptr), iResult));
< Tcl_SetLongObj(valuePtr, iResult);
< ++stackTop; /* valuePtr now on stk top has right r.c. */
---
>
> if (iResult) {
> PUSH_OBJECT(eePtr->one);
> } else {
> PUSH_OBJECT(eePtr->zero);
1986a1991,1994
> TRACE(("%.20s %.20s => %d\n",
> O2S(valuePtr), O2S(value2Ptr), iResult));
>
> TclDecrRefCount(valuePtr);
2035c2043
< objPtr = Tcl_NewObj();
---
> objPtr = eePtr->empty;
2104c2112,2116
< PUSH_OBJECT(Tcl_NewIntObj(iResult));
---
> if (iResult) {
> PUSH_OBJECT(eePtr->one);
> } else {
> PUSH_OBJECT(eePtr->zero);
> }
2168c2180
< iResult = -1;
---
> PUSH_OBJECT(eePtr->mone);
2170c2182,2184
< iResult = 1;
---
> PUSH_OBJECT(eePtr->one);
> } else {
> PUSH_OBJECT(eePtr->zero);
2173d2186
< PUSH_OBJECT(Tcl_NewIntObj(iResult));
2252c2265
< objPtr = Tcl_NewObj();
---
> objPtr = eePtr->empty;
2275,2277d2287
< /*
< * Reuse the casePtr object already on stack if possible.
< */
2281,2286c2291,2295
< if (Tcl_IsShared(objPtr)) {
< PUSH_OBJECT(Tcl_NewIntObj(match));
< TclDecrRefCount(objPtr);
< } else { /* reuse the valuePtr object */
< Tcl_SetIntObj(objPtr, match);
< ++stackTop; /* valuePtr now on stk top has right r.c. */
---
>
> if (match) {
> PUSH_OBJECT(eePtr->one);
> } else {
> PUSH_OBJECT(eePtr->zero);
2287a2297,2298
>
> TclDecrRefCount(objPtr);
2444,2457c2455,2458
< /*
< * Reuse the valuePtr object already on stack if possible.
< */
<
< if (Tcl_IsShared(valuePtr)) {
< PUSH_OBJECT(Tcl_NewLongObj(iResult));
< TRACE(("%.20s %.20s => %ld\n",
< O2S(valuePtr), O2S(value2Ptr), iResult));
< TclDecrRefCount(valuePtr);
< } else { /* reuse the valuePtr object */
< TRACE(("%.20s %.20s => %ld\n",
< O2S(valuePtr), O2S(value2Ptr), iResult));
< Tcl_SetLongObj(valuePtr, iResult);
< ++stackTop; /* valuePtr now on stk top has right r.c. */
---
> if (iResult) {
> PUSH_OBJECT(eePtr->one);
> } else {
> PUSH_OBJECT(eePtr->zero);
2458a2460,2464
>
> TRACE(("%.20s %.20s => %ld\n",
> O2S(valuePtr), O2S(value2Ptr), iResult));
>
> TclDecrRefCount(valuePtr);
2890,2893c2896
< if (Tcl_IsShared(valuePtr)) {
< /*
< * Create a new object.
< */
---
> if (*pc == INST_LNOT) {
2896,2898c2899,2900
< objPtr = Tcl_NewLongObj(
< (*pc == INST_UMINUS)? -i : !i);
< TRACE_WITH_OBJ(("%ld => ", i), objPtr);
---
> objPtr = (i ? eePtr->zero : eePtr->one);
> TRACE_WITH_OBJ(("%ld => ", i), objPtr);
2901,2909c2903
< if (*pc == INST_UMINUS) {
< objPtr = Tcl_NewDoubleObj(-d);
< } else {
< /*
< * Should be able to use "!d", but apparently
< * some compilers can't handle it.
< */
< objPtr = Tcl_NewLongObj((d==0.0)? 1 : 0);
< }
---
> objPtr = ((d!=0.0) ? eePtr->zero : eePtr->one);
2915,2922c2909,2923
< /*
< * valuePtr is unshared. Modify it directly.
< */
< if ((tPtr == &tclIntType) || (tPtr == &tclBooleanType)) {
< i = valuePtr->internalRep.longValue;
< Tcl_SetLongObj(valuePtr,
< (*pc == INST_UMINUS)? -i : !i);
< TRACE_WITH_OBJ(("%ld => ", i), valuePtr);
---
> if (Tcl_IsShared(valuePtr)) {
> /*
> * Create a new object.
> */
> if ((tPtr == &tclIntType) || (tPtr == &tclBooleanType)) {
> i = valuePtr->internalRep.longValue;
> objPtr = Tcl_NewLongObj(-i);
> TRACE_WITH_OBJ(("%ld => ", i), objPtr);
> } else {
> d = valuePtr->internalRep.doubleValue;
> objPtr = Tcl_NewDoubleObj(-d);
> TRACE_WITH_OBJ(("%.6g => ", d), objPtr);
> }
> PUSH_OBJECT(objPtr);
> TclDecrRefCount(valuePtr);
2924,2926c2925,2931
< d = valuePtr->internalRep.doubleValue;
< if (*pc == INST_UMINUS) {
< Tcl_SetDoubleObj(valuePtr, -d);
---
> /*
> * valuePtr is unshared. Modify it directly.
> */
> if ((tPtr == &tclIntType) || (tPtr == &tclBooleanType)) {
> i = valuePtr->internalRep.longValue;
> Tcl_SetLongObj(valuePtr,-i);
> TRACE_WITH_OBJ(("%ld => ", i), valuePtr);
2928,2932c2933,2935
< /*
< * Should be able to use "!d", but apparently
< * some compilers can't handle it.
< */
< Tcl_SetLongObj(valuePtr, (d==0.0)? 1 : 0);
---
> d = valuePtr->internalRep.doubleValue;
> Tcl_SetDoubleObj(valuePtr, -d);
> TRACE_WITH_OBJ(("%.6g => ", d), valuePtr);
2934c2937
< TRACE_WITH_OBJ(("%.6g => ", d), valuePtr);
---
> ++stackTop; /* valuePtr now on stk top has right r.c. */
2936d2938
< ++stackTop; /* valuePtr now on stk top has right r.c. */
3309c3311
< valuePtr = Tcl_NewObj();
---
> valuePtr = eePtr->empty;
3340c3342,3343
< PUSH_OBJECT(Tcl_NewLongObj(continueLoop));
---
> objPtr = (continueLoop ? eePtr->one : eePtr->zero);
> PUSH_OBJECT(objPtr);
Index: generic/tclInt.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclInt.h,v
retrieving revision 1.57
diff -r1.57 tclInt.h
877a878
> * It also holds the four constants "zero", "one", "mone" (minus one) and "empty"
885a887,890
> Tcl_Obj *zero;
> Tcl_Obj *one;
> Tcl_Obj *mone;
> Tcl_Obj *empty;
