Tcl package Thread source code

    # are compatible with.
    TEA_VERSION="3.9"

    echo "$as_me:$LINENO: checking for correct TEA configuration" >&5
echo $ECHO_N "checking for correct TEA configuration... $ECHO_C" >&6
    if test x"${PACKAGE_NAME}" = x ; then
	{ { echo "$as_me:$LINENO: error:
The PACKAGE_NAME variable must be defined by your TEA configure.ac" >&5
echo "$as_me: error:
The PACKAGE_NAME variable must be defined by your TEA configure.ac" >&2;}
   { (exit 1); exit 1; }; }
    fi
    if test x"3.9" = x ; then
	{ { echo "$as_me:$LINENO: error:
TEA version not specified." >&5
echo "$as_me: error:
TEA version not specified." >&2;}

else
  AR="$ac_cv_prog_AR"
fi

    STLIB_LD='${AR} cr'
    LD_LIBRARY_PATH_VAR="LD_LIBRARY_PATH"
    if test "x$SHLIB_VERSION" = x; then
  SHLIB_VERSION=""
else
  SHLIB_VERSION=".$SHLIB_VERSION"
fi

    case $system in
	# TEA specific:
	windows)
	    # This is a 2-stage check to make sure we have the 64-bit SDK
	    # We have to know where the SDK is installed.

		SHLIB_SUFFIX=".so"
		if test $doRpath = yes; then

		    CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
fi

		LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS}
		SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.so${SHLIB_VERSION}'
		LDFLAGS="-Wl,-export-dynamic"
		;;
	    esac
	    case "$arch" in
	    vax)
		CFLAGS_OPTIMIZE="-O1"
		;;

	    if test x"${TK_BIN_DIR}" != x ; then
		SHLIB_LD_LIBS="${SHLIB_LD_LIBS} \"`${CYGPATH} ${TK_BIN_DIR}/${TK_STUB_LIB_FILE}`\""
	    fi
	    SHLIB_LD_LIBS="${SHLIB_LD_LIBS} \"`${CYGPATH} ${TCL_BIN_DIR}/${TCL_STUB_LIB_FILE}`\""
	    if test "$GCC" = "yes"; then
		SHLIB_LD_LIBS="${SHLIB_LD_LIBS} -static-libgcc"
	    fi
	    eval eval "PKG_LIB_FILE=${PACKAGE_LIB_PREFIX}${PACKAGE_NAME}${SHARED_LIB_SUFFIX}"
	else
	    eval eval "PKG_LIB_FILE=${PACKAGE_LIB_PREFIX}${PACKAGE_NAME}${UNSHARED_LIB_SUFFIX}"
	    if test "$GCC" = "yes"; then
		PKG_LIB_FILE=lib${PKG_LIB_FILE}
	    fi
	fi
	# Some packages build their own stubs libraries
	eval eval "PKG_STUB_LIB_FILE=${PACKAGE_LIB_PREFIX}${PACKAGE_NAME}stub${UNSHARED_LIB_SUFFIX}"
	if test "$GCC" = "yes"; then
	    PKG_STUB_LIB_FILE=lib${PKG_STUB_LIB_FILE}
	fi
	# These aren't needed on Windows (either MSVC or gcc)
	RANLIB=:
	RANLIB_STUB=:
    else
	RANLIB_STUB="${RANLIB}"
	if test "${SHARED_BUILD}" = "1" ; then
	    SHLIB_LD_LIBS="${SHLIB_LD_LIBS} ${TCL_STUB_LIB_SPEC}"
	    if test x"${TK_BIN_DIR}" != x ; then
		SHLIB_LD_LIBS="${SHLIB_LD_LIBS} ${TK_STUB_LIB_SPEC}"
	    fi
	    eval eval "PKG_LIB_FILE=lib${PACKAGE_LIB_PREFIX}${PACKAGE_NAME}${SHARED_LIB_SUFFIX}"
	    RANLIB=:
	else
	    eval eval "PKG_LIB_FILE=lib${PACKAGE_LIB_PREFIX}${PACKAGE_NAME}${UNSHARED_LIB_SUFFIX}"
	fi
	# Some packages build their own stubs libraries
	eval eval "PKG_STUB_LIB_FILE=lib${PACKAGE_LIB_PREFIX}${PACKAGE_NAME}stub${UNSHARED_LIB_SUFFIX}"
    fi

    # These are escaped so that only CFLAGS is picked up at configure time.
    # The other values will be substituted at make time.
    CFLAGS="${CFLAGS} \${CFLAGS_DEFAULT} \${CFLAGS_WARNING}"
    if test "${SHARED_BUILD}" = "1" ; then
	CFLAGS="${CFLAGS} \${SHLIB_CFLAGS}"

/*
 * Definition of flags for ThreadSend.
 */

#define THREAD_SEND_WAIT 1<<1
#define THREAD_SEND_HEAD 1<<2
#define THREAD_SEND_CLBK 1<<3

#ifdef BUILD_thread
# undef  TCL_STORAGE_CLASS
# define TCL_STORAGE_CLASS DLLEXPORT
#endif

/*

        Tcl_ThreadQueueEvent(thrId, (Tcl_Event*)eventPtr, TCL_QUEUE_TAIL);
    }
    Tcl_ThreadAlert(thrId);

    if ((flags & THREAD_SEND_WAIT) == 0) {
        /*
         * Might potentially spend some time here, until the
         * worker thread cleans up its queue a little bit.
         */
	if ((flags & THREAD_SEND_CLBK) == 0) {
            while (tsdPtr->maxEventsCount &&
                   tsdPtr->eventsPending > tsdPtr->maxEventsCount) {
                Tcl_ConditionWait(&tsdPtr->doOneEvent, &threadMutex, NULL);
            }
	}
        Tcl_MutexUnlock(&threadMutex);
        return TCL_OK;
    }

    /*
     * Block on the result indefinitely.
     */

    interp = (sendPtr && sendPtr->interp) ? sendPtr->interp : tsdPtr->interp;

    if (interp != NULL) {
        Tcl_Preserve((ClientData)interp);

        if (clbkPtr && clbkPtr->threadId == thrId) {
            Tcl_Release((ClientData)interp);
            /* Watch: this thread evaluates its own callback. */
            interp = clbkPtr->interp;
            Tcl_Preserve((ClientData)interp);
        }

        Tcl_ResetResult(interp);

        if (sendPtr) {

         */

        if (code != TCL_OK) {
            ThreadErrorProc(interp);
        }

        ThreadSetResult(interp, code, &clbkPtr->result);
        ThreadSend(interp, clbkPtr->threadId, tmpPtr, NULL, THREAD_SEND_CLBK);

    } else if (code != TCL_OK) {
        /*
         * Only pass errors onto the registered error handler
         * when we don't have a result target for this event.
         */
        ThreadErrorProc(interp);