From 64edc0ede7a6c7770bc5f152e97aa48674ed6682 Mon Sep 17 00:00:00 2001 From: dkf Date: Wed, 5 Jun 2013 12:34:21 +0000 Subject: More cleaning up; factor out optimizer to new file. Some weird problems still. --- generic/tclCompCmds.c | 30 +++++---- generic/tclCompile.c | 174 +------------------------------------------------- generic/tclCompile.h | 1 + unix/Makefile.in | 6 +- win/Makefile.in | 1 + win/makefile.bc | 1 + win/makefile.vc | 1 + 7 files changed, 26 insertions(+), 188 deletions(-) diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c index 365e647..8cb5fcd 100644 --- a/generic/tclCompCmds.c +++ b/generic/tclCompCmds.c @@ -499,6 +499,13 @@ TclCompileBreakCmd( TclCleanupStackForBreakContinue(envPtr, auxPtr); TclAddLoopBreakFixup(envPtr, auxPtr); + + /* + * Instructions that raise exceptions don't really have to follow the + * usual stack management rules, but the cleanup code does. + */ + + TclAdjustStackDepth(1, envPtr); } else { /* * Emit a real break. @@ -510,12 +517,6 @@ TclCompileBreakCmd( TclEmitInt4(0, envPtr); } - /* - * Instructions that raise exceptions don't really have to follow the - * usual stack management rules, but the cleanup code does. - */ - - TclAdjustStackDepth(1, envPtr); return TCL_OK; } @@ -833,6 +834,13 @@ TclCompileContinueCmd( TclCleanupStackForBreakContinue(envPtr, auxPtr); TclAddLoopContinueFixup(envPtr, auxPtr); + + /* + * Instructions that raise exceptions don't really have to follow the + * usual stack management rules, but the cleanup code does. + */ + + TclAdjustStackDepth(1, envPtr); } else { /* * Emit a real continue. @@ -844,12 +852,6 @@ TclCompileContinueCmd( TclEmitInt4(0, envPtr); } - /* - * Instructions that raise exceptions don't really have to follow the - * usual stack management rules, but the cleanup code does. - */ - - TclAdjustStackDepth(1, envPtr); return TCL_OK; } @@ -2121,10 +2123,10 @@ TclCompileDictWithCmd( TclEmitInstInt4( INST_BEGIN_CATCH4, range, envPtr); ExceptionRangeStarts(envPtr, range); - envPtr->currStackDepth++; + //envPtr->currStackDepth++; SetLineInformation(parsePtr->numWords-1); CompileBody(envPtr, tokenPtr, interp); - envPtr->currStackDepth = savedStackDepth; + //envPtr->currStackDepth = savedStackDepth; ExceptionRangeEnds(envPtr, range); /* diff --git a/generic/tclCompile.c b/generic/tclCompile.c index 69517bc..4a989c7 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -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 ; icodeNext--; - } - 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/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 \ -- cgit v0.12