From ddebbb181a979f87cfae4b83623a50a83497cf40 Mon Sep 17 00:00:00 2001 From: Miguel Sofer Date: Mon, 12 Jan 2004 03:23:31 +0000 Subject: * generic/tclCompExpr.c (CompileLandOrLorExpr): new logic, fewer instructions. As a side effect, the instructions INST_LOR and INST_LAND are now never used. * generic/tclExecute.c (INST_JUMP*): small optimisation; fix a bug in debug code. --- ChangeLog | 8 ++++++ generic/tclCompExpr.c | 79 ++++++++++++++++++++++++++++----------------------- generic/tclExecute.c | 22 +++++++++++--- 3 files changed, 70 insertions(+), 39 deletions(-) diff --git a/ChangeLog b/ChangeLog index 718138f..2b6aa82 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,11 @@ +2004-01-12 Miguel Sofer + + * generic/tclCompExpr.c (CompileLandOrLorExpr): new logic, fewer + instructions. As a side effect, the instructions INST_LOR and + INST_LAND are now never used. + * generic/tclExecute.c (INST_JUMP*): small optimisation; fix a + bug in debug code. + 2004-01-11 David Gravereaux * win/tclWinThrd.c (Tcl_ConditionNotify): condPtr must be diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c index d44a528..c3b4952 100644 --- a/generic/tclCompExpr.c +++ b/generic/tclCompExpr.c @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclCompExpr.c,v 1.17 2003/12/24 04:18:19 davygrvy Exp $ + * RCS: @(#) $Id: tclCompExpr.c,v 1.18 2004/01/12 03:23:31 msofer Exp $ */ #include "tclInt.h" @@ -595,8 +595,9 @@ CompileLandOrLorExpr(exprTokenPtr, opIndex, infoPtr, envPtr, endPtrPtr) { JumpFixup shortCircuitFixup; /* Used to fix up the short circuit jump * after the first subexpression. */ - JumpFixup lhsTrueFixup, lhsEndFixup; - /* Used to fix up jumps used to convert the + JumpFixup shortCircuitFixup2;/* Used to fix up the second jump to the + * short-circuit target. */ + JumpFixup endFixup; /* Used to fix up jumps used to convert the * first operand to 0 or 1. */ Tcl_Token *tokenPtr; int dist, code; @@ -614,32 +615,9 @@ CompileLandOrLorExpr(exprTokenPtr, opIndex, infoPtr, envPtr, endPtrPtr) tokenPtr += (tokenPtr->numComponents + 1); /* - * Convert the first operand to the result that Tcl requires: - * "0" or "1". Eventually we'll use a new instruction for this. - */ - - TclEmitForwardJump(envPtr, TCL_TRUE_JUMP, &lhsTrueFixup); - TclEmitPush(TclRegisterNewLiteral(envPtr, "0", 1), envPtr); - TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &lhsEndFixup); - dist = (envPtr->codeNext - envPtr->codeStart) - lhsTrueFixup.codeOffset; - if (TclFixupForwardJump(envPtr, &lhsTrueFixup, dist, 127)) { - badDist: - Tcl_Panic("CompileLandOrLorExpr: bad jump distance %d\n", dist); - } - envPtr->currStackDepth = savedStackDepth; - TclEmitPush(TclRegisterNewLiteral(envPtr, "1", 1), envPtr); - dist = (envPtr->codeNext - envPtr->codeStart) - lhsEndFixup.codeOffset; - if (TclFixupForwardJump(envPtr, &lhsEndFixup, dist, 127)) { - goto badDist; - } - - /* - * Emit the "short circuit" jump around the rest of the expression. - * Duplicate the "0" or "1" on top of the stack first to keep the - * jump from consuming it. + * Emit the short-circuit jump. */ - TclEmitOpcode(INST_DUP, envPtr); TclEmitForwardJump(envPtr, ((opIndex==OP_LAND)? TCL_FALSE_JUMP : TCL_TRUE_JUMP), &shortCircuitFixup); @@ -653,23 +631,54 @@ CompileLandOrLorExpr(exprTokenPtr, opIndex, infoPtr, envPtr, endPtrPtr) goto done; } tokenPtr += (tokenPtr->numComponents + 1); - + /* - * Emit a "logical and" or "logical or" instruction. This does not try - * to "short- circuit" the evaluation of both operands, but instead - * ensures that we either have a "1" or a "0" result. + * Second operand has the same boolean value as the first: + * emit a new jump to the short-circuit target. */ - TclEmitOpcode(((opIndex==OP_LAND)? INST_LAND : INST_LOR), envPtr); + TclEmitForwardJump(envPtr, + ((opIndex==OP_LAND)? TCL_FALSE_JUMP : TCL_TRUE_JUMP), + &shortCircuitFixup2); /* - * Now that we know the target of the forward jump, update it with the - * correct distance. + * Push the boolean value of the second operand, jump to the end. */ + if (opIndex == OP_LAND) { + TclEmitPush(TclRegisterNewLiteral(envPtr, "1", 1), envPtr); + } else { + TclEmitPush(TclRegisterNewLiteral(envPtr, "0", 1), envPtr); + } + TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &endFixup); + + /* + * Fixup the short-circuit jumps and push the correct boolean. + * NOTE: fixup the jumps in the order they were made + */ dist = (envPtr->codeNext - envPtr->codeStart) - shortCircuitFixup.codeOffset; - TclFixupForwardJump(envPtr, &shortCircuitFixup, dist, 127); + if (TclFixupForwardJump(envPtr, &shortCircuitFixup, dist, 127)) { + /* + * The short-circuit jump was grown by 3 bytes: update the + * fixups for the other two jumps. + */ + + shortCircuitFixup2.codeOffset += 3; + endFixup.codeOffset += 3; + } + dist = (envPtr->codeNext - envPtr->codeStart) + - shortCircuitFixup2.codeOffset; + TclFixupForwardJump(envPtr, &shortCircuitFixup2, dist, 127); + + if (opIndex == OP_LAND) { + TclEmitPush(TclRegisterNewLiteral(envPtr, "0", 1), envPtr); + } else { + TclEmitPush(TclRegisterNewLiteral(envPtr, "1", 1), envPtr); + } + + dist = (envPtr->codeNext - envPtr->codeStart) - endFixup.codeOffset; + TclFixupForwardJump(envPtr, &endFixup, dist, 127); *endPtrPtr = tokenPtr; done: diff --git a/generic/tclExecute.c b/generic/tclExecute.c index f12452b..61d444b 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.118 2003/12/24 04:18:19 davygrvy Exp $ + * RCS: @(#) $Id: tclExecute.c,v 1.119 2004/01/12 03:23:31 msofer Exp $ */ #include "tclInt.h" @@ -2275,7 +2275,16 @@ TclExecuteByteCode(interp, codePtr) int b; valuePtr = *tosPtr; - if (valuePtr->typePtr == &tclIntType) { + /* + * The following will be partially resolved at compile + * time and optimised away. + */ + if (((sizeof(long) == sizeof(int)) && + (valuePtr->typePtr == &tclIntType)) + || (valuePtr->typePtr == &tclBooleanType)) { + b = (int) valuePtr->internalRep.longValue; + } else if ((sizeof(long) != sizeof(int)) && + (valuePtr->typePtr == &tclIntType)) { b = (valuePtr->internalRep.longValue != 0); } else if (valuePtr->typePtr == &tclDoubleType) { b = (valuePtr->internalRep.doubleValue != 0.0); @@ -2293,7 +2302,7 @@ TclExecuteByteCode(interp, codePtr) NEXT_INST_F((b? opnd : pcAdjustment), 1, 0); #else if (b) { - if ((*pc == INST_JUMP_TRUE1) || (*pc == INST_JUMP_TRUE1)) { + if ((*pc == INST_JUMP_TRUE1) || (*pc == INST_JUMP_TRUE4)) { TRACE(("%d => %.20s true, new pc %u\n", opnd, O2S(valuePtr), (unsigned int)(pc+opnd - codePtr->codeStart))); } else { @@ -2301,7 +2310,7 @@ TclExecuteByteCode(interp, codePtr) } NEXT_INST_F(opnd, 1, 0); } else { - if ((*pc == INST_JUMP_TRUE1) || (*pc == INST_JUMP_TRUE1)) { + if ((*pc == INST_JUMP_TRUE1) || (*pc == INST_JUMP_TRUE4)) { TRACE(("%d => %.20s false\n", opnd, O2S(valuePtr))); } else { opnd = pcAdjustment; @@ -2313,6 +2322,11 @@ TclExecuteByteCode(interp, codePtr) #endif } + /* + * These two instructions are now redundant: the complete logic of the + * LOR and LAND is now handled by the expression compiler. + */ + case INST_LOR: case INST_LAND: { -- cgit v0.12