diff options
| -rw-r--r-- | generic/tclCompCmds.c | 2 | ||||
| -rw-r--r-- | generic/tclCompile.c | 176 | ||||
| -rw-r--r-- | generic/tclCompile.h | 1 | ||||
| -rw-r--r-- | generic/tclOptimize.c | 287 | ||||
| -rw-r--r-- | unix/Makefile.in | 6 | ||||
| -rw-r--r-- | win/Makefile.in | 1 | ||||
| -rw-r--r-- | win/makefile.bc | 1 | ||||
| -rw-r--r-- | win/makefile.vc | 1 |
8 files changed, 298 insertions, 177 deletions
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c index 10a789e..7324360 100644 --- a/generic/tclCompCmds.c +++ b/generic/tclCompCmds.c @@ -2111,10 +2111,8 @@ TclCompileDictWithCmd( TclEmitInstInt4( INST_BEGIN_CATCH4, range, envPtr); ExceptionRangeStarts(envPtr, range); - envPtr->currStackDepth++; SetLineInformation(parsePtr->numWords-1); CompileBody(envPtr, tokenPtr, interp); - envPtr->currStackDepth = savedStackDepth; ExceptionRangeEnds(envPtr, range); /* diff --git a/generic/tclCompile.c b/generic/tclCompile.c index 69517bc..572f660 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -431,7 +431,7 @@ InstructionDesc const tclInstructionTable[] = { /* Map variable contents back into a dictionary in a variable. Part of * [dict with]. * Stack: ... dictVarName path keyList => ... */ - {"dictRecombineImm", 1, -2, 1, {OPERAND_LVT4}}, + {"dictRecombineImm", 5, -2, 1, {OPERAND_LVT4}}, /* Map variable contents back into a dictionary in the local variable * indicated by the LVT index. Part of [dict with]. * Stack: ... path keyList => ... */ @@ -568,7 +568,6 @@ static void FreeSubstCodeInternalRep(Tcl_Obj *objPtr); static int GetCmdLocEncodingSize(CompileEnv *envPtr); static int IsCompactibleCompileEnv(Tcl_Interp *interp, CompileEnv *envPtr); -static void PeepholeOptimize(CompileEnv *envPtr); #ifdef TCL_COMPILE_STATS static void RecordByteCodeStats(ByteCode *codePtr); #endif /* TCL_COMPILE_STATS */ @@ -760,7 +759,7 @@ TclSetByteCodeFromAny( * instruction generator boundaries. */ - PeepholeOptimize(&compEnv); + TclOptimizeBytecode(&compEnv); /* * Invoke the compilation hook procedure if one exists. @@ -1102,177 +1101,6 @@ IsCompactibleCompileEnv( } /* - * ---------------------------------------------------------------------- - * - * PeepholeOptimize -- - * - * A very simple peephole optimizer for bytecode. - * - * ---------------------------------------------------------------------- - */ - -static void -PeepholeOptimize( - CompileEnv *envPtr) -{ - unsigned char *pc, *prev1 = NULL, *prev2 = NULL, *target; - int size, isNew; - Tcl_HashTable targets; - Tcl_HashEntry *hPtr; - Tcl_HashSearch hSearch; - - /* - * Find places where we should be careful about replacing instructions - * because they are the targets of various types of jumps. - */ - - Tcl_InitHashTable(&targets, TCL_ONE_WORD_KEYS); - for (pc = envPtr->codeStart ; pc < envPtr->codeNext ; pc += size) { - size = tclInstructionTable[*pc].numBytes; - switch (*pc) { - case INST_JUMP1: - case INST_JUMP_TRUE1: - case INST_JUMP_FALSE1: - target = pc + TclGetInt1AtPtr(pc+1); - goto storeTarget; - case INST_JUMP4: - case INST_JUMP_TRUE4: - case INST_JUMP_FALSE4: - target = pc + TclGetInt4AtPtr(pc+1); - goto storeTarget; - case INST_BEGIN_CATCH4: - target = envPtr->codeStart + envPtr->exceptArrayPtr[ - TclGetUInt4AtPtr(pc+1)].codeOffset; - storeTarget: - (void) Tcl_CreateHashEntry(&targets, (void *) target, &isNew); - break; - case INST_JUMP_TABLE: - hPtr = Tcl_FirstHashEntry( - &JUMPTABLEINFO(envPtr, pc+1)->hashTable, &hSearch); - for (; hPtr ; hPtr = Tcl_NextHashEntry(&hSearch)) { - target = pc + PTR2INT(Tcl_GetHashValue(hPtr)); - (void) Tcl_CreateHashEntry(&targets, (void *) target, &isNew); - } - break; - case INST_START_CMD: - assert (envPtr->atCmdStart < 2); - } - } - - /* - * Replace PUSH/POP sequences (when non-hazardous) with NOPs. Also replace - * PUSH empty/CONCAT and TRY_CVT_NUMERIC (when followed by an operation - * that guarantees the check for arithmeticity). - */ - - (void) Tcl_CreateHashEntry(&targets, (void *) pc, &isNew); - for (pc = envPtr->codeStart ; pc < envPtr->codeNext ; pc += size) { - int blank = 0, i, inst; - - size = tclInstructionTable[*pc].numBytes; - prev2 = prev1; - prev1 = pc; - while (*(pc+size) == INST_NOP) { - if (Tcl_FindHashEntry(&targets, (void *) (pc + size))) { - break; - } - size += tclInstructionTable[INST_NOP].numBytes; - } - if (Tcl_FindHashEntry(&targets, (void *) (pc + size))) { - continue; - } - inst = *(pc + size); - switch (*pc) { - case INST_PUSH1: - if (inst == INST_POP) { - blank = size + tclInstructionTable[inst].numBytes; - } else if (inst == INST_CONCAT1 - && TclGetUInt1AtPtr(pc + size + 1) == 2) { - Tcl_Obj *litPtr = TclFetchLiteral(envPtr, - TclGetUInt1AtPtr(pc + 1)); - int numBytes; - - (void) Tcl_GetStringFromObj(litPtr, &numBytes); - if (numBytes == 0) { - blank = size + tclInstructionTable[inst].numBytes; - } - } - break; - case INST_PUSH4: - if (inst == INST_POP) { - blank = size + 1; - } else if (inst == INST_CONCAT1 - && TclGetUInt1AtPtr(pc + size + 1) == 2) { - Tcl_Obj *litPtr = TclFetchLiteral(envPtr, - TclGetUInt4AtPtr(pc + 1)); - int numBytes; - - (void) Tcl_GetStringFromObj(litPtr, &numBytes); - if (numBytes == 0) { - blank = size + tclInstructionTable[inst].numBytes; - } - } - break; - case INST_TRY_CVT_TO_NUMERIC: - switch (inst) { - case INST_JUMP_TRUE1: - case INST_JUMP_TRUE4: - case INST_JUMP_FALSE1: - case INST_JUMP_FALSE4: - case INST_INCR_SCALAR1: - case INST_INCR_ARRAY1: - case INST_INCR_ARRAY_STK: - case INST_INCR_SCALAR_STK: - case INST_INCR_STK: - case INST_LOR: - case INST_LAND: - case INST_EQ: - case INST_NEQ: - case INST_LT: - case INST_LE: - case INST_GT: - case INST_GE: - case INST_MOD: - case INST_LSHIFT: - case INST_RSHIFT: - case INST_BITOR: - case INST_BITXOR: - case INST_BITAND: - case INST_EXPON: - case INST_ADD: - case INST_SUB: - case INST_DIV: - case INST_MULT: - case INST_LNOT: - case INST_BITNOT: - case INST_UMINUS: - case INST_UPLUS: - case INST_TRY_CVT_TO_NUMERIC: - blank = size; - break; - } - break; - } - if (blank > 0) { - for (i=0 ; i<blank ; i++) { - *(pc + i) = INST_NOP; - } - size = blank; - } - } - - /* - * Trim a trailing double DONE. - */ - - if (prev1 && prev2 && *prev1 == INST_DONE && *prev2 == INST_DONE - && !Tcl_FindHashEntry(&targets, (void *) prev1)) { - envPtr->codeNext--; - } - Tcl_DeleteHashTable(&targets); -} - -/* *---------------------------------------------------------------------- * * Tcl_SubstObj -- diff --git a/generic/tclCompile.h b/generic/tclCompile.h index 15b5477..fdb281b 100644 --- a/generic/tclCompile.h +++ b/generic/tclCompile.h @@ -1060,6 +1060,7 @@ MODULE_SCOPE void TclFinalizeLoopExceptionRange(CompileEnv *envPtr, MODULE_SCOPE char * TclLiteralStats(LiteralTable *tablePtr); MODULE_SCOPE int TclLog2(int value); #endif +MODULE_SCOPE void TclOptimizeBytecode(CompileEnv *envPtr); #ifdef TCL_COMPILE_DEBUG MODULE_SCOPE void TclPrintByteCodeObj(Tcl_Interp *interp, Tcl_Obj *objPtr); diff --git a/generic/tclOptimize.c b/generic/tclOptimize.c new file mode 100644 index 0000000..18dc208 --- /dev/null +++ b/generic/tclOptimize.c @@ -0,0 +1,287 @@ +/* + * tclOptimize.c -- + * + * This file contains the bytecode optimizer. + * + * Copyright (c) 2013 by Donal Fellows. + * + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. + */ + +#include "tclInt.h" +#include "tclCompile.h" +#include <assert.h> + +#define DefineTargetAddress(tablePtr, address) \ + ((void) Tcl_CreateHashEntry((tablePtr), (void *) (address), &isNew)) +#define IsTargetAddress(tablePtr, address) \ + (Tcl_FindHashEntry((tablePtr), (void *) (address)) != NULL) + +static void +LocateTargetAddresses( + CompileEnv *envPtr, + Tcl_HashTable *tablePtr) +{ + unsigned char *pc, *target; + int size, isNew, i; + Tcl_HashEntry *hPtr; + Tcl_HashSearch hSearch; + + Tcl_InitHashTable(tablePtr, TCL_ONE_WORD_KEYS); + + /* + * The starts of commands represent target addresses. + */ + + for (i=0 ; i<envPtr->numCommands ; i++) { + DefineTargetAddress(tablePtr, + envPtr->codeStart + envPtr->cmdMapPtr[i].codeOffset); + } + + /* + * Find places where we should be careful about replacing instructions + * because they are the targets of various types of jumps. + */ + + for (pc = envPtr->codeStart ; pc < envPtr->codeNext ; pc += size) { + size = tclInstructionTable[*pc].numBytes; + switch (*pc) { + case INST_JUMP1: + case INST_JUMP_TRUE1: + case INST_JUMP_FALSE1: + target = pc + TclGetInt1AtPtr(pc+1); + goto storeTarget; + case INST_JUMP4: + case INST_JUMP_TRUE4: + case INST_JUMP_FALSE4: + target = pc + TclGetInt4AtPtr(pc+1); + goto storeTarget; + case INST_BEGIN_CATCH4: + target = envPtr->codeStart + envPtr->exceptArrayPtr[ + TclGetUInt4AtPtr(pc+1)].codeOffset; + storeTarget: + DefineTargetAddress(tablePtr, target); + break; + case INST_JUMP_TABLE: + hPtr = Tcl_FirstHashEntry( + &JUMPTABLEINFO(envPtr, pc+1)->hashTable, &hSearch); + for (; hPtr ; hPtr = Tcl_NextHashEntry(&hSearch)) { + target = pc + PTR2INT(Tcl_GetHashValue(hPtr)); + DefineTargetAddress(tablePtr, target); + } + break; + case INST_RETURN_CODE_BRANCH: + for (i=TCL_ERROR ; i<TCL_CONTINUE+1 ; i++) { + DefineTargetAddress(tablePtr, pc + 2*i - 1); + } + break; + case INST_START_CMD: + assert (envPtr->atCmdStart < 2); + } + } + + /* + * Add a marker *after* the last bytecode instruction. WARNING: points to + * one past the end! + */ + + DefineTargetAddress(tablePtr, pc); + + /* + * Enter in the targets of exception ranges. + */ + + for (i=0 ; i<envPtr->exceptArrayNext ; i++) { + ExceptionRange *rangePtr = &envPtr->exceptArrayPtr[i]; + + if (rangePtr->type == CATCH_EXCEPTION_RANGE) { + target = envPtr->codeStart + rangePtr->catchOffset; + DefineTargetAddress(tablePtr, target); + } else { + target = envPtr->codeStart + rangePtr->breakOffset; + DefineTargetAddress(tablePtr, target); + if (rangePtr->continueOffset >= 0) { + target = envPtr->codeStart + rangePtr->continueOffset; + DefineTargetAddress(tablePtr, target); + } + } + } +} + +/* + * ---------------------------------------------------------------------- + * + * TclOptimizeBytecode -- + * + * A very simple peephole optimizer for bytecode. + * + * ---------------------------------------------------------------------- + */ + +void +TclOptimizeBytecode( + CompileEnv *envPtr) +{ + unsigned char *pc; + int size; + Tcl_HashTable targets; + + /* + * Replace PUSH/POP sequences (when non-hazardous) with NOPs. Also replace + * PUSH empty/CONCAT and TRY_CVT_NUMERIC (when followed by an operation + * that guarantees the check for arithmeticity) and eliminate LNOT when we + * can invert the following JUMP condition. + */ + + LocateTargetAddresses(envPtr, &targets); + for (pc = envPtr->codeStart ; pc < envPtr->codeNext ; pc += size) { + int blank = 0, i, inst; + + size = tclInstructionTable[*pc].numBytes; + while (*(pc+size) == INST_NOP) { + if (IsTargetAddress(&targets, pc + size)) { + break; + } + size += tclInstructionTable[INST_NOP].numBytes; + } + if (IsTargetAddress(&targets, pc + size)) { + continue; + } + inst = *(pc + size); + switch (*pc) { + case INST_PUSH1: + if (inst == INST_POP) { + blank = size + tclInstructionTable[inst].numBytes; + } else if (inst == INST_CONCAT1 + && TclGetUInt1AtPtr(pc + size + 1) == 2) { + Tcl_Obj *litPtr = TclFetchLiteral(envPtr, + TclGetUInt1AtPtr(pc + 1)); + int numBytes; + + (void) Tcl_GetStringFromObj(litPtr, &numBytes); + if (numBytes == 0) { + blank = size + tclInstructionTable[inst].numBytes; + } + } + break; + case INST_PUSH4: + if (inst == INST_POP) { + blank = size + 1; + } else if (inst == INST_CONCAT1 + && TclGetUInt1AtPtr(pc + size + 1) == 2) { + Tcl_Obj *litPtr = TclFetchLiteral(envPtr, + TclGetUInt4AtPtr(pc + 1)); + int numBytes; + + (void) Tcl_GetStringFromObj(litPtr, &numBytes); + if (numBytes == 0) { + blank = size + tclInstructionTable[inst].numBytes; + } + } + break; + case INST_LNOT: + switch (inst) { + case INST_JUMP_TRUE1: + blank = size; + *(pc + size) = INST_JUMP_FALSE1; + break; + case INST_JUMP_FALSE1: + blank = size; + *(pc + size) = INST_JUMP_TRUE1; + break; + case INST_JUMP_TRUE4: + blank = size; + *(pc + size) = INST_JUMP_FALSE4; + break; + case INST_JUMP_FALSE4: + blank = size; + *(pc + size) = INST_JUMP_TRUE4; + break; + } + break; + case INST_TRY_CVT_TO_NUMERIC: + switch (inst) { + case INST_JUMP_TRUE1: + case INST_JUMP_TRUE4: + case INST_JUMP_FALSE1: + case INST_JUMP_FALSE4: + case INST_INCR_SCALAR1: + case INST_INCR_ARRAY1: + case INST_INCR_ARRAY_STK: + case INST_INCR_SCALAR_STK: + case INST_INCR_STK: + case INST_LOR: + case INST_LAND: + case INST_EQ: + case INST_NEQ: + case INST_LT: + case INST_LE: + case INST_GT: + case INST_GE: + case INST_MOD: + case INST_LSHIFT: + case INST_RSHIFT: + case INST_BITOR: + case INST_BITXOR: + case INST_BITAND: + case INST_EXPON: + case INST_ADD: + case INST_SUB: + case INST_DIV: + case INST_MULT: + case INST_LNOT: + case INST_BITNOT: + case INST_UMINUS: + case INST_UPLUS: + case INST_TRY_CVT_TO_NUMERIC: + blank = size; + break; + } + break; + } + if (blank > 0) { + for (i=0 ; i<blank ; i++) { + *(pc + i) = INST_NOP; + } + size = blank; + } + } + Tcl_DeleteHashTable(&targets); + + /* + * Trim unreachable instructions after a DONE. + */ + + LocateTargetAddresses(envPtr, &targets); + for (pc = envPtr->codeStart ; pc < envPtr->codeNext-1 ; pc += size) { + int clear = 0; + + size = tclInstructionTable[*pc].numBytes; + if (*pc != INST_DONE) { + continue; + } + assert (size == 1); + while (!IsTargetAddress(&targets, pc + 1 + clear)) { + clear += tclInstructionTable[*(pc + 1 + clear)].numBytes; + } + if (pc + 1 + clear == envPtr->codeNext) { + envPtr->codeNext -= clear; + } else { + while (clear --> 0) { + *(pc + 1 + clear) = INST_NOP; + } + } + } + + Tcl_DeleteHashTable(&targets); +} + +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * tab-width: 8 + * End: + */ diff --git a/unix/Makefile.in b/unix/Makefile.in index 9bf8b43..3e4a6f6 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -301,7 +301,7 @@ GENERIC_OBJS = regcomp.o regexec.o regfree.o regerror.o tclAlloc.o \ tclIORChan.o tclIORTrans.o tclIOGT.o tclIOSock.o tclIOUtil.o \ tclLink.o tclListObj.o \ tclLiteral.o tclLoad.o tclMain.o tclNamesp.o tclNotify.o \ - tclObj.o tclPanic.o tclParse.o tclPathObj.o tclPipe.o \ + tclObj.o tclOptimize.o tclPanic.o tclParse.o tclPathObj.o tclPipe.o \ tclPkg.o tclPkgConfig.o tclPosixStr.o \ tclPreserve.o tclProc.o tclRegexp.o \ tclResolve.o tclResult.o tclScan.o tclStringObj.o \ @@ -429,6 +429,7 @@ GENERIC_SRCS = \ $(GENERIC_DIR)/tclNamesp.c \ $(GENERIC_DIR)/tclNotify.c \ $(GENERIC_DIR)/tclObj.c \ + $(GENERIC_DIR)/tclOptimize.c \ $(GENERIC_DIR)/tclParse.c \ $(GENERIC_DIR)/tclPathObj.c \ $(GENERIC_DIR)/tclPipe.c \ @@ -1165,6 +1166,9 @@ tclLiteral.o: $(GENERIC_DIR)/tclLiteral.c $(COMPILEHDR) tclObj.o: $(GENERIC_DIR)/tclObj.c $(COMPILEHDR) $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclObj.c +tclOptimize.o: $(GENERIC_DIR)/tclOptimize.c $(COMPILEHDR) + $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclOptimize.c + tclLoad.o: $(GENERIC_DIR)/tclLoad.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclLoad.c diff --git a/win/Makefile.in b/win/Makefile.in index 047b0b5..18993fe 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -267,6 +267,7 @@ GENERIC_OBJS = \ tclOOMethod.$(OBJEXT) \ tclOOStubInit.$(OBJEXT) \ tclObj.$(OBJEXT) \ + tclOptimize.$(OBJEXT) \ tclPanic.$(OBJEXT) \ tclParse.$(OBJEXT) \ tclPathObj.$(OBJEXT) \ diff --git a/win/makefile.bc b/win/makefile.bc index d148513..0b17cea 100644 --- a/win/makefile.bc +++ b/win/makefile.bc @@ -239,6 +239,7 @@ TCLOBJS = \ $(TMPDIR)\tclOOMethod.obj \ $(TMPDIR)\tclOOStubInit.obj \ $(TMPDIR)\tclObj.obj \ + $(TMPDIR)\tclOptimize.obj \ $(TMPDIR)\tclPanic.obj \ $(TMPDIR)\tclParse.obj \ $(TMPDIR)\tclPipe.obj \ diff --git a/win/makefile.vc b/win/makefile.vc index 95d3a9d..cddb253 100644 --- a/win/makefile.vc +++ b/win/makefile.vc @@ -316,6 +316,7 @@ COREOBJS = \ $(TMP_DIR)\tclOOMethod.obj \ $(TMP_DIR)\tclOOStubInit.obj \ $(TMP_DIR)\tclObj.obj \ + $(TMP_DIR)\tclOptimize.obj \ $(TMP_DIR)\tclPanic.obj \ $(TMP_DIR)\tclParse.obj \ $(TMP_DIR)\tclPathObj.obj \ |