tclmacthrd.c

tcl是工具命令语言

/* 
 * tclMacThrd.c --
 *
 *	This file implements the Mac-specific thread support.
 *
 * Copyright (c) 1991-1994 The Regents of the University of California.
 * Copyright (c) 1994-1998 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS:  @(#) tclMacThrd.c 1.2 98/02/23 16:48:07
 */

#include "tclInt.h"
#include "tclPort.h"
#include "tclMacInt.h"
#include <Threads.h>
#include <Gestalt.h>

#define TCL_MAC_THRD_DEFAULT_STACK (256*1024)


typedef struct TclMacThrdData {
    ThreadID threadID;
    VOID *data;
    struct TclMacThrdData *next;
} TclMacThrdData;

/*
 * This is an array of the Thread Data Keys.  It is a process-wide table.
 * Its size is originally set to 32, but it can grow if needed.
 */
 
static TclMacThrdData **tclMacDataKeyArray;
#define TCL_MAC_INITIAL_KEYSIZE 32

/*
 * These two bits of data store the current maximum number of keys
 * and the keyCounter (which is the number of occupied slots in the
 * KeyData array.
 * 
 */
 
static int maxNumKeys = 0;
static int keyCounter = 0;

/*
 * Prototypes for functions used only in this file
 */
 
TclMacThrdData *GetThreadDataStruct(Tcl_ThreadDataKey keyVal);
TclMacThrdData *RemoveThreadDataStruct(Tcl_ThreadDataKey keyVal);

/*
 * Note: The race evoked by the emulation layer for joinable threads
 * (see ../win/tclWinThrd.c) cannot occur on this platform due to
 * the cooperative implementation of multithreading.
 */

/*
 *----------------------------------------------------------------------
 *
 * TclMacHaveThreads --
 *
 *	Do we have the Thread Manager?
 *
 * Results:
 *	1 if the ThreadManager is present, 0 otherwise.
 *
 * Side effects:
 *	If this is the first time this is called, the return is cached.
 *
 *----------------------------------------------------------------------
 */

int
TclMacHaveThreads(void)
{
    static initialized = false;
    static int tclMacHaveThreads = false;
    long response = 0;
    OSErr err = noErr;
    
    if (!initialized) {
	err = Gestalt(gestaltThreadMgrAttr, &response);
	if (err == noErr) {
	    tclMacHaveThreads = response | (1 << gestaltThreadMgrPresent);
	}
    }

    return tclMacHaveThreads;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_CreateThread --
 *
 *	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
Tcl_CreateThread(idPtr, proc, clientData, stackSize, flags)
    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 */
{
    if (!TclMacHaveThreads()) {
        return TCL_ERROR;
    }

    if (stackSize == TCL_THREAD_STACK_DEFAULT) {
        stackSize = TCL_MAC_THRD_DEFAULT_STACK;
    }

#if TARGET_CPU_68K && TARGET_RT_MAC_CFM
    {
        ThreadEntryProcPtr entryProc;
        entryProc = NewThreadEntryUPP(proc);
        
        NewThread(kCooperativeThread, entryProc, (void *) clientData, 
            stackSize, kCreateIfNeeded, NULL, (ThreadID *) idPtr);
    }
#else
    NewThread(kCooperativeThread, proc, (void *) clientData, 
        stackSize, kCreateIfNeeded, NULL, (ThreadID *) idPtr);
#endif        
    if ((ThreadID) *idPtr == kNoThreadID) {
        return TCL_ERROR;
    } else {
        if (flags & TCL_THREAD_JOINABLE) {
	    TclRememberJoinableThread (*idPtr);
	}

        return TCL_OK;
    }

}

/*
 *----------------------------------------------------------------------
 *
 * 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(id, result)
    Tcl_ThreadId id;	/* Id of the thread to wait upon */
    int*     result;	/* Reference to the storage the result
			 * of the thread we wait upon will be
			 * written into. */
{
    if (!TclMacHaveThreads()) {
        return TCL_ERROR;
    }

    return TclJoinThread (id, result);
}

/*
 *----------------------------------------------------------------------
 *
 * TclpThreadExit --
 *
 *	This procedure terminates the current thread.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	This procedure terminates the current thread.
 *
 *----------------------------------------------------------------------
 */

void
TclpThreadExit(status)
    int status;
{
    ThreadID curThread;
    
    if (!TclMacHaveThreads()) {
        return;
    }
    
    GetCurrentThread(&curThread);
    TclSignalExitThread ((Tcl_ThreadId) curThread, status);

    DisposeThread(curThread, NULL, false);
}

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

Tcl_ThreadId
Tcl_GetCurrentThread()
{
#ifdef TCL_THREADS
    ThreadID curThread;

    if (!TclMacHaveThreads()) {
        return (Tcl_ThreadId) 0;
    } else {
        GetCurrentThread(&curThread);
        return (Tcl_ThreadId) curThread;
    }
#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()
{
#ifdef TCL_THREADS
    /* There is nothing to do on the Mac. */;
#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()
{
#ifdef TCL_THREADS
    /* There is nothing to do on the Mac */;
#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()
{
#ifdef TCL_THREADS
    /* There is nothing to do on the Mac */;
#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()
{
#ifdef TCL_THREADS
    /* There is nothing to do on the Mac */
#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()
{
    /* There is nothing to do on the Mac */
    return NULL;
}

#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(mutexPtr)
    Tcl_Mutex *mutexPtr;	/* Really (pthread_mutex_t **) */
{
/* There is nothing to do on the Mac */
}


/*
 *----------------------------------------------------------------------
 *
 * TclpMutexUnlock --
 *
 *	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(mutexPtr)