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); } }
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; }
int TnmSnmpSysUpTime() { static Tcl_Time bootTime = { 0, 0 }; Tcl_Time currentTime; int delta = 0; Tcl_GetTime(¤tTime); if (bootTime.sec == 0 && bootTime.usec == 0) { bootTime = currentTime; } else { delta = (currentTime.sec - bootTime.sec) * 100 + (currentTime.usec - bootTime.usec) / 10000; } return delta; }
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); } }
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); } } }
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); }
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); }
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; }
/* 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; }
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; }
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; }
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; }
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); }