summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2013-06-05 21:42:29 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2013-06-05 21:42:29 (GMT)
commit4b11467bd8b565659352c19b7736f872569c0975 (patch)
tree378bc662ee103e3267b37793d35f629707f8fe39 /generic
parentdc66944c443e2457cac229a26fb22fcfb8aac10d (diff)
parent38cbf3feb975cb1a1a9bffc69cf773f4f2d2c11c (diff)
downloadtcl-4b11467bd8b565659352c19b7736f872569c0975.zip
tcl-4b11467bd8b565659352c19b7736f872569c0975.tar.gz
tcl-4b11467bd8b565659352c19b7736f872569c0975.tar.bz2
Working on the optimizer, and finding a few bugs in bytecode generation.
Diffstat (limited to 'generic')
-rw-r--r--generic/tclCompCmds.c2
-rw-r--r--generic/tclCompile.c176
-rw-r--r--generic/tclCompile.h1
-rw-r--r--generic/tclOptimize.c287
4 files changed, 290 insertions, 176 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:
+ */