Example #1
0
void
Tcl_Sleep(
    int ms)			/* Number of milliseconds to sleep. */
{
    struct timeval delay;
    Tcl_Time before, after, vdelay;

    /*
     * The only trick here is that select appears to return early under some
     * conditions, so we have to check to make sure that the right amount of
     * time really has elapsed.  If it's too early, go back to sleep again.
     */

    Tcl_GetTime(&before);
    after = before;
    after.sec += ms/1000;
    after.usec += (ms%1000)*1000;
    if (after.usec > 1000000) {
	after.usec -= 1000000;
	after.sec += 1;
    }
    while (1) {
	/*
	 * TIP #233: Scale from virtual time to real-time for select.
	 */

	vdelay.sec  = after.sec  - before.sec;
	vdelay.usec = after.usec - before.usec;

	if (vdelay.usec < 0) {
	    vdelay.usec += 1000000;
	    vdelay.sec  -= 1;
	}

	if ((vdelay.sec != 0) || (vdelay.usec != 0)) {
	    (*tclScaleTimeProcPtr) (&vdelay, tclTimeClientData);
	}

	delay.tv_sec  = vdelay.sec;
	delay.tv_usec = vdelay.usec;

	/*
	 * Special note: must convert delay.tv_sec to int before comparing to
	 * zero, since delay.tv_usec is unsigned on some platforms.
	 */

	if ((((int) delay.tv_sec) < 0)
		|| ((delay.tv_usec == 0) && (delay.tv_sec == 0))) {
	    break;
	}
	(void) select(0, (SELECT_MASK *) 0, (SELECT_MASK *) 0,
		(SELECT_MASK *) 0, &delay);
	Tcl_GetTime(&before);
    }
}
Example #2
0
static int
TestwinclockCmd(
    ClientData dummy,		/* Unused */
    Tcl_Interp* interp,		/* Tcl interpreter */
    int objc,			/* Argument count */
    Tcl_Obj *const objv[])	/* Argument vector */
{
    static const FILETIME posixEpoch = { 0xD53E8000, 0x019DB1DE };
				/* The Posix epoch, expressed as a Windows
				 * FILETIME */
    Tcl_Time tclTime;		/* Tcl clock */
    FILETIME sysTime;		/* System clock */
    Tcl_Obj *result;		/* Result of the command */
    LARGE_INTEGER t1, t2;
    LARGE_INTEGER p1, p2;

    if (objc != 1) {
	Tcl_WrongNumArgs(interp, 1, objv, "");
	return TCL_ERROR;
    }

    QueryPerformanceCounter(&p1);

    Tcl_GetTime(&tclTime);
    GetSystemTimeAsFileTime(&sysTime);
    t1.LowPart = posixEpoch.dwLowDateTime;
    t1.HighPart = posixEpoch.dwHighDateTime;
    t2.LowPart = sysTime.dwLowDateTime;
    t2.HighPart = sysTime.dwHighDateTime;
    t2.QuadPart -= t1.QuadPart;

    QueryPerformanceCounter(&p2);

    result = Tcl_NewObj();
    Tcl_ListObjAppendElement(interp, result,
	    Tcl_NewIntObj((int) (t2.QuadPart / 10000000)));
    Tcl_ListObjAppendElement(interp, result,
	    Tcl_NewIntObj((int) ((t2.QuadPart / 10) % 1000000)));
    Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj(tclTime.sec));
    Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj(tclTime.usec));

    Tcl_ListObjAppendElement(interp, result, Tcl_NewWideIntObj(p1.QuadPart));
    Tcl_ListObjAppendElement(interp, result, Tcl_NewWideIntObj(p2.QuadPart));

    Tcl_SetObjResult(interp, result);

    return TCL_OK;
}
Example #3
0
int
TnmSnmpSysUpTime()
{
    static Tcl_Time bootTime = { 0, 0 };
    Tcl_Time currentTime;
    int delta = 0;

    Tcl_GetTime(&currentTime);
    if (bootTime.sec == 0 && bootTime.usec == 0) {
	bootTime = currentTime;
    } else {
	delta = (currentTime.sec - bootTime.sec) * 100
	    + (currentTime.usec - bootTime.usec) / 10000;
    }
    return delta;
}
Example #4
0
void
Tcl_ConditionWait(
    Tcl_Condition *condPtr,	/* Really (pthread_cond_t **) */
    Tcl_Mutex *mutexPtr,	/* Really (pthread_mutex_t **) */
    Tcl_Time *timePtr)		/* Timeout on waiting period */
{
    pthread_cond_t *pcondPtr;
    pthread_mutex_t *pmutexPtr;
    struct timespec ptime;

    if (*condPtr == NULL) {
	MASTER_LOCK;

	/*
	 * Double check inside mutex to avoid race, then initialize condition
	 * variable if necessary.
	 */

	if (*condPtr == NULL) {
	    pcondPtr = (pthread_cond_t *) ckalloc(sizeof(pthread_cond_t));
	    pthread_cond_init(pcondPtr, NULL);
	    *condPtr = (Tcl_Condition)pcondPtr;
	    TclRememberCondition(condPtr);
	}
	MASTER_UNLOCK;
    }
    pmutexPtr = *((pthread_mutex_t **)mutexPtr);
    pcondPtr = *((pthread_cond_t **)condPtr);
    if (timePtr == NULL) {
	pthread_cond_wait(pcondPtr, pmutexPtr);
    } else {
	Tcl_Time now;

	/*
	 * Make sure to take into account the microsecond component of the
	 * current time, including possible overflow situations. [Bug #411603]
	 */

	Tcl_GetTime(&now);
	ptime.tv_sec = timePtr->sec + now.sec +
	    (timePtr->usec + now.usec) / 1000000;
	ptime.tv_nsec = 1000 * ((timePtr->usec + now.usec) % 1000000);
	pthread_cond_timedwait(pcondPtr, pmutexPtr, &ptime);
    }
}
Example #5
0
static void
TimerCheckProc(
    ClientData data,		/* Not used. */
    int flags)			/* Event flags as passed to Tcl_DoOneEvent. */
{
    Tcl_Event *timerEvPtr;
    Tcl_Time blockTime;
    ThreadSpecificData *tsdPtr = InitTimer();

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

	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 the first timer has expired, stick an event on the queue.
	 */

	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);
	}
    }
}
Example #6
0
File: tclTimer.c Project: aosm/tcl
static void
TimerSetupProc(
    ClientData data,		/* Not used. */
    int flags)			/* Event flags as passed to Tcl_DoOneEvent. */
{
    Tcl_Time blockTime;
    ThreadSpecificData *tsdPtr = InitTimer();

    if (((flags & TCL_IDLE_EVENTS) && tsdPtr->idleList)
	    || ((flags & TCL_TIMER_EVENTS) && tsdPtr->timerPending)) {
	/*
	 * There is an idle handler or a pending timer event, so just poll.
	 */

	blockTime.sec = 0;
	blockTime.usec = 0;

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

	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;
	}
    } else {
	return;
    }

    Tcl_SetMaxBlockTime(&blockTime);
}
Example #7
0
Tcl_TimerToken
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_Time time;

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

    Tcl_GetTime(&time);
    time.sec += milliseconds/1000;
    time.usec += (milliseconds%1000)*1000;
    if (time.usec >= 1000000) {
	time.usec -= 1000000;
	time.sec += 1;
    }
    return TclCreateAbsoluteTimerHandler(&time, proc, clientData);
}
Example #8
0
int
TkUnixDoOneXEvent(
    Tcl_Time *timePtr)		/* Specifies the absolute time when the call
				 * should time out. */
{
    TkDisplay *dispPtr;
    static fd_mask readMask[MASK_SIZE];
    struct timeval blockTime, *timeoutPtr;
    Tcl_Time now;
    int fd, index, numFound, numFdBits = 0;
    fd_mask bit, *readMaskPtr = readMask;

    /*
     * Look for queued events first.
     */

    if (Tcl_ServiceEvent(TCL_WINDOW_EVENTS)) {
	return 1;
    }

    /*
     * Compute the next block time and check to see if we have timed out. Note
     * that HP-UX defines tv_sec to be unsigned so we have to be careful in
     * our arithmetic.
     */

    if (timePtr) {
	Tcl_GetTime(&now);
	blockTime.tv_sec = timePtr->sec;
	blockTime.tv_usec = timePtr->usec - now.usec;
	if (blockTime.tv_usec < 0) {
	    now.sec += 1;
	    blockTime.tv_usec += 1000000;
	}
	if (blockTime.tv_sec < now.sec) {
	    blockTime.tv_sec = 0;
	    blockTime.tv_usec = 0;
	} else {
	    blockTime.tv_sec -= now.sec;
	}
	timeoutPtr = &blockTime;
    } else {
	timeoutPtr = NULL;
    }

    /*
     * Set up the select mask for all of the displays. If a display has data
     * pending, then we want to poll instead of blocking.
     */

    memset(readMask, 0, MASK_SIZE*sizeof(fd_mask));
    for (dispPtr = TkGetDisplayList(); dispPtr != NULL;
	    dispPtr = dispPtr->nextPtr) {
	XFlush(dispPtr->display);
	if (QLength(dispPtr->display) > 0) {
	    blockTime.tv_sec = 0;
	    blockTime.tv_usec = 0;
	}
	fd = ConnectionNumber(dispPtr->display);
	index = fd/(NBBY*sizeof(fd_mask));
	bit = ((fd_mask)1) << (fd%(NBBY*sizeof(fd_mask)));
	readMask[index] |= bit;
	if (numFdBits <= fd) {
	    numFdBits = fd+1;
	}
    }

    numFound = select(numFdBits, (SELECT_MASK *) readMaskPtr, NULL, NULL,
	    timeoutPtr);
    if (numFound <= 0) {
	/*
	 * Some systems don't clear the masks after an error, so we have to do
	 * it here.
	 */

	memset(readMask, 0, MASK_SIZE*sizeof(fd_mask));
    }

    /*
     * Process any new events on the display connections.
     */

    for (dispPtr = TkGetDisplayList(); dispPtr != NULL;
	    dispPtr = dispPtr->nextPtr) {
	fd = ConnectionNumber(dispPtr->display);
	index = fd/(NBBY*sizeof(fd_mask));
	bit = ((fd_mask)1) << (fd%(NBBY*sizeof(fd_mask)));
	if ((readMask[index] & bit) || (QLength(dispPtr->display) > 0)) {
	    DisplayFileProc((ClientData)dispPtr, TCL_READABLE);
	}
    }
    if (Tcl_ServiceEvent(TCL_WINDOW_EVENTS)) {
	return 1;
    }

    /*
     * Check to see if we timed out.
     */

    if (timePtr) {
	Tcl_GetTime(&now);
	if ((now.sec > timePtr->sec) || ((now.sec == timePtr->sec)
		&& (now.usec > timePtr->usec))) {
	    return 0;
	}
    }

    /*
     * We had an event but we did not generate a Tcl event from it. Behave as
     * though we dealt with it. (JYL&SS)
     */

    return 1;
}
Example #9
0
	/* ARGSUSED */
