merge 8.5

Although it fixed the bug demonstrated by the test io-33.12, it caused new
breakage in [gets] not yet understood.  Test io-33.12 left in place to
prompt further work.

doc/TraceCmd.3

@@ -86,11 +86,14 @@ operation is being performed on the command.  The bit
 \fBTCL_TRACE_DESTROYED\fR will be set in \fIflags\fR if the trace is about
 to be destroyed; this information may be useful to \fIproc\fR so that
 it can clean up its own internal data structures (see the section
-\fBTCL_TRACE_DESTROYED\fR below for more details).  Lastly, the bit
-\fBTCL_INTERP_DESTROYED\fR will be set if the entire interpreter is being
-destroyed.  When this bit is set, \fIproc\fR must be especially
-careful in the things it does (see the section \fBTCL_INTERP_DESTROYED\fR
-below).
+\fBTCL_TRACE_DESTROYED\fR below for more details).  Because the
+deletion of commands can take place as part of the deletion of the interp
+that contains them, \fIproc\fR must be careful about checking what
+the passed in \fIinterp\fR value can be called upon to do.
+The routine \fBTcl_InterpDeleted\fR is an important tool for this.
+When \fBTcl_InterpDeleted\fR returns 1, \fIproc\fR will not be able
+to invoke any scripts in \fIinterp\fR.  The function of \fIproc\fR
+in that circumstance is limited to the cleanup of its own data structures.
 .PP
 \fBTcl_UntraceCommand\fR may be used to remove a trace.  If the
 command specified by \fIinterp\fR, \fIcmdName\fR, and \fIflags\fR has
@@ -123,7 +126,8 @@ traces for a given command that have the same \fIproc\fR.
 .PP
 During rename traces, the command being renamed is visible with both
 names simultaneously, and the command still exists during delete
-traces (if \fBTCL_INTERP_DESTROYED\fR is not set).  However, there is no
+traces, unless the interp that contains it is being deleted.
+However, there is no
 mechanism for signaling that an error occurred in a trace procedure,
 so great care should be taken that errors do not get silently lost.
 .SH "MULTIPLE TRACES"
@@ -142,22 +146,5 @@ rename the command, the last renaming takes precedence.
 In a delete callback to \fIproc\fR, the \fBTCL_TRACE_DESTROYED\fR bit
 is set in \fIflags\fR.
 .\" Perhaps need some more comments here? - DKF
-.SH "TCL_INTERP_DESTROYED"
-.PP
-When an interpreter is destroyed, unset traces are called for
-all of its commands.
-The \fBTCL_INTERP_DESTROYED\fR bit will be set in the \fIflags\fR
-argument passed to the trace procedures.
-Trace procedures must be extremely careful in what they do if
-the \fBTCL_INTERP_DESTROYED\fR bit is set.
-It is not safe for the procedures to invoke any Tcl procedures
-on the interpreter, since its state is partially deleted.
-All that trace procedures should do under these circumstances is
-to clean up and free their own internal data structures.
-.SH BUGS
-.PP
-Tcl does not do any error checking to prevent trace procedures
-from misusing the interpreter during traces with \fBTCL_INTERP_DESTROYED\fR
-set.
 .SH KEYWORDS
 clientData, trace, command

generic/tclAlloc.c

@@ -31,7 +31,7 @@
  * until Tcl uses config.h properly.
  */
 
-#if defined(_MSC_VER) || defined(__MINGW32__) || defined(__BORLANDC__)
+#if defined(_MSC_VER) || defined(__MSVCRT__) || defined(__BORLANDC__)
 typedef unsigned long caddr_t;
 #endif
 

generic/tclCompCmds.c

