Tcl Source Code

 * optimization (fragile on changes) in one place.
 */

MODULE_SCOPE int	TclIsSpaceProc(int byte);
#define TclIsSpaceProcM(byte) \
    (((byte) > 0x20) ? 0 : TclIsSpaceProc(byte))

/*
 * Monotonic time independent on the wall clock
 * MS-WIndows part extracted from ticket [3328635fff]
 */

#ifdef WIN32
MODULE_SCOPE int	TclpGetMonotonicTime(Tcl_Time *timePtr);
#endif

/*
 *----------------------------------------------------------------
 * Command procedures in the generic core:
 *----------------------------------------------------------------
 */

MODULE_SCOPE Tcl_ObjCmdProc Tcl_AfterObjCmd;

    }

    if ((iPtr->limit.active & TCL_LIMIT_TIME) &&
	    ((iPtr->limit.timeGranularity == 1) ||
		(ticker % iPtr->limit.timeGranularity == 0))) {
	Tcl_Time now;

	/*
	 * Monotonic time independent on the wall clock
	 * MS-WIndows part extracted from ticket [3328635fff]
	 */

#ifdef WIN32
	TclpGetMonotonicTime(&now);
#else
	Tcl_GetTime(&now);
#endif
	if (iPtr->limit.time.sec < now.sec ||
		(iPtr->limit.time.sec == now.sec &&
		iPtr->limit.time.usec < now.usec)) {
	    iPtr->limit.exceeded |= TCL_LIMIT_TIME;
	    Tcl_Preserve(interp);
	    RunLimitHandlers(iPtr->limit.timeHandlers, interp);
	    if (iPtr->limit.time.sec > now.sec ||

void
Tcl_LimitSetTime(
    Tcl_Interp *interp,
    Tcl_Time *timeLimitPtr)
{
    Interp *iPtr = (Interp *) interp;
    Tcl_Time nextMoment;

    /*
     * Monotonic time independent on the wall clock
     * MS-WIndows part extracted from ticket [3328635fff]
     */

#ifdef WIN32
    Tcl_Time mono, real, limit;
    if (TclpGetMonotonicTime(&mono)) {
	Tcl_GetTime(&real);
	limit = *timeLimitPtr;
	limit.sec -= real.sec;
	limit.usec -= real.usec;
	if (limit.usec < 0) {
	    limit.sec -= 1;
	    limit.usec += 1000000;
	}
	limit.sec += mono.sec;
	limit.usec += mono.usec;
	if (limit.usec >= 1000000) {
	    limit.sec += 1;
	    limit.usec -= 1000000;
	}
	timeLimitPtr = &limit;
    }
#endif

    memcpy(&iPtr->limit.time, timeLimitPtr, sizeof(Tcl_Time));
    if (iPtr->limit.timeEvent != NULL) {
	Tcl_DeleteTimerHandler(iPtr->limit.timeEvent);
    }
    nextMoment.sec = timeLimitPtr->sec;
    nextMoment.usec = timeLimitPtr->usec+10;

void
Tcl_LimitGetTime(
    Tcl_Interp *interp,
    Tcl_Time *timeLimitPtr)
{
    Interp *iPtr = (Interp *) interp;

    /*
     * Monotonic time independent on the wall clock
     * MS-WIndows part extracted from ticket [3328635fff]
     */

#ifdef WIN32
    Tcl_Time mono, real, limit;

    if (TclpGetMonotonicTime(&mono)) {
	Tcl_GetTime(&real);
	limit = iPtr->limit.time;
	limit.sec -= mono.sec;
	limit.usec -= mono.usec;
	if (limit.usec < 0) {
	    limit.sec -= 1;
	    limit.usec += 1000000;
	}
	limit.sec += real.sec;
	limit.usec += real.usec;
	if (limit.usec >= 1000000) {
	    limit.sec += 1;
	    limit.usec -= 1000000;
	}
	memcpy(timeLimitPtr, &limit, sizeof(Tcl_Time));
	return;
    }
#endif
    memcpy(timeLimitPtr, &iPtr->limit.time, sizeof(Tcl_Time));
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_LimitSetGranularity --

{
    Tcl_Time time;

    /*
     * Compute when the event should fire.
     */

    /*
     * Monotonic time independent on the wall clock
     * MS-WIndows part extracted from ticket [3328635fff]
     */

#ifdef WIN32
    TclpGetMonotonicTime(&time);
#else
    Tcl_GetTime(&time);
#endif
    time.sec += milliseconds/1000;
    time.usec += (milliseconds%1000)*1000;
    if (time.usec >= 1000000) {
	time.usec -= 1000000;
	time.sec += 1;
    }
    return TclCreateAbsoluteTimerHandler(&time, proc, clientData);

	blockTime.sec = 0;
	blockTime.usec = 0;
    } else if ((flags & TCL_TIMER_EVENTS) && tsdPtr->firstTimerHandlerPtr) {
	/*
	 * Compute the timeout for the next timer on the list.
	 */

    /*
     * Monotonic time independent on the wall clock
     * MS-WIndows part extracted from ticket [3328635fff]
     */

#ifdef WIN32
	TclpGetMonotonicTime(&blockTime);
#else
	Tcl_GetTime(&blockTime);
#endif
	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;
	}

    ThreadSpecificData *tsdPtr = InitTimer();

    if ((flags & TCL_TIMER_EVENTS) && tsdPtr->firstTimerHandlerPtr) {
	/*
	 * Compute the timeout for the next timer on the list.
	 */

    /*
     * Monotonic time independent on the wall clock
     * MS-WIndows part extracted from ticket [3328635fff]
     */

#ifdef WIN32
	TclpGetMonotonicTime(&blockTime);
#else
	Tcl_GetTime(&blockTime);
#endif
	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;
	}

     *	  most recently created handler appearing after earlier ones with the
     *	  same expiration time, we don't have to worry about newer generation
     *	  timers appearing before later ones.
     */

    tsdPtr->timerPending = 0;
    currentTimerId = tsdPtr->lastTimerId;

    /*
     * Monotonic time independent on the wall clock
     * MS-WIndows part extracted from ticket [3328635fff]
     */

#ifdef WIN32
    TclpGetMonotonicTime(&time);
#else
    Tcl_GetTime(&time);
#endif
    while (1) {
	nextPtrPtr = &tsdPtr->firstTimerHandlerPtr;
	timerHandlerPtr = tsdPtr->firstTimerHandlerPtr;
	if (timerHandlerPtr == NULL) {
	    break;
	}

	 * the future, and wrap-around is unlikely to occur in less than about
	 * 1-10 years. Thus it's unlikely that any old ids will still be
	 * around when wrap-around occurs.
	 */

	afterPtr->id = tsdPtr->afterId;
	tsdPtr->afterId += 1;

    /*
     * Monotonic time independent on the wall clock
     * MS-WIndows part extracted from ticket [3328635fff]
     */

#ifdef WIN32
	TclpGetMonotonicTime(&wakeup);
#else
	Tcl_GetTime(&wakeup);
#endif
	wakeup.sec += ms / 1000;
	wakeup.usec += ms % 1000 * 1000;
	if (wakeup.usec > 1000000) {
	    wakeup.sec++;
	    wakeup.usec -= 1000000;
	}
	afterPtr->token = TclCreateAbsoluteTimerHandler(&wakeup,

    Tcl_WideInt ms)
{
    Interp *iPtr = (Interp *) interp;

    Tcl_Time endTime, now;
    Tcl_WideInt diff;


    /*
     * Monotonic time independent on the wall clock
     * MS-WIndows part extracted from ticket [3328635fff]
     */

#ifdef WIN32
    TclpGetMonotonicTime(&now);
#else
    Tcl_GetTime(&now);
#endif
    endTime = now;
    endTime.sec += (ms / 1000);
    endTime.usec += (ms % 1000) * 1000;
    if (endTime.usec >= 1000000) {
	endTime.sec++;
	endTime.usec -= 1000000;
    }

	    if (Tcl_Canceled(interp, TCL_LEAVE_ERR_MSG) == TCL_ERROR) {
		return TCL_ERROR;
	    }
	    if (Tcl_LimitCheck(interp) != TCL_OK) {
		return TCL_ERROR;
	    }
	}

#ifdef WIN32
	TclpGetMonotonicTime(&now);
#else
	Tcl_GetTime(&now);
#endif
    } while (TCL_TIME_BEFORE(now, endTime));
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *

    *lengthPtr = i;

  done:
    Tcl_DStringFree(&envString);
    Tcl_Free(nameUpper);
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * TclpGetMononoticTime --
 *
 *	Like Tcl_GetTime() but return a monotonic clock source,
 *
 * Results:
 *	1 if monotonic.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclpGetMonotonicTime(Tcl_Time *timePtr)
{
    ULONGLONG ms;

    ms = GetTickCount64();
    timePtr->sec = (long)(ms/1000);
    timePtr->usec = ((long)(ms%1000))*1000;
    return 1;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:

    int status;

    /*
     * Compute the timeout in milliseconds.
     */

    if (timePtr) {




	timeout = timePtr->sec * 1000 + timePtr->usec / 1000;

	if (timeout == INFINITE) {


	    timeout--;


	} 


    } else {
	timeout = INFINITE;
    }

    /*
     * Check to see if there are any messages in the queue before waiting
     * because MsgWaitForMultipleObjects will not wake up if there are events

    Tcl_Time vdelay;		/* Time to sleep, for scaling virtual ->
				 * real. */
    DWORD sleepTime;		/* Time to sleep, real-time */

    vdelay.sec  = ms / 1000;
    vdelay.usec = (ms % 1000) * 1000;

    TclpGetMonotonicTime(&now);
    desired.sec  = now.sec  + vdelay.sec;
    desired.usec = now.usec + vdelay.usec;
    if (desired.usec > 1000000) {
	++desired.sec;
	desired.usec -= 1000000;
    }

    /*
     * TIP #233: Scale delay from virtual to real-time.
     */

    TclScaleTime(&vdelay);
    sleepTime = (DWORD)vdelay.sec * 1000 + (unsigned long)vdelay.usec / 1000;
    if (sleepTime == INFINITE) {
	--sleepTime;
    }

    for (;;) {
	SleepEx(sleepTime, TRUE);
	TclpGetMonotonicTime(&now);
	if (now.sec > desired.sec) {
	    break;
	} else if ((now.sec == desired.sec) && (now.usec >= desired.usec)) {
	    break;
	}

	vdelay.sec  = desired.sec  - now.sec;
	vdelay.usec = desired.usec - now.usec;

	TclScaleTime(&vdelay);
	sleepTime = (DWORD)vdelay.sec * 1000 + (unsigned long)vdelay.usec / 1000;
	if (sleepTime == INFINITE) {
	    --sleepTime;
	}
    }
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

void
Tcl_SetTimeProc(
    Tcl_GetTimeProc *getProc,
    Tcl_ScaleTimeProc *scaleProc,
    void *clientData)
{



}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_QueryTimeProc --
 *