int
Tcl_AfterObjCmd(
    ClientData clientData,	/* Unused */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_WideInt ms = 0;		/* Number of milliseconds to wait */
    Tcl_Time wakeup;
    AfterInfo *afterPtr;
    AfterAssocData *assocPtr;
    int length;
    int index;
    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 ...?");
	return TCL_ERROR;
    }

    /*
     * Create the "after" information associated for this interpreter, if it
     * doesn't already exist.
     */

    assocPtr = Tcl_GetAssocData(interp, "tclAfter", NULL);
    if (assocPtr == NULL) {
	assocPtr = ckalloc(sizeof(AfterAssocData));
	assocPtr->interp = interp;
	assocPtr->firstAfterPtr = NULL;
	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
#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;
	}
    }

    /*
     * 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 = ckalloc(sizeof(AfterInfo));
	afterPtr->assocPtr = assocPtr;
	if (objc == 3) {
	    afterPtr->commandPtr = objv[2];
	} else {
	    afterPtr->commandPtr = Tcl_ConcatObj(objc-2, objv+2);
	}
	Tcl_IncrRefCount(afterPtr->commandPtr);

	/*
	 * The variable below is used to generate unique identifiers for after
	 * commands. This id can wrap around, which can potentially cause
	 * problems. However, there are not likely to be problems in practice,
	 * because after commands can only be requested to about a month in
	 * 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;
	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));
	return TCL_OK;
    }
    case AFTER_CANCEL: {
	Tcl_Obj *commandPtr;
	const char *command, *tempCommand;
	int tempLength;

	if (objc < 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "id|command");
	    return TCL_ERROR;
	}
	if (objc == 3) {
	    commandPtr = objv[2];
	} else {
	    commandPtr = Tcl_ConcatObj(objc-2, objv+2);;
	}
	command = TclGetStringFromObj(commandPtr, &length);
	for (afterPtr = assocPtr->firstAfterPtr;  afterPtr != NULL;
		afterPtr = afterPtr->nextPtr) {
	    tempCommand = TclGetStringFromObj(afterPtr->commandPtr,
		    &tempLength);
	    if ((length == tempLength)
		    && !memcmp(command, tempCommand, (unsigned) length)) {
		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);
	    }
	    FreeAfterPtr(afterPtr);
	}
	break;
    }
    case AFTER_IDLE:
	if (objc < 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "script ?script ...?");
	    return TCL_ERROR;
	}
	afterPtr = ckalloc(sizeof(AfterInfo));
	afterPtr->assocPtr = assocPtr;
	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:
	if (objc == 2) {
            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));
		}
	    }
            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]);

	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                    "event \"%s\" doesn't exist", eventStr));
            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);
        }
	break;
    default:
	Tcl_Panic("Tcl_AfterObjCmd: bad subcommand index to afterSubCmds");
    }
    return TCL_OK;
}
Example #10
0
static int
TimerHandlerEventProc(
    Tcl_Event *evPtr,		/* Event to service. */
    int flags)			/* Flags that indicate what events to handle,
				 * such as TCL_FILE_EVENTS. */
{
    TimerHandler *timerHandlerPtr, **nextPtrPtr;
    Tcl_Time time;
    int currentTimerId;
    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;
    }

    /*
     * The code below is trickier than it may look, for the following reasons:
     *
     * 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.
     * 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.
     * 3. Tcl_DeleteTimerHandler can be called to remove an element from the
     *	  list while a handler is executing, so the list could change
     *	  structure during the call.
     * 4. Because we only fetch the current time before entering the loop, the
     *	  only way a new timer will even be considered runnable is if its
     *	  expiration time is within the same millisecond as the current time.
     *	  This is fairly likely on Windows, since it has a course granularity
     *	  clock. Since timers are placed on the queue in time order with the
     *	  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;
    Tcl_GetTime(&time);
    while (1) {
	nextPtrPtr = &tsdPtr->firstTimerHandlerPtr;
	timerHandlerPtr = tsdPtr->firstTimerHandlerPtr;
	if (timerHandlerPtr == NULL) {
	    break;
	}

	if (TCL_TIME_BEFORE(time, timerHandlerPtr->time)) {
	    break;
	}

	/*
	 * Bail out if the next timer is of a newer generation.
	 */

	if ((currentTimerId - PTR2INT(timerHandlerPtr->token)) < 0) {
	    break;
	}

	/*
	 * Remove the handler from the queue before invoking it, to avoid
	 * potential reentrancy problems.
	 */

	*nextPtrPtr = timerHandlerPtr->nextPtr;
	timerHandlerPtr->proc(timerHandlerPtr->clientData);
	ckfree(timerHandlerPtr);
    }
    TimerSetupProc(NULL, TCL_TIMER_EVENTS);
    return 1;
}
Example #11
0
static int
AfterDelay(
    Tcl_Interp *interp,
    Tcl_WideInt ms)
{
    Interp *iPtr = (Interp *) interp;

    Tcl_Time endTime, now;
    Tcl_WideInt diff;

    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 {
	if (Tcl_AsyncReady()) {
	    if (Tcl_AsyncInvoke(interp, TCL_OK) != TCL_OK) {
		return TCL_ERROR;
	    }
	}
	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;
		}
	    }
	    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;
}
Example #12
0
int
TclUnixWaitForFile(
    int fd,			/* Handle for file on which to wait. */
    int mask,			/* What to wait for: OR'ed combination of
				 * TCL_READABLE, TCL_WRITABLE, and
				 * TCL_EXCEPTION. */
    int timeout)		/* Maximum amount of time to wait for one of
				 * the conditions in mask to occur, in
				 * milliseconds. A value of 0 means don't wait
				 * at all, and a value of -1 means wait
				 * forever. */
{
    Tcl_Time abortTime = {0, 0}, now; /* silence gcc 4 warning */
    struct timeval blockTime, *timeoutPtr;
    int numFound, result = 0;
    fd_set readableMask;
    fd_set writableMask;
    fd_set exceptionMask;

#ifndef _DARWIN_C_SOURCE
    /*
     * Sanity check fd.
     */

    if (fd >= FD_SETSIZE) {
	Tcl_Panic("TclUnixWaitForFile can't handle file id %d", fd);
	/* must never get here, or select masks overrun will occur below */
    }
#endif

    /*
     * If there is a non-zero finite timeout, compute the time when we give
     * up.
     */

    if (timeout > 0) {
	Tcl_GetTime(&now);
	abortTime.sec = now.sec + timeout/1000;
	abortTime.usec = now.usec + (timeout%1000)*1000;
	if (abortTime.usec >= 1000000) {
	    abortTime.usec -= 1000000;
	    abortTime.sec += 1;
	}
	timeoutPtr = &blockTime;
    } else if (timeout == 0) {
	timeoutPtr = &blockTime;
	blockTime.tv_sec = 0;
	blockTime.tv_usec = 0;
    } else {
	timeoutPtr = NULL;
    }

    /*
     * Initialize the select masks.
     */

    FD_ZERO(&readableMask);
    FD_ZERO(&writableMask);
    FD_ZERO(&exceptionMask);

    /*
     * Loop in a mini-event loop of our own, waiting for either the file to
     * become ready or a timeout to occur.
     */

    while (1) {
	if (timeout > 0) {
	    blockTime.tv_sec = abortTime.sec - now.sec;
	    blockTime.tv_usec = abortTime.usec - now.usec;
	    if (blockTime.tv_usec < 0) {
		blockTime.tv_sec -= 1;
		blockTime.tv_usec += 1000000;
	    }
	    if (blockTime.tv_sec < 0) {
		blockTime.tv_sec = 0;
		blockTime.tv_usec = 0;
	    }
	}

	/*
	 * Setup the select masks for the fd.
	 */

	if (mask & TCL_READABLE) {
	    FD_SET(fd, &readableMask);
	}
	if (mask & TCL_WRITABLE) {
	    FD_SET(fd, &writableMask);
	}
	if (mask & TCL_EXCEPTION) {
	    FD_SET(fd, &exceptionMask);
	}

	/*
	 * Wait for the event or a timeout.
	 */

	numFound = select(fd + 1, &readableMask, &writableMask,
		&exceptionMask, timeoutPtr);
	if (numFound == 1) {
	    if (FD_ISSET(fd, &readableMask)) {
		SET_BITS(result, TCL_READABLE);
	    }
	    if (FD_ISSET(fd, &writableMask)) {
		SET_BITS(result, TCL_WRITABLE);
	    }
	    if (FD_ISSET(fd, &exceptionMask)) {
		SET_BITS(result, TCL_EXCEPTION);
	    }
	    result &= mask;
	    if (result) {
		break;
	    }
	}
	if (timeout == 0) {
	    break;
	}
	if (timeout < 0) {
	    continue;
	}

	/*
	 * The select returned early, so we need to recompute the timeout.
	 */

	Tcl_GetTime(&now);
	if ((abortTime.sec < now.sec)
		|| (abortTime.sec==now.sec && abortTime.usec<=now.usec)) {
	    break;
	}
    }
    return result;
}
Example #13
0
static void
InitVars(Tcl_Interp *interp)
{
    const char *machine, *os, *vers, *user;
    char *tmp, *p;
    char buffer[20];
    Tcl_DString arch;
    Tcl_Obj *path;

    TnmInitPath(interp);

    Tcl_SetVar2(interp, "tnm", "version", TNM_VERSION, TCL_GLOBAL_ONLY);
    Tcl_SetVar2(interp, "tnm", "url", TNM_URL, TCL_GLOBAL_ONLY);

    /*
     * Get the startup time of the Tnm extension.
     */

    if (! tnmStartTime.sec && ! tnmStartTime.usec) {
	Tcl_GetTime(&tnmStartTime);
    }
    sprintf(buffer, "%ld", tnmStartTime.sec);
    Tcl_SetVar2(interp, "tnm", "start", buffer, TCL_GLOBAL_ONLY);

    /*
     * Check if the current version of the Tnm extension is still valid
     * or if it has expired. Note, this is only useful in distribution
     * demos or test versions. This check should be turned off on all
     * stable and final releases.
     */

#ifdef TNM_EXPIRE_TIME
    if (tnmStartTime.sec > TNM_EXPIRE_TIME) {
	Tcl_Panic("Tnm Tcl extension expired. Please upgrade to a newer version.");
    }
    sprintf(buffer, "%ld", TNM_EXPIRE_TIME);
    Tcl_SetVar2(interp, "tnm", "expire", buffer, TCL_GLOBAL_ONLY);
#endif

    /*
     * Set the host name. We are only interested in the name and not
     * in a fully qualified domain name. This makes the result
     * predictable and thus portable.
     */

    tmp = ckstrdup(Tcl_GetHostName());
    p = strchr(tmp, '.');
    if (p) *p = '\0';
    Tcl_SetVar2(interp, "tnm", "host", tmp, TCL_GLOBAL_ONLY);
    ckfree(tmp);
    
    /*
     * Get the user name. We try a sequence of different environment
     * variables in the hope to find something which works on all
     * systems.
     */

    user = getenv("USER");
    if (user == NULL) {
	user = getenv("USERNAME");
	if (user == NULL) {
	    user = getenv("LOGNAME");
	    if (user == NULL) {
		user = "******";
	    }
	}
    }
    Tcl_SetVar2(interp, "tnm", "user", user, TCL_GLOBAL_ONLY);

    /*
     * Search for a directory which allows to hold temporary files.
     * Save the directory name in the tnm(tmp) variable.
     */

    tmp = getenv("TEMP");
    if (! tmp) {
	tmp = getenv("TMP");
	if (! tmp) {
	    tmp = "/tmp";
	    if (access(tmp, W_OK) != 0) {
		tmp = ".";
	    }
	}
    }
    for (p = tmp; *p; p++) {
	if (*p == '\\') {
	    *p = '/';
	}
    }
    Tcl_SetVar2(interp, "tnm", "tmp", tmp, TCL_GLOBAL_ONLY);

    /*
     * Determine the architecture string which is used to store 
     * machine dependend files in the Tnm cache area.
     */

    machine = Tcl_GetVar2(interp, "tcl_platform", "machine", TCL_GLOBAL_ONLY);
    os = Tcl_GetVar2(interp, "tcl_platform", "os", TCL_GLOBAL_ONLY);
    vers = Tcl_GetVar2(interp, "tcl_platform", "osVersion", TCL_GLOBAL_ONLY);

    Tcl_DStringInit(&arch);
    if (machine && os && vers) {
	Tcl_DStringAppend(&arch, machine, -1);
	Tcl_DStringAppend(&arch, "-", 1);
	Tcl_DStringAppend(&arch, os, -1);
	Tcl_DStringAppend(&arch, "-", 1);
	Tcl_DStringAppend(&arch, vers, -1);
    } else {
	Tcl_DStringAppend(&arch, "unknown-os", -1);
    }

    /*
     * Initialize the tnm(cache) variable which points to a directory
     * where we can cache shared data between different instantiations
     * of the Tnm extension. We usually locate the cache in the users
     * home directory. However, if this fails (because the user does
     * not have a home), we locate the cache in the tmp file area.
     */

    path = Tcl_NewObj();
    Tcl_AppendStringsToObj(path, "~/.tnm", TNM_VERSION, NULL);
    if (Tcl_FSConvertToPathType(interp, path) == TCL_ERROR) {
	Tcl_SetStringObj(path, tmp, -1);
	Tcl_AppendStringsToObj(path, "/tnm", TNM_VERSION, NULL);
    }
    if (Tcl_FSConvertToPathType(interp, path) == TCL_OK) {
	(void) TnmMkDir(interp, path);
    }
    Tcl_SetVar2(interp, "tnm", "cache",
		Tcl_GetStringFromObj(path, NULL), TCL_GLOBAL_ONLY);
    Tcl_DecrRefCount(path);

    /*
     * Remove all white spaces and slashes from the architecture string 
     * because these characters are a potential source of problems and 
     * I really do not like white spaces in a directory name.
     */

    {
	char *d = Tcl_DStringValue(&arch);
	char *s = Tcl_DStringValue(&arch);

	while (*s) {
	    *d = *s;
	    if ((!isspace((int) *s)) && (*s != '/')) d++;
	    s++;
	}
	*d = '\0';
    } 

    Tcl_SetVar2(interp, "tnm", "arch", 
		Tcl_DStringValue(&arch), TCL_GLOBAL_ONLY);
    Tcl_DStringFree(&arch);
}