1 files changed, 254 insertions, 192 deletions

diff --git a/generic/tclTimer.c b/generic/tclTimer.c
index ce07825..c10986a 100644
--- a/generic/tclTimer.c
+++ b/generic/tclTimer.c
@@ -8,8 +8,6 @@
  *
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclTimer.c,v 1.17 2005/07/24 22:56:44 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -74,7 +72,7 @@ typedef struct AfterAssocData {
  */
 
 typedef struct IdleHandler {
-    Tcl_IdleProc (*proc);	/* Function to call. */
+    Tcl_IdleProc *proc;		/* Function to call. */
     ClientData clientData;	/* Value to pass to proc. */
     int generation;		/* Used to distinguish older handlers from
 				 * recently-created ones. */
@@ -126,28 +124,44 @@ static Tcl_ThreadDataKey dataKey;
     (((t1).sec<(t2).sec) || ((t1).sec==(t2).sec && (t1).usec<(t2).usec))
 
 #define TCL_TIME_DIFF_MS(t1, t2) \
-    (1000*((long)(t1).sec - (long)(t2).sec) + \
+    (1000*((Tcl_WideInt)(t1).sec - (Tcl_WideInt)(t2).sec) + \
 	    ((long)(t1).usec - (long)(t2).usec)/1000)
 
+#define TCL_TIME_DIFF_MS_CEILING(t1, t2) \
+    (1000*((Tcl_WideInt)(t1).sec - (Tcl_WideInt)(t2).sec) + \
+	    ((long)(t1).usec - (long)(t2).usec + 999)/1000)
+
+/*
+ * Sleeps under that number of milliseconds don't get double-checked
+ * and are done in exactly one Tcl_Sleep(). This to limit gettimeofday()s.
+ */
+
+#define SLEEP_OFFLOAD_GETTIMEOFDAY 20
+
+/*
+ * The maximum number of milliseconds for each Tcl_Sleep call in AfterDelay.
+ * This is used to limit the maximum lag between interp limit and script
+ * cancellation checks.
+ */
+
+#define TCL_TIME_MAXIMUM_SLICE 500
+
 /*
  * Prototypes for functions referenced only in this file:
  */
 
-static void		AfterCleanupProc _ANSI_ARGS_((ClientData clientData,
-			    Tcl_Interp *interp));
-static int		AfterDelay _ANSI_ARGS_((Tcl_Interp *interp, int ms));
-static void		AfterProc _ANSI_ARGS_((ClientData clientData));
-static void		FreeAfterPtr _ANSI_ARGS_((AfterInfo *afterPtr));
-static AfterInfo *	GetAfterEvent _ANSI_ARGS_((AfterAssocData *assocPtr,
-			    Tcl_Obj *commandPtr));
-static ThreadSpecificData *InitTimer _ANSI_ARGS_((void));
-static void		TimerExitProc _ANSI_ARGS_((ClientData clientData));
-static int		TimerHandlerEventProc _ANSI_ARGS_((Tcl_Event *evPtr,
-			    int flags));
-static void		TimerCheckProc _ANSI_ARGS_((ClientData clientData,
-			    int flags));
-static void		TimerSetupProc _ANSI_ARGS_((ClientData clientData,
-			    int flags));
+static void		AfterCleanupProc(ClientData clientData,
+			    Tcl_Interp *interp);
+static int		AfterDelay(Tcl_Interp *interp, Tcl_WideInt ms);
+static void		AfterProc(ClientData clientData);
+static void		FreeAfterPtr(AfterInfo *afterPtr);
+static AfterInfo *	GetAfterEvent(AfterAssocData *assocPtr,
+			    Tcl_Obj *commandPtr);
+static ThreadSpecificData *InitTimer(void);
+static void		TimerExitProc(ClientData clientData);
+static int		TimerHandlerEventProc(Tcl_Event *evPtr, int flags);
+static void		TimerCheckProc(ClientData clientData, int flags);
+static void		TimerSetupProc(ClientData clientData, int flags);
 
 /*
  *----------------------------------------------------------------------
@@ -166,10 +180,9 @@ static void		TimerSetupProc _ANSI_ARGS_((ClientData clientData,
  */
 
 static ThreadSpecificData *
-InitTimer()
+InitTimer(void)
 {
-    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
-	    TclThreadDataKeyGet(&dataKey);
+    ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
 
     if (tsdPtr == NULL) {
 	tsdPtr = TCL_TSD_INIT(&dataKey);
@@ -197,11 +210,10 @@ InitTimer()
  */
 
 static void
-TimerExitProc(clientData)
-    ClientData clientData;	/* Not used. */
+TimerExitProc(
+    ClientData clientData)	/* Not used. */
 {
-    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
-	    TclThreadDataKeyGet(&dataKey);
+    ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
 
     Tcl_DeleteEventSource(TimerSetupProc, TimerCheckProc, NULL);
     if (tsdPtr != NULL) {
@@ -210,7 +222,7 @@ TimerExitProc(clientData)
 	timerHandlerPtr = tsdPtr->firstTimerHandlerPtr;
 	while (timerHandlerPtr != NULL) {
 	    tsdPtr->firstTimerHandlerPtr = timerHandlerPtr->nextPtr;
-	    ckfree((char *) timerHandlerPtr);
+	    ckfree(timerHandlerPtr);
 	    timerHandlerPtr = tsdPtr->firstTimerHandlerPtr;
 	}
     }
@@ -235,11 +247,11 @@ TimerExitProc(clientData)
  */
 
 Tcl_TimerToken
-Tcl_CreateTimerHandler(milliseconds, proc, clientData)
-    int milliseconds;		/* How many milliseconds to wait before
+Tcl_CreateTimerHandler(
+    int milliseconds,		/* How many milliseconds to wait before
 				 * invoking proc. */
-    Tcl_TimerProc *proc;	/* Function to invoke. */
-    ClientData clientData;	/* Arbitrary data to pass to proc. */
+    Tcl_TimerProc *proc,	/* Function to invoke. */
+    ClientData clientData)	/* Arbitrary data to pass to proc. */
 {
     Tcl_Time time;
 
@@ -277,26 +289,25 @@ Tcl_CreateTimerHandler(milliseconds, proc, clientData)
  */
 
 Tcl_TimerToken
-TclCreateAbsoluteTimerHandler(timePtr, proc, clientData)
-    Tcl_Time *timePtr;
-    Tcl_TimerProc *proc;
-    ClientData clientData;
+TclCreateAbsoluteTimerHandler(
+    Tcl_Time *timePtr,
+    Tcl_TimerProc *proc,
+    ClientData clientData)
 {
     register TimerHandler *timerHandlerPtr, *tPtr2, *prevPtr;
-    ThreadSpecificData *tsdPtr;
+    ThreadSpecificData *tsdPtr = InitTimer();
 
-    tsdPtr = InitTimer();
-    timerHandlerPtr = (TimerHandler *) ckalloc(sizeof(TimerHandler));
+    timerHandlerPtr = ckalloc(sizeof(TimerHandler));
 
     /*
      * Fill in fields for the event.
      */
 
-    memcpy((void *)&timerHandlerPtr->time, (void *)timePtr, sizeof(Tcl_Time));
+    memcpy(&timerHandlerPtr->time, timePtr, sizeof(Tcl_Time));
     timerHandlerPtr->proc = proc;
     timerHandlerPtr->clientData = clientData;
     tsdPtr->lastTimerId++;
-    timerHandlerPtr->token = (Tcl_TimerToken) tsdPtr->lastTimerId;
+    timerHandlerPtr->token = (Tcl_TimerToken) INT2PTR(tsdPtr->lastTimerId);
 
     /*
      * Add the event to the queue in the correct position
@@ -340,14 +351,17 @@ TclCreateAbsoluteTimerHandler(timePtr, proc, clientData)
  */
 
 void
-Tcl_DeleteTimerHandler(token)
-    Tcl_TimerToken token;	/* Result previously returned by
+Tcl_DeleteTimerHandler(
+    Tcl_TimerToken token)	/* Result previously returned by
 				 * Tcl_DeleteTimerHandler. */
 {
     register TimerHandler *timerHandlerPtr, *prevPtr;
-    ThreadSpecificData *tsdPtr;
+    ThreadSpecificData *tsdPtr = InitTimer();
+
+    if (token == NULL) {
+	return;
+    }
 
-    tsdPtr = InitTimer();
     for (timerHandlerPtr = tsdPtr->firstTimerHandlerPtr, prevPtr = NULL;
 	    timerHandlerPtr != NULL; prevPtr = timerHandlerPtr,
 	    timerHandlerPtr = timerHandlerPtr->nextPtr) {
@@ -359,7 +373,7 @@ Tcl_DeleteTimerHandler(token)
 	} else {
 	    prevPtr->nextPtr = timerHandlerPtr->nextPtr;
 	}
-	ckfree((char *) timerHandlerPtr);
+	ckfree(timerHandlerPtr);
 	return;
     }
 }
@@ -383,9 +397,9 @@ Tcl_DeleteTimerHandler(token)
  */
 
 static void
-TimerSetupProc(data, flags)
-    ClientData data;		/* Not used. */
-    int flags;			/* Event flags as passed to Tcl_DoOneEvent. */
+TimerSetupProc(
+    ClientData data,		/* Not used. */
+    int flags)			/* Event flags as passed to Tcl_DoOneEvent. */
 {
     Tcl_Time blockTime;
     ThreadSpecificData *tsdPtr = InitTimer();
@@ -398,7 +412,6 @@ TimerSetupProc(data, flags)
 
 	blockTime.sec = 0;
 	blockTime.usec = 0;
-
     } else if ((flags & TCL_TIMER_EVENTS) && tsdPtr->firstTimerHandlerPtr) {
 	/*
 	 * Compute the timeout for the next timer on the list.
@@ -442,9 +455,9 @@ TimerSetupProc(data, flags)
  */
 
 static void
-TimerCheckProc(data, flags)
-    ClientData data;		/* Not used. */
-    int flags;			/* Event flags as passed to Tcl_DoOneEvent. */
+TimerCheckProc(
+    ClientData data,		/* Not used. */
+    int flags)			/* Event flags as passed to Tcl_DoOneEvent. */
 {
     Tcl_Event *timerEvPtr;
     Tcl_Time blockTime;
@@ -475,7 +488,7 @@ TimerCheckProc(data, flags)
 	if (blockTime.sec == 0 && blockTime.usec == 0 &&
 		!tsdPtr->timerPending) {
 	    tsdPtr->timerPending = 1;
-	    timerEvPtr = (Tcl_Event *) ckalloc(sizeof(Tcl_Event));
+	    timerEvPtr = ckalloc(sizeof(Tcl_Event));
 	    timerEvPtr->proc = TimerHandlerEventProc;
 	    Tcl_QueueEvent(timerEvPtr, TCL_QUEUE_TAIL);
 	}
@@ -504,9 +517,9 @@ TimerCheckProc(data, flags)
  */
 
 static int
-TimerHandlerEventProc(evPtr, flags)
-    Tcl_Event *evPtr;		/* Event to service. */
-    int flags;			/* Flags that indicate what events to handle,
+TimerHandlerEventProc(
+    Tcl_Event *evPtr,		/* Event to service. */
+    int flags)			/* Flags that indicate what events to handle,
 				 * such as TCL_FILE_EVENTS. */
 {
     TimerHandler *timerHandlerPtr, **nextPtrPtr;
@@ -567,7 +580,7 @@ TimerHandlerEventProc(evPtr, flags)
 	 * Bail out if the next timer is of a newer generation.
 	 */
 
-	if ((currentTimerId - (int)timerHandlerPtr->token) < 0) {
+	if ((currentTimerId - PTR2INT(timerHandlerPtr->token)) < 0) {
 	    break;
 	}
 
@@ -576,9 +589,9 @@ TimerHandlerEventProc(evPtr, flags)
 	 * potential reentrancy problems.
 	 */
 
-	(*nextPtrPtr) = timerHandlerPtr->nextPtr;
-	(*timerHandlerPtr->proc)(timerHandlerPtr->clientData);
-	ckfree((char *) timerHandlerPtr);
+	*nextPtrPtr = timerHandlerPtr->nextPtr;
+	timerHandlerPtr->proc(timerHandlerPtr->clientData);
+	ckfree(timerHandlerPtr);
     }
     TimerSetupProc(NULL, TCL_TIMER_EVENTS);
     return 1;
@@ -604,15 +617,15 @@ TimerHandlerEventProc(evPtr, flags)
  */
 
 void
-Tcl_DoWhenIdle(proc, clientData)
-    Tcl_IdleProc *proc;		/* Function to invoke. */
-    ClientData clientData;	/* Arbitrary value to pass to proc. */
+Tcl_DoWhenIdle(
+    Tcl_IdleProc *proc,		/* Function to invoke. */
+    ClientData clientData)	/* Arbitrary value to pass to proc. */
 {
     register IdleHandler *idlePtr;
     Tcl_Time blockTime;
     ThreadSpecificData *tsdPtr = InitTimer();
 
-    idlePtr = (IdleHandler *) ckalloc(sizeof(IdleHandler));
+    idlePtr = ckalloc(sizeof(IdleHandler));
     idlePtr->proc = proc;
     idlePtr->clientData = clientData;
     idlePtr->generation = tsdPtr->idleGeneration;
@@ -648,9 +661,9 @@ Tcl_DoWhenIdle(proc, clientData)
  */
 
 void
-Tcl_CancelIdleCall(proc, clientData)
-    Tcl_IdleProc *proc;		/* Function that was previously registered. */
-    ClientData clientData;	/* Arbitrary value to pass to proc. */
+Tcl_CancelIdleCall(
+    Tcl_IdleProc *proc,		/* Function that was previously registered. */
+    ClientData clientData)	/* Arbitrary value to pass to proc. */
 {
     register IdleHandler *idlePtr, *prevPtr;
     IdleHandler *nextPtr;
@@ -661,7 +674,7 @@ Tcl_CancelIdleCall(proc, clientData)
 	while ((idlePtr->proc == proc)
 		&& (idlePtr->clientData == clientData)) {
 	    nextPtr = idlePtr->nextPtr;
-	    ckfree((char *) idlePtr);
+	    ckfree(idlePtr);
 	    idlePtr = nextPtr;
 	    if (prevPtr == NULL) {
 		tsdPtr->idleList = idlePtr;
@@ -696,7 +709,7 @@ Tcl_CancelIdleCall(proc, clientData)
  */
 
 int
-TclServiceIdle()
+TclServiceIdle(void)
 {
     IdleHandler *idlePtr;
     int oldGeneration;
@@ -735,8 +748,8 @@ TclServiceIdle()
 	if (tsdPtr->idleList == NULL) {
 	    tsdPtr->lastIdlePtr = NULL;
 	}
-	(*idlePtr->proc)(idlePtr->clientData);
-	ckfree((char *) idlePtr);
+	idlePtr->proc(idlePtr->clientData);
+	ckfree(idlePtr);
     }
     if (tsdPtr->idleList) {
 	blockTime.sec = 0;
@@ -765,27 +778,26 @@ TclServiceIdle()
 
 	/* ARGSUSED */
 int
-Tcl_AfterObjCmd(clientData, interp, objc, objv)
-    ClientData clientData;	/* Unused */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument objects. */
+Tcl_AfterObjCmd(
+    ClientData clientData,	/* Unused */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
-    int ms;
+    Tcl_WideInt ms = 0;		/* Number of milliseconds to wait */
+    Tcl_Time wakeup;
     AfterInfo *afterPtr;
     AfterAssocData *assocPtr;
     int length;
-    char *argString;
     int index;
-    char buf[16 + TCL_INTEGER_SPACE];
-    static CONST char *afterSubCmds[] = {
-	"cancel", "idle", "info", (char *) NULL
+    static const char *const afterSubCmds[] = {
+	"cancel", "idle", "info", NULL
     };
     enum afterSubCmds {AFTER_CANCEL, AFTER_IDLE, AFTER_INFO};
     ThreadSpecificData *tsdPtr = InitTimer();
 
     if (objc < 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?");
+	Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
 	return TCL_ERROR;
     }
 
@@ -796,39 +808,55 @@ Tcl_AfterObjCmd(clientData, interp, objc, objv)
 
     assocPtr = Tcl_GetAssocData(interp, "tclAfter", NULL);
     if (assocPtr == NULL) {
-	assocPtr = (AfterAssocData *) ckalloc(sizeof(AfterAssocData));
+	assocPtr = ckalloc(sizeof(AfterAssocData));
 	assocPtr->interp = interp;
 	assocPtr->firstAfterPtr = NULL;
-	Tcl_SetAssocData(interp, "tclAfter", AfterCleanupProc,
-		(ClientData) assocPtr);
+	Tcl_SetAssocData(interp, "tclAfter", AfterCleanupProc, assocPtr);
     }
 
     /*
      * First lets see if the command was passed a number as the first argument.
      */
 
-    if (objv[1]->typePtr == &tclIntType) {
-	ms = (int) objv[1]->internalRep.longValue;
-	goto processInteger;
-    }
-    argString = Tcl_GetStringFromObj(objv[1], &length);
-    if (isdigit(UCHAR(argString[0]))) {	/* INTL: digit */
-	if (Tcl_GetIntFromObj(interp, objv[1], &ms) != TCL_OK) {
+    if (objv[1]->typePtr == &tclIntType
+#ifndef TCL_WIDE_INT_IS_LONG
+	    || objv[1]->typePtr == &tclWideIntType
+#endif
+	    || objv[1]->typePtr == &tclBignumType
+	    || (Tcl_GetIndexFromObj(NULL, objv[1], afterSubCmds, "", 0,
+		    &index) != TCL_OK)) {
+	index = -1;
+	if (Tcl_GetWideIntFromObj(NULL, objv[1], &ms) != TCL_OK) {
+            const char *arg = Tcl_GetString(objv[1]);
+
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+                    "bad argument \"%s\": must be"
+                    " cancel, idle, info, or an integer", arg));
+            Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "argument",
+                    arg, NULL);
 	    return TCL_ERROR;
 	}
-    processInteger:
+    }
+
+    /*
+     * At this point, either index = -1 and ms contains the number of ms
+     * to wait, or else index is the index of a subcommand.
+     */
+
+    switch (index) {
+    case -1: {
 	if (ms < 0) {
 	    ms = 0;
 	}
 	if (objc == 2) {
 	    return AfterDelay(interp, ms);
 	}
-	afterPtr = (AfterInfo *) ckalloc((unsigned) (sizeof(AfterInfo)));
+	afterPtr = ckalloc(sizeof(AfterInfo));
 	afterPtr->assocPtr = assocPtr;
 	if (objc == 3) {
 	    afterPtr->commandPtr = objv[2];
 	} else {
- 	    afterPtr->commandPtr = Tcl_ConcatObj(objc-2, objv+2);
+	    afterPtr->commandPtr = Tcl_ConcatObj(objc-2, objv+2);
 	}
 	Tcl_IncrRefCount(afterPtr->commandPtr);
 
@@ -844,31 +872,23 @@ Tcl_AfterObjCmd(clientData, interp, objc, objv)
 
 	afterPtr->id = tsdPtr->afterId;
 	tsdPtr->afterId += 1;
-	afterPtr->token = Tcl_CreateTimerHandler(ms, AfterProc,
-		(ClientData) afterPtr);
+	Tcl_GetTime(&wakeup);
+	wakeup.sec += (long)(ms / 1000);
+	wakeup.usec += ((long)(ms % 1000)) * 1000;
+	if (wakeup.usec > 1000000) {
+	    wakeup.sec++;
+	    wakeup.usec -= 1000000;
+	}
+	afterPtr->token = TclCreateAbsoluteTimerHandler(&wakeup,
+		AfterProc, afterPtr);
 	afterPtr->nextPtr = assocPtr->firstAfterPtr;
 	assocPtr->firstAfterPtr = afterPtr;
-	sprintf(buf, "after#%d", afterPtr->id);
-	Tcl_AppendResult(interp, buf, (char *) NULL);
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf("after#%d", afterPtr->id));
 	return TCL_OK;
     }
-
-    /*
-     * If it's not a number it must be a subcommand. Note that we're using a
-     * custom error message here, so we do not pass an interpreter to T_GIFO.
-     */
-
-    if (Tcl_GetIndexFromObj(NULL, objv[1], afterSubCmds, "argument", 0,
-	    &index) != TCL_OK) {
-	Tcl_AppendResult(interp, "bad argument \"", argString,
-		"\": must be cancel, idle, info, or a number",
-		(char *) NULL);
-	return TCL_ERROR;
-    }
-    switch ((enum afterSubCmds) index) {
     case AFTER_CANCEL: {
 	Tcl_Obj *commandPtr;
-	char *command, *tempCommand;
+	const char *command, *tempCommand;
 	int tempLength;
 
 	if (objc < 3) {
@@ -886,8 +906,7 @@ Tcl_AfterObjCmd(clientData, interp, objc, objv)
 	    tempCommand = Tcl_GetStringFromObj(afterPtr->commandPtr,
 		    &tempLength);
 	    if ((length == tempLength)
-		    && (memcmp((void*) command, (void*) tempCommand,
-			    (unsigned) length) == 0)) {
+		    && !memcmp(command, tempCommand, (unsigned) length)) {
 		break;
 	    }
 	}
@@ -901,7 +920,7 @@ Tcl_AfterObjCmd(clientData, interp, objc, objv)
 	    if (afterPtr->token != NULL) {
 		Tcl_DeleteTimerHandler(afterPtr->token);
 	    } else {
-		Tcl_CancelIdleCall(AfterProc, (ClientData) afterPtr);
+		Tcl_CancelIdleCall(AfterProc, afterPtr);
 	    }
 	    FreeAfterPtr(afterPtr);
 	}
@@ -909,10 +928,10 @@ Tcl_AfterObjCmd(clientData, interp, objc, objv)
     }
     case AFTER_IDLE:
 	if (objc < 3) {
-	    Tcl_WrongNumArgs(interp, 2, objv, "script script ...");
+	    Tcl_WrongNumArgs(interp, 2, objv, "script ?script ...?");
 	    return TCL_ERROR;
 	}
-	afterPtr = (AfterInfo *) ckalloc((unsigned) (sizeof(AfterInfo)));
+	afterPtr = ckalloc(sizeof(AfterInfo));
 	afterPtr->assocPtr = assocPtr;
 	if (objc == 3) {
 	    afterPtr->commandPtr = objv[2];
@@ -925,21 +944,21 @@ Tcl_AfterObjCmd(clientData, interp, objc, objv)
 	afterPtr->token = NULL;
 	afterPtr->nextPtr = assocPtr->firstAfterPtr;
 	assocPtr->firstAfterPtr = afterPtr;
-	Tcl_DoWhenIdle(AfterProc, (ClientData) afterPtr);
-	sprintf(buf, "after#%d", afterPtr->id);
-	Tcl_AppendResult(interp, buf, (char *) NULL);
+	Tcl_DoWhenIdle(AfterProc, afterPtr);
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf("after#%d", afterPtr->id));
 	break;
-    case AFTER_INFO: {
-	Tcl_Obj *resultListPtr;
-
+    case AFTER_INFO:
 	if (objc == 2) {
+            Tcl_Obj *resultObj = Tcl_NewObj();
+
 	    for (afterPtr = assocPtr->firstAfterPtr; afterPtr != NULL;
 		    afterPtr = afterPtr->nextPtr) {
 		if (assocPtr->interp == interp) {
-		    sprintf(buf, "after#%d", afterPtr->id);
-		    Tcl_AppendElement(interp, buf);
+                    Tcl_ListObjAppendElement(NULL, resultObj, Tcl_ObjPrintf(
+                            "after#%d", afterPtr->id));
 		}
 	    }
+            Tcl_SetObjResult(interp, resultObj);
 	    return TCL_OK;
 	}
 	if (objc != 3) {
@@ -948,17 +967,22 @@ Tcl_AfterObjCmd(clientData, interp, objc, objv)
 	}
 	afterPtr = GetAfterEvent(assocPtr, objv[2]);
 	if (afterPtr == NULL) {
-	    Tcl_AppendResult(interp, "event \"", Tcl_GetString(objv[2]),
-		    "\" doesn't exist", (char *) NULL);
+            const char *eventStr = TclGetString(objv[2]);
+
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+                    "event \"%s\" doesn't exist", eventStr));
+            Tcl_SetErrorCode(interp, "TCL","LOOKUP","EVENT", eventStr, NULL);
 	    return TCL_ERROR;
-	}
-	resultListPtr = Tcl_NewObj();
-	Tcl_ListObjAppendElement(interp, resultListPtr, afterPtr->commandPtr);
-	Tcl_ListObjAppendElement(interp, resultListPtr, Tcl_NewStringObj(
- 		(afterPtr->token == NULL) ? "idle" : "timer", -1));
-	Tcl_SetObjResult(interp, resultListPtr);
+	} else {
+            Tcl_Obj *resultListPtr = Tcl_NewObj();
+
+            Tcl_ListObjAppendElement(interp, resultListPtr,
+                    afterPtr->commandPtr);
+            Tcl_ListObjAppendElement(interp, resultListPtr, Tcl_NewStringObj(
+		    (afterPtr->token == NULL) ? "idle" : "timer", -1));
+            Tcl_SetObjResult(interp, resultListPtr);
+        }
 	break;
-    }
     default:
 	Tcl_Panic("Tcl_AfterObjCmd: bad subcommand index to afterSubCmds");
     }
@@ -975,7 +999,7 @@ Tcl_AfterObjCmd(clientData, interp, objc, objv)
  *
  * Results:
  *	Standard Tcl result code (with error set if an error occurred due to a
- *	time limit being exceeded).
+ *	time limit being exceeded or being canceled).
  *
  * Side effects:
  *	May adjust the time limit granularity marker.
@@ -984,44 +1008,83 @@ Tcl_AfterObjCmd(clientData, interp, objc, objv)
  */
 
 static int
-AfterDelay(interp, ms)
-    Tcl_Interp *interp;
-    int ms;
+AfterDelay(
+    Tcl_Interp *interp,
+    Tcl_WideInt ms)
 {
     Interp *iPtr = (Interp *) interp;
 
-    if (iPtr->limit.timeEvent != NULL) {
-	Tcl_Time endTime, now;
+    Tcl_Time endTime, now;
+    Tcl_WideInt diff;
 
-	Tcl_GetTime(&endTime);
-	endTime.sec += ms/1000;
-	endTime.usec += (ms%1000)*1000;
-	if (endTime.usec >= 1000000) {
-	    endTime.sec++;
-	    endTime.usec -= 1000000;
-	}
+    Tcl_GetTime(&now);
+    endTime = now;
+    endTime.sec += (long)(ms/1000);
+    endTime.usec += ((int)(ms%1000))*1000;
+    if (endTime.usec >= 1000000) {
+	endTime.sec++;
+	endTime.usec -= 1000000;
+    }
 
-	do {
-	    Tcl_GetTime(&now);
-	    if (TCL_TIME_BEFORE(iPtr->limit.time, now)) {
-		iPtr->limit.granularityTicker = 0;
-		if (Tcl_LimitCheck(interp) != TCL_OK) {
-		    return TCL_ERROR;
-		}
+    do {
+	if (Tcl_AsyncReady()) {
+	    if (Tcl_AsyncInvoke(interp, TCL_OK) != TCL_OK) {
+		return TCL_ERROR;
 	    }
-	    if (TCL_TIME_BEFORE(endTime, iPtr->limit.time)) {
-		Tcl_Sleep(TCL_TIME_DIFF_MS(endTime, now));
-		break;
-	    } else {
-		Tcl_Sleep(TCL_TIME_DIFF_MS(iPtr->limit.time, now));
-		if (Tcl_LimitCheck(interp) != TCL_OK) {
+	}
+	if (Tcl_Canceled(interp, TCL_LEAVE_ERR_MSG) == TCL_ERROR) {
+	    return TCL_ERROR;
+	}
+	if (iPtr->limit.timeEvent != NULL
+		&& TCL_TIME_BEFORE(iPtr->limit.time, now)) {
+	    iPtr->limit.granularityTicker = 0;
+	    if (Tcl_LimitCheck(interp) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	}
+	if (iPtr->limit.timeEvent == NULL
+		|| TCL_TIME_BEFORE(endTime, iPtr->limit.time)) {
+	    diff = TCL_TIME_DIFF_MS_CEILING(endTime, now);
+#ifndef TCL_WIDE_INT_IS_LONG
+	    if (diff > LONG_MAX) {
+		diff = LONG_MAX;
+	    }
+#endif
+	    if (diff > TCL_TIME_MAXIMUM_SLICE) {
+		diff = TCL_TIME_MAXIMUM_SLICE;
+	    }
+            if (diff == 0 && TCL_TIME_BEFORE(now, endTime)) diff = 1;
+	    if (diff > 0) {
+		Tcl_Sleep((long) diff);
+                if (diff < SLEEP_OFFLOAD_GETTIMEOFDAY) break;
+	    } else break;
+	} else {
+	    diff = TCL_TIME_DIFF_MS(iPtr->limit.time, now);
+#ifndef TCL_WIDE_INT_IS_LONG
+	    if (diff > LONG_MAX) {
+		diff = LONG_MAX;
+	    }
+#endif
+	    if (diff > TCL_TIME_MAXIMUM_SLICE) {
+		diff = TCL_TIME_MAXIMUM_SLICE;
+	    }
+	    if (diff > 0) {
+		Tcl_Sleep((long) diff);
+	    }
+	    if (Tcl_AsyncReady()) {
+		if (Tcl_AsyncInvoke(interp, TCL_OK) != TCL_OK) {
 		    return TCL_ERROR;
 		}
 	    }
-	} while (TCL_TIME_BEFORE(now, endTime));
-    } else {
-	Tcl_Sleep(ms);
-    }
+	    if (Tcl_Canceled(interp, TCL_LEAVE_ERR_MSG) == TCL_ERROR) {
+		return TCL_ERROR;
+	    }
+	    if (Tcl_LimitCheck(interp) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	}
+        Tcl_GetTime(&now);
+    } while (TCL_TIME_BEFORE(now, endTime));
     return TCL_OK;
 }
 
@@ -1045,18 +1108,18 @@ AfterDelay(interp, ms)
  */
 
 static AfterInfo *
-GetAfterEvent(assocPtr, commandPtr)
-    AfterAssocData *assocPtr;	/* Points to "after"-related information for
+GetAfterEvent(
+    AfterAssocData *assocPtr,	/* Points to "after"-related information for
 				 * this interpreter. */
-    Tcl_Obj *commandPtr;
+    Tcl_Obj *commandPtr)
 {
-    char *cmdString;		/* Textual identifier for after event, such as
+    const char *cmdString;	/* Textual identifier for after event, such as
 				 * "after#6". */
     AfterInfo *afterPtr;
     int id;
     char *end;
 
-    cmdString = Tcl_GetString(commandPtr);
+    cmdString = TclGetString(commandPtr);
     if (strncmp(cmdString, "after#", 6) != 0) {
 	return NULL;
     }
@@ -1094,16 +1157,14 @@ GetAfterEvent(assocPtr, commandPtr)
  */
 
 static void
-AfterProc(clientData)
-    ClientData clientData;	/* Describes command to execute. */
+AfterProc(
+    ClientData clientData)	/* Describes command to execute. */
 {
-    AfterInfo *afterPtr = (AfterInfo *) clientData;
+    AfterInfo *afterPtr = clientData;
     AfterAssocData *assocPtr = afterPtr->assocPtr;
     AfterInfo *prevPtr;
     int result;
     Tcl_Interp *interp;
-    char *script;
-    int numBytes;
 
     /*
      * First remove the callback from our list of callbacks; otherwise someone
@@ -1126,21 +1187,20 @@ AfterProc(clientData)
      */
 
     interp = assocPtr->interp;
-    Tcl_Preserve((ClientData) interp);
-    script = Tcl_GetStringFromObj(afterPtr->commandPtr, &numBytes);
-    result = Tcl_EvalEx(interp, script, numBytes, TCL_EVAL_GLOBAL);
+    Tcl_Preserve(interp);
+    result = Tcl_EvalObjEx(interp, afterPtr->commandPtr, TCL_EVAL_GLOBAL);
     if (result != TCL_OK) {
 	Tcl_AddErrorInfo(interp, "\n    (\"after\" script)");
-	Tcl_BackgroundError(interp);
+	Tcl_BackgroundException(interp, result);
     }
-    Tcl_Release((ClientData) interp);
+    Tcl_Release(interp);
 
     /*
      * Free the memory for the callback.
      */
 
     Tcl_DecrRefCount(afterPtr->commandPtr);
-    ckfree((char *) afterPtr);
+    ckfree(afterPtr);
 }
 
 /*
@@ -1162,8 +1222,8 @@ AfterProc(clientData)
  */
 
 static void
-FreeAfterPtr(afterPtr)
-    AfterInfo *afterPtr;		/* Command to be deleted. */
+FreeAfterPtr(
+    AfterInfo *afterPtr)		/* Command to be deleted. */
 {
     AfterInfo *prevPtr;
     AfterAssocData *assocPtr = afterPtr->assocPtr;
@@ -1178,7 +1238,7 @@ FreeAfterPtr(afterPtr)
 	prevPtr->nextPtr = afterPtr->nextPtr;
     }
     Tcl_DecrRefCount(afterPtr->commandPtr);
-    ckfree((char *) afterPtr);
+    ckfree(afterPtr);
 }
 
 /*
@@ -1200,12 +1260,12 @@ FreeAfterPtr(afterPtr)
 
 	/* ARGSUSED */
 static void
-AfterCleanupProc(clientData, interp)
-    ClientData clientData;	/* Points to AfterAssocData for the
+AfterCleanupProc(
+    ClientData clientData,	/* Points to AfterAssocData for the
 				 * interpreter. */
-    Tcl_Interp *interp;		/* Interpreter that is being deleted. */
+    Tcl_Interp *interp)		/* Interpreter that is being deleted. */
 {
-    AfterAssocData *assocPtr = (AfterAssocData *) clientData;
+    AfterAssocData *assocPtr = clientData;
     AfterInfo *afterPtr;
 
     while (assocPtr->firstAfterPtr != NULL) {
@@ -1214,12 +1274,12 @@ AfterCleanupProc(clientData, interp)
 	if (afterPtr->token != NULL) {
 	    Tcl_DeleteTimerHandler(afterPtr->token);
 	} else {
-	    Tcl_CancelIdleCall(AfterProc, (ClientData) afterPtr);
+	    Tcl_CancelIdleCall(AfterProc, afterPtr);
 	}
 	Tcl_DecrRefCount(afterPtr->commandPtr);
-	ckfree((char *) afterPtr);
+	ckfree(afterPtr);
     }
-    ckfree((char *) assocPtr);
+    ckfree(assocPtr);
 }
 
 /*
@@ -1227,5 +1287,7 @@ AfterCleanupProc(clientData, interp)
  * mode: c
  * c-basic-offset: 4
  * fill-column: 78
+ * tab-width: 8
+ * indent-tabs-mode: nil
  * End:
  */