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);
}
