source: downloads/tcl8.5.2/unix/tclUnixThrd.c @ 52

/*
 * tclUnixThrd.c --
 *
 *      This file implements the UNIX-specific thread support.
 *
 * Copyright (c) 1991-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclUnixThrd.c,v 1.57 2008/01/11 11:53:02 msofer Exp $
 */

#include "tclInt.h"

#ifdef TCL_THREADS

#include "pthread.h"

typedef struct ThreadSpecificData {
    char nabuf[16];
} ThreadSpecificData;

static Tcl_ThreadDataKey dataKey;

/*
 * masterLock is used to serialize creation of mutexes, condition variables,
 * and thread local storage. This is the only place that can count on the
 * ability to statically initialize the mutex.
 */

static pthread_mutex_t masterLock = PTHREAD_MUTEX_INITIALIZER;

/*
 * initLock is used to serialize initialization and finalization of Tcl. It
 * cannot use any dyamically allocated storage.
 */

static pthread_mutex_t initLock = PTHREAD_MUTEX_INITIALIZER;

/*
 * allocLock is used by Tcl's version of malloc for synchronization. For
 * obvious reasons, cannot use any dyamically allocated storage.
 */

static pthread_mutex_t allocLock = PTHREAD_MUTEX_INITIALIZER;
static pthread_mutex_t *allocLockPtr = &allocLock;

/*
 * These are for the critical sections inside this file.
 */

#define MASTER_LOCK     pthread_mutex_lock(&masterLock)
#define MASTER_UNLOCK   pthread_mutex_unlock(&masterLock)

#endif /* TCL_THREADS */


/*
 *----------------------------------------------------------------------
 *
 * TclpThreadCreate --
 *
 *      This procedure creates a new thread.
 *
 * Results:
 *      TCL_OK if the thread could be created. The thread ID is returned in a
 *      parameter.
 *
 * Side effects:
 *      A new thread is created.
 *
 *----------------------------------------------------------------------
 */

