summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--generic/tclCompCmds.c30
-rw-r--r--generic/tclCompile.c174
-rw-r--r--generic/tclCompile.h1
-rw-r--r--unix/Makefile.in6
-rw-r--r--win/Makefile.in1
-rw-r--r--win/makefile.bc1
-rw-r--r--win/makefile.vc1
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 ; 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/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 \
generated by cgit v0.12 at 2024-12-04 04:32:47 (GMT)