summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
Diffstat (limited to 'generic')
-rw-r--r--generic/tcl.h4
-rw-r--r--generic/tclAssembly.c243
-rw-r--r--generic/tclBasic.c8
-rw-r--r--generic/tclFileName.c14
-rw-r--r--generic/tclIO.c9
-rw-r--r--generic/tclIORChan.c43
-rw-r--r--generic/tclIORTrans.c36
-rw-r--r--generic/tclIOSock.c9
-rw-r--r--generic/tclObj.c27
-rw-r--r--generic/tclProc.c9
-rwxr-xr-xgeneric/tclStrToD.c6
-rw-r--r--generic/tclVar.c3
-rw-r--r--generic/tclZlib.c18
13 files changed, 195 insertions, 234 deletions
diff --git a/generic/tcl.h b/generic/tcl.h
index 7644e63..54bfedc 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -58,10 +58,10 @@ extern "C" {
#define TCL_MAJOR_VERSION 8
#define TCL_MINOR_VERSION 6
#define TCL_RELEASE_LEVEL TCL_BETA_RELEASE
-#define TCL_RELEASE_SERIAL 1
+#define TCL_RELEASE_SERIAL 2
#define TCL_VERSION "8.6"
-#define TCL_PATCH_LEVEL "8.6b1.2"
+#define TCL_PATCH_LEVEL "8.6b2"
/*
*----------------------------------------------------------------------------
diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c
index e12d0f8..f45ae07 100644
--- a/generic/tclAssembly.c
+++ b/generic/tclAssembly.c
@@ -1,5 +1,5 @@
/*
- * tclAssembly,c --
+ * tclAssembly.c --
*
* Assembler for Tcl bytecodes.
*
@@ -84,7 +84,7 @@ typedef struct BasicBlock {
* unresolved */
int initialStackDepth; /* Absolute stack depth on entry */
int minStackDepth; /* Low-water relative stack depth */
- int maxStackDepth; /* High-water relative stack depth */
+ int maxStackDepth; /* High-water relative stack depth */
int finalStackDepth; /* Relative stack depth on exit */
enum BasicBlockCatchState catchState;
/* State of the block for 'catch' analysis */
@@ -193,7 +193,7 @@ typedef enum TalInstType {
typedef struct TalInstDesc {
const char *name; /* Name of instruction. */
- TalInstType instType; /* The type of instruction */
+ TalInstType instType; /* The type of instruction */
int tclInstCode; /* Instruction code. For instructions having
* 1- and 4-byte variables, tclInstCode is
* ((1byte)<<8) || (4byte) */
@@ -831,16 +831,20 @@ CompileAssembleObj(
if (objPtr->typePtr == &assembleCodeType) {
namespacePtr = iPtr->varFramePtr->nsPtr;
codePtr = objPtr->internalRep.otherValuePtr;
- if (((Interp *) *codePtr->interpHandle != iPtr)
- || (codePtr->compileEpoch != iPtr->compileEpoch)
- || (codePtr->nsPtr != namespacePtr)
- || (codePtr->nsEpoch != namespacePtr->resolverEpoch)
- || (codePtr->localCachePtr
- != iPtr->varFramePtr->localCachePtr)) {
- FreeAssembleCodeInternalRep(objPtr);
- } else {
+ if (((Interp *) *codePtr->interpHandle == iPtr)
+ && (codePtr->compileEpoch == iPtr->compileEpoch)
+ && (codePtr->nsPtr == namespacePtr)
+ && (codePtr->nsEpoch == namespacePtr->resolverEpoch)
+ && (codePtr->localCachePtr
+ == iPtr->varFramePtr->localCachePtr)) {
return codePtr;
}
+
+ /*
+ * Not valid, so free it and regenerate.
+ */
+
+ FreeAssembleCodeInternalRep(objPtr);
}
/*
@@ -967,7 +971,7 @@ TclCompileAssembleCmd(
static int
TclAssembleCode(
- CompileEnv *envPtr, /* Compilation environment that is to receive
+ CompileEnv *envPtr, /* Compilation environment that is to receive
* the generated bytecode */
const char* codePtr, /* Assembly-language code to be processed */
int codeLen, /* Length of the code */
@@ -1173,24 +1177,10 @@ FreeAssemblyEnv(
}
/*
- * Free the label hash.
- */
-
- while (1) {
- Tcl_HashEntry* hashEntry;
- Tcl_HashSearch hashSearch;
-
- hashEntry = Tcl_FirstHashEntry(&assemEnvPtr->labelHash, &hashSearch);
- if (hashEntry == NULL) {
- break;
- }
- Tcl_DeleteHashEntry(hashEntry);
- }
-
- /*
* Dispose what's left.
*/
+ Tcl_DeleteHashTable(&assemEnvPtr->labelHash);
TclStackFree(interp, assemEnvPtr->parsePtr);
TclStackFree(interp, assemEnvPtr);
}
@@ -1222,13 +1212,12 @@ AssembleOneLine(
Tcl_Parse* parsePtr = assemEnvPtr->parsePtr;
/* Parse of the line of code */
Tcl_Token* tokenPtr; /* Current token within the line of code */
- Tcl_Obj* instNameObj = NULL;
- /* Name of the instruction */
+ Tcl_Obj* instNameObj; /* Name of the instruction */
int tblIdx; /* Index in TalInstructionTable of the
* instruction */
enum TalInstType instType; /* Type of the instruction */
Tcl_Obj* operand1Obj = NULL;
- /* First operand to the instruction */
+ /* First operand to the instruction */
const char* operand1; /* String rep of the operand */
int operand1Len; /* String length of the operand */
int opnd; /* Integer representation of an operand */
@@ -1255,7 +1244,7 @@ AssembleOneLine(
if (Tcl_GetIndexFromObjStruct(interp, instNameObj,
&TalInstructionTable[0].name, sizeof(TalInstDesc), "instruction",
TCL_EXACT, &tblIdx) != TCL_OK) {
- return TCL_ERROR;
+ goto cleanup;
}
/*
@@ -1324,8 +1313,11 @@ AssembleOneLine(
Tcl_WrongNumArgs(interp, 1, &instNameObj, "boolean varName");
goto cleanup;
}
- if (GetBooleanOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK
- || (localVar = FindLocalVar(assemEnvPtr, &tokenPtr)) < 0) {
+ if (GetBooleanOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK) {
+ goto cleanup;
+ }
+ localVar = FindLocalVar(assemEnvPtr, &tokenPtr);
+ if (localVar < 0) {
goto cleanup;
}
BBEmitInstInt1(assemEnvPtr, tblIdx, opnd, 0);
@@ -1363,8 +1355,11 @@ AssembleOneLine(
goto cleanup;
}
if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK
- || CheckStrictlyPositive(interp, opnd) != TCL_OK
- || (localVar = FindLocalVar(assemEnvPtr, &tokenPtr)) == -1) {
+ || CheckStrictlyPositive(interp, opnd) != TCL_OK) {
+ goto cleanup;
+ }
+ localVar = FindLocalVar(assemEnvPtr, &tokenPtr);
+ if (localVar < 0) {
goto cleanup;
}
BBEmitInstInt4(assemEnvPtr, tblIdx, opnd, opnd+1);
@@ -1377,8 +1372,11 @@ AssembleOneLine(
goto cleanup;
}
if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK
- || CheckStrictlyPositive(interp, opnd) != TCL_OK
- || (localVar = FindLocalVar(assemEnvPtr, &tokenPtr)) == -1) {
+ || CheckStrictlyPositive(interp, opnd) != TCL_OK) {
+ goto cleanup;
+ }
+ localVar = FindLocalVar(assemEnvPtr, &tokenPtr);
+ if (localVar < 0) {
goto cleanup;
}
BBEmitInstInt4(assemEnvPtr, tblIdx, opnd, opnd);
@@ -1572,7 +1570,8 @@ AssembleOneLine(
Tcl_WrongNumArgs(interp, 1, &instNameObj, "varname");
goto cleanup;
}
- if ((localVar = FindLocalVar(assemEnvPtr, &tokenPtr)) < 0) {
+ localVar = FindLocalVar(assemEnvPtr, &tokenPtr);
+ if (localVar < 0) {
goto cleanup;
}
BBEmitInst1or4(assemEnvPtr, tblIdx, localVar, 0);
@@ -1583,8 +1582,8 @@ AssembleOneLine(
Tcl_WrongNumArgs(interp, 1, &instNameObj, "varname");
goto cleanup;
}
- if ((localVar = FindLocalVar(assemEnvPtr, &tokenPtr)) < 0
- || CheckOneByte(interp, localVar)) {
+ localVar = FindLocalVar(assemEnvPtr, &tokenPtr);
+ if (localVar < 0 || CheckOneByte(interp, localVar)) {
goto cleanup;
}
BBEmitInstInt1(assemEnvPtr, tblIdx, localVar, 0);
@@ -1595,8 +1594,8 @@ AssembleOneLine(
Tcl_WrongNumArgs(interp, 1, &instNameObj, "varName imm8");
goto cleanup;
}
- if ((localVar = FindLocalVar(assemEnvPtr, &tokenPtr)) < 0
- || CheckOneByte(interp, localVar)
+ localVar = FindLocalVar(assemEnvPtr, &tokenPtr);
+ if (localVar < 0 || CheckOneByte(interp, localVar)
|| GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK
|| CheckSignedOneByte(interp, opnd)) {
goto cleanup;
@@ -1610,7 +1609,8 @@ AssembleOneLine(
Tcl_WrongNumArgs(interp, 1, &instNameObj, "varname");
goto cleanup;
}
- if ((localVar = FindLocalVar(assemEnvPtr, &tokenPtr)) < 0) {
+ localVar = FindLocalVar(assemEnvPtr, &tokenPtr);
+ if (localVar < 0) {
goto cleanup;
}
BBEmitInstInt4(assemEnvPtr, tblIdx, localVar, 0);
@@ -1672,8 +1672,11 @@ AssembleOneLine(
Tcl_WrongNumArgs(interp, 1, &instNameObj, "count varName");
goto cleanup;
}
- if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK
- || (localVar = FindLocalVar(assemEnvPtr, &tokenPtr)) == -1) {
+ if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK) {
+ goto cleanup;
+ }
+ localVar = FindLocalVar(assemEnvPtr, &tokenPtr);
+ if (localVar < 0) {
goto cleanup;
}
BBEmitInstInt4(assemEnvPtr, tblIdx, opnd, 0);
@@ -1687,9 +1690,7 @@ AssembleOneLine(
status = TCL_OK;
cleanup:
- if (instNameObj) {
- Tcl_DecrRefCount(instNameObj);
- }
+ Tcl_DecrRefCount(instNameObj);
if (operand1Obj) {
Tcl_DecrRefCount(operand1Obj);
}
@@ -1871,7 +1872,7 @@ MoveExceptionRangesToBasicBlock(
curr_bb, exceptionCount, savedExceptArrayNext);
curr_bb->foreignExceptionBase = savedExceptArrayNext;
curr_bb->foreignExceptionCount = exceptionCount;
- curr_bb->foreignExceptions =
+ curr_bb->foreignExceptions =
ckalloc(exceptionCount * sizeof(ExceptionRange));
memcpy(curr_bb->foreignExceptions,
envPtr->exceptArrayPtr + savedExceptArrayNext,
@@ -1918,7 +1919,6 @@ CreateMirrorJumpTable(
Tcl_HashEntry* hashEntry; /* Entry for a key in the hashtable */
int isNew; /* Flag==1 if the key is not yet in the
* table. */
- Tcl_Obj* result; /* Error message */
int i;
if (Tcl_ListObjGetElements(interp, jumps, &objc, &objv) != TCL_OK) {
@@ -1954,17 +1954,15 @@ CreateMirrorJumpTable(
&isNew);
if (!isNew) {
if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
- result = Tcl_NewStringObj(
- "duplicate entry in jump table for \"", -1);
- Tcl_AppendObjToObj(result, objv[i]);
- Tcl_AppendToObj(result, "\"", -1);
- Tcl_SetObjResult(interp, result);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "duplicate entry in jump table for \"%s\"",
+ Tcl_GetString(objv[i])));
Tcl_SetErrorCode(interp, "TCL", "ASSEM", "DUPJUMPTABLEENTRY");
DeleteMirrorJumpTable(jtPtr);
return TCL_ERROR;
}
}
- Tcl_SetHashValue(hashEntry, (ClientData) objv[i+1]);
+ Tcl_SetHashValue(hashEntry, objv[i+1]);
Tcl_IncrRefCount(objv[i+1]);
}
DEBUG_PRINT("}\n");
@@ -2243,8 +2241,8 @@ FindLocalVar(
Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
/* Tcl interpreter */
Tcl_Token* tokenPtr = *tokenPtrPtr;
- /* INOUT: Pointer to the next token
- * in the source code */
+ /* INOUT: Pointer to the next token in the
+ * source code. */
Tcl_Obj* varNameObj; /* Name of the variable */
const char* varNameStr;
int varNameLen;
@@ -2255,6 +2253,7 @@ FindLocalVar(
}
varNameStr = Tcl_GetStringFromObj(varNameObj, &varNameLen);
if (CheckNamespaceQualifiers(interp, varNameStr, varNameLen)) {
+ Tcl_DecrRefCount(varNameObj);
return -1;
}
localVar = TclFindCompiledLocal(varNameStr, varNameLen, 1, envPtr);
@@ -2293,14 +2292,12 @@ CheckNamespaceQualifiers(
const char* name, /* Variable name to check */
int nameLen) /* Length of the variable */
{
- Tcl_Obj* result; /* Error message */
const char* p;
+
for (p = name; p+2 < name+nameLen; p++) {
if ((*p == ':') && (p[1] == ':')) {
- result = Tcl_NewStringObj("variable \"", -1);
- Tcl_AppendToObj(result, name, -1);
- Tcl_AppendToObj(result, "\" is not local", -1);
- Tcl_SetObjResult(interp, result);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "variable \"%s\" is not local", name));
Tcl_SetErrorCode(interp, "TCL", "ASSEM", "NONLOCAL", name, NULL);
return TCL_ERROR;
}
@@ -2471,7 +2468,6 @@ DefineLabel(
Tcl_HashEntry* entry; /* Label's entry in the symbol table */
int isNew; /* Flag == 1 iff the label was previously
* undefined */
- Tcl_Obj* result; /* Error message */
/* TODO - This can now be simplified! */
@@ -2487,14 +2483,11 @@ DefineLabel(
* This is a duplicate label.
*/
- if (assemEnvPtr-> flags & (TCL_EVAL_DIRECT)) {
- result = Tcl_NewStringObj(
- "duplicate definition of label \"", -1);
- Tcl_AppendToObj(result, labelName, -1);
- Tcl_AppendToObj(result, "\"", -1);
- Tcl_SetObjResult(interp, result);
- Tcl_SetErrorCode(interp, "TCL", "ASSEM", "DUPLABEL",
- labelName, NULL);
+ if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "duplicate definition of label \"%s\"", labelName));
+ Tcl_SetErrorCode(interp, "TCL", "ASSEM", "DUPLABEL", labelName,
+ NULL);
}
return TCL_ERROR;
}
@@ -2531,7 +2524,7 @@ StartBasicBlock(
{
CompileEnv* envPtr = assemEnvPtr->envPtr;
/* Compilation environment */
- BasicBlock* newBB; /* BasicBlock structure for the new block */
+ BasicBlock* newBB; /* BasicBlock structure for the new block */
BasicBlock* currBB = assemEnvPtr->curr_bb;
/*
@@ -2693,8 +2686,10 @@ FinishAssembly(
return TCL_ERROR;
}
- /* TODO - Check for unreachable code */
- /* Maybe not - unreachable code is Mostly Harmless. */
+ /*
+ * TODO - Check for unreachable code. Or maybe not; unreachable code is
+ * Mostly Harmless.
+ */
return TCL_OK;
}
@@ -2752,7 +2747,7 @@ CalculateJumpRelocations(
motion = 0;
for (bbPtr = assemEnvPtr->head_bb;
bbPtr != NULL;
- bbPtr=bbPtr->successor1) {
+ bbPtr = bbPtr->successor1) {
/*
* Advance the basic block start offset by however many bytes we
* have inserted in the code up to this point
@@ -2852,8 +2847,7 @@ CheckJumpTableLabels(
Tcl_GetString(symbolObj));
DEBUG_PRINT(" %s -> %s (%d)\n",
(char*) Tcl_GetHashKey(symHash, symEntryPtr),
- Tcl_GetString(symbolObj),
- (valEntryPtr != NULL));
+ Tcl_GetString(symbolObj), (valEntryPtr != NULL));
if (valEntryPtr == NULL) {
ReportUndefinedLabel(assemEnvPtr, bbPtr, symbolObj);
return TCL_ERROR;
@@ -2876,6 +2870,7 @@ CheckJumpTableLabels(
*
*-----------------------------------------------------------------------------
*/
+
static void
ReportUndefinedLabel(
AssemblyEnv* assemEnvPtr, /* Assembly environment */
@@ -2887,13 +2882,10 @@ ReportUndefinedLabel(
/* Compilation environment */
Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
/* Tcl interpreter */
- Tcl_Obj* result; /* Error message */
if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
- result = Tcl_NewStringObj("undefined label \"", -1);
- Tcl_AppendObjToObj(result, jumpTarget);
- Tcl_AppendToObj(result, "\"", -1);
- Tcl_SetObjResult(interp, result);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "undefined label \"%s\"", Tcl_GetString(jumpTarget)));
Tcl_SetErrorCode(interp, "TCL", "ASSEM", "NOLABEL",
Tcl_GetString(jumpTarget), NULL);
Tcl_SetErrorLine(interp, bbPtr->jumpLine);
@@ -3038,8 +3030,7 @@ ResolveJumpTableTargets(
auxDataIndex = TclGetInt4AtPtr(envPtr->codeStart + bbPtr->jumpOffset + 1);
DEBUG_PRINT("bbPtr = %p jumpOffset = %d auxDataIndex = %d\n",
bbPtr, bbPtr->jumpOffset, auxDataIndex);
- realJumpTablePtr = (JumptableInfo*)
- envPtr->auxDataArrayPtr[auxDataIndex].clientData;
+ realJumpTablePtr = envPtr->auxDataArrayPtr[auxDataIndex].clientData;
realJumpHashPtr = &realJumpTablePtr->hashTable;
/*
@@ -3147,7 +3138,6 @@ CheckNonThrowingBlock(
int bound; /* Bytecode offset following the last
* instruction of the block. */
unsigned char opcode; /* Current bytecode instruction */
- Tcl_Obj* retval; /* Error message */
/*
* Determine where in the code array the basic block ends.
@@ -3177,13 +3167,12 @@ CheckNonThrowingBlock(
*/
if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
- retval = Tcl_NewStringObj("\"", -1);
- Tcl_AppendToObj(retval, tclInstructionTable[opcode].name, -1);
- Tcl_AppendToObj(retval, "\" instruction may not appear in "
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "\"%s\" instruction may not appear in "
"a context where an exception has been "
- "caught and not disposed of.", -1);
+ "caught and not disposed of.",
+ tclInstructionTable[opcode].name));
Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADTHROW", NULL);
- Tcl_SetObjResult(interp, retval);
AddBasicBlockRangeToErrorInfo(assemEnvPtr, blockPtr);
}
return TCL_ERROR;
@@ -3216,7 +3205,7 @@ BytecodeMightThrow(
*/
int min = 0;
- int max = sizeof(NonThrowingByteCodes)-1;
+ int max = sizeof(NonThrowingByteCodes) - 1;
int mid;
unsigned char c;
@@ -3357,7 +3346,11 @@ StackCheckBasicBlock(
if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"inconsistent stack depths on two execution paths", -1));
- /* TODO - add execution trace of both paths */
+
+ /*
+ * TODO - add execution trace of both paths
+ */
+
Tcl_SetErrorLine(interp, blockPtr->startLine);
Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADSTACK", NULL);
}
@@ -3490,8 +3483,6 @@ StackCheckExit(
int depth; /* Net stack effect */
int litIndex; /* Index in the literal pool of the empty
* string */
- Tcl_Obj* depthObj; /* Net stack effect for an error message */
- Tcl_Obj* resultObj; /* Error message from this procedure */
BasicBlock* curr_bb = assemEnvPtr->curr_bb;
/* Final basic block in the assembly */
@@ -3502,51 +3493,45 @@ StackCheckExit(
*/
if (curr_bb->flags & BB_VISITED) {
- /*
+ /*
* Exit with no operands; push an empty one.
*/
- depth = curr_bb->finalStackDepth + curr_bb->initialStackDepth;
- if (depth == 0) {
- /*
+ depth = curr_bb->finalStackDepth + curr_bb->initialStackDepth;
+ if (depth == 0) {
+ /*
* Emit a 'push' of the empty literal.
*/
- litIndex = TclRegisterNewLiteral(envPtr, "", 0);
+ litIndex = TclRegisterNewLiteral(envPtr, "", 0);
- /*
+ /*
* Assumes that 'push' is at slot 0 in TalInstructionTable.
*/
- BBEmitInst1or4(assemEnvPtr, 0, litIndex, 0);
- ++depth;
- }
+ BBEmitInst1or4(assemEnvPtr, 0, litIndex, 0);
+ ++depth;
+ }
- /*
+ /*
* Exit with unbalanced stack.
*/
- if (depth != 1) {
- if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
- depthObj = Tcl_NewIntObj(depth);
- Tcl_IncrRefCount(depthObj);
- resultObj = Tcl_NewStringObj(
- "stack is unbalanced on exit from the code (depth=",
- -1);
- Tcl_AppendObjToObj(resultObj, depthObj);
- Tcl_DecrRefCount(depthObj);
- Tcl_AppendToObj(resultObj, ")", -1);
- Tcl_SetObjResult(interp, resultObj);
- Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADSTACK", NULL);
- }
- return TCL_ERROR;
- }
-
- /*
+ if (depth != 1) {
+ if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "stack is unbalanced on exit from the code (depth=%d)",
+ depth));
+ Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADSTACK", NULL);
+ }
+ return TCL_ERROR;
+ }
+
+ /*
* Record stack usage.
*/
- envPtr->currStackDepth += depth;
+ envPtr->currStackDepth += depth;
}
return TCL_OK;
@@ -3711,8 +3696,10 @@ ProcessCatchesInBasicBlock(
jumpEnclosing = enclosing;
jumpState = state;
- /* TODO: Make sure that the test cases include validating
- * that a natural loop can't include 'beginCatch' or 'endCatch' */
+ /*
+ * TODO: Make sure that the test cases include validating that a natural
+ * loop can't include 'beginCatch' or 'endCatch'
+ */
if (bbPtr->flags & BB_BEGINCATCH) {
/*
@@ -3856,8 +3843,8 @@ BuildExceptionRanges(
int catchDepth = 0; /* Current catch depth */
int maxCatchDepth = 0; /* Maximum catch depth in the program */
BasicBlock** catches; /* Stack of catches in progress */
- int* catchIndices; /* Indices of the exception ranges
- * of catches in progress */
+ int* catchIndices; /* Indices of the exception ranges of catches
+ * in progress */
int i;
/*
@@ -4106,7 +4093,7 @@ RestoreEmbeddedExceptionRanges(
* range as reinstalled */
ExceptionRange* range; /* Current foreign exception range */
unsigned char opcode; /* Current instruction's opcode */
- int catchIndex; /* Index of the exception range to which the
+ int catchIndex; /* Index of the exception range to which the
* current instruction refers */
int i;
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index c46510c..a44d736 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -3645,12 +3645,8 @@ Tcl_GetMathFuncInfo(
*/
if (cmdPtr == NULL) {
- Tcl_Obj *message;
-
- TclNewLiteralStringObj(message, "unknown math function \"");
- Tcl_AppendToObj(message, name, -1);
- Tcl_AppendToObj(message, "\"", 1);
- Tcl_SetObjResult(interp, message);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "unknown math function \"%s\"", name));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "MATHFUNC", name, NULL);
*numArgsPtr = -1;
*argTypesPtr = NULL;
diff --git a/generic/tclFileName.c b/generic/tclFileName.c
index 05ecb04..8ed6f96 100644
--- a/generic/tclFileName.c
+++ b/generic/tclFileName.c
@@ -1210,7 +1210,7 @@ Tcl_GlobObjCmd(
int index, i, globFlags, length, join, dir, result;
char *string;
const char *separators;
- Tcl_Obj *typePtr, *resultPtr, *look;
+ Tcl_Obj *typePtr, *look;
Tcl_Obj *pathOrDir = NULL;
Tcl_DString prefix;
static const char *const options[] = {
@@ -1497,8 +1497,8 @@ Tcl_GlobObjCmd(
} else {
Tcl_Obj *item;
- if ((Tcl_ListObjLength(NULL, look, &len) == TCL_OK) &&
- (len == 3)) {
+ if ((Tcl_ListObjLength(NULL, look, &len) == TCL_OK)
+ && (len == 3)) {
Tcl_ListObjIndex(interp, look, 0, &item);
if (!strcmp("macintosh", Tcl_GetString(item))) {
Tcl_ListObjIndex(interp, look, 1, &item);
@@ -1528,10 +1528,9 @@ Tcl_GlobObjCmd(
*/
badTypesArg:
- TclNewObj(resultPtr);
- Tcl_AppendToObj(resultPtr, "bad argument to \"-types\": ", -1);
- Tcl_AppendObjToObj(resultPtr, look);
- Tcl_SetObjResult(interp, resultPtr);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad argument to \"-types\": %s",
+ Tcl_GetString(look)));
Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "BAD", NULL);
result = TCL_ERROR;
join = 0;
@@ -1624,6 +1623,7 @@ Tcl_GlobObjCmd(
Tcl_AppendResult(interp, Tcl_DStringValue(&prefix), NULL);
} else {
const char *sep = "";
+
for (i = 0; i < objc; i++) {
string = Tcl_GetString(objv[i]);
Tcl_AppendResult(interp, sep, string, NULL);
diff --git a/generic/tclIO.c b/generic/tclIO.c
index c7fab6c..78c1dc0 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -2095,12 +2095,9 @@ Tcl_GetChannelHandle(
chanPtr = ((Channel *) chan)->state->bottomChanPtr;
if (!chanPtr->typePtr->getHandleProc) {
- Tcl_Obj *err;
-
- TclNewLiteralStringObj(err, "channel \"");
- Tcl_AppendToObj(err, Tcl_GetChannelName(chan), -1);
- Tcl_AppendToObj(err, "\" does not support OS handles", -1);
- Tcl_SetChannelError(chan, err);
+ Tcl_SetChannelError(chan, Tcl_ObjPrintf(
+ "channel \"%s\" does not support OS handles",
+ Tcl_GetChannelName(chan)));
return TCL_ERROR;
}
result = chanPtr->typePtr->getHandleProc(chanPtr->instanceData, direction,
diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c
index 683e2e4..9ba42ef 100644
--- a/generic/tclIORChan.c
+++ b/generic/tclIORChan.c
@@ -605,11 +605,9 @@ TclChanCreateObjCmd(
*/
if (Tcl_ListObjGetElements(NULL, resObj, &listc, &listv) != TCL_OK) {
- TclNewLiteralStringObj(err, "chan handler \"");
- Tcl_AppendObjToObj(err, cmdObj);
- Tcl_AppendToObj(err, " initialize\" returned non-list: ", -1);
- Tcl_AppendObjToObj(err, resObj);
- Tcl_SetObjResult(interp, err);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "chan handler \"%s initialize\" returned non-list: %s",
+ Tcl_GetString(cmdObj), Tcl_GetString(resObj)));
Tcl_DecrRefCount(resObj);
goto error;
}
@@ -633,42 +631,37 @@ TclChanCreateObjCmd(
Tcl_DecrRefCount(resObj);
if ((REQUIRED_METHODS & methods) != REQUIRED_METHODS) {
- TclNewLiteralStringObj(err, "chan handler \"");
- Tcl_AppendObjToObj(err, cmdObj);
- Tcl_AppendToObj(err, "\" does not support all required methods", -1);
- Tcl_SetObjResult(interp, err);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "chan handler \"%s\" does not support all required methods",
+ Tcl_GetString(cmdObj)));
goto error;
}
if ((mode & TCL_READABLE) && !HAS(methods, METH_READ)) {
- TclNewLiteralStringObj(err, "chan handler \"");
- Tcl_AppendObjToObj(err, cmdObj);
- Tcl_AppendToObj(err, "\" lacks a \"read\" method", -1);
- Tcl_SetObjResult(interp, err);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "chan handler \"%s\" lacks a \"read\" method",
+ Tcl_GetString(cmdObj)));
goto error;
}
if ((mode & TCL_WRITABLE) && !HAS(methods, METH_WRITE)) {
- TclNewLiteralStringObj(err, "chan handler \"");
- Tcl_AppendObjToObj(err, cmdObj);
- Tcl_AppendToObj(err, "\" lacks a \"write\" method", -1);
- Tcl_SetObjResult(interp, err);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "chan handler \"%s\" lacks a \"write\" method",
+ Tcl_GetString(cmdObj)));
goto error;
}
if (!IMPLIES(HAS(methods, METH_CGET), HAS(methods, METH_CGETALL))) {
- TclNewLiteralStringObj(err, "chan handler \"");
- Tcl_AppendObjToObj(err, cmdObj);
- Tcl_AppendToObj(err, "\" supports \"cget\" but not \"cgetall\"", -1);
- Tcl_SetObjResult(interp, err);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "chan handler \"%s\" supports \"cget\" but not \"cgetall\"",
+ Tcl_GetString(cmdObj)));
goto error;
}
if (!IMPLIES(HAS(methods, METH_CGETALL), HAS(methods, METH_CGET))) {
- TclNewLiteralStringObj(err, "chan handler \"");
- Tcl_AppendObjToObj(err, cmdObj);
- Tcl_AppendToObj(err, "\" supports \"cgetall\" but not \"cget\"", -1);
- Tcl_SetObjResult(interp, err);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "chan handler \"%s\" supports \"cgetall\" but not \"cget\"",
+ Tcl_GetString(cmdObj)));
goto error;
}
diff --git a/generic/tclIORTrans.c b/generic/tclIORTrans.c
index 5bd77b7..272306b 100644
--- a/generic/tclIORTrans.c
+++ b/generic/tclIORTrans.c
@@ -601,11 +601,9 @@ TclChanPushObjCmd(
*/
if (Tcl_ListObjGetElements(NULL, resObj, &listc, &listv) != TCL_OK) {
- TclNewLiteralStringObj(err, "chan handler \"");
- Tcl_AppendObjToObj(err, cmdObj);
- Tcl_AppendToObj(err, " initialize\" returned non-list: ", -1);
- Tcl_AppendObjToObj(err, resObj);
- Tcl_SetObjResult(interp, err);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "chan handler \"%s initialize\" returned non-list: %s",
+ Tcl_GetString(cmdObj), Tcl_GetString(resObj)));
Tcl_DecrRefCount(resObj);
goto error;
}
@@ -629,10 +627,9 @@ TclChanPushObjCmd(
Tcl_DecrRefCount(resObj);
if ((REQUIRED_METHODS & methods) != REQUIRED_METHODS) {
- TclNewLiteralStringObj(err, "chan handler \"");
- Tcl_AppendObjToObj(err, cmdObj);
- Tcl_AppendToObj(err, "\" does not support all required methods", -1);
- Tcl_SetObjResult(interp, err);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "chan handler \"%s\" does not support all required methods",
+ Tcl_GetString(cmdObj)));
goto error;
}
@@ -652,10 +649,9 @@ TclChanPushObjCmd(
}
if (!mode) {
- TclNewLiteralStringObj(err, "chan handler \"");
- Tcl_AppendObjToObj(err, cmdObj);
- Tcl_AppendToObj(err, "\" makes the channel inacessible", -1);
- Tcl_SetObjResult(interp, err);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "chan handler \"%s\" makes the channel inaccessible",
+ Tcl_GetString(cmdObj)));
goto error;
}
@@ -664,18 +660,16 @@ TclChanPushObjCmd(
*/
if (!IMPLIES(HAS(methods, METH_DRAIN), HAS(methods, METH_READ))) {
- TclNewLiteralStringObj(err, "chan handler \"");
- Tcl_AppendObjToObj(err, cmdObj);
- Tcl_AppendToObj(err, "\" supports \"drain\" but not \"read\"", -1);
- Tcl_SetObjResult(interp, err);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "chan handler \"%s\" supports \"drain\" but not \"read\"",
+ Tcl_GetString(cmdObj)));
goto error;
}
if (!IMPLIES(HAS(methods, METH_FLUSH), HAS(methods, METH_WRITE))) {
- TclNewLiteralStringObj(err, "chan handler \"");
- Tcl_AppendObjToObj(err, cmdObj);
- Tcl_AppendToObj(err, "\" supports \"flush\" but not \"write\"", -1);
- Tcl_SetObjResult(interp, err);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "chan handler \"%s\" supports \"flush\" but not \"write\"",
+ Tcl_GetString(cmdObj)));
goto error;
}
diff --git a/generic/tclIOSock.c b/generic/tclIOSock.c
index 768428f..aabd67d 100644
--- a/generic/tclIOSock.c
+++ b/generic/tclIOSock.c
@@ -178,14 +178,6 @@ TclCreateSocketAddress(
}
hints.ai_socktype = SOCK_STREAM;
-#if 0
- /*
- * We found some problems when using AI_ADDRCONFIG, e.g. on systems that
- * have no networking besides the loopback interface and want to resolve
- * localhost. See bugs 3385024, 3382419, 3382431. As the advantage of
- * using AI_ADDRCONFIG in situations where it works, is probably low,
- * we'll leave it out for now. After all, it is just an optimisation.
- */
#if defined(AI_ADDRCONFIG) && !defined(_AIX) && !defined(__hpux)
/*
* Missing on: OpenBSD, NetBSD.
@@ -193,7 +185,6 @@ TclCreateSocketAddress(
*/
hints.ai_flags |= AI_ADDRCONFIG;
#endif
-#endif
if (willBind) {
hints.ai_flags |= AI_PASSIVE;
}
diff --git a/generic/tclObj.c b/generic/tclObj.c
index a1316d9..099b67d 100644
--- a/generic/tclObj.c
+++ b/generic/tclObj.c
@@ -2763,12 +2763,9 @@ Tcl_GetLongFromObj(
#endif
if (objPtr->typePtr == &tclDoubleType) {
if (interp != NULL) {
- Tcl_Obj *msg;
-
- TclNewLiteralStringObj(msg, "expected integer but got \"");
- Tcl_AppendObjToObj(msg, objPtr);
- Tcl_AppendToObj(msg, "\"", -1);
- Tcl_SetObjResult(interp, msg);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "expected integer but got \"%s\"",
+ Tcl_GetString(objPtr)));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", NULL);
}
return TCL_ERROR;
@@ -3067,12 +3064,9 @@ Tcl_GetWideIntFromObj(
}
if (objPtr->typePtr == &tclDoubleType) {
if (interp != NULL) {
- Tcl_Obj *msg;
-
- TclNewLiteralStringObj(msg, "expected integer but got \"");
- Tcl_AppendObjToObj(msg, objPtr);
- Tcl_AppendToObj(msg, "\"", -1);
- Tcl_SetObjResult(interp, msg);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "expected integer but got \"%s\"",
+ Tcl_GetString(objPtr)));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", NULL);
}
return TCL_ERROR;
@@ -3401,12 +3395,9 @@ GetBignumFromObj(
#endif
if (objPtr->typePtr == &tclDoubleType) {
if (interp != NULL) {
- Tcl_Obj *msg;
-
- TclNewLiteralStringObj(msg, "expected integer but got \"");
- Tcl_AppendObjToObj(msg, objPtr);
- Tcl_AppendToObj(msg, "\"", -1);
- Tcl_SetObjResult(interp, msg);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "expected integer but got \"%s\"",
+ Tcl_GetString(objPtr)));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", NULL);
}
return TCL_ERROR;
diff --git a/generic/tclProc.c b/generic/tclProc.c
index 48f472f..50cf0f7 100644
--- a/generic/tclProc.c
+++ b/generic/tclProc.c
@@ -2480,7 +2480,7 @@ SetLambdaFromAny(
{
Interp *iPtr = (Interp *) interp;
const char *name;
- Tcl_Obj *argsPtr, *bodyPtr, *nsObjPtr, **objv, *errPtr;
+ Tcl_Obj *argsPtr, *bodyPtr, *nsObjPtr, **objv;
int objc, result;
Proc *procPtr;
@@ -2495,10 +2495,9 @@ SetLambdaFromAny(
result = TclListObjGetElements(NULL, objPtr, &objc, &objv);
if ((result != TCL_OK) || ((objc != 2) && (objc != 3))) {
- TclNewLiteralStringObj(errPtr, "can't interpret \"");
- Tcl_AppendObjToObj(errPtr, objPtr);
- Tcl_AppendToObj(errPtr, "\" as a lambda expression", -1);
- Tcl_SetObjResult(interp, errPtr);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't interpret \"%s\" as a lambda expression",
+ Tcl_GetString(objPtr)));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "LAMBDA", NULL);
return TCL_ERROR;
}
diff --git a/generic/tclStrToD.c b/generic/tclStrToD.c
index 15bff3e..8a961ff 100755
--- a/generic/tclStrToD.c
+++ b/generic/tclStrToD.c
@@ -1384,11 +1384,9 @@ TclParseNumber(
if (status != TCL_OK) {
if (interp != NULL) {
- Tcl_Obj *msg;
+ Tcl_Obj *msg = Tcl_ObjPrintf("expected %s but got \"",
+ expected);
- TclNewLiteralStringObj(msg, "expected ");
- Tcl_AppendToObj(msg, expected, -1);
- Tcl_AppendToObj(msg, " but got \"", -1);
Tcl_AppendLimitedToObj(msg, bytes, numBytes, 50, "");
Tcl_AppendToObj(msg, "\"", -1);
if (state == BAD_OCTAL) {
diff --git a/generic/tclVar.c b/generic/tclVar.c
index 55c031c..62bf1c4 100644
--- a/generic/tclVar.c
+++ b/generic/tclVar.c
@@ -1826,6 +1826,7 @@ TclPtrSetVar(
Tcl_Obj *oldValuePtr;
Tcl_Obj *resultPtr = NULL;
int result;
+ int cleanupOnEarlyError = (newValuePtr->refCount == 0);
/*
* If the variable is in a hashtable and its hPtr field is NULL, then we
@@ -1997,7 +1998,7 @@ TclPtrSetVar(
return resultPtr;
earlyError:
- if (newValuePtr->refCount == 0) {
+ if (cleanupOnEarlyError) {
Tcl_DecrRefCount(newValuePtr);
}
goto cleanup;
diff --git a/generic/tclZlib.c b/generic/tclZlib.c
index 3ddc3fb..922ec18 100644
--- a/generic/tclZlib.c
+++ b/generic/tclZlib.c
@@ -2253,7 +2253,16 @@ ZlibTransformClose(
ZlibChannelData *cd = instanceData;
int e, result = TCL_OK;
+ /*
+ * Delete the support timer.
+ */
+
ZlibTransformTimerKill(cd);
+
+ /*
+ * Flush any data waiting to be compressed.
+ */
+
if (cd->mode == TCL_ZLIB_STREAM_DEFLATE) {
cd->outStream.avail_in = 0;
do {
@@ -2286,11 +2295,15 @@ ZlibTransformClose(
}
}
} while (e != Z_STREAM_END);
- e = deflateEnd(&cd->inStream);
+ e = deflateEnd(&cd->outStream);
} else {
- e = inflateEnd(&cd->outStream);
+ e = inflateEnd(&cd->inStream);
}
+ /*
+ * Release all memory.
+ */
+
if (cd->inBuffer) {
ckfree(cd->inBuffer);
cd->inBuffer = NULL;
@@ -2299,6 +2312,7 @@ ZlibTransformClose(
ckfree(cd->outBuffer);
cd->outBuffer = NULL;
}
+ ckfree(cd);
return result;
}
generated by cgit v0.12 at 2024-11-17 20:43:56 (GMT)