int
TclpThreadCreate(
    Tcl_ThreadId *idPtr,        /* Return, the ID of the thread */
    Tcl_ThreadCreateProc proc,  /* Main() function of the thread */
    ClientData clientData,      /* The one argument to Main() */
    int stackSize,              /* Size of stack for the new thread */
    int flags)                  /* Flags controlling behaviour of the new
                                 * thread. */
{
#ifdef TCL_THREADS
    pthread_attr_t attr;
    pthread_t theThread;
    int result;

    pthread_attr_init(&attr);
    pthread_attr_setscope(&attr, PTHREAD_SCOPE_SYSTEM);

#ifdef HAVE_PTHREAD_ATTR_SETSTACKSIZE
    if (stackSize != TCL_THREAD_STACK_DEFAULT) {
        pthread_attr_setstacksize(&attr, (size_t) stackSize);
#ifdef TCL_THREAD_STACK_MIN
    } else {
        /*
         * Certain systems define a thread stack size that by default is too
         * small for many operations. The user has the option of defining
         * TCL_THREAD_STACK_MIN to a value large enough to work for their
         * needs. This would look like (for 128K min stack):
         *    make MEM_DEBUG_FLAGS=-DTCL_THREAD_STACK_MIN=131072L
         *
         * This solution is not optimal, as we should allow the user to
         * specify a size at runtime, but we don't want to slow this function
         * down, and that would still leave the main thread at the default.
         */

        size_t size;
        result = pthread_attr_getstacksize(&attr, &size);
        if (!result && (size < TCL_THREAD_STACK_MIN)) {
            pthread_attr_setstacksize(&attr, (size_t) TCL_THREAD_STACK_MIN);
        }
#endif
    }
#endif
    if (! (flags & TCL_THREAD_JOINABLE)) {
        pthread_attr_setdetachstate (&attr, PTHREAD_CREATE_DETACHED);
    }


    if (pthread_create(&theThread, &attr,
            (void * (*)(void *))proc, (void *)clientData) &&
            pthread_create(&theThread, NULL,
                    (void * (*)(void *))proc, (void *)clientData)) {
        result = TCL_ERROR;
    } else {
        *idPtr = (Tcl_ThreadId)theThread;
        result = TCL_OK;
    }
    pthread_attr_destroy(&attr);
    return result;
#else
    return TCL_ERROR;
#endif /* TCL_THREADS */
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_JoinThread --
 *
 *      This procedure waits upon the exit of the specified thread.
 *
 * Results:
 *      TCL_OK if the wait was successful, TCL_ERROR else.
 *
 * Side effects:
 *      The result area is set to the exit code of the thread we waited upon.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_JoinThread(
    Tcl_ThreadId threadId,      /* Id of the thread to wait upon. */
    int *state)                 /* Reference to the storage the result of the
                                 * thread we wait upon will be written into.
                                 * May be NULL. */
{
#ifdef TCL_THREADS
    int result;
    unsigned long retcode, *retcodePtr = &retcode;

    result = pthread_join((pthread_t) threadId, (void**) retcodePtr);
    if (state) {
        *state = (int) retcode;
    }
    return (result == 0) ? TCL_OK : TCL_ERROR;
#else
    return TCL_ERROR;
#endif
}

#ifdef TCL_THREADS
/*
 *----------------------------------------------------------------------
 *
 * TclpThreadExit --
 *
 *      This procedure terminates the current thread.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      This procedure terminates the current thread.
 *
 *----------------------------------------------------------------------
 */

void
TclpThreadExit(
    int status)
{
    pthread_exit(INT2PTR(status));
}
#endif /* TCL_THREADS */

#ifdef TCL_THREADS
/*
 *----------------------------------------------------------------------
 *
 * TclpThreadGetStackSize --
 *
 *      This procedure returns the size of the current thread's stack.
 *
 * Results:
 *      Stack size (in bytes?) or -1 for error or 0 for undeterminable.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */

size_t
TclpThreadGetStackSize(void)
{
    size_t stackSize = 0;
#if defined(HAVE_PTHREAD_ATTR_SETSTACKSIZE) && defined(TclpPthreadGetAttrs)
    pthread_attr_t threadAttr;  /* This will hold the thread attributes for
                                 * the current thread. */
#ifdef __GLIBC__ 
    /*
     * Fix for [Bug 1815573]
     *
     * DESCRIPTION:
     * On linux TclpPthreadGetAttrs (which is pthread_attr_get_np) may return
     * bogus values on the initial thread. 
     *
     * ASSUMPTIONS:
     * There seems to be no api to determine if we are on the initial
     * thread. The simple scheme implemented here assumes:
     *   1. The first Tcl interp to be created lives in the initial thread. If
     *      this assumption is not true, the fix is to call
     *      TclpThreadGetStackSize from the initial thread previous to
     *      creating any Tcl interpreter. In this case, especially if another
     *      Tcl interpreter may be created in the initial thread, it might be
     *      better to enable the second branch in the #if below
     *   2. There will be no races in creating the first Tcl interp - ie, the
     *      second Tcl interp will be created only after the first call to
     *      Tcl_CreateInterp returns.
     *
     * These assumptions are satisfied by tclsh. Embedders on linux may want
     * to check their validity, and possibly adapt the code on failing to meet
     * them.
     */

    static int initialized = 0;

    if (!initialized) {
        initialized = 1;
        return 0;
    } else {
#else
    {
#endif
        if (pthread_attr_init(&threadAttr) != 0) {
            return -1;
        }
        if (TclpPthreadGetAttrs(pthread_self(), &threadAttr) != 0) {
            pthread_attr_destroy(&threadAttr);
            return (size_t)-1;
        }
    }

    
    if (pthread_attr_getstacksize(&threadAttr, &stackSize) != 0) {
        pthread_attr_destroy(&threadAttr);
        return (size_t)-1;
    }
    pthread_attr_destroy(&threadAttr);
#elif defined(HAVE_PTHREAD_GET_STACKSIZE_NP)
#ifdef __APPLE__
    /*
     * On Darwin, the API below does not return the correct stack size for the
     * main thread (which is not a real pthread), so fallback to getrlimit().
     */  
    if (!pthread_main_np())
#endif
    stackSize = pthread_get_stacksize_np(pthread_self());
#else
    /*
     * Cannot determine the real stack size of this thread. The caller might
     * want to try looking at the process accounting limits instead.
     */
#endif
    return stackSize;
}
#endif /* TCL_THREADS */

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetCurrentThread --
 *
 *      This procedure returns the ID of the currently running thread.
 *
 * Results:
 *      A thread ID.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */

Tcl_ThreadId
Tcl_GetCurrentThread(void)
{
#ifdef TCL_THREADS
    return (Tcl_ThreadId) pthread_self();
#else
    return (Tcl_ThreadId) 0;
#endif
}

/*
 *----------------------------------------------------------------------
 *
 * TclpInitLock
 *
 *      This procedure is used to grab a lock that serializes initialization
 *      and finalization of Tcl. On some platforms this may also initialize
 *      the mutex used to serialize creation of more mutexes and thread local
 *      storage keys.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Acquire the initialization mutex.
 *
 *----------------------------------------------------------------------
 */

void
TclpInitLock(void)
{
#ifdef TCL_THREADS
    pthread_mutex_lock(&initLock);
#endif
}

/*
 *----------------------------------------------------------------------
 *
 * TclpFinalizeLock
 *
 *      This procedure is used to destroy all private resources used in this
 *      file.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Destroys everything private. TclpInitLock must be held entering this
 *      function.
 *
 *----------------------------------------------------------------------
 */

void
TclFinalizeLock(void)
{
#ifdef TCL_THREADS
    /*
     * You do not need to destroy mutexes that were created with the
     * PTHREAD_MUTEX_INITIALIZER macro. These mutexes do not need any
     * destruction: masterLock, allocLock, and initLock.
     */

    pthread_mutex_unlock(&initLock);
#endif
}

/*
 *----------------------------------------------------------------------
 *
 * TclpInitUnlock
 *
 *      This procedure is used to release a lock that serializes
 *      initialization and finalization of Tcl.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Release the initialization mutex.
 *
 *----------------------------------------------------------------------
 */

void
TclpInitUnlock(void)
{
#ifdef TCL_THREADS
    pthread_mutex_unlock(&initLock);
#endif
}

/*
 *----------------------------------------------------------------------
 *
 * TclpMasterLock
 *
 *      This procedure is used to grab a lock that serializes creation and
 *      finalization of serialization objects. This interface is only needed
 *      in finalization; it is hidden during creation of the objects.
 *
 *      This lock must be different than the initLock because the initLock is
 *      held during creation of syncronization objects.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Acquire the master mutex.
 *
 *----------------------------------------------------------------------
 */

void
TclpMasterLock(void)
{
#ifdef TCL_THREADS
    pthread_mutex_lock(&masterLock);
#endif
}


/*
 *----------------------------------------------------------------------
 *
 * TclpMasterUnlock
 *
 *      This procedure is used to release a lock that serializes creation and
 *      finalization of synchronization objects.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Release the master mutex.
 *
 *----------------------------------------------------------------------
 */

void
TclpMasterUnlock(void)
{
#ifdef TCL_THREADS
    pthread_mutex_unlock(&masterLock);
#endif
}


/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetAllocMutex
 *
 *      This procedure returns a pointer to a statically initialized mutex for
 *      use by the memory allocator. The alloctor must use this lock, because
 *      all other locks are allocated...
 *
 * Results:
 *      A pointer to a mutex that is suitable for passing to Tcl_MutexLock and
 *      Tcl_MutexUnlock.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */

Tcl_Mutex *
Tcl_GetAllocMutex(void)
{
#ifdef TCL_THREADS
    pthread_mutex_t **allocLockPtrPtr = &allocLockPtr;
    return (Tcl_Mutex *) allocLockPtrPtr;
#else
    return NULL;
#endif
}

#ifdef TCL_THREADS

/*
 *----------------------------------------------------------------------
 *
 * Tcl_MutexLock --
 *
 *      This procedure is invoked to lock a mutex. This procedure handles
 *      initializing the mutex, if necessary. The caller can rely on the fact
 *      that Tcl_Mutex is an opaque pointer. This routine will change that
 *      pointer from NULL after first use.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      May block the current thread. The mutex is aquired when this returns.
 *      Will allocate memory for a pthread_mutex_t and initialize this the
 *      first time this Tcl_Mutex is used.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_MutexLock(
    Tcl_Mutex *mutexPtr)        /* Really (pthread_mutex_t **) */
{
    pthread_mutex_t *pmutexPtr;
    if (*mutexPtr == NULL) {
        MASTER_LOCK;
        if (*mutexPtr == NULL) {
            /*
             * Double inside master lock check to avoid a race condition.
             */

            pmutexPtr = (pthread_mutex_t *)ckalloc(sizeof(pthread_mutex_t));
            pthread_mutex_init(pmutexPtr, NULL);
            *mutexPtr = (Tcl_Mutex)pmutexPtr;
            TclRememberMutex(mutexPtr);
        }
        MASTER_UNLOCK;
    }
    pmutexPtr = *((pthread_mutex_t **)mutexPtr);
    pthread_mutex_lock(pmutexPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_MutexUnlock --
 *
 *      This procedure is invoked to unlock a mutex. The mutex must have been
 *      locked by Tcl_MutexLock.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      The mutex is released when this returns.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_MutexUnlock(
    Tcl_Mutex *mutexPtr)        /* Really (pthread_mutex_t **) */
{
    pthread_mutex_t *pmutexPtr = *(pthread_mutex_t **)mutexPtr;
    pthread_mutex_unlock(pmutexPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * TclpFinalizeMutex --
 *
 *      This procedure is invoked to clean up one mutex. This is only safe to
 *      call at the end of time.
 *
 *      This assumes the Master Lock is held.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      The mutex list is deallocated.
 *
 *----------------------------------------------------------------------
 */

void
TclpFinalizeMutex(
    Tcl_Mutex *mutexPtr)
{
    pthread_mutex_t *pmutexPtr = *(pthread_mutex_t **)mutexPtr;
    if (pmutexPtr != NULL) {
        pthread_mutex_destroy(pmutexPtr);
        ckfree((char *) pmutexPtr);
        *mutexPtr = NULL;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ConditionWait --
 *
 *      This procedure is invoked to wait on a condition variable. The mutex
 *      is automically released as part of the wait, and automatically grabbed
 *      when the condition is signaled.
 *
 *      The mutex must be held when this procedure is called.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      May block the current thread. The mutex is aquired when this returns.
 *      Will allocate memory for a pthread_mutex_t and initialize this the
 *      first time this Tcl_Mutex is used.
 *
 *----------------------------------------------------------------------
 */

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

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ConditionNotify --
 *
 *      This procedure is invoked to signal a condition variable.
 *
 *      The mutex must be held during this call to avoid races, but this
 *      interface does not enforce that.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      May unblock another thread.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_ConditionNotify(
    Tcl_Condition *condPtr)
{
    pthread_cond_t *pcondPtr = *((pthread_cond_t **)condPtr);
    if (pcondPtr != NULL) {
        pthread_cond_broadcast(pcondPtr);
    } else {
        /*
         * Noone has used the condition variable, so there are no waiters.
         */
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclpFinalizeCondition --
 *
 *      This procedure is invoked to clean up a condition variable. This is
 *      only safe to call at the end of time.
 *
 *      This assumes the Master Lock is held.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      The condition variable is deallocated.
 *
 *----------------------------------------------------------------------
 */

void
TclpFinalizeCondition(
    Tcl_Condition *condPtr)
{
    pthread_cond_t *pcondPtr = *(pthread_cond_t **)condPtr;
    if (pcondPtr != NULL) {
        pthread_cond_destroy(pcondPtr);
        ckfree((char *) pcondPtr);
        *condPtr = NULL;
    }
}
#endif /* TCL_THREADS */

/*
 *----------------------------------------------------------------------
 *
 * TclpReaddir, TclpLocaltime, TclpGmtime, TclpInetNtoa --
 *
 *      These procedures replace core C versions to be used in a threaded
 *      environment.
 *
 * Results:
 *      See documentation of C functions.
 *
 * Side effects:
 *      See documentation of C functions.
 *
 * Notes:
 *      TclpReaddir is no longer used by the core (see 1095909), but it
 *      appears in the internal stubs table (see #589526).
 *
 *----------------------------------------------------------------------
 */

Tcl_DirEntry *
TclpReaddir(
    DIR * dir)
{
    return TclOSreaddir(dir);
}

char *
TclpInetNtoa(
    struct in_addr addr)
{
#ifdef TCL_THREADS
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    unsigned char *b = (unsigned char*) &addr.s_addr;

    sprintf(tsdPtr->nabuf, "%u.%u.%u.%u", b[0], b[1], b[2], b[3]);
    return tsdPtr->nabuf;
#else
    return inet_ntoa(addr);
#endif
}

#ifdef TCL_THREADS
/*
 * Additions by AOL for specialized thread memory allocator.
 */

#ifdef USE_THREAD_ALLOC
static volatile int initialized = 0;
static pthread_key_t key;

typedef struct allocMutex {
    Tcl_Mutex tlock;
    pthread_mutex_t plock;
} allocMutex;

Tcl_Mutex *
TclpNewAllocMutex(void)
{
    struct allocMutex *lockPtr;
    register pthread_mutex_t *plockPtr;

    lockPtr = malloc(sizeof(struct allocMutex));
    if (lockPtr == NULL) {
        Tcl_Panic("could not allocate lock");
    }
    plockPtr = &lockPtr->plock;
    lockPtr->tlock = (Tcl_Mutex) plockPtr;
    pthread_mutex_init(&lockPtr->plock, NULL);
    return &lockPtr->tlock;
}

void
TclpFreeAllocMutex(
    Tcl_Mutex *mutex)           /* The alloc mutex to free. */
{
    allocMutex* lockPtr = (allocMutex*) mutex;
    if (!lockPtr) {
        return;
    }
    pthread_mutex_destroy(&lockPtr->plock);
    free(lockPtr);
}

void
TclpFreeAllocCache(
    void *ptr)
{
    if (ptr != NULL) {
        /*
         * Called by the pthread lib when a thread exits
         */

        TclFreeAllocCache(ptr);

    } else if (initialized) {
        /*
         * Called by us in TclFinalizeThreadAlloc() during the library
         * finalization initiated from Tcl_Finalize()
         */

        pthread_key_delete(key);
        initialized = 0;
    }
}

void *
TclpGetAllocCache(void)
{
    if (!initialized) {
        pthread_mutex_lock(allocLockPtr);
        if (!initialized) {
            pthread_key_create(&key, TclpFreeAllocCache);
            initialized = 1;
        }
        pthread_mutex_unlock(allocLockPtr);
    }
    return pthread_getspecific(key);
}

void
TclpSetAllocCache(
    void *arg)
{
    pthread_setspecific(key, arg);
}
#endif /* USE_THREAD_ALLOC */
#endif /* TCL_THREADS */

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */