merge trunk

4 files changed, 70 insertions, 38 deletions

diff --git a/generic/tclDisassemble.c b/generic/tclDisassemble.c
index 0433bea..9e7edc9 100644
--- a/generic/tclDisassemble.c
+++ b/generic/tclDisassemble.c
@@ -27,9 +27,8 @@ static Tcl_Obj *	DisassembleByteCodeObj(Tcl_Interp *interp,
 			    Tcl_Obj *objPtr);
 static int		FormatInstruction(ByteCode *codePtr,
 			    const unsigned char *pc, Tcl_Obj *bufferObj);
-static void		GetLocationInformation(Tcl_Interp *interp,
-			    Proc *procPtr, Tcl_Obj **fileObjPtr,
-			    int *linePtr);
+static void		GetLocationInformation(Proc *procPtr,
+			    Tcl_Obj **fileObjPtr, int *linePtr);
 static void		PrintSourceToObj(Tcl_Obj *appendObj,
 			    const char *stringPtr, int maxChars);
 static void		UpdateStringOfInstName(Tcl_Obj *objPtr);
@@ -82,8 +81,6 @@ static const Tcl_ObjType instNameType = {
 
 static void
 GetLocationInformation(
-    Tcl_Interp *interp,		/* Where to look up the location
-				 * information. */
     Proc *procPtr,		/* What to look up the information for. */
     Tcl_Obj **fileObjPtr,	/* Where to write the information about what
 				 * file the code came from. Will be written
@@ -97,20 +94,21 @@ GetLocationInformation(
 				 * either with the line number or with -1 if
 				 * the information is not available. */
 {
-    Interp *iPtr = (Interp *) interp;
-    Tcl_HashEntry *hePtr;
-    CmdFrame *cfPtr;
+    CmdFrame *cfPtr = TclGetCmdFrameForProcedure(procPtr);
 
     *fileObjPtr = NULL;
     *linePtr = -1;
-    if (iPtr != NULL && procPtr != NULL) {
-	hePtr = Tcl_FindHashEntry(iPtr->linePBodyPtr, procPtr);
-	if (hePtr != NULL && (cfPtr = Tcl_GetHashValue(hePtr)) != NULL) {
-	    *linePtr = cfPtr->line[0];
-	    if (cfPtr->type == TCL_LOCATION_SOURCE) {
-		*fileObjPtr = cfPtr->data.eval.path;
-	    }
-	}
+    if (cfPtr == NULL) {
+	return;
+    }
+
+    /*
+     * Get the source location data out of the CmdFrame.
+     */
+
+    *linePtr = cfPtr->line[0];
+    if (cfPtr->type == TCL_LOCATION_SOURCE) {
+	*fileObjPtr = cfPtr->data.eval.path;
     }
 }
 
@@ -288,7 +286,7 @@ DisassembleByteCodeObj(
     Tcl_AppendToObj(bufferObj, "  Source ", -1);
     PrintSourceToObj(bufferObj, codePtr->source,
 	    TclMin(codePtr->numSrcBytes, 55));
-    GetLocationInformation(interp, codePtr->procPtr, &fileObj, &line);
+    GetLocationInformation(codePtr->procPtr, &fileObj, &line);
     if (line > -1 && fileObj != NULL) {
 	Tcl_AppendPrintfToObj(bufferObj, "\n  File \"%s\" Line %d",
 		Tcl_GetString(fileObj), line);
@@ -1233,7 +1231,7 @@ DisassembleByteCodeAsDicts(
      * system if it is available.
      */
 
-    GetLocationInformation(interp, codePtr->procPtr, &file, &line);
+    GetLocationInformation(codePtr->procPtr, &file, &line);
 
     /*
      * Build the overall result.
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 3e4ee8c..a67dddd 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -2971,7 +2971,8 @@ MODULE_SCOPE Tcl_Obj *	TclGetBgErrorHandler(Tcl_Interp *interp);
 MODULE_SCOPE int	TclGetChannelFromObj(Tcl_Interp *interp,
 			    Tcl_Obj *objPtr, Tcl_Channel *chanPtr,
 			    int *modePtr, int flags);
-MODULE_SCOPE int TclGetCompletionCodeFromObj(Tcl_Interp *interp,
+MODULE_SCOPE CmdFrame *	TclGetCmdFrameForProcedure(Proc *procPtr);
+MODULE_SCOPE int	TclGetCompletionCodeFromObj(Tcl_Interp *interp,
 			    Tcl_Obj *value, int *code);
 MODULE_SCOPE Proc *	TclGetLambdaFromObj(Tcl_Interp *interp,
 			    Tcl_Obj *objPtr, Tcl_Obj **nsObjPtrPtr);
@@ -3970,7 +3971,7 @@ MODULE_SCOPE int	TclCompileAssembleCmd(Tcl_Interp *interp,
 			    struct CompileEnv *envPtr);
 
 /*
- * Functions defined in generic/tclVar.c and currenttly exported only for use
+ * Functions defined in generic/tclVar.c and currently exported only for use
  * by the bytecode compiler and engine. Some of these could later be placed in
  * the public interface.
  */
diff --git a/generic/tclProc.c b/generic/tclProc.c
index 96f2167..1679a09 100644
--- a/generic/tclProc.c
+++ b/generic/tclProc.c
@@ -2807,6 +2807,41 @@ MakeLambdaError(
 }
 
 /*
+ *----------------------------------------------------------------------
+ *
+ * TclGetCmdFrameForProcedure --
+ *
+ *	How to get the CmdFrame information for a procedure.
+ *
+ * Results:
+ *	A pointer to the CmdFrame (only guaranteed to be valid until the next
+ *	Tcl command is processed or the interpreter's state is otherwise
+ *	modified) or a NULL if the information is not available.
+ *
+ * Side effects:
+ *	none.
+ *
+ *----------------------------------------------------------------------
+ */
+
+CmdFrame *
+TclGetCmdFrameForProcedure(
+    Proc *procPtr)		/* The procedure whose cmd-frame is to be
+				 * looked up. */
+{
+    Tcl_HashEntry *hePtr;
+
+    if (procPtr == NULL || procPtr->iPtr == NULL) {
+	return NULL;
+    }
+    hePtr = Tcl_FindHashEntry(procPtr->iPtr->linePBodyPtr, procPtr);
+    if (hePtr == NULL) {
+	return NULL;
+    }
+    return (CmdFrame *) Tcl_GetHashValue(hePtr);
+}
+
+/*
  * Local Variables:
  * mode: c
  * c-basic-offset: 4
diff --git a/generic/tclZlib.c b/generic/tclZlib.c
index 96b8318..33eebd1 100644
--- a/generic/tclZlib.c
+++ b/generic/tclZlib.c
@@ -3113,30 +3113,28 @@ ZlibTransformOutput(
 		errorCodePtr);
     }
 
+    /*
+     * No zero-length writes. Flushes must be explicit.
+     */
+
+    if (toWrite == 0) {
+	return 0;
+    }
+
     cd->outStream.next_in = (Bytef *) buf;
     cd->outStream.avail_in = toWrite;
-    do {
+    while (cd->outStream.avail_in > 0) {
 	e = Deflate(&cd->outStream, cd->outBuffer, cd->outAllocated,
 		Z_NO_FLUSH, &produced);
+	if (e != Z_OK || produced == 0) {
+	    break;
+	}
 
-	if ((e == Z_OK && produced > 0) || e == Z_BUF_ERROR) {
-	    /*
-	     * deflate() indicates that it is out of space by returning
-	     * Z_BUF_ERROR *or* by simply returning Z_OK with no remaining
-	     * space; in either case, we must write the whole buffer out and
-	     * retry to compress what is left.
-	     */
-
-	    if (e == Z_BUF_ERROR) {
-		produced = cd->outAllocated;
-		e = Z_OK;
-	    }
-	    if (Tcl_WriteRaw(cd->parent, cd->outBuffer, produced) < 0) {
-		*errorCodePtr = Tcl_GetErrno();
-		return -1;
-	    }
+	if (Tcl_WriteRaw(cd->parent, cd->outBuffer, produced) < 0) {
+	    *errorCodePtr = Tcl_GetErrno();
+	    return -1;
 	}
-    } while (e == Z_OK && produced > 0 && cd->outStream.avail_in > 0);
+    }
 
     if (e == Z_OK) {
 	return toWrite - cd->outStream.avail_in;