merge resp. reintegrate sebres-8-5-event-perf-branch to 8.6

1 files changed, 1230 insertions, 441 deletions

diff --git a/generic/tclTimer.c b/generic/tclTimer.c
index c10986a..81e79aa 100644
--- a/generic/tclTimer.c
+++ b/generic/tclTimer.c
@@ -13,22 +13,6 @@
 #include "tclInt.h"
 
 /*
- * For each timer callback that's pending there is one record of the following
- * type. The normal handlers (created by Tcl_CreateTimerHandler) are chained
- * together in a list sorted by time (earliest event first).
- */
-
-typedef struct TimerHandler {
-    Tcl_Time time;		/* When timer is to fire. */
-    Tcl_TimerProc *proc;	/* Function to call. */
-    ClientData clientData;	/* Argument to pass to proc. */
-    Tcl_TimerToken token;	/* Identifies handler so it can be deleted. */
-    struct TimerHandler *nextPtr;
-				/* Next event in queue, or NULL for end of
-				 * queue. */
-} TimerHandler;
-
-/*
  * The data structure below is used by the "after" command to remember the
  * command to be executed later. All of the pending "after" commands for an
  * interpreter are linked together in a list.
@@ -40,15 +24,12 @@ typedef struct AfterInfo {
 				 * interp in which command will be
 				 * executed. */
     Tcl_Obj *commandPtr;	/* Command to execute. */
-    int id;			/* Integer identifier for command; used to
-				 * cancel it. */
-    Tcl_TimerToken token;	/* Used to cancel the "after" command. NULL
-				 * means that the command is run as an idle
-				 * handler rather than as a timer handler.
-				 * NULL means this is an "after idle" handler
-				 * rather than a timer handler. */
+    Tcl_Obj *selfPtr;		/* Points to the handle object (self) */
+    unsigned int id;		/* Integer identifier for command */
     struct AfterInfo *nextPtr;	/* Next in list of all "after" commands for
 				 * this interpreter. */
+    struct AfterInfo *prevPtr;	/* Prev in list of all "after" commands for
+				 * this interpreter. */
 } AfterInfo;
 
 /*
@@ -63,23 +44,10 @@ typedef struct AfterAssocData {
     AfterInfo *firstAfterPtr;	/* First in list of all "after" commands still
 				 * pending for this interpreter, or NULL if
 				 * none. */
+    AfterInfo *lastAfterPtr;	/* Last in list of all "after" commands. */
 } AfterAssocData;
 
 /*
- * There is one of the following structures for each of the handlers declared
- * in a call to Tcl_DoWhenIdle. All of the currently-active handlers are
- * linked together into a list.
- */
-
-typedef struct IdleHandler {
-    Tcl_IdleProc *proc;		/* Function to call. */
-    ClientData clientData;	/* Value to pass to proc. */
-    int generation;		/* Used to distinguish older handlers from
-				 * recently-created ones. */
-    struct IdleHandler *nextPtr;/* Next in list of active handlers. */
-} IdleHandler;
-
-/*
  * The timer and idle queues are per-thread because they are associated with
  * the notifier, which is also per-thread.
  *
@@ -91,54 +59,48 @@ typedef struct IdleHandler {
  * The structure defined below is used in this file only.
  */
 
-typedef struct ThreadSpecificData {
-    TimerHandler *firstTimerHandlerPtr;	/* First event in queue. */
+typedef struct {
+    Tcl_WideInt relTimerBase;	/* Time base of the first known relative */
+				/* timer, used to revert all events to the new
+				 * base after possible time-jump (adjustment).*/
+    TclTimerEvent *promptList;	/* First immediate event in queue. */
+    TclTimerEvent *promptTail;	/* Last immediate event in queue. */
+    TclTimerEvent *relTimerList;/* First event in queue of relative timers. */
+    TclTimerEvent *relTimerTail;/* Last event in queue of relative timers. */
+    TclTimerEvent *absTimerList;/* First event in queue of absolute timers. */
+    TclTimerEvent *absTimerTail;/* Last event in queue of absolute timers. */
+    size_t timerListEpoch;	/* Used for safe process of event queue (stop
+    				 * the cycle after modifying of event queue) */
     int lastTimerId;		/* Timer identifier of most recently created
-				 * timer. */
+				 * timer event. */
     int timerPending;		/* 1 if a timer event is in the queue. */
-    IdleHandler *idleList;	/* First in list of all idle handlers. */
-    IdleHandler *lastIdlePtr;	/* Last in list (or NULL for empty list). */
-    int idleGeneration;		/* Used to fill in the "generation" fields of
-				 * IdleHandler structures. Increments each
-				 * time Tcl_DoOneEvent starts calling idle
-				 * handlers, so that all old handlers can be
+    TclTimerEvent *idleList;	/* First in list of all idle handlers. */
+    TclTimerEvent *idleTail;	/* Last in list (or NULL for empty list). */
+    size_t timerGeneration;	/* Used to fill in the "generation" fields of */
+    size_t idleGeneration;	/* timer or idle structures. Increments each
+				 * time we place a new handler to queue inside,
+				 * a new loop, so that all old handlers can be
 				 * called without calling any of the new ones
 				 * created by old ones. */
-    int afterId;		/* For unique identifiers of after events. */
+    unsigned int afterId;	/* For unique identifiers of after events. */
 } ThreadSpecificData;
 
 static Tcl_ThreadDataKey dataKey;
 
 /*
- * Helper macros for working with times. TCL_TIME_BEFORE encodes how to write
- * the ordering relation on (normalized) times, and TCL_TIME_DIFF_MS computes
- * the number of milliseconds difference between two times. Both macros use
- * both of their arguments multiple times, so make sure they are cheap and
- * side-effect free. The "prototypes" for these macros are:
- *
- * static int	TCL_TIME_BEFORE(Tcl_Time t1, Tcl_Time t2);
- * static long	TCL_TIME_DIFF_MS(Tcl_Time t1, Tcl_Time t2);
+ * Helper macros to wrap AfterInfo and handlers (and vice versa)
  */
 
-#define TCL_TIME_BEFORE(t1, t2) \
-    (((t1).sec<(t2).sec) || ((t1).sec==(t2).sec && (t1).usec<(t2).usec))
-
-#define TCL_TIME_DIFF_MS(t1, t2) \
-    (1000*((Tcl_WideInt)(t1).sec - (Tcl_WideInt)(t2).sec) + \
-	    ((long)(t1).usec - (long)(t2).usec)/1000)
+#define TclpTimerEvent2AfterInfo(ptr)					\
+	    ( (AfterInfo*)TclpTimerEvent2ExtraData(ptr) )
+#define TclpAfterInfo2TimerEvent(ptr)					\
+	    TclpExtraData2TimerEvent(ptr)
 
 #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.
@@ -152,16 +114,126 @@ static Tcl_ThreadDataKey dataKey;
 
 static void		AfterCleanupProc(ClientData clientData,
 			    Tcl_Interp *interp);
-static int		AfterDelay(Tcl_Interp *interp, Tcl_WideInt ms);
+static int		AfterDelay(Tcl_Interp *interp, Tcl_WideInt usec,
+			    int absolute);
 static void		AfterProc(ClientData clientData);
-static void		FreeAfterPtr(AfterInfo *afterPtr);
-static AfterInfo *	GetAfterEvent(AfterAssocData *assocPtr,
-			    Tcl_Obj *commandPtr);
+static void		FreeAfterPtr(ClientData clientData);
+static AfterInfo *	GetAfterEvent(AfterAssocData *assocPtr, Tcl_Obj *objPtr);
 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);
+
+static void             AfterObj_DupInternalRep(Tcl_Obj *, Tcl_Obj *);
+static void		AfterObj_FreeInternalRep(Tcl_Obj *);
+static void		AfterObj_UpdateString(Tcl_Obj *);
+
+/*
+ * Type definition.
+ */
+
+Tcl_ObjType afterObjType = {
+    "after",                    /* name */
+    AfterObj_FreeInternalRep,   /* freeIntRepProc */
+    AfterObj_DupInternalRep,    /* dupIntRepProc */
+    AfterObj_UpdateString,      /* updateStringProc */
+    NULL                        /* setFromAnyProc */
+};
+
+/*
+ *----------------------------------------------------------------------
+ */
+static void
+AfterObj_DupInternalRep(srcPtr, dupPtr)
+    Tcl_Obj *srcPtr;
+    Tcl_Obj *dupPtr;
+{
+    /* 
+     * Because we should have only a single reference to the after event,
+     * we'll copy string representation only.
+     */
+    if (dupPtr->bytes == NULL) {
+	if (srcPtr->bytes == NULL) {
+	    AfterObj_UpdateString(srcPtr);
+	}
+	if (srcPtr->bytes != tclEmptyStringRep) {
+	    TclInitStringRep(dupPtr, srcPtr->bytes, srcPtr->length);
+	} else {
+	    dupPtr->bytes = tclEmptyStringRep;
+	}
+    }
+}
+/*
+ *----------------------------------------------------------------------
+ */
+static void
+AfterObj_FreeInternalRep(objPtr)
+    Tcl_Obj *objPtr;
+{
+    /* 
+     * Because we should always have a reference by active after event,
+     * so it is a triggered / canceled event - just reset type and pointers
+     */
+    objPtr->internalRep.twoPtrValue.ptr1 = NULL;
+    objPtr->internalRep.twoPtrValue.ptr2 = NULL;
+    objPtr->typePtr = NULL;
+
+    /* prevent no string representation bug */
+    if (objPtr->bytes == NULL) {
+	objPtr->length = 0;
+	objPtr->bytes = tclEmptyStringRep;
+    }
+}
+/*
+ *----------------------------------------------------------------------
+ */
+static void
+AfterObj_UpdateString(objPtr)
+    Tcl_Obj  *objPtr;
+{
+    char buf[16 + TCL_INTEGER_SPACE];
+    int len;
+ 
+    AfterInfo *afterPtr = (AfterInfo*)objPtr->internalRep.twoPtrValue.ptr1;
+
+    /* if already triggered / canceled - equivalent not found, we can use empty */
+    if (!afterPtr) {
+	objPtr->length = 0;
+	objPtr->bytes = tclEmptyStringRep;
+	return;
+    }
+
+    len = sprintf(buf, "after#%u", afterPtr->id);
+
+    objPtr->length = len;
+    objPtr->bytes = ckalloc((size_t)++len);
+    if (objPtr->bytes)
+	memcpy(objPtr->bytes, buf, len);
+
+}
+/*
+ *----------------------------------------------------------------------
+ */
+Tcl_Obj*
+GetAfterObj(
+    AfterInfo *afterPtr)
+{
+    Tcl_Obj * objPtr = afterPtr->selfPtr;
+    
+    if (objPtr != NULL) {
+	return objPtr;
+    }
+    
+    TclNewObj(objPtr);
+    objPtr->typePtr = &afterObjType;
+    objPtr->bytes = NULL;
+    objPtr->internalRep.twoPtrValue.ptr1 = afterPtr;
+    objPtr->internalRep.twoPtrValue.ptr2 = NULL;
+    Tcl_IncrRefCount(objPtr);
+    afterPtr->selfPtr = objPtr;
+
+    return objPtr;
+};
 
 /*
  *----------------------------------------------------------------------
@@ -186,12 +258,140 @@ InitTimer(void)
 
     if (tsdPtr == NULL) {
 	tsdPtr = TCL_TSD_INIT(&dataKey);
-	Tcl_CreateEventSource(TimerSetupProc, TimerCheckProc, NULL);
+	Tcl_CreateEventSource(TimerSetupProc, TimerCheckProc, tsdPtr);
 	Tcl_CreateThreadExitHandler(TimerExitProc, NULL);
     }
     return tsdPtr;
 }
 
+static void
+AttachTimerEvent(
+    ThreadSpecificData *tsdPtr,
+    TclTimerEvent *tmrEvent)
+{
+    TclTimerEvent **tmrList, **tmrTail;
+
+    tmrEvent->flags |= TCL_TMREV_LISTED;
+    if (tmrEvent->flags & TCL_TMREV_PROMPT) {
+	/* use timer generation, because usually no differences between 
+	 * call of "after 0" and "after 1" */
+	tmrEvent->generation = tsdPtr->timerGeneration;
+	/* attach to the prompt queue */
+	TclSpliceTailEx(tmrEvent, tsdPtr->promptList, tsdPtr->promptTail);
+	/* execute immediately: signal pending and set timer marker */
+	tsdPtr->timerPending = 1;
+	TclSetTimerEventMarker(0);
+	return;
+    } 
+
+    if (tmrEvent->flags & TCL_TMREV_IDLE) {
+	/* idle generation */
+	tmrEvent->generation = tsdPtr->idleGeneration;
+	/* attach to the idle queue */
+	TclSpliceTailEx(tmrEvent, tsdPtr->idleList, tsdPtr->idleTail);
+	return;
+    }
+
+    /* current timer generation */
+    tmrEvent->generation = tsdPtr->timerGeneration;
+
+    /*
+     * Add the event to the queue in the correct position
+     * (ordered by event firing time).
+     */
+
+    tsdPtr->timerListEpoch++; /* signal - timer list was changed */
+
+    if (!(tmrEvent->flags & TCL_TMREV_AT)) {
+	tmrList = &tsdPtr->relTimerList;
+	tmrTail = &tsdPtr->relTimerTail;
+    } else {
+	tmrList = &tsdPtr->absTimerList;
+	tmrTail = &tsdPtr->absTimerTail;
+    }
+    /* if before current first (e. g. "after 1" before first "after 1000") */
+    if ( !(*tmrList) || tmrEvent->time < (*tmrList)->time) {
+    	/* splice to the head */
+	TclSpliceInEx(tmrEvent, *tmrList, *tmrTail);
+    } else {
+    	TclTimerEvent *tmrEventPos;
+	Tcl_WideInt usec = tmrEvent->time;
+	/* search from end as long as one with time before not found */
+	for (tmrEventPos = *tmrTail; tmrEventPos != NULL;
+	    tmrEventPos = tmrEventPos->prevPtr) {
+	    if (usec >= tmrEventPos->time) {
+		break;
+	    }
+	}
+	/* normally it should be always true, because checked above, but ... */
+	if (tmrEventPos != NULL) {
+	    /* insert after found element (with time before new) */
+	    tmrEvent->prevPtr = tmrEventPos;
+	    if ((tmrEvent->nextPtr = tmrEventPos->nextPtr)) {
+		tmrEventPos->nextPtr->prevPtr = tmrEvent;
+	    } else {
+		*tmrTail = tmrEvent;
+	    }
+	    tmrEventPos->nextPtr = tmrEvent;
+	} else {
+	    /* unexpected case, but ... splice to the head */
+	    TclSpliceInEx(tmrEvent, *tmrList, *tmrTail);
+	}
+    }
+}
+
+static void
+DetachTimerEvent(
+    ThreadSpecificData *tsdPtr,
+    TclTimerEvent *tmrEvent)
+{
+    tmrEvent->flags &= ~TCL_TMREV_LISTED;
+    if (tmrEvent->flags & TCL_TMREV_PROMPT) {
+	/* prompt handler */
+	TclSpliceOutEx(tmrEvent, tsdPtr->promptList, tsdPtr->promptTail);
+	return;
+    } 
+    if (tmrEvent->flags & TCL_TMREV_IDLE) {
+	/* idle handler */
+	TclSpliceOutEx(tmrEvent, tsdPtr->idleList, tsdPtr->idleTail);
+	return;
+    }
+    /* timer event-handler */
+    tsdPtr->timerListEpoch++; /* signal - timer list was changed */
+    if (!(tmrEvent->flags & TCL_TMREV_AT)) {
+	TclSpliceOutEx(tmrEvent, tsdPtr->relTimerList, tsdPtr->relTimerTail);
+    } else {
+    	TclSpliceOutEx(tmrEvent, tsdPtr->absTimerList, tsdPtr->absTimerTail);
+    }
+}
+
+static Tcl_WideInt
+TimerMakeRelativeTime(
+    ThreadSpecificData *tsdPtr,
+    Tcl_WideInt usec)
+{
+    Tcl_WideInt now = TclpGetUTimeMonotonic();
+
+    /* 
+     * We should have the ability to ajust end-time of relative events,
+     * for possible time-jumps.
+     */
+    if (tsdPtr->relTimerList) {
+	/* 
+	 * end-time = now + usec
+	 * Adjust value of usec relative current base (to now), so
+	 * end-time = base + relative event-time, which corresponds 
+	 * original end-time.
+	 */
+	usec += now - tsdPtr->relTimerBase;
+    } else {
+	/* first event here - initial values (base/epoch) */
+	tsdPtr->relTimerBase = now;
+    }
+
+    return usec;
+}
+
 /*
  *----------------------------------------------------------------------
  *
@@ -215,15 +415,20 @@ TimerExitProc(
 {
     ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
 
-    Tcl_DeleteEventSource(TimerSetupProc, TimerCheckProc, NULL);
     if (tsdPtr != NULL) {
-	register TimerHandler *timerHandlerPtr;
+	Tcl_DeleteEventSource(TimerSetupProc, TimerCheckProc, tsdPtr);
 
-	timerHandlerPtr = tsdPtr->firstTimerHandlerPtr;
-	while (timerHandlerPtr != NULL) {
-	    tsdPtr->firstTimerHandlerPtr = timerHandlerPtr->nextPtr;
-	    ckfree(timerHandlerPtr);
-	    timerHandlerPtr = tsdPtr->firstTimerHandlerPtr;
+	while ((tsdPtr->promptTail) != NULL) {
+	    TclpDeleteTimerEvent(tsdPtr->promptTail);
+	}
+	while ((tsdPtr->relTimerTail) != NULL) {
+	    TclpDeleteTimerEvent(tsdPtr->relTimerTail);
+	}
+	while ((tsdPtr->absTimerTail) != NULL) {
+	    TclpDeleteTimerEvent(tsdPtr->absTimerTail);
+	}
+	while ((tsdPtr->idleTail) != NULL) {
+	    TclpDeleteTimerEvent(tsdPtr->idleTail);
 	}
     }
 }
@@ -253,20 +458,151 @@ Tcl_CreateTimerHandler(
     Tcl_TimerProc *proc,	/* Function to invoke. */
     ClientData clientData)	/* Arbitrary data to pass to proc. */
 {
-    Tcl_Time time;
+    register TclTimerEvent *tmrEvent;
+    Tcl_WideInt usec;
 
     /*
-     * Compute when the event should fire.
+     * Compute when the event should fire (avoid overflow).
      */
 
-    Tcl_GetTime(&time);
-    time.sec += milliseconds/1000;
-    time.usec += (milliseconds%1000)*1000;
-    if (time.usec >= 1000000) {
-	time.usec -= 1000000;
-	time.sec += 1;
+    if (milliseconds < 0x7FFFFFFFFFFFFFFFL / 1000) {
+	usec = (Tcl_WideInt)milliseconds*1000;
+    } else {
+	usec = 0x7FFFFFFFFFFFFFFFL;
+    }
+
+    tmrEvent = TclpCreateTimerEvent(usec, proc, NULL, 0, 0);
+    if (tmrEvent == NULL) {
+	return NULL;
     }
-    return TclCreateAbsoluteTimerHandler(&time, proc, clientData);
+    tmrEvent->clientData = clientData;
+
+    return tmrEvent->token;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TclpCreateTimerEvent --
+ *
+ *	Arrange for a given function to be invoked at or in a particular time
+ *	in the future (microseconds).
+ *
+ * Results:
+ *	The return value is a handler entry of the timer event, which may be
+ *	used to access the event entry, e. g. delete the event before it fires.
+ *
+ * Side effects:
+ *	When the time or offset in timePtr has been reached, proc will be invoked
+ *	exactly once.
+ *
+ *--------------------------------------------------------------
+ */
+
+TclTimerEvent*
+TclpCreateTimerEvent(
+    Tcl_WideInt usec,		/* Time to be invoked (absolute/relative) */
+    Tcl_TimerProc *proc,	/* Function to invoke */
+    Tcl_TimerDeleteProc *deleteProc,/* Function to cleanup */
+    size_t extraDataSize,	/* Size of extra data to allocate */
+    int flags)			/* Flags corresponding type of event */
+{
+    register TclTimerEvent *tmrEvent;
+    ThreadSpecificData *tsdPtr;
+
+    tsdPtr = InitTimer();
+    tmrEvent = (TclTimerEvent *)ckalloc(
+			sizeof(TclTimerEvent) + extraDataSize);
+    if (tmrEvent == NULL) {
+	return NULL;
+    }
+
+    if (usec <= 0 && !(flags & (TCL_TMREV_AT|TCL_TMREV_PROMPT|TCL_TMREV_IDLE))) {
+    	usec = 0;
+    	flags |= TCL_TMREV_PROMPT;
+    }
+    
+    /*
+     * Fill in fields for the event.
+     */
+
+    tmrEvent->proc = proc;
+    tmrEvent->deleteProc = deleteProc;
+    tmrEvent->clientData = TclpTimerEvent2ExtraData(tmrEvent);
+    tmrEvent->flags = flags & (TCL_TMREV_AT|TCL_TMREV_PROMPT|TCL_TMREV_IDLE);
+    tsdPtr->lastTimerId++;
+    tmrEvent->token = (Tcl_TimerToken) INT2PTR(tsdPtr->lastTimerId);
+
+    /* 
+     * If TCL_TMREV_AT (and TCL_TMREV_PROMPT) are not specified, event observes
+     * due-time considering possible time-jump.
+     */
+    if (!(flags & (TCL_TMREV_AT|TCL_TMREV_PROMPT|TCL_TMREV_IDLE))) {
+	/* relative event - realign time using current relative base */
+	usec = TimerMakeRelativeTime(tsdPtr, usec);
+    }
+
+    tmrEvent->time = usec;
+    tmrEvent->refCount = 0;
+
+    /*
+     * Attach the event to the corresponding queue in the correct position
+     * (ordered by event firing time, if time specified).
+     */
+
+    AttachTimerEvent(tsdPtr, tmrEvent);
+
+    return tmrEvent;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TclpCreatePromptTimerEvent --
+ *
+ *	Arrange for proc to be invoked delayed (but prompt) as timer event,
+ *	without time ("after 0").
+ *	Or as idle event (the next time the system is idle i.e., just 
+ *	before the next time that Tcl_DoOneEvent would have to wait for
+ *	something to happen).
+ *
+ *	Providing the flag TCL_TMREV_PROMPT ensures that timer event-handler
+ *	will be queued immediately to guarantee the execution of timer-event
+ *	as soon as possible
+ *
+ * Results:
+ *	Returns the created timer entry.
+ *
+ * Side effects:
+ *	None.
+ *
+ *--------------------------------------------------------------
+ */
+
+TclTimerEvent *
+TclpCreatePromptTimerEvent(
+    Tcl_TimerProc *proc,		/* Function to invoke. */
+    Tcl_TimerDeleteProc *deleteProc,	/* Function to cleanup */
+    size_t extraDataSize,
+    int flags)
+{
+    register TclTimerEvent *tmrEvent;
+    ThreadSpecificData *tsdPtr = InitTimer();
+
+    tmrEvent = (TclTimerEvent *) ckalloc(sizeof(TclTimerEvent) + extraDataSize);
+    if (tmrEvent == NULL) {
+	return NULL;
+    }
+    tmrEvent->proc = proc;
+    tmrEvent->deleteProc = deleteProc;
+    tmrEvent->clientData = TclpTimerEvent2ExtraData(tmrEvent);
+    tmrEvent->flags = flags;
+    tmrEvent->time = 0;
+    tmrEvent->refCount = 0;
+
+    AttachTimerEvent(tsdPtr, tmrEvent);
+
+    return tmrEvent;
 }
 
 /*
@@ -275,11 +611,11 @@ Tcl_CreateTimerHandler(
  * TclCreateAbsoluteTimerHandler --
  *
  *	Arrange for a given function to be invoked at a particular time in the
- *	future.
+ *	future (absolute time).
  *
  * Results:
- *	The return value is a token for the timer event, which may be used to
- *	delete the event before it fires.
+ *	The return value is a token of the timer event, which
+ *	may be used to delete the event before it fires.
  *
  * Side effects:
  *	When the time in timePtr has been reached, proc will be invoked
@@ -294,42 +630,73 @@ TclCreateAbsoluteTimerHandler(
     Tcl_TimerProc *proc,
     ClientData clientData)
 {
-    register TimerHandler *timerHandlerPtr, *tPtr2, *prevPtr;
-    ThreadSpecificData *tsdPtr = InitTimer();
-
-    timerHandlerPtr = ckalloc(sizeof(TimerHandler));
+    register TclTimerEvent *tmrEvent;
+    Tcl_WideInt usec;
 
     /*
-     * Fill in fields for the event.
+     * Compute when the event should fire (avoid overflow).
      */
 
-    memcpy(&timerHandlerPtr->time, timePtr, sizeof(Tcl_Time));
-    timerHandlerPtr->proc = proc;
-    timerHandlerPtr->clientData = clientData;
-    tsdPtr->lastTimerId++;
-    timerHandlerPtr->token = (Tcl_TimerToken) INT2PTR(tsdPtr->lastTimerId);
+    if (timePtr->sec < 0x7FFFFFFFFFFFFFFFL / 1000000) {
+	usec = (((Tcl_WideInt)timePtr->sec) * 1000000) + timePtr->usec;
+    } else {
+	usec = 0x7FFFFFFFFFFFFFFFL;
+    }
+
+    tmrEvent = TclpCreateTimerEvent(usec, proc, NULL, 0, TCL_TMREV_AT);
+    if (tmrEvent == NULL) {
+	return NULL;
+    }
+    tmrEvent->clientData = clientData;
+
+    return tmrEvent->token;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TclCreateRelativeTimerHandler --
+ *
+ *	Arrange for a given function to be invoked in a particular time offset
+ *	in the future.
+ *
+ * Results:
+ *	The return value is token of the timer event, which
+ *	may be used to delete the event before it fires.
+ *
+ * Side effects:
+ *	In contrary to absolute timer functions operate on relative time.
+ *
+ *--------------------------------------------------------------
+ */
+
+Tcl_TimerToken
+TclCreateTimerHandler(
+    Tcl_Time *timePtr,
+    Tcl_TimerProc *proc,
+    ClientData clientData,
+    int flags)
+{
+    register TclTimerEvent *tmrEvent;
+    Tcl_WideInt usec;
 
     /*
-     * Add the event to the queue in the correct position
-     * (ordered by event firing time).
+     * Compute when the event should fire (avoid overflow).
      */
 
-    for (tPtr2 = tsdPtr->firstTimerHandlerPtr, prevPtr = NULL; tPtr2 != NULL;
-	    prevPtr = tPtr2, tPtr2 = tPtr2->nextPtr) {
-	if (TCL_TIME_BEFORE(timerHandlerPtr->time, tPtr2->time)) {
-	    break;
-	}
-    }
-    timerHandlerPtr->nextPtr = tPtr2;
-    if (prevPtr == NULL) {
-	tsdPtr->firstTimerHandlerPtr = timerHandlerPtr;
+    if (timePtr->sec < 0x7FFFFFFFFFFFFFFFL / 1000000) {
+	usec = (((Tcl_WideInt)timePtr->sec) * 1000000) + timePtr->usec;
     } else {
-	prevPtr->nextPtr = timerHandlerPtr;
+	usec = 0x7FFFFFFFFFFFFFFFL;
     }
 
-    TimerSetupProc(NULL, TCL_ALL_EVENTS);
+    tmrEvent = TclpCreateTimerEvent(usec, proc, NULL, 0, flags);
+    if (tmrEvent == NULL) {
+	return NULL;
+    }
+    tmrEvent->clientData = clientData;
 
-    return timerHandlerPtr->token;
+    return tmrEvent->token;
 }
 
 /*
@@ -353,30 +720,180 @@ TclCreateAbsoluteTimerHandler(
 void
 Tcl_DeleteTimerHandler(
     Tcl_TimerToken token)	/* Result previously returned by
-				 * Tcl_DeleteTimerHandler. */
+				 * Tcl_CreateTimerHandler. */
 {
-    register TimerHandler *timerHandlerPtr, *prevPtr;
+    register TclTimerEvent *tmrEvent;
     ThreadSpecificData *tsdPtr = InitTimer();
 
     if (token == NULL) {
 	return;
     }
 
-    for (timerHandlerPtr = tsdPtr->firstTimerHandlerPtr, prevPtr = NULL;
-	    timerHandlerPtr != NULL; prevPtr = timerHandlerPtr,
-	    timerHandlerPtr = timerHandlerPtr->nextPtr) {
-	if (timerHandlerPtr->token != token) {
+    for (tmrEvent = tsdPtr->relTimerTail;
+	tmrEvent != NULL;
+	tmrEvent = tmrEvent->prevPtr
+    ) {
+	if (tmrEvent->token != token) {
 	    continue;
 	}
-	if (prevPtr == NULL) {
-	    tsdPtr->firstTimerHandlerPtr = timerHandlerPtr->nextPtr;
-	} else {
-	    prevPtr->nextPtr = timerHandlerPtr->nextPtr;
+
+	TclpDeleteTimerEvent(tmrEvent);
+	return;
+    }
+
+    for (tmrEvent = tsdPtr->absTimerTail;
+	tmrEvent != NULL;
+	tmrEvent = tmrEvent->prevPtr
+    ) {
+	if (tmrEvent->token != token) {
+	    continue;
 	}
-	ckfree(timerHandlerPtr);
+
+	TclpDeleteTimerEvent(tmrEvent);
 	return;
     }
 }
+
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TclpDeleteTimerEvent --
+ *
+ *	Delete a previously-registered prompt, timer or idle handler.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Destroy the timer callback, so that its associated function will
+ *	not be called. If the callback has already fired this will be executed
+ *	internally.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+TclpDeleteTimerEvent(
+    TclTimerEvent *tmrEvent)	/* Result previously returned by */
+	/* TclpCreateTimerEvent or derivatives. */
+{
+    ThreadSpecificData *tsdPtr;
+
+    if (tmrEvent == NULL) {
+	return;
+    }
+
+    tsdPtr = InitTimer();
+
+    /* detach from list */
+    if (tmrEvent->flags & TCL_TMREV_LISTED) {
+	DetachTimerEvent(tsdPtr, tmrEvent);
+    }
+
+    /* free it via deleteProc and ckfree */
+    if (tmrEvent->deleteProc && !(tmrEvent->flags & TCL_TMREV_DELETE)) {
+	/* 
+	 * Mark this entry will be deleted, so it can avoid double delete and
+	 * caller can check in delete callback, the time entry handle is still
+	 * the same (was not overriden in some recursive async-envent).
+	 */
+    	tmrEvent->flags |= TCL_TMREV_DELETE;
+	(*tmrEvent->deleteProc)(tmrEvent->clientData);
+    }
+
+    /* if frozen somewhere (nested service cycle) */
+    if (tmrEvent->refCount > 0) {
+	/* do nothing - event will be automatically deleted hereafter */
+	return;
+    }
+
+    ckfree(tmrEvent);
+}
+
+TclTimerEvent *
+TclpProlongTimerEvent(
+    TclTimerEvent *tmrEvent,
+    Tcl_WideInt usec,
+    int flags)
+{
+#if 0
+    return NULL;
+#else
+    ThreadSpecificData *tsdPtr = InitTimer();
+
+    if (tmrEvent->flags & TCL_TMREV_DELETE) {
+	return NULL;
+    }
+    /* if still belong to the queue, detach it from corresponding list */
+    if (tmrEvent->flags & TCL_TMREV_LISTED) {
+	DetachTimerEvent(tsdPtr, tmrEvent);
+    }
+    /* set wanted flags and prolong */
+    tmrEvent->flags |= (flags & (TCL_TMREV_AT|TCL_TMREV_PROMPT|TCL_TMREV_IDLE));
+    /* new firing time */
+    if (!(flags & (TCL_TMREV_PROMPT|TCL_TMREV_IDLE))) {
+	/* if relative event - realign time using current relative base */
+	if (!(flags & TCL_TMREV_AT)) {
+	    usec = TimerMakeRelativeTime(tsdPtr, usec);
+	}
+	tmrEvent->time = usec;
+    }
+    /* attach to the queue again (new generation) */
+    AttachTimerEvent(tsdPtr, tmrEvent);
+    return tmrEvent;
+#endif
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TimerGetDueTime --
+ *
+ *	Find the execution time offset of first relative or absolute timer 
+ *	starting from given heads.
+ *
+ * Results:
+ *	A wide integer representing the due time (as microseconds) of first
+ *	timer event to execute.
+ *
+ * Side effects:
+ *	If time-jump recognized, may adjust the base for relative timers.
+ *
+ *--------------------------------------------------------------
+ */
+
+static Tcl_WideInt
+TimerGetDueTime(
+    ThreadSpecificData *tsdPtr,
+    TclTimerEvent *relTimerList,
+    TclTimerEvent *absTimerList,
+    TclTimerEvent **dueEventPtr)
+{
+    TclTimerEvent *tmrEvent;
+    Tcl_WideInt timeOffs = 0x7FFFFFFFFFFFFFFFL;
+
+    /* find shortest due-time */
+    if ((tmrEvent = relTimerList) != NULL) {
+	/* offset to now (monotonic base) */
+	timeOffs = tsdPtr->relTimerBase + tmrEvent->time
+			    - TclpGetUTimeMonotonic();
+    }
+    if (absTimerList) {
+	Tcl_WideInt absOffs;
+	/* offset to now (real-time base) */
+	absOffs = absTimerList->time - TclpGetMicroseconds();
+	if (!tmrEvent || absOffs < timeOffs) {
+	    tmrEvent = absTimerList;
+	    timeOffs = absOffs;
+	}
+    }
+
+    if (dueEventPtr) {
+	*dueEventPtr = tmrEvent;
+    }
+    return timeOffs;
+}
 
 /*
  *----------------------------------------------------------------------
@@ -398,37 +915,65 @@ Tcl_DeleteTimerHandler(
 
 static void
 TimerSetupProc(
-    ClientData data,		/* Not used. */
+    ClientData data,		/* Specific data. */
     int flags)			/* Event flags as passed to Tcl_DoOneEvent. */
 {
     Tcl_Time blockTime;
-    ThreadSpecificData *tsdPtr = InitTimer();
+    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)data;
 
-    if (((flags & TCL_IDLE_EVENTS) && tsdPtr->idleList)
-	    || ((flags & TCL_TIMER_EVENTS) && tsdPtr->timerPending)) {
+    if (tsdPtr == NULL) { tsdPtr = InitTimer(); };
+
+    if ( ((flags & TCL_TIMER_EVENTS) && (tsdPtr->timerPending || tsdPtr->promptList))
+      || ((flags & TCL_IDLE_EVENTS) && tsdPtr->idleList )
+    ) {
 	/*
-	 * There is an idle handler or a pending timer event, so just poll.
+	 * There is a pending timer event or an idle handler, so just poll.
 	 */
 
 	blockTime.sec = 0;
 	blockTime.usec = 0;
-    } else if ((flags & TCL_TIMER_EVENTS) && tsdPtr->firstTimerHandlerPtr) {
+    } else if (
+	   (flags & TCL_TIMER_EVENTS) 
+	&& (tsdPtr->relTimerList || tsdPtr->absTimerList)
+    ) {
 	/*
 	 * Compute the timeout for the next timer on the list.
 	 */
+	Tcl_WideInt timeOffs;
 
-	Tcl_GetTime(&blockTime);
-	blockTime.sec = tsdPtr->firstTimerHandlerPtr->time.sec - blockTime.sec;
-	blockTime.usec = tsdPtr->firstTimerHandlerPtr->time.usec -
-		blockTime.usec;
-	if (blockTime.usec < 0) {
-	    blockTime.sec -= 1;
-	    blockTime.usec += 1000000;
-	}
-	if (blockTime.sec < 0) {
+	timeOffs = TimerGetDueTime(tsdPtr,
+			tsdPtr->relTimerList, tsdPtr->absTimerList, NULL);
+
+	#ifdef TMR_RES_TOLERANCE
+	    /* consider timer resolution tolerance (avoid busy wait) */
+	    timeOffs -= ((timeOffs <= 1000000) ? timeOffs : 1000000) *
+				TMR_RES_TOLERANCE / 100;
+	#endif
+
+	if (timeOffs > 0) {
+	    blockTime.sec = 0;
+	    if (timeOffs >= 1000000) {
+		/*
+		 * Note we use monotonic time by all wait functions, so to
+		 * avoid too long wait by the absolute timers (to be able
+		 * to trigger it) if time jumped to the expected time, just
+		 * let block for maximal 1s if absolute timers available.
+		 */
+		if (tsdPtr->absTimerList) {
+		    /* we've some absolute timers - won't wait longer as 1s. */
+		    timeOffs = 1000000;
+		}
+		blockTime.sec = (long) (timeOffs / 1000000);
+		blockTime.usec = (unsigned long)(timeOffs % 1000000);
+	    } else {
+		blockTime.sec = 0;
+		blockTime.usec = (unsigned long)timeOffs;
+	    }
+	} else {
 	    blockTime.sec = 0;
 	    blockTime.usec = 0;
 	}
+	
     } else {
 	return;
     }
@@ -442,8 +987,7 @@ TimerSetupProc(
  * TimerCheckProc --
  *
  *	This function is called by Tcl_DoOneEvent to check the timer event
- *	source for events. This routine checks both the idle and after timer
- *	lists.
+ *	source for events. This routine checks the first timer in the list.
  *
  * Results:
  *	None.
@@ -456,59 +1000,65 @@ TimerSetupProc(
 
 static void
 TimerCheckProc(
-    ClientData data,		/* Not used. */
+    ClientData data,		/* Specific data. */
     int flags)			/* Event flags as passed to Tcl_DoOneEvent. */
 {
-    Tcl_Event *timerEvPtr;
-    Tcl_Time blockTime;
-    ThreadSpecificData *tsdPtr = InitTimer();
+    Tcl_WideInt timeOffs = 0;
+    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)data;
 
-    if ((flags & TCL_TIMER_EVENTS) && tsdPtr->firstTimerHandlerPtr) {
-	/*
-	 * Compute the timeout for the next timer on the list.
-	 */
+    if (!(flags & TCL_TIMER_EVENTS)) {
+    	return;
+    }
 
-	Tcl_GetTime(&blockTime);
-	blockTime.sec = tsdPtr->firstTimerHandlerPtr->time.sec - blockTime.sec;
-	blockTime.usec = tsdPtr->firstTimerHandlerPtr->time.usec -
-		blockTime.usec;
-	if (blockTime.usec < 0) {
-	    blockTime.sec -= 1;
-	    blockTime.usec += 1000000;
-	}
-	if (blockTime.sec < 0) {
-	    blockTime.sec = 0;
-	    blockTime.usec = 0;
-	}
+    if (tsdPtr == NULL) { tsdPtr = InitTimer(); };
 
-	/*
-	 * If the first timer has expired, stick an event on the queue.
-	 */
+    /* If already pending (or prompt-events) */
+    if (tsdPtr->timerPending || tsdPtr->promptList) {
+	goto mark;
+    }
 
-	if (blockTime.sec == 0 && blockTime.usec == 0 &&
-		!tsdPtr->timerPending) {
-	    tsdPtr->timerPending = 1;
-	    timerEvPtr = ckalloc(sizeof(Tcl_Event));
-	    timerEvPtr->proc = TimerHandlerEventProc;
-	    Tcl_QueueEvent(timerEvPtr, TCL_QUEUE_TAIL);
-	}
+    /*
+     * Verify the first timer on the queue.
+     */
+
+    if (!tsdPtr->relTimerList && !tsdPtr->absTimerList) {
+	return;
+    }
+
+    timeOffs = TimerGetDueTime(tsdPtr,
+			tsdPtr->relTimerList, tsdPtr->absTimerList, NULL);
+
+#ifdef TMR_RES_TOLERANCE
+    /* consider timer resolution tolerance (avoid busy wait) */
+    timeOffs -= ((timeOffs <= 1000000) ? timeOffs : 1000000) *
+			TMR_RES_TOLERANCE / 100;
+#endif
+   
+    /*
+    * If the first timer has expired, stick an event on the queue.
+    */
+    if (timeOffs <= 0) {
+  mark:
+	TclSetTimerEventMarker(flags); /* force timer execution */
+	tsdPtr->timerPending = 1;
     }
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * TimerHandlerEventProc --
+ * TclServiceTimerEvents --
  *
- *	This function is called by Tcl_ServiceEvent when a timer event reaches
- *	the front of the event queue. This function handles the event by
+ *	This function is called by Tcl_ServiceEvent when a timer events should 
+ *	be processed. This function handles the event by
  *	invoking the callbacks for all timers that are ready.
  *
  * Results:
  *	Returns 1 if the event was handled, meaning it should be removed from
- *	the queue. Returns 0 if the event was not handled, meaning it should
- *	stay on the queue. The only time the event isn't handled is if the
- *	TCL_TIMER_EVENTS flag bit isn't set.
+ *	the queue. 
+ *	Returns 0 if the event was not handled (no timer events).
+ *	Returns -1 if pending timer events available, meaning the marker should
+ *	stay on the head of queue.
  *
  * Side effects:
  *	Whatever the timer handler callback functions do.
@@ -516,25 +1066,17 @@ TimerCheckProc(
  *----------------------------------------------------------------------
  */
 
-static int
-TimerHandlerEventProc(
-    Tcl_Event *evPtr,		/* Event to service. */
-    int flags)			/* Flags that indicate what events to handle,
-				 * such as TCL_FILE_EVENTS. */
+int
+TclServiceTimerEvents(void)
 {
-    TimerHandler *timerHandlerPtr, **nextPtrPtr;
-    Tcl_Time time;
-    int currentTimerId;
+    TclTimerEvent *tmrEvent, *relTimerList, *absTimerList;
+    size_t currentGeneration, currentEpoch;
+    int result = 0;
+    int prevTmrPending;
     ThreadSpecificData *tsdPtr = InitTimer();
 
-    /*
-     * Do nothing if timers aren't enabled. This leaves the event on the
-     * queue, so we will get to it as soon as ServiceEvents() is called with
-     * timers enabled.
-     */
-
-    if (!(flags & TCL_TIMER_EVENTS)) {
-	return 0;
+    if (!tsdPtr->timerPending) {
+    	return 0; /* no timer events */
     }
 
     /*
@@ -543,9 +1085,7 @@ TimerHandlerEventProc(
      * 1. New handlers can get added to the list while the current one is
      *	  being processed. If new ones get added, we don't want to process
      *	  them during this pass through the list to avoid starving other event
-     *	  sources. This is implemented using the token number in the handler:
-     *	  new handlers will have a newer token than any of the ones currently
-     *	  on the list.
+     *	  sources. This is implemented using check of the generation epoch.
      * 2. The handler can call Tcl_DoOneEvent, so we have to remove the
      *	  handler from the list before calling it. Otherwise an infinite loop
      *	  could result.
@@ -562,39 +1102,140 @@ TimerHandlerEventProc(
      *	  timers appearing before later ones.
      */
 
+    currentGeneration = tsdPtr->timerGeneration++;
     tsdPtr->timerPending = 0;
-    currentTimerId = tsdPtr->lastTimerId;
-    Tcl_GetTime(&time);
-    while (1) {
-	nextPtrPtr = &tsdPtr->firstTimerHandlerPtr;
-	timerHandlerPtr = tsdPtr->firstTimerHandlerPtr;
-	if (timerHandlerPtr == NULL) {
-	    break;
+
+    /* First process all prompt (immediate) events */
+    while ((tmrEvent = tsdPtr->promptList) != NULL
+	&& tmrEvent->generation <= currentGeneration
+    ) {
+	/* freeze / detach entry from the owner's list */
+	tmrEvent->refCount++;
+	tmrEvent->flags &= ~TCL_TMREV_LISTED;
+	TclSpliceOutEx(tmrEvent, tsdPtr->promptList, tsdPtr->promptTail);
+	/* reset current timer pending (correct process nested wait event) */
+	prevTmrPending = tsdPtr->timerPending;
+	tsdPtr->timerPending = 0;
+	/* execute event */
+	(*tmrEvent->proc)(tmrEvent->clientData);
+	result = 1;
+	/* restore current timer pending */
+	tsdPtr->timerPending += prevTmrPending;
+	/* unfreeze / if used somewhere else (nested) or prolongation (reattached) */
+	if (tmrEvent->refCount-- > 1 || (tmrEvent->flags & TCL_TMREV_LISTED)) {
+	    continue;
+	};
+	/* free it via deleteProc and ckfree */
+	if (tmrEvent->deleteProc && !(tmrEvent->flags & TCL_TMREV_DELETE)) {
+	    tmrEvent->flags |= TCL_TMREV_DELETE;
+	    (*tmrEvent->deleteProc)(tmrEvent->clientData);
 	}
+	ckfree(tmrEvent);
+    }
+
+    /* if stil pending prompt events (new generation) - repeat event cycle as 
+     * soon as possible */
+    if (tsdPtr->promptList) {
+        tsdPtr->timerPending = 1;
+    	return -1;
+    }
 
-	if (TCL_TIME_BEFORE(time, timerHandlerPtr->time)) {
+    /* Hereafter all relative and absolute timer events with time before now */
+    relTimerList = tsdPtr->relTimerList;
+    absTimerList = tsdPtr->absTimerList;
+    while (relTimerList || absTimerList) {
+	Tcl_WideInt timeOffs;
+
+	/* find timer (absolute/relative) with shortest due-time */
+	timeOffs = TimerGetDueTime(tsdPtr,
+			relTimerList, absTimerList, &tmrEvent);
+    	/* the same tolerance logic as in TimerSetupProc/TimerCheckProc */
+    #ifdef TMR_RES_TOLERANCE
+	timeOffs -= ((timeOffs <= 1000000) ? timeOffs : 1000000) *
+				TMR_RES_TOLERANCE / 100;
+    #endif
+	/* still not reached */
+	if (timeOffs > 0) {
 	    break;
 	}
 
+	/* for the next iteration */
+	if (tmrEvent == relTimerList) {
+	    relTimerList = tmrEvent->nextPtr;
+	} else {
+	    absTimerList = tmrEvent->nextPtr;
+	}
+
 	/*
-	 * Bail out if the next timer is of a newer generation.
+	 * Bypass timers of newer generation.
 	 */
 
-	if ((currentTimerId - PTR2INT(timerHandlerPtr->token)) < 0) {
-	    break;
+	if (tmrEvent->generation > currentGeneration) {
+	    /* increase pending to signal repeat */
+	    tsdPtr->timerPending++;
+	    continue;
 	}
 
+	tsdPtr->timerListEpoch++; /* signal - timer list was changed */
+	currentEpoch = tsdPtr->timerListEpoch; /* save it to compare */
+	 
 	/*
 	 * Remove the handler from the queue before invoking it, to avoid
 	 * potential reentrancy problems.
 	 */
+	tmrEvent->refCount++; /* freeze */
+	tmrEvent->flags &= ~TCL_TMREV_LISTED;
+	if (!(tmrEvent->flags & TCL_TMREV_AT)) {
+	    TclSpliceOutEx(tmrEvent,
+		tsdPtr->relTimerList, tsdPtr->relTimerTail);
+	} else {
+	    TclSpliceOutEx(tmrEvent,
+		tsdPtr->absTimerList, tsdPtr->absTimerTail);
+	}
+
+	/* reset current timer pending (correct process nested wait event) */
+	prevTmrPending = tsdPtr->timerPending;
+	tsdPtr->timerPending = 0;
+	/* invoke timer proc */
+	(*tmrEvent->proc)(tmrEvent->clientData);
+	result = 1;
+	/* restore current timer pending */
+	tsdPtr->timerPending += prevTmrPending;
+	/* unfreeze / if used somewhere else (nested) or prolongation (reattached) */
+	if (tmrEvent->refCount-- > 1 || (tmrEvent->flags & TCL_TMREV_LISTED)) {
+	    goto nextEvent;
+	};
+	/* free it via deleteProc and ckfree */
+	if (tmrEvent->deleteProc && !(tmrEvent->flags & TCL_TMREV_DELETE)) {
+	    tmrEvent->flags |= TCL_TMREV_DELETE;
+	    (*tmrEvent->deleteProc)(tmrEvent->clientData);
+	}
+	ckfree(tmrEvent);
+    
+    nextEvent:
+	/* be sure that timer-list was not changed inside the proc call */
+	if (currentEpoch != tsdPtr->timerListEpoch) {
+	    /* timer-list was changed - stop processing */
+	    tsdPtr->timerPending++;
+	    break;
+	}
+    }
 
-	*nextPtrPtr = timerHandlerPtr->nextPtr;
-	timerHandlerPtr->proc(timerHandlerPtr->clientData);
-	ckfree(timerHandlerPtr);
+    /* pending timer events, so mark (queue) timer events  */
+    if (tsdPtr->timerPending >= 1) {
+    	tsdPtr->timerPending = 1;
+    	return -1;
     }
-    TimerSetupProc(NULL, TCL_TIMER_EVENTS);
-    return 1;
+
+    /* Reset generation if both timer queue are empty */
+    if (!tsdPtr->promptList && !tsdPtr->relTimerList && !tsdPtr->absTimerList) {
+	tsdPtr->timerGeneration = 0;
+    }
+
+    /* Compute the next timeout (later via TimerSetupProc using the first timer). */
+    tsdPtr->timerPending = 0;
+
+    return result; /* processing done, again later via TimerCheckProc */
 }
 
 /*
@@ -615,31 +1256,16 @@ TimerHandlerEventProc(
  *
  *--------------------------------------------------------------
  */
-
 void
 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();
+    TclTimerEvent *idlePtr = TclpCreatePromptTimerEvent(proc, NULL, 0, TCL_TMREV_IDLE);
 
-    idlePtr = ckalloc(sizeof(IdleHandler));
-    idlePtr->proc = proc;
-    idlePtr->clientData = clientData;
-    idlePtr->generation = tsdPtr->idleGeneration;
-    idlePtr->nextPtr = NULL;
-    if (tsdPtr->lastIdlePtr == NULL) {
-	tsdPtr->idleList = idlePtr;
-    } else {
-	tsdPtr->lastIdlePtr->nextPtr = idlePtr;
+    if (idlePtr) {
+    	idlePtr->clientData = clientData;
     }
-    tsdPtr->lastIdlePtr = idlePtr;
-
-    blockTime.sec = 0;
-    blockTime.usec = 0;
-    Tcl_SetMaxBlockTime(&blockTime);
 }
 
 /*
@@ -665,26 +1291,26 @@ Tcl_CancelIdleCall(
     Tcl_IdleProc *proc,		/* Function that was previously registered. */
     ClientData clientData)	/* Arbitrary value to pass to proc. */
 {
-    register IdleHandler *idlePtr, *prevPtr;
-    IdleHandler *nextPtr;
+    register TclTimerEvent *idlePtr, *nextPtr;
     ThreadSpecificData *tsdPtr = InitTimer();
 
-    for (prevPtr = NULL, idlePtr = tsdPtr->idleList; idlePtr != NULL;
-	    prevPtr = idlePtr, idlePtr = idlePtr->nextPtr) {
-	while ((idlePtr->proc == proc)
+    for (idlePtr = tsdPtr->idleList;
+    	idlePtr != NULL;
+	idlePtr = nextPtr
+    ) {
+    	nextPtr = idlePtr->nextPtr;
+	if ((idlePtr->proc == proc)
 		&& (idlePtr->clientData == clientData)) {
-	    nextPtr = idlePtr->nextPtr;
-	    ckfree(idlePtr);
-	    idlePtr = nextPtr;
-	    if (prevPtr == NULL) {
-		tsdPtr->idleList = idlePtr;
-	    } else {
-		prevPtr->nextPtr = idlePtr;
-	    }
-	    if (idlePtr == NULL) {
-		tsdPtr->lastIdlePtr = prevPtr;
-		return;
+	    /* detach entry from the owner list */
+	    idlePtr->flags &= ~TCL_TMREV_LISTED;
+	    TclSpliceOutEx(idlePtr, tsdPtr->idleList, tsdPtr->idleTail);
+
+	    /* free it via deleteProc and ckfree */
+	    if (idlePtr->deleteProc && !(idlePtr->flags & TCL_TMREV_DELETE)) {
+		idlePtr->flags |= TCL_TMREV_DELETE;
+		(*idlePtr->deleteProc)(idlePtr->clientData);
 	    }
+	    ckfree(idlePtr);
 	}
     }
 }
@@ -692,7 +1318,7 @@ Tcl_CancelIdleCall(
 /*
  *----------------------------------------------------------------------
  *
- * TclServiceIdle --
+ * TclServiceIdle -- , TclServiceIdleEx --
  *
  *	This function is invoked by the notifier when it becomes idle. It will
  *	invoke all idle handlers that are present at the time the call is
@@ -709,19 +1335,19 @@ Tcl_CancelIdleCall(
  */
 
 int
-TclServiceIdle(void)
+TclServiceIdleEx(
+    int flags,
+    int count)
 {
-    IdleHandler *idlePtr;
-    int oldGeneration;
-    Tcl_Time blockTime;
+    TclTimerEvent *idlePtr;
+    size_t currentGeneration;
     ThreadSpecificData *tsdPtr = InitTimer();
 
-    if (tsdPtr->idleList == NULL) {
+    if ((idlePtr = tsdPtr->idleList) == NULL) {
 	return 0;
     }
 
-    oldGeneration = tsdPtr->idleGeneration;
-    tsdPtr->idleGeneration++;
+    currentGeneration = tsdPtr->idleGeneration++;
 
     /*
      * The code below is trickier than it may look, for the following reasons:
@@ -740,24 +1366,113 @@ TclServiceIdle(void)
      *	  during the call.
      */
 
-    for (idlePtr = tsdPtr->idleList;
-	    ((idlePtr != NULL)
-		    && ((oldGeneration - idlePtr->generation) >= 0));
-	    idlePtr = tsdPtr->idleList) {
-	tsdPtr->idleList = idlePtr->nextPtr;
-	if (tsdPtr->idleList == NULL) {
-	    tsdPtr->lastIdlePtr = NULL;
+    while (idlePtr->generation <= currentGeneration) {
+	/* freeze / detach entry from the owner's list */
+	idlePtr->refCount++;
+	idlePtr->flags &= ~TCL_TMREV_LISTED;
+	TclSpliceOutEx(idlePtr, tsdPtr->idleList, tsdPtr->idleTail);
+
+	/* execute event */
+	(*idlePtr->proc)(idlePtr->clientData);
+	/* unfreeze / if used somewhere else (nested) or prolongation (reattached) */
+	if (idlePtr->refCount-- > 1 || (idlePtr->flags & TCL_TMREV_LISTED)) {
+	    goto nextEvent;
+	};
+	/* free it via deleteProc and ckfree */
+	if (idlePtr->deleteProc && !(idlePtr->flags & TCL_TMREV_DELETE)) {
+	    idlePtr->flags |= TCL_TMREV_DELETE;
+	    (*idlePtr->deleteProc)(idlePtr->clientData);
 	}
-	idlePtr->proc(idlePtr->clientData);
 	ckfree(idlePtr);
+
+    nextEvent:
+	/*
+	 * Stop processing idle if idle queue empty, count reached or other
+	 * events queued (only if not idle events only to service).
+	 */
+	if ( (idlePtr = tsdPtr->idleList) == NULL
+	  || !--count
+	  || ((flags & TCL_ALL_EVENTS) != TCL_IDLE_EVENTS 
+		&& TclPeekEventQueued(flags))
+	) {
+	    break;
+	}
     }
-    if (tsdPtr->idleList) {
-	blockTime.sec = 0;
-	blockTime.usec = 0;
-	Tcl_SetMaxBlockTime(&blockTime);
+
+    /* Reset generation */
+    if (!tsdPtr->idleList) {
+    	tsdPtr->idleGeneration = 0;
     }
     return 1;
 }
+
+int
+TclServiceIdle(void)
+{
+    return TclServiceIdleEx(TCL_ALL_EVENTS, INT_MAX);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpGetUTimeFromObj --
+ *
+ *	This function converts numeric tcl-object contains decimal milliseconds,
+ *	(using milliseconds base) to time offset in microseconds,
+ *
+ *	If input object contains double, the return time has microsecond 
+ *	precision.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	If possible leaves internal representation unchanged (e. g. integer).
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclpGetUTimeFromObj(
+    Tcl_Interp	*interp,	/* Current interpreter or NULL. */
+    Tcl_Obj	*objPtr,	/* Object to read numeric time (in units
+				 * corresponding given factor). */
+    Tcl_WideInt	*timePtr,	/* Resulting time if converted (in microseconds). */
+    int factor)			/* Current factor of the time-object:
+				 *         1 - microseconds,
+				 *	1000 - milliseconds,
+				 *   1000000 - seconds */
+{
+    if (objPtr->typePtr != &tclDoubleType) {
+	Tcl_WideInt tm;
+	if (Tcl_GetWideIntFromObj(NULL, objPtr, &tm) == TCL_OK) {
+	    if (tm < 0x7FFFFFFFFFFFFFFFL / factor) { /* avoid overflow */
+		*timePtr = (tm * factor);
+		return TCL_OK;
+	    }
+	    *timePtr = 0x7FFFFFFFFFFFFFFFL;
+	    return TCL_OK;
+	}
+    }
+    if (1) {
+	double tm;
+	if (Tcl_GetDoubleFromObj(interp, objPtr, &tm) == TCL_OK) {
+	    if (tm < 0x7FFFFFFFFFFFFFFFL / factor) { /* avoid overflow */
+		/* use precise as possible calculation by double (microseconds) */
+		if (factor == 1) {
+		    *timePtr = (Tcl_WideInt)tm;
+		} else {
+		    *timePtr = ((Tcl_WideInt)tm * factor) + 
+			(((Tcl_WideInt)(tm*factor)) % factor);
+		}
+		return TCL_OK;
+	    }
+	    *timePtr = 0x7FFFFFFFFFFFFFFFL;
+	    return TCL_OK;
+	}
+    }
+    return TCL_ERROR;
+}
 
 /*
  *----------------------------------------------------------------------
@@ -784,16 +1499,20 @@ Tcl_AfterObjCmd(
     int objc,			/* Number of arguments. */
     Tcl_Obj *const objv[])	/* Argument objects. */
 {
-    Tcl_WideInt ms = 0;		/* Number of milliseconds to wait */
-    Tcl_Time wakeup;
+
+
+
+    Tcl_WideInt usec;		/* Number of microseconds to wait (or time to wakeup) */
     AfterInfo *afterPtr;
     AfterAssocData *assocPtr;
     int length;
     int index;
-    static const char *const afterSubCmds[] = {
-	"cancel", "idle", "info", NULL
+    static const char *afterSubCmds[] = {
+	"at", "cancel", "idle", "info", NULL
+    };
+    enum afterSubCmds {
+	AFTER_AT, AFTER_CANCEL, AFTER_IDLE, AFTER_INFO
     };
-    enum afterSubCmds {AFTER_CANCEL, AFTER_IDLE, AFTER_INFO};
     ThreadSpecificData *tsdPtr = InitTimer();
 
     if (objc < 2) {
@@ -811,6 +1530,7 @@ Tcl_AfterObjCmd(
 	assocPtr = ckalloc(sizeof(AfterAssocData));
 	assocPtr->interp = interp;
 	assocPtr->firstAfterPtr = NULL;
+	assocPtr->lastAfterPtr = NULL;
 	Tcl_SetAssocData(interp, "tclAfter", AfterCleanupProc, assocPtr);
     }
 
@@ -818,45 +1538,84 @@ Tcl_AfterObjCmd(
      * First lets see if the command was passed a number as the first argument.
      */
 
-    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;
-	}
+    index = -1;
+    if ( ( TclObjIsIndexOfTable(objv[1], afterSubCmds)
+	|| TclpGetUTimeFromObj(NULL, objv[1], &usec, 1000) != TCL_OK
+      )
+      && Tcl_GetIndexFromObj(NULL, objv[1], afterSubCmds, "", 0,
+				 &index) != TCL_OK
+    ) {
+	const char *arg = Tcl_GetString(objv[1]);
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		"bad argument \"%s\": must be "
+		"at, cancel, idle, info or a time", arg));
+        Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "argument",
+                arg, NULL);
+	return TCL_ERROR;
     }
 
-    /*
-     * At this point, either index = -1 and ms contains the number of ms
+    /* 
+     * At this point, either index = -1 and usec contains the time
      * to wait, or else index is the index of a subcommand.
      */
 
     switch (index) {
-    case -1: {
-	if (ms < 0) {
-	    ms = 0;
+    case -1:
+	/* usec already contains time-offset from objv[1] */
+	/* relative time offset should be positive */
+	if (usec < 0) {
+	    usec = 0;
 	}
 	if (objc == 2) {
-	    return AfterDelay(interp, ms);
+	    /* after <offset> */
+	    return AfterDelay(interp, usec, 0);
 	}
-	afterPtr = ckalloc(sizeof(AfterInfo));
+    case AFTER_AT: {
+    	TclTimerEvent *tmrEvent;
+    	int flags = 0;
+    	if (index == AFTER_AT) {
+	    flags = TCL_TMREV_AT;
+    	    objc--;
+    	    objv++;
+	    if (objc < 2) {
+		Tcl_WrongNumArgs(interp, 1, objv, "?option? time");
+		return TCL_ERROR;
+	    }
+	    /* get time from object, default factor for "at" - 1000000 (s) */
+	    if (TclpGetUTimeFromObj(interp, objv[1], &usec, 1000000) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	    if (objc == 2) {
+		/* after at <time> */
+		return AfterDelay(interp, usec, flags);
+	    }
+	}
+
+	if (usec || (index == AFTER_AT)) {
+	    /* after ?at? <time|offset> <command> ... */
+	    tmrEvent = TclpCreateTimerEvent(usec, AfterProc,
+			    FreeAfterPtr, sizeof(AfterInfo), flags);
+	} else {
+	    /* after 0 <command> ... */
+	    tmrEvent = TclpCreatePromptTimerEvent(AfterProc,
+			    FreeAfterPtr, sizeof(AfterInfo), TCL_TMREV_PROMPT);
+	}
+
+	if (tmrEvent == NULL) { /* error handled in panic */
+	    return TCL_ERROR;
+	}
+	afterPtr = TclpTimerEvent2AfterInfo(tmrEvent);
+
+	/* attach to the list */
 	afterPtr->assocPtr = assocPtr;
+	TclSpliceTailEx(afterPtr, 
+		assocPtr->firstAfterPtr, assocPtr->lastAfterPtr);
+	afterPtr->selfPtr = NULL;
+
 	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);
 
@@ -870,20 +1629,9 @@ Tcl_AfterObjCmd(
 	 * around when wrap-around occurs.
 	 */
 
-	afterPtr->id = tsdPtr->afterId;
-	tsdPtr->afterId += 1;
-	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;
-	Tcl_SetObjResult(interp, Tcl_ObjPrintf("after#%d", afterPtr->id));
+	afterPtr->id = tsdPtr->afterId++;
+
+	Tcl_SetObjResult(interp, GetAfterObj(afterPtr));
 	return TCL_OK;
     }
     case AFTER_CANCEL: {
@@ -895,94 +1643,116 @@ Tcl_AfterObjCmd(
 	    Tcl_WrongNumArgs(interp, 2, objv, "id|command");
 	    return TCL_ERROR;
 	}
+
+	afterPtr = NULL;
 	if (objc == 3) {
 	    commandPtr = objv[2];
 	} else {
 	    commandPtr = Tcl_ConcatObj(objc-2, objv+2);;
 	}
-	command = Tcl_GetStringFromObj(commandPtr, &length);
-	for (afterPtr = assocPtr->firstAfterPtr;  afterPtr != NULL;
-		afterPtr = afterPtr->nextPtr) {
-	    tempCommand = Tcl_GetStringFromObj(afterPtr->commandPtr,
-		    &tempLength);
-	    if ((length == tempLength)
+	if (commandPtr->typePtr == &afterObjType) {
+	    afterPtr = (AfterInfo*)commandPtr->internalRep.twoPtrValue.ptr1;
+	} else {
+	    command = Tcl_GetStringFromObj(commandPtr, &length);
+	    for (afterPtr = assocPtr->lastAfterPtr;
+		 afterPtr != NULL;
+		 afterPtr = afterPtr->prevPtr
+	    ) {
+		tempCommand = Tcl_GetStringFromObj(afterPtr->commandPtr,
+			&tempLength);
+		if ((length == tempLength)
 		    && !memcmp(command, tempCommand, (unsigned) length)) {
-		break;
+		    break;
+		}
 	    }
-	}
-	if (afterPtr == NULL) {
-	    afterPtr = GetAfterEvent(assocPtr, commandPtr);
-	}
-	if (objc != 3) {
-	    Tcl_DecrRefCount(commandPtr);
-	}
-	if (afterPtr != NULL) {
-	    if (afterPtr->token != NULL) {
-		Tcl_DeleteTimerHandler(afterPtr->token);
-	    } else {
-		Tcl_CancelIdleCall(AfterProc, afterPtr);
+	    if (afterPtr == NULL) {
+		afterPtr = GetAfterEvent(assocPtr, commandPtr);
+	    }
+	    if (objc != 3) {
+		Tcl_DecrRefCount(commandPtr);
 	    }
-	    FreeAfterPtr(afterPtr);
+	}
+	if (afterPtr != NULL && afterPtr->assocPtr->interp == interp) {
+	    TclpDeleteTimerEvent(TclpAfterInfo2TimerEvent(afterPtr));
 	}
 	break;
     }
-    case AFTER_IDLE:
+    case AFTER_IDLE: {
+    	TclTimerEvent *idlePtr;
+
 	if (objc < 3) {
 	    Tcl_WrongNumArgs(interp, 2, objv, "script ?script ...?");
 	    return TCL_ERROR;
 	}
-	afterPtr = ckalloc(sizeof(AfterInfo));
+
+	idlePtr = TclpCreatePromptTimerEvent(AfterProc,
+			FreeAfterPtr, sizeof(AfterInfo), TCL_TMREV_IDLE);
+	if (idlePtr == NULL) { /* error handled in panic */
+	    return TCL_ERROR;
+	}
+	afterPtr = TclpTimerEvent2AfterInfo(idlePtr);
+
+	/* attach to the list */
 	afterPtr->assocPtr = assocPtr;
+	TclSpliceTailEx(afterPtr, 
+		assocPtr->firstAfterPtr, assocPtr->lastAfterPtr);
+	afterPtr->selfPtr = NULL;
+
 	if (objc == 3) {
 	    afterPtr->commandPtr = objv[2];
 	} else {
 	    afterPtr->commandPtr = Tcl_ConcatObj(objc-2, objv+2);
 	}
 	Tcl_IncrRefCount(afterPtr->commandPtr);
-	afterPtr->id = tsdPtr->afterId;
-	tsdPtr->afterId += 1;
-	afterPtr->token = NULL;
-	afterPtr->nextPtr = assocPtr->firstAfterPtr;
-	assocPtr->firstAfterPtr = afterPtr;
-	Tcl_DoWhenIdle(AfterProc, afterPtr);
-	Tcl_SetObjResult(interp, Tcl_ObjPrintf("after#%d", afterPtr->id));
-	break;
-    case AFTER_INFO:
+	
+	afterPtr->id = tsdPtr->afterId++;
+	
+	Tcl_SetObjResult(interp, GetAfterObj(afterPtr));
+
+	return TCL_OK;
+    };
+    case AFTER_INFO: {
+	Tcl_Obj *resultListPtr;
+
 	if (objc == 2) {
+	    /* return list of all after-events */
             Tcl_Obj *resultObj = Tcl_NewObj();
-
-	    for (afterPtr = assocPtr->firstAfterPtr; afterPtr != NULL;
-		    afterPtr = afterPtr->nextPtr) {
-		if (assocPtr->interp == interp) {
-                    Tcl_ListObjAppendElement(NULL, resultObj, Tcl_ObjPrintf(
-                            "after#%d", afterPtr->id));
+	    for (afterPtr = assocPtr->lastAfterPtr;
+		 afterPtr != NULL;
+		 afterPtr = afterPtr->prevPtr
+	    ) {
+		if (assocPtr->interp != interp) {
+		    continue;
 		}
+		
+		Tcl_ListObjAppendElement(NULL, resultObj, GetAfterObj(afterPtr));
 	    }
-            Tcl_SetObjResult(interp, resultObj);
+
+	    Tcl_SetObjResult(interp, resultObj);
 	    return TCL_OK;
 	}
 	if (objc != 3) {
 	    Tcl_WrongNumArgs(interp, 2, objv, "?id?");
 	    return TCL_ERROR;
 	}
-	afterPtr = GetAfterEvent(assocPtr, objv[2]);
-	if (afterPtr == NULL) {
-            const char *eventStr = TclGetString(objv[2]);
 
+	afterPtr = GetAfterEvent(assocPtr, objv[2]);
+	if (afterPtr == NULL || afterPtr->assocPtr->interp != interp) {
+	    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);
+	    Tcl_SetErrorCode(interp, "TCL","LOOKUP","EVENT", eventStr, NULL);
 	    return TCL_ERROR;
-	} 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);
-        }
+	}
+	resultListPtr = Tcl_NewObj();
+	Tcl_ListObjAppendElement(interp, resultListPtr, afterPtr->commandPtr);
+	Tcl_ListObjAppendElement(interp, resultListPtr, Tcl_NewStringObj(
+ 		(TclpAfterInfo2TimerEvent(afterPtr)->flags & TCL_TMREV_IDLE) ?
+ 		    "idle" : "timer", -1));
+	Tcl_SetObjResult(interp, resultListPtr);
 	break;
+    }
     default:
 	Tcl_Panic("Tcl_AfterObjCmd: bad subcommand index to afterSubCmds");
     }
@@ -1010,22 +1780,33 @@ Tcl_AfterObjCmd(
 static int
 AfterDelay(
     Tcl_Interp *interp,
-    Tcl_WideInt ms)
+    Tcl_WideInt usec,
+    int absolute)
 {
     Interp *iPtr = (Interp *) interp;
 
-    Tcl_Time endTime, now;
-    Tcl_WideInt diff;
+    Tcl_WideInt endTime, now, diff, limOffs = 0x7FFFFFFFFFFFFFFFL;
+    long tolerance = 0;
 
-    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;
+    if (usec > 0) {
+	/* calculate possible maximal tolerance (in usec) of original wait-time */
+    #ifdef TMR_RES_TOLERANCE
+	tolerance = ((usec < 1000000) ? usec : 1000000) * TMR_RES_TOLERANCE / 100;
+    #endif
     }
 
+    if (!absolute) {
+	/*
+	 * Note the time can be switched (time-jump), so use monotonic time here.
+	 */
+	now = TclpGetUTimeMonotonic();
+	if ((endTime = (now + usec)) < now) { /* overflow */
+	    endTime = 0x7FFFFFFFFFFFFFFFL;
+	}
+    } else {
+	now = TclpGetMicroseconds();
+	endTime = usec;
+    }
     do {
 	if (Tcl_AsyncReady()) {
 	    if (Tcl_AsyncInvoke(interp, TCL_OK) != TCL_OK) {
@@ -1035,41 +1816,48 @@ AfterDelay(
 	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)) {
+	if ( iPtr->limit.timeEvent != NULL
+	  && (limOffs = (TCL_TIME_TO_USEC(iPtr->limit.time)
+				- TclpGetMicroseconds())) <= 0
+	) {
 	    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;
+	diff = endTime - now;
+	if (absolute && diff >= 1000000) {
+	    /*
+	     * Note by absolute sleep we should avoid too long waits, to be
+	     * able to process further if time jumped to the expected time, so
+	     * just let wait maximal 1 second.
+	     */
+	    diff = 1000000;
+	}
+	if (iPtr->limit.timeEvent == NULL || diff < limOffs) {
 	    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 > TCL_TIME_MAXIMUM_SLICE) {
+		    diff = TCL_TIME_MAXIMUM_SLICE;
+		}
+		TclpUSleep(diff);
+		if (!absolute) {
+		    now = TclpGetUTimeMonotonic();
+		} else {
+		    now = TclpGetMicroseconds();
+		}
 	    }
+	} else {
+	    diff = limOffs;
 	    if (diff > 0) {
-		Tcl_Sleep((long) diff);
+		if (diff > TCL_TIME_MAXIMUM_SLICE) {
+		    diff = TCL_TIME_MAXIMUM_SLICE;
+		}
+		TclpUSleep(diff);
+		if (!absolute) {
+		    now = TclpGetUTimeMonotonic();
+		} else {
+		    now = TclpGetMicroseconds();
+		}
 	    }
 	    if (Tcl_AsyncReady()) {
 		if (Tcl_AsyncInvoke(interp, TCL_OK) != TCL_OK) {
@@ -1083,8 +1871,9 @@ AfterDelay(
 		return TCL_ERROR;
 	    }
 	}
-        Tcl_GetTime(&now);
-    } while (TCL_TIME_BEFORE(now, endTime));
+
+	/* consider timer resolution tolerance (avoid busy wait) */
+    } while (now < endTime - tolerance);
     return TCL_OK;
 }
 
@@ -1111,7 +1900,7 @@ static AfterInfo *
 GetAfterEvent(
     AfterAssocData *assocPtr,	/* Points to "after"-related information for
 				 * this interpreter. */
-    Tcl_Obj *commandPtr)
+    Tcl_Obj *objPtr)
 {
     const char *cmdString;	/* Textual identifier for after event, such as
 				 * "after#6". */
@@ -1119,7 +1908,11 @@ GetAfterEvent(
     int id;
     char *end;
 
-    cmdString = TclGetString(commandPtr);
+    if (objPtr->typePtr == &afterObjType) {
+	return (AfterInfo*)objPtr->internalRep.twoPtrValue.ptr1;
+    }
+
+    cmdString = TclGetString(objPtr);
     if (strncmp(cmdString, "after#", 6) != 0) {
 	return NULL;
     }
@@ -1128,8 +1921,8 @@ GetAfterEvent(
     if ((end == cmdString) || (*end != 0)) {
 	return NULL;
     }
-    for (afterPtr = assocPtr->firstAfterPtr; afterPtr != NULL;
-	    afterPtr = afterPtr->nextPtr) {
+    for (afterPtr = assocPtr->lastAfterPtr; afterPtr != NULL;
+	    afterPtr = afterPtr->prevPtr) {
 	if (afterPtr->id == id) {
 	    return afterPtr;
 	}
@@ -1162,7 +1955,6 @@ AfterProc(
 {
     AfterInfo *afterPtr = clientData;
     AfterAssocData *assocPtr = afterPtr->assocPtr;
-    AfterInfo *prevPtr;
     int result;
     Tcl_Interp *interp;
 
@@ -1172,16 +1964,21 @@ AfterProc(
      * a core dump.
      */
 
-    if (assocPtr->firstAfterPtr == afterPtr) {
-	assocPtr->firstAfterPtr = afterPtr->nextPtr;
-    } else {
-	for (prevPtr = assocPtr->firstAfterPtr; prevPtr->nextPtr != afterPtr;
-		prevPtr = prevPtr->nextPtr) {
-	    /* Empty loop body. */
+    /* remove delete proc from handler (we'll do cleanup here) */
+    TclpAfterInfo2TimerEvent(afterPtr)->deleteProc = NULL;
+
+    /* release object (mark it was triggered) */
+    if (afterPtr->selfPtr) {
+	if (afterPtr->selfPtr->typePtr == &afterObjType) {
+	    afterPtr->selfPtr->internalRep.twoPtrValue.ptr1 = NULL;
 	}
-	prevPtr->nextPtr = afterPtr->nextPtr;
+	Tcl_DecrRefCount(afterPtr->selfPtr);
+	afterPtr->selfPtr = NULL;
     }
 
+    /* detach after-entry from the owner's list */
+    TclSpliceOutEx(afterPtr, assocPtr->firstAfterPtr, assocPtr->lastAfterPtr);
+
     /*
      * Execute the callback.
      */
@@ -1200,7 +1997,6 @@ AfterProc(
      */
 
     Tcl_DecrRefCount(afterPtr->commandPtr);
-    ckfree(afterPtr);
 }
 
 /*
@@ -1216,29 +2012,32 @@ AfterProc(
  *	None.
  *
  * Side effects:
- *	The memory associated with afterPtr is released.
+ *	The memory associated with afterPtr is not released (owned by handler).
  *
  *----------------------------------------------------------------------
  */
 
 static void
 FreeAfterPtr(
-    AfterInfo *afterPtr)		/* Command to be deleted. */
+    ClientData clientData)		/* Command to be deleted. */
 {
-    AfterInfo *prevPtr;
+    AfterInfo *afterPtr = (AfterInfo *) clientData;
     AfterAssocData *assocPtr = afterPtr->assocPtr;
 
-    if (assocPtr->firstAfterPtr == afterPtr) {
-	assocPtr->firstAfterPtr = afterPtr->nextPtr;
-    } else {
-	for (prevPtr = assocPtr->firstAfterPtr; prevPtr->nextPtr != afterPtr;
-		prevPtr = prevPtr->nextPtr) {
-	    /* Empty loop body. */
+    /* release object (mark it was removed) */
+    if (afterPtr->selfPtr) {
+	if (afterPtr->selfPtr->typePtr == &afterObjType) {
+	    afterPtr->selfPtr->internalRep.twoPtrValue.ptr1 = NULL;
 	}
-	prevPtr->nextPtr = afterPtr->nextPtr;
+	Tcl_DecrRefCount(afterPtr->selfPtr);
+	afterPtr->selfPtr = NULL;
     }
+
+    /* detach after-entry from the owner's list */
+    TclSpliceOutEx(afterPtr, assocPtr->firstAfterPtr, assocPtr->lastAfterPtr);
+
+    /* free command of entry */
     Tcl_DecrRefCount(afterPtr->commandPtr);
-    ckfree(afterPtr);
 }
 
 /*
@@ -1266,20 +2065,10 @@ AfterCleanupProc(
     Tcl_Interp *interp)		/* Interpreter that is being deleted. */
 {
     AfterAssocData *assocPtr = clientData;
-    AfterInfo *afterPtr;
 
-    while (assocPtr->firstAfterPtr != NULL) {
-	afterPtr = assocPtr->firstAfterPtr;
-	assocPtr->firstAfterPtr = afterPtr->nextPtr;
-	if (afterPtr->token != NULL) {
-	    Tcl_DeleteTimerHandler(afterPtr->token);
-	} else {
-	    Tcl_CancelIdleCall(AfterProc, afterPtr);
-	}
-	Tcl_DecrRefCount(afterPtr->commandPtr);
-	ckfree(afterPtr);
+    while ( assocPtr->lastAfterPtr ) {
+	TclpDeleteTimerEvent(TclpAfterInfo2TimerEvent(assocPtr->lastAfterPtr));
     }
-    ckfree(assocPtr);
 }
 
 /*