From 4459bed11ee445f9e2a6f0263e2b93a31add3dfe Mon Sep 17 00:00:00 2001 From: dgp Date: Wed, 18 May 2005 20:54:54 +0000 Subject: * generic/tclBasic.c (Tcl_ExprBoolean): Rewrite as wrapper around Tcl_ExprBooleanObj. * generic/tclCmdMZ.c ([string is boolean/true/false]): Rewrite dropping string-based Tcl_GetBoolean call, so that internal reps are kept for subsequent quick boolean operations. * generic/tclExecute.c: Dropped most special handling of the "boolean" Tcl_ObjType, since that type should now be rarely encountered. * doc/BoolObj.3: Rewrite of documentation dropping many details about the internals of Tcl_Objs. Shorter documentation focuses on the function and use of the routines. --- ChangeLog | 11 ++++++++ generic/tclBasic.c | 36 +++++++++--------------- generic/tclCmdMZ.c | 16 ++++------- generic/tclExecute.c | 77 +++++++++++++++++++++------------------------------- 4 files changed, 60 insertions(+), 80 deletions(-) diff --git a/ChangeLog b/ChangeLog index 04bf525..45fd42b 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,5 +1,16 @@ 2005-05-18 Don Porter + * generic/tclBasic.c (Tcl_ExprBoolean): Rewrite as wrapper around + Tcl_ExprBooleanObj. + + * generic/tclCmdMZ.c ([string is boolean/true/false]): Rewrite + dropping string-based Tcl_GetBoolean call, so that internal reps + are kept for subsequent quick boolean operations. + + * generic/tclExecute.c: Dropped most special handling of the + "boolean" Tcl_ObjType, since that type should now be rarely + encountered. + * doc/BoolObj.3: Rewrite of documentation dropping many details about the internals of Tcl_Objs. Shorter documentation focuses on the function and use of the routines. diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 843a30a..d6e6695 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -13,7 +13,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclBasic.c,v 1.153 2005/05/14 23:15:11 dkf Exp $ + * RCS: @(#) $Id: tclBasic.c,v 1.154 2005/05/18 20:55:03 dgp Exp $ */ #include "tclInt.h" @@ -4293,22 +4293,19 @@ Tcl_ExprBoolean(interp, exprstring, ptr) CONST char *exprstring; /* Expression to evaluate. */ int *ptr; /* Where to store 0/1 result. */ { - register Tcl_Obj *exprPtr; - Tcl_Obj *resultPtr; - int length = strlen(exprstring); - int result = TCL_OK; + if (*exprstring == '\0') { + /* + * An empty string. Just set the result boolean to 0 (false). + */ - if (length > 0) { - exprPtr = Tcl_NewStringObj(exprstring, length); + *ptr = 0; + return TCL_OK; + } else { + int result; + Tcl_Obj *exprPtr = Tcl_NewStringObj(exprstring, -1); Tcl_IncrRefCount(exprPtr); - result = Tcl_ExprObj(interp, exprPtr, &resultPtr); - if (result == TCL_OK) { - /* - * Store a boolean based on the expression result. - */ - result = Tcl_GetBooleanFromObj(interp, resultPtr, ptr); - Tcl_DecrRefCount(resultPtr); /* discard the result object */ - } + result = Tcl_ExprBooleanObj(interp, exprPtr, ptr); + Tcl_DecrRefCount(exprPtr); if (result != TCL_OK) { /* * Move the interpreter's object result to the string result, @@ -4317,15 +4314,8 @@ Tcl_ExprBoolean(interp, exprstring, ptr) (void) Tcl_GetStringResult(interp); } - Tcl_DecrRefCount(exprPtr); /* discard the expression object */ - } else { - /* - * An empty string. Just set the result boolean to 0 (false). - */ - - *ptr = 0; + return result; } - return result; } /* diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index 91e4b1e..5bc89c0 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -15,7 +15,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclCmdMZ.c,v 1.119 2005/05/11 00:51:28 hobbs Exp $ + * RCS: @(#) $Id: tclCmdMZ.c,v 1.120 2005/05/18 20:55:04 dgp Exp $ */ #include "tclInt.h" @@ -1480,19 +1480,13 @@ Tcl_StringObjCmd(dummy, interp, objc, objv) case STR_IS_BOOL: case STR_IS_TRUE: case STR_IS_FALSE: - if (objPtr->typePtr == &tclBooleanType) { - if ((((enum isOptions) index == STR_IS_TRUE) && + if (TCL_OK != Tcl_ConvertToType(NULL, objPtr, + &tclBooleanType)) { + result = 0; + } else if ((((enum isOptions) index == STR_IS_TRUE) && objPtr->internalRep.longValue == 0) || (((enum isOptions) index == STR_IS_FALSE) && objPtr->internalRep.longValue != 0)) { - result = 0; - } - } else if ((Tcl_GetBoolean(NULL, string1, &i) - == TCL_ERROR) || - (((enum isOptions) index == STR_IS_TRUE) && - i == 0) || - (((enum isOptions) index == STR_IS_FALSE) && - i != 0)) { result = 0; } break; diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 0557515..c86be8f 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.189 2005/05/13 17:12:17 dgp Exp $ + * RCS: @(#) $Id: tclExecute.c,v 1.190 2005/05/18 20:55:04 dgp Exp $ */ #include "tclInt.h" @@ -2478,8 +2478,7 @@ TclExecuteByteCode(interp, codePtr) doCondJump: valuePtr = *tosPtr; - if ((valuePtr->typePtr == &tclIntType) - || (valuePtr->typePtr == &tclBooleanType)) { + if (valuePtr->typePtr == &tclIntType) { b = (valuePtr->internalRep.longValue != 0); } else if (valuePtr->typePtr == &tclDoubleType) { b = (valuePtr->internalRep.doubleValue != 0.0); @@ -2553,7 +2552,7 @@ TclExecuteByteCode(interp, codePtr) t1Ptr = valuePtr->typePtr; t2Ptr = value2Ptr->typePtr; - if ((t1Ptr == &tclIntType) || (t1Ptr == &tclBooleanType)) { + if (t1Ptr == &tclIntType) { i1 = (valuePtr->internalRep.longValue != 0); } else if (t1Ptr == &tclWideIntType) { TclGetWide(w,valuePtr); @@ -2572,9 +2571,7 @@ TclExecuteByteCode(interp, codePtr) i1 = (w != W0); } } else { - result = Tcl_GetBooleanFromObj((Tcl_Interp *) NULL, - valuePtr, &i1); - i1 = (i1 != 0); + result = Tcl_GetBooleanFromObj(NULL, valuePtr, &i1); } if (result != TCL_OK) { TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(valuePtr), @@ -2584,7 +2581,7 @@ TclExecuteByteCode(interp, codePtr) } } - if ((t2Ptr == &tclIntType) || (t2Ptr == &tclBooleanType)) { + if (t2Ptr == &tclIntType) { i2 = (value2Ptr->internalRep.longValue != 0); } else if (t2Ptr == &tclWideIntType) { TclGetWide(w,value2Ptr); @@ -2603,7 +2600,7 @@ TclExecuteByteCode(interp, codePtr) i2 = (w != W0); } } else { - result = Tcl_GetBooleanFromObj((Tcl_Interp *) NULL, value2Ptr, &i2); + result = Tcl_GetBooleanFromObj(NULL, value2Ptr, &i2); } if (result != TCL_OK) { TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(value2Ptr), @@ -4254,28 +4251,22 @@ TclExecuteByteCode(interp, codePtr) * Otherwise, we need to generate a numeric internal rep. * from the string rep. */ - if ((tPtr == &tclBooleanType) && (valuePtr->bytes == NULL)) { - valuePtr->typePtr = &tclIntType; + int length; + char *s = Tcl_GetStringFromObj(valuePtr, &length); + if (TclLooksLikeInt(s, length)) { + GET_WIDE_OR_INT(result, valuePtr, i, w); } else { - int length; - char *s = Tcl_GetStringFromObj(valuePtr, &length); - if (TclLooksLikeInt(s, length)) { - GET_WIDE_OR_INT(result, valuePtr, i, w); - } else { - result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL, - valuePtr, &d); - } - if (result == TCL_ERROR && *pc == INST_LNOT) { - result = Tcl_GetBooleanFromObj((Tcl_Interp *)NULL, - valuePtr, &boolvar); - i = (long)boolvar; /* i is long, not int! */ - } - if (result != TCL_OK) { - TRACE(("\"%.20s\" => ILLEGAL TYPE %s\n", - s, (tPtr? tPtr->name : "null"))); - IllegalExprOperandType(interp, pc, valuePtr); - goto checkForCatch; - } + result = Tcl_GetDoubleFromObj(NULL, valuePtr, &d); + } + if (result == TCL_ERROR && *pc == INST_LNOT) { + result = Tcl_GetBooleanFromObj(NULL, valuePtr, &boolvar); + i = (long)boolvar; /* i is long, not int! */ + } + if (result != TCL_OK) { + TRACE(("\"%.20s\" => ILLEGAL TYPE %s\n", s, + (tPtr? tPtr->name : "null"))); + IllegalExprOperandType(interp, pc, valuePtr); + goto checkForCatch; } tPtr = valuePtr->typePtr; } @@ -4285,7 +4276,7 @@ TclExecuteByteCode(interp, codePtr) /* * Create a new object. */ - if ((tPtr == &tclIntType) || (tPtr == &tclBooleanType)) { + if (tPtr == &tclIntType) { i = valuePtr->internalRep.longValue; TclNewLongObj(objResultPtr, -i); TRACE_WITH_OBJ(("%ld => ", i), objResultPtr); @@ -4303,7 +4294,7 @@ TclExecuteByteCode(interp, codePtr) /* * valuePtr is unshared. Modify it directly. */ - if ((tPtr == &tclIntType) || (tPtr == &tclBooleanType)) { + if (tPtr == &tclIntType) { i = valuePtr->internalRep.longValue; TclSetLongObj(valuePtr, -i); TRACE_WITH_OBJ(("%ld => ", i), valuePtr); @@ -4435,22 +4426,16 @@ TclExecuteByteCode(interp, codePtr) * Otherwise, we need to generate a numeric internal rep. * from the string rep. */ - if ((tPtr == &tclBooleanType) && (valuePtr->bytes == NULL)) { - valuePtr->typePtr = &tclIntType; - converted = 1; + s = Tcl_GetStringFromObj(valuePtr, &length); + if (TclLooksLikeInt(s, length)) { + GET_WIDE_OR_INT(result, valuePtr, i, w); } else { - s = Tcl_GetStringFromObj(valuePtr, &length); - if (TclLooksLikeInt(s, length)) { - GET_WIDE_OR_INT(result, valuePtr, i, w); - } else { - result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL, - valuePtr, &d); - } - if (result == TCL_OK) { - converted = 1; - } - result = TCL_OK; /* reset the result variable */ + result = Tcl_GetDoubleFromObj(NULL, valuePtr, &d); + } + if (result == TCL_OK) { + converted = 1; } + result = TCL_OK; /* reset the result variable */ tPtr = valuePtr->typePtr; } -- cgit v0.12