@@ -301,7 +301,8 @@ TclCompileArraySetCmd(
      * a proc, we cannot do a better compile than generic.
      */
 
-    if (envPtr->procPtr == NULL && !(isDataEven && len == 0)) {
+    if ((varTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) ||
+	    (envPtr->procPtr == NULL && !(isDataEven && len == 0))) {
 	code = TclCompileBasic2ArgCmd(interp, parsePtr, cmdPtr, envPtr);
 	goto done;
     }
@@ -342,8 +343,9 @@ TclCompileArraySetCmd(
 	 * a non-local variable: upvar from a local one! This consumes the
 	 * variable name that was left at stacktop.
 	 */
-	
-	localIndex = AnonymousLocal(envPtr);
+
+	localIndex = TclFindCompiledLocal(varTokenPtr->start,
+		varTokenPtr->size, 1, envPtr);
 	PushStringLiteral(envPtr, "0");
 	TclEmitInstInt4(INST_REVERSE, 2,        		envPtr);
 	TclEmitInstInt4(INST_UPVAR, localIndex, 		envPtr);
@@ -2401,7 +2403,6 @@ TclCompileForCmd(
 
     SetLineInformation(2);
     TclCompileExprWords(interp, testTokenPtr, 1, envPtr);
-    TclClearNumConversion(envPtr);
 
     jumpDist = CurrentOffset(envPtr) - bodyCodeOffset;
     if (jumpDist > 127) {

generic/tclCompCmdsGR.c

@@ -281,7 +281,6 @@ TclCompileIfCmd(
 		SetLineInformation(wordIdx);
 		Tcl_ResetResult(interp);
 		TclCompileExprWords(interp, testTokenPtr, 1, envPtr);
-		TclClearNumConversion(envPtr);
 		if (jumpFalseFixupArray.next >= jumpFalseFixupArray.end) {
 		    TclExpandJumpFixupArray(&jumpFalseFixupArray);
 		}
@@ -531,7 +530,6 @@ TclCompileIncrCmd(
 	} else {
 	    SetLineInformation(2);
 	    CompileTokens(envPtr, incrTokenPtr, interp);
-	    TclClearNumConversion(envPtr);
 	}
     } else {			/* No incr amount given so use 1. */
 	haveImmValue = 1;

generic/tclCompCmdsSZ.c

@@ -322,8 +322,8 @@ TclCompileStringCatCmd(
 	    CompileWord(envPtr, wordTokenPtr, interp, i);
 	    numArgs ++;
 	    if (numArgs >= 254) { /* 254 to take care of the possible +1 of "folded" above */
-		TclEmitInstInt1(INST_STR_CONCAT1, 254, envPtr);
-		numArgs -= 253;	/* concat pushes 1 obj, the result */
+		TclEmitInstInt1(INST_STR_CONCAT1, numArgs, envPtr);
+		numArgs = 1;	/* concat pushes 1 obj, the result */
 	    }
 	}
 	wordTokenPtr = TokenAfter(wordTokenPtr);
@@ -3782,7 +3782,6 @@ TclCompileWhileCmd(
 	}
 	SetLineInformation(1);
 	TclCompileExprWords(interp, testTokenPtr, 1, envPtr);
-	TclClearNumConversion(envPtr);
 
 	jumpDist = CurrentOffset(envPtr) - bodyCodeOffset;
 	if (jumpDist > 127) {

generic/tclCompile.h

@@ -1413,18 +1413,6 @@ MODULE_SCOPE int	TclPushProcCallFrame(ClientData clientData,
 	}							 \
     } while (0)
 
-/*
- * If the expr compiler finished with TRY_CONVERT, macro to remove it when the
- * job is done by the following instruction.
- */
-
-#define TclClearNumConversion(envPtr) \
-    do {								\
-	if (*(envPtr->codeNext - 1) == INST_TRY_CVT_TO_NUMERIC) {	\
-	    envPtr->codeNext--;						\
-	}								\
-    } while (0)
-
 /*
  * Macros to update a (signed or unsigned) integer starting at a pointer. The
  * two variants depend on the number of bytes. The ANSI C "prototypes" for

generic/tclIO.c

@@ -3894,7 +3894,10 @@ Tcl_Write(
     if (srcLen < 0) {
 	srcLen = strlen(src);
     }
-    return WriteBytes(chanPtr, src, srcLen);
+    if (WriteBytes(chanPtr, src, srcLen) < 0) {
+	return -1;
+    }
+    return srcLen;
 }
 
 /*
@@ -4798,6 +4801,7 @@ TclGetsObjBinary(
 
     eolChar = (statePtr->inputTranslation == TCL_TRANSLATE_LF) ? '\n' : '\r';
 
+    ResetFlag(statePtr, CHANNEL_BLOCKED);
     while (1) {
 	/*
 	 * Subtract the number of bytes that were removed from channel
@@ -6046,12 +6050,11 @@ ReadChars(
 	    /* 
 	     * We read more chars than allowed.  Reset limits to
 	     * prevent that and try again.  Don't forget the extra
-	     * padding of TCL_UTF_MAX - 1 bytes demanded by the
+	     * padding of TCL_UTF_MAX bytes demanded by the
 	     * Tcl_ExternalToUtf() call!
 	     */
 
-	    dstLimit = Tcl_UtfAtIndex(dst, charsToRead + 1) 
-		    + TCL_UTF_MAX - 1 - dst;
+	    dstLimit = Tcl_UtfAtIndex(dst, charsToRead) + TCL_UTF_MAX - dst;
 	    statePtr->flags = savedFlags;
 	    statePtr->inputEncodingFlags = savedIEFlags;
 	    statePtr->inputEncodingState = savedState;
@@ -9021,7 +9024,7 @@ MBRead(
     }
 
     code = GetInput(inStatePtr->topChanPtr);
-    if (code == 0) {
+    if (code == 0 || GotFlag(inStatePtr, CHANNEL_BLOCKED)) {
 	return TCL_OK;
     } else {
 	MBError(csPtr, TCL_READABLE, code);
@@ -9271,6 +9274,10 @@ CopyData(
 			csPtr);
 	    }
 	    if (size == 0) {
+		if (!GotFlag(inStatePtr, CHANNEL_NONBLOCKING)) {
+		    /* We allowed a short read.  Keep trying. */
+		    continue;
+		}
 		if (bufObj != NULL) {
 		    TclDecrRefCount(bufObj);
 		    bufObj = NULL;
@@ -9503,21 +9510,39 @@ DoRead(
 	}
 
 	/*
-	 * If there is not enough data in the buffers to possibly
-	 * complete the read, then go get more.
+	 * Don't read more data if we have what we need. 
 	 */
 
-	if (bufPtr == NULL || BytesLeft(bufPtr) < bytesToRead) {
+	while (!bufPtr ||			/* We got no buffer!   OR */
+		(!IsBufferFull(bufPtr) && 	/* Our buffer has room AND */
+		(BytesLeft(bufPtr) < bytesToRead) ) ) {
+						/* Not enough bytes in it 
+						 * yet to fill the dst */
+	    int code;
+
 	moreData:
-	    if (GetInput(chanPtr)) {
+	    code = GetInput(chanPtr);
+	    bufPtr = statePtr->inQueueHead;
+
+	    assert (bufPtr != NULL);
+
+	    if (GotFlag(statePtr, CHANNEL_EOF|CHANNEL_BLOCKED)) {
+		/* Further reads cannot do any more */
+		break;
+	    }
+
+	    if (code) {
 		/* Read error */
 		UpdateInterest(chanPtr);
 		TclChannelRelease((Tcl_Channel)chanPtr);
 		return -1;
 	    }
-	    bufPtr = statePtr->inQueueHead;
+
+	    assert (IsBufferFull(bufPtr));
 	}
 
+	assert (bufPtr != NULL);
+
 	bytesRead = BytesLeft(bufPtr);
 	bytesWritten = bytesToRead;
 

generic/tclInt.h

@@ -1741,7 +1741,7 @@ enum PkgPreferOptions {
  * definition there.
  * Some macros require knowledge of some fields in the struct in order to
  * avoid hitting the TSD unnecessarily. In order to facilitate this, a pointer
- * to the relevant fields is kept in the objCache field in struct Interp.
+ * to the relevant fields is kept in the allocCache field in struct Interp.
  *----------------------------------------------------------------
  */
 

generic/tclStubLibTbl.c

@@ -0,0 +1,58 @@
+/*
+ * tclStubLibTbl.c --
+ *
+ *	Stub object that will be statically linked into extensions that want
+ *	to access Tcl.
+ *
+ * Copyright (c) 1998-1999 by Scriptics Corporation.
+ * Copyright (c) 1998 Paul Duffin.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#include "tclInt.h"
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclInitStubTable --
+ *
+ *	Initialize the stub table, using the structure pointed at
+ *	by the "version" argument.
+ *
+ * Results:
+ *	Outputs the value of the "version" argument.
+ *
+ * Side effects:
+ *	Sets the stub table pointers.
+ *
+ *----------------------------------------------------------------------
+ */
+MODULE_SCOPE const char *
+TclInitStubTable(
+	const char *version) /* points to the version field of a
+	                        TclStubInfoType structure variable. */
+{
+    tclStubsPtr = ((const TclStubInfoType *) version)->stubs;
+
+    if (tclStubsPtr->hooks) {
+	tclPlatStubsPtr = tclStubsPtr->hooks->tclPlatStubs;
+	tclIntStubsPtr = tclStubsPtr->hooks->tclIntStubs;
+	tclIntPlatStubsPtr = tclStubsPtr->hooks->tclIntPlatStubs;
+    } else {
+	tclPlatStubsPtr = NULL;
+	tclIntStubsPtr = NULL;
+	tclIntPlatStubsPtr = NULL;
+    }
+
+    return version;
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */

generic/tclTrace.c

@@ -2511,6 +2511,9 @@ TclObjCallVarTraces(
     if (!part1Ptr) {
 	part1Ptr = localName(iPtr->varFramePtr, index);
     }
+    if (!part1Ptr) {
+	Tcl_Panic("Cannot trace a variable with no name");
+    }
     part1 = TclGetString(part1Ptr);
     part2 = part2Ptr? TclGetString(part2Ptr) : NULL;