Tcl package Thread source code

CONFIG_CLEAN_FILES = Makefile pkgIndex.tcl
CLEANFILES	= @CLEANFILES@

CPPFLAGS	= @CPPFLAGS@
LIBS		= @PKG_LIBS@ @LIBS@
AR		= @AR@
CFLAGS		= @CFLAGS@ -DUSE_INTERP_ERRORLINE
COMPILE		= $(CC) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS)

#========================================================================
# Start of user-definable TARGETS section
#========================================================================

#========================================================================

dist-clean:
	rm -rf $(DIST_DIR) $(DIST_ROOT)/$(PKG_DIR).tar.*

dist: dist-clean
	mkdir -p $(DIST_DIR)
	cp -p $(srcdir)/ChangeLog $(srcdir)/README* $(srcdir)/license.terms \
		$(srcdir)/aclocal.m4 $(srcdir)/naviserver.m4 $(srcdir)/configure \
        $(srcdir)/*.in \
		$(DIST_DIR)/
	chmod 664 $(DIST_DIR)/Makefile.in $(DIST_DIR)/aclocal.m4
	chmod 775 $(DIST_DIR)/configure $(DIST_DIR)/configure.in

	mkdir $(DIST_DIR)/tclconfig
	cp $(srcdir)/tclconfig/install-sh $(srcdir)/tclconfig/tcl.m4 \

WHAT IS THIS ?
==============

This is the source distribution of the Tcl Thread extension. 
You can use this extension to gain script-level access to Tcl 
threading capabilities.
The extension can be used with Tcl cores starting from Tcl8.4 and later.
(This beta can be compiled using Tcl8.4 or later, and it can run with
Tcl8.5 and later. The only reason why it cannot run with Tcl 8.4 is
because Tcl 8.4 cannot handle package versions with "b" in it. Therefore
the final Thread 2.7for84+ release will run fine with Tcl 8.4)
Also, this extension supports, i.e. can be used as a loadable module of,
AOLserver 4.x series of the highly-scalable web server from America Online. 

You need to have your Tcl core compiled with "--enable-threads" in order
to turn on internal directives supporting thread-specific details of the
Tcl API. The extension will not load in an Tcl shell built w/o thread
support. 

This extension is a freely available open source package. You can do 

#
# Pull in the standard Tcl autoconf macros.
# If you don't have the "tclconfig" subdirectory, it is a dependent CVS
# module. Either "cvs -d <root> checkout tclconfig" right here, or
# re-checkout the thread module
#
builtin(include,tclconfig/tcl.m4)
builtin(include,naviserver.m4)

#
# Handle the "--with-gdbm" option for linking-in
# the gdbm-based peristent store for shared arrays.
# It tries to locate gdbm files in couple of standard
# system directories and/or common install locations
# in addition to the directory passed by the user.

#! /bin/sh
# Guess values for system-dependent variables and create Makefiles.
# Generated by GNU Autoconf 2.59 for thread 2.7.0.
#
# Copyright (C) 2003 Free Software Foundation, Inc.
# This configure script is free software; the Free Software Foundation
# gives unlimited permission to copy, distribute and modify it.
## --------------------- ##
## M4sh Initialization.  ##
## --------------------- ##

# This variable seems obsolete.  It should probably be removed, and
# only ac_max_sed_lines should be used.
: ${ac_max_here_lines=38}

# Identity of this package.
PACKAGE_NAME='thread'
PACKAGE_TARNAME='thread'
PACKAGE_VERSION='2.7.0'
PACKAGE_STRING='thread 2.7.0'
PACKAGE_BUGREPORT=''

# Factoring default headers for most tests.
ac_includes_default="\
#include <stdio.h>
#if HAVE_SYS_TYPES_H
# include <sys/types.h>

#
# Report the --help message.
#
if test "$ac_init_help" = "long"; then
  # Omit some internal or obsolete options to make the list less imposing.
  # This message is too long to be a string in the A/UX 3.1 sh.
  cat <<_ACEOF
\`configure' configures thread 2.7.0 to adapt to many kinds of systems.

Usage: $0 [OPTION]... [VAR=VALUE]...

To assign environment variables (e.g., CC, CFLAGS...), specify them as
VAR=VALUE.  See below for descriptions of some of the useful variables.

Defaults for the options are specified in brackets.

  cat <<\_ACEOF
_ACEOF
fi

if test -n "$ac_init_help"; then
  case $ac_init_help in
     short | recursive ) echo "Configuration of thread 2.7.0:";;
   esac
  cat <<\_ACEOF

Optional Features:
  --disable-FEATURE       do not include FEATURE (same as --enable-FEATURE=no)
  --enable-FEATURE[=ARG]  include FEATURE [ARG=yes]
  --enable-threads        build with threads
  --enable-shared         build and link with shared libraries (default: on)
  --enable-64bit          enable 64bit support (default: off)
  --enable-64bit-vis      enable 64bit Sparc VIS support (default: off)
  --disable-rpath         disable rpath support (default: on)
  --enable-wince          enable Win/CE support (where applicable)
  --enable-symbols        build with debugging symbols (default: off)

Optional Packages:
  --with-PACKAGE[=ARG]    use PACKAGE [ARG=yes]
  --without-PACKAGE       do not use PACKAGE (same as --with-PACKAGE=no)
  --with-tcl              directory containing tcl configuration
                          (tclConfig.sh)
  --with-gdbm             link with optional GDBM support
  --with-naviserver       directory with NaviServer/AOLserver distribution
  --with-tclinclude       directory containing the public Tcl header files
  --with-celib=DIR        use Windows/CE support library from DIR

Some influential environment variables:
  CC          C compiler command
  CFLAGS      C compiler flags
  LDFLAGS     linker flags, e.g. -L<lib dir> if you have libraries in a

    cd $ac_popdir
  done
fi

test -n "$ac_init_help" && exit 0
if $ac_init_version; then
  cat <<\_ACEOF
thread configure 2.7.0
generated by GNU Autoconf 2.59

Copyright (C) 2003 Free Software Foundation, Inc.
This configure script is free software; the Free Software Foundation
gives unlimited permission to copy, distribute and modify it.
_ACEOF
  exit 0
fi
exec 5>config.log
cat >&5 <<_ACEOF
This file contains any messages produced by compilers while
running configure, to aid debugging if configure makes a mistake.

It was created by thread $as_me 2.7.0, which was
generated by GNU Autoconf 2.59.  Invocation command line was

  $ $0 $@

_ACEOF
{
cat <<_ASUNAME

if test "${TCL_MAJOR_VERSION}" -ne 8 ; then
    { { echo "$as_me:$LINENO: error: ${PACKAGE_NAME} ${PACKAGE_VERSION} requires Tcl 8.4+
Found config for Tcl ${TCL_VERSION}" >&5
echo "$as_me: error: ${PACKAGE_NAME} ${PACKAGE_VERSION} requires Tcl 8.4+
Found config for Tcl ${TCL_VERSION}" >&2;}
   { (exit 1); exit 1; }; }
fi
if test "${TCL_MINOR_VERSION}" -lt 4 ; then
    { { echo "$as_me:$LINENO: error: ${PACKAGE_NAME} ${PACKAGE_VERSION} requires Tcl 8.4+
Found config for Tcl ${TCL_VERSION}" >&5
echo "$as_me: error: ${PACKAGE_NAME} ${PACKAGE_VERSION} requires Tcl 8.4+
Found config for Tcl ${TCL_VERSION}" >&2;}
   { (exit 1); exit 1; }; }
fi


#--------------------------------------------------------------------
# Load the tkConfig.sh file if necessary (Tk extension)
#--------------------------------------------------------------------

#TEA_PATH_TKCONFIG
#TEA_LOAD_TKCONFIG

            GDBM_LIBS="-L\"$glibdir\" -lgdbm"
        fi
    fi
    fi


#--------------------------------------------------------------------
# Locate the NaviServer/AOLserver dir for compilation as NaviServer/AOLserver module.
# This will declare NS_INCLUDES, NS_LIBS and define NS_AOLSERVER.
#--------------------------------------------------------------------


    echo "$as_me:$LINENO: checking for NaviServer/AOLserver configuration" >&5
echo $ECHO_N "checking for NaviServer/AOLserver configuration... $ECHO_C" >&6

# Check whether --with-naviserver or --without-naviserver was given.
if test "${with_naviserver+set}" = set; then
  withval="$with_naviserver"
  \
    with_naviserver=${withval}
fi;

    if test "${ac_cv_c_naviserver+set}" = set; then
  echo $ECHO_N "(cached) $ECHO_C" >&6
else

    if test x"${with_naviserver}" != x ; then
        if test -f "${with_naviserver}/include/ns.h" ; then
            ac_cv_c_naviserver=`(cd ${with_naviserver}; pwd)`
        else
            { { echo "$as_me:$LINENO: error: ${with_naviserver} directory doesn't contain ns.h" >&5
echo "$as_me: error: ${with_naviserver} directory doesn't contain ns.h" >&2;}
   { (exit 1); exit 1; }; }
        fi
    fi

fi

    if test x"${ac_cv_c_naviserver}" = x ; then
        echo "$as_me:$LINENO: result: none found" >&5
echo "${ECHO_T}none found" >&6
    else
        NS_DIR=${ac_cv_c_naviserver}
        echo "$as_me:$LINENO: result: found NaviServer/AOLserver in $NS_DIR" >&5
echo "${ECHO_T}found NaviServer/AOLserver in $NS_DIR" >&6
        NS_INCLUDES="-I\"${NS_DIR}/include\""
        if test "`uname -s`" = Darwin ; then
            aollibs=`ls ${NS_DIR}/lib/libns* 2>/dev/null`
            if test x"$aollibs" != x ; then
                NS_LIBS="-L\"${NS_DIR}/lib\" -lnsd -lnsthread"
            fi
        fi
        cat >>confdefs.h <<\_ACEOF
#define NS_AOLSERVER 1
_ACEOF

    fi


#-----------------------------------------------------------------------
# __CHANGE__
# Specify the C source files to compile in TEA_ADD_SOURCES,
# public headers that need to be installed in TEA_ADD_HEADERS,
# stub library C source files to compile in TEA_ADD_STUB_SOURCES,
# and runtime Tcl library files in TEA_ADD_TCL_SOURCES.
# This defines PKG(_STUB)_SOURCES, PKG(_STUB)_OBJECTS, PKG_HEADERS
# and PKG_TCL_SOURCES.
#-----------------------------------------------------------------------


    vars="generic/threadNs.c           \
                 generic/threadCmd.c          \
                 generic/threadSvCmd.c        \
                 generic/threadSpCmd.c        \
                 generic/threadPoolCmd.c      \
                 generic/psGdbm.c             \
                 generic/threadSvListCmd.c    \
                 generic/threadSvKeylistCmd.c \
                 generic/tclXkeylist.c        \

   { (exit 1); exit 1; }; }
	fi
	PKG_HEADERS="$PKG_HEADERS $i"
    done



    vars="${NS_INCLUDES}"
    for i in $vars; do
	PKG_INCLUDES="$PKG_INCLUDES $i"
    done



    vars="${GDBM_LIBS} ${NS_LIBS}"
    for i in $vars; do
	if test "${TEA_PLATFORM}" = "windows" -a "$GCC" = "yes" ; then
	    # Convert foo.lib to -lfoo for GCC.  No-op if not *.lib
	    i=`echo "$i" | sed -e 's/^\([^-].*\)\.lib$/-l\1/i'`
	fi
	PKG_LIBS="$PKG_LIBS $i"
    done

  echo
  sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX
## Running $as_me. ##
_ASBOX
} >&5
cat >&5 <<_CSEOF

This file was extended by thread $as_me 2.7.0, which was
generated by GNU Autoconf 2.59.  Invocation command line was

  CONFIG_FILES    = $CONFIG_FILES
  CONFIG_HEADERS  = $CONFIG_HEADERS
  CONFIG_LINKS    = $CONFIG_LINKS
  CONFIG_COMMANDS = $CONFIG_COMMANDS
  $ $0 $@

$config_files

Report bugs to <[email protected]>."
_ACEOF

cat >>$CONFIG_STATUS <<_ACEOF
ac_cs_version="\\
thread config.status 2.7.0
configured by $0, generated by GNU Autoconf 2.59,
  with options \\"`echo "$ac_configure_args" | sed 's/[\\""\`\$]/\\\\&/g'`\\"

Copyright (C) 2003 Free Software Foundation, Inc.
This config.status script is free software; the Free Software Foundation
gives unlimited permission to copy, distribute and modify it."
srcdir=$srcdir

# Set your package name and version numbers here.
#
# This initializes the environment with PACKAGE_NAME and PACKAGE_VERSION
# set as provided.  These will also be added as -D defs in your Makefile
# so you can encode the package version directly into the source files.
#-----------------------------------------------------------------------

AC_INIT([thread], [2.7.0])

#--------------------------------------------------------------------
# Call TEA_INIT as the first TEA_ macro to set up initial vars.
# This will define a ${TEA_PLATFORM} variable == "unix" or "windows"
# as well as PKG_LIB_FILE and PKG_STUB_LIB_FILE.
#--------------------------------------------------------------------

TEA_INIT([3.9])

AC_CONFIG_AUX_DIR(tclconfig)

#--------------------------------------------------------------------
# Load the tclConfig.sh file
#--------------------------------------------------------------------

TEA_PATH_TCLCONFIG
TEA_LOAD_TCLCONFIG

if test "${TCL_MAJOR_VERSION}" -ne 8 ; then
    AC_MSG_ERROR([${PACKAGE_NAME} ${PACKAGE_VERSION} requires Tcl 8.4+
Found config for Tcl ${TCL_VERSION}])
fi
if test "${TCL_MINOR_VERSION}" -lt 4 ; then
    AC_MSG_ERROR([${PACKAGE_NAME} ${PACKAGE_VERSION} requires Tcl 8.4+
Found config for Tcl ${TCL_VERSION}])
fi


#--------------------------------------------------------------------
# Load the tkConfig.sh file if necessary (Tk extension)
#--------------------------------------------------------------------

#TEA_PATH_TKCONFIG
#TEA_LOAD_TKCONFIG

# Check if building with optional Gdbm package. This will declare
# GDBM_CFLAGS and GDBM_LIBS variables.
#--------------------------------------------------------------------

TCLTHREAD_WITH_GDBM

#--------------------------------------------------------------------
# Locate the NaviServer/AOLserver dir for compilation as NaviServer/AOLserver module.
# This will declare NS_INCLUDES, NS_LIBS and define NS_AOLSERVER.
#--------------------------------------------------------------------

NS_PATH_AOLSERVER

#-----------------------------------------------------------------------
# __CHANGE__
# Specify the C source files to compile in TEA_ADD_SOURCES,
# public headers that need to be installed in TEA_ADD_HEADERS,
# stub library C source files to compile in TEA_ADD_STUB_SOURCES,
# and runtime Tcl library files in TEA_ADD_TCL_SOURCES.
# This defines PKG(_STUB)_SOURCES, PKG(_STUB)_OBJECTS, PKG_HEADERS
# and PKG_TCL_SOURCES.
#-----------------------------------------------------------------------

TEA_ADD_SOURCES([generic/threadNs.c           \
                 generic/threadCmd.c          \
                 generic/threadSvCmd.c        \
                 generic/threadSpCmd.c        \
                 generic/threadPoolCmd.c      \
                 generic/psGdbm.c             \
                 generic/threadSvListCmd.c    \
                 generic/threadSvKeylistCmd.c \
                 generic/tclXkeylist.c        \
])

TEA_ADD_HEADERS([generic/tclThread.h])
TEA_ADD_INCLUDES([${NS_INCLUDES}])
TEA_ADD_LIBS([${GDBM_LIBS} ${NS_LIBS}])
TEA_ADD_CFLAGS([${GDBM_CFLAGS}])
TEA_ADD_STUB_SOURCES([])
TEA_ADD_TCL_SOURCES([lib/ttrace.tcl])

#--------------------------------------------------------------------
# __CHANGE__
# A few miscellaneous platform-specific items:

#define _TCL_THREAD_INT_H_

#include "tclThread.h"
#include <stdlib.h> /* For strtoul */
#include <string.h> /* For memset and friends */

/*
 * For linking against NaviServer/AOLserver require V4 at least
 */

#ifdef NS_AOLSERVER
# include <ns.h>
# if !defined(NS_MAJOR_VERSION) || NS_MAJOR_VERSION < 4
#  error "unsupported NaviServer/AOLserver version"
# endif
#endif

/*
 * Allow for some command names customization.
 * Only thread:: and tpool:: are handled here.
 * Shared variable commands are more complicated.

#define OPT_CMP(a,b) \
  ((a) && (b) && (*(a)==*(b)) && (*(a+1)==*(b+1)) && (!strcmp((a),(b))))

#ifndef TCL_TSD_INIT
#define TCL_TSD_INIT(keyPtr) \
  (ThreadSpecificData*)Tcl_GetThreadData((keyPtr),sizeof(ThreadSpecificData))
#endif

/*
 * Structure to pass to NsThread_Init. This holds the module
 * and virtual server name for proper interp initializations.
 */

typedef struct {
    char *modname;
    char *server;
} NsThreadInterpData;

/*
 * Handle binary compatibility regarding
 * Tcl_GetErrorLine in 8.x
 * See Tcl bug #3562640.
 */
#if (TCL_MAJOR_VERSION == 8)
# undef Tcl_GetErrorLine
# define Tcl_GetErrorLine(interp) ((interp)->errorLine)
#endif


#endif /* _TCL_THREAD_INT_H_ */

 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 * ----------------------------------------------------------------------------
 */

#include "tclThreadInt.h"

/*
 * Check if this is Tcl 8.5 or higher. In that case, we will have the TIP
 * #143 APIs (i.e. interpreter resource limiting) available.
 */
#define haveInterpLimit (tclVersion>84)
#if (TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION < 5)
# define Tcl_LimitExceeded ((int (*)(Tcl_Interp *)) \
    ((&(tclStubsPtr->tcl_PkgProvideEx))[524]))
#endif

/*
 * Check if this is Tcl 8.6 or higher.  In that case, we will have the TIP
 * #285 APIs (i.e. asynchronous script cancellation) available.
 */

#define haveInterpCancel (tclVersion>85)
#if (TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION < 6)
# define TCL_CANCEL_UNWIND 0x100000
# define Tcl_CancelEval ((int (*)(Tcl_Interp *, Tcl_Obj *, ClientData, int)) \
    ((&(tclStubsPtr->tcl_PkgProvideEx))[580]))
# define Tcl_Canceled ((int (*)(Tcl_Interp *, int)) \
    ((&(tclStubsPtr->tcl_PkgProvideEx))[581]))
#endif

/*
 * Access to the list of threads and to the thread send results
 * (defined below) is guarded by this mutex.
 */

static struct ThreadSpecificData *threadList = NULL;

/*
 * Used to represent the empty result.
 */

static char *threadEmptyResult = (char *)"";

static int tclVersion = 0;

/*
 * An instance of the following structure contains all information that is
 * passed into a new thread when the thread is created using either the
 * "thread create" Tcl command or the ThreadCreate() C function.
 */

static Tcl_ObjCmdProc ThreadAttachObjCmd;
static Tcl_ObjCmdProc ThreadCancelObjCmd;

static int
ThreadInit(interp)
    Tcl_Interp *interp; /* The current Tcl interpreter */
{


    if (Tcl_InitStubs(interp, "8.4", 0) == NULL) {
        return TCL_ERROR;
    }

    if (!tclVersion) {
	/*
	 * Perform a version check now to stop using from trying to use
	 * the TIP #143 or TIP #285 functionality if they are not present.
	 */
	int major, minor;

	Tcl_GetVersion(&major, &minor, NULL, NULL);
	tclVersion = 10 * major + minor;



    }

    TCL_CMD(interp, THREAD_CMD_PREFIX"create",    ThreadCreateObjCmd);
    TCL_CMD(interp, THREAD_CMD_PREFIX"send",      ThreadSendObjCmd);
    TCL_CMD(interp, THREAD_CMD_PREFIX"broadcast", ThreadBroadcastObjCmd);
    TCL_CMD(interp, THREAD_CMD_PREFIX"exit",      ThreadExitObjCmd);
    TCL_CMD(interp, THREAD_CMD_PREFIX"unwind",    ThreadUnwindObjCmd);

    int         flags;          /* Zero for no flags */
    int         preserve;       /* If true, reserve the thread */
{
    char thrHandle[THREAD_HNDLMAXLEN];
    ThreadCtrl ctrl;
    Tcl_ThreadId thrId;


    ctrl.cd = Tcl_GetAssocData(interp, "thread:nsd", NULL);

    ctrl.script   = (char *)script;
    ctrl.condWait = NULL;
    ctrl.flags    = 0;

    Tcl_MutexLock(&threadMutex);
    if (Tcl_CreateThread(&thrId, NewThread, (ClientData)&ctrl,
            stacksize, flags) != TCL_OK) {

    if (tsdPtr == (ThreadSpecificData*)NULL) {
        Tcl_MutexUnlock(&threadMutex);
        ErrorNoSuchThread(interp, thrId);
        return TCL_ERROR;
    }

    Tcl_MutexUnlock(&threadMutex);

    if (!haveInterpCancel) {
	Tcl_AppendResult(interp, "not supported with this Tcl version", NULL);
	return TCL_ERROR;
    }

    return Tcl_CancelEval(tsdPtr->interp,
            (result != NULL) ? Tcl_NewStringObj(result, -1) : NULL, 0, flags);
}

/*
 *----------------------------------------------------------------------

         * a script in progress to be canceled or exceed its limit;
         * therefore, check for these conditions if we are able to
         * (i.e. we are running in a high enough version of Tcl).
         */

        Tcl_DoOneEvent(TCL_ALL_EVENTS);

        if (haveInterpCancel) {
            /*
             * If the script has been unwound, bail out immediately. This does
             * not follow the recommended guidelines for how extensions should
             * handle the script cancellation functionality because this is
             * not a "normal" extension. Most extensions do not have a command
             * that simply enters an infinite Tcl event loop. Normal extensions
             * should not specify the TCL_CANCEL_UNWIND when calling the
             * Tcl_Canceled function to check if the command has been canceled.
             */

            if (Tcl_Canceled(tsdPtr->interp,
                    TCL_LEAVE_ERR_MSG | TCL_CANCEL_UNWIND) == TCL_ERROR) {
                code = TCL_ERROR;
                break;
            }
        }
        if (haveInterpLimit) {
            if (Tcl_LimitExceeded(tsdPtr->interp)) {
                code = TCL_ERROR;
                break;
            }
        }

        /*
         * Test stop condition under mutex since
         * some other thread may flip our flags.
         */

    if (threadEvalScript && threadEvalScript != threadEmptyResult) {
        Tcl_Free((char*)threadEvalScript);
    }

    Tcl_MutexLock(&threadMutex);

    /*
     * NaviServer/AOLserver and threadpool threads get started/stopped
     * out of the control of this interface so this is
     * the first chance to split them out of the thread list.
     */

    ListRemoveInner(tsdPtr);

    /*

/*
 * aolstub.cpp --
 *
 * Adds interface for loading the extension into the NaviServer/AOLserver.
 *
 * Copyright (c) 2002 by Zoran Vasiljevic.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 * ---------------------------------------------------------------------------
 */

#ifdef NS_AOLSERVER
#include <ns.h>
#include "tclThreadInt.h"

int Ns_ModuleVersion = 1;

/*
 *----------------------------------------------------------------------------
 *
 * NsThread_Init --
 *
 *    Loads the package for the first time, i.e. in the startup thread.
 *
 * Results:
 *    Standard Tcl result
 *
 * Side effects:
 *    Package initialized. Tcl commands created.
 *
 *----------------------------------------------------------------------------
 */

static int
NsThread_Init (Tcl_Interp *interp, void *cd)
{
    NsThreadInterpData *md = (NsThreadInterpData*)cd;
    int ret = Thread_Init(interp);

    if (ret != TCL_OK) {
        Ns_Log(Warning, "can't load module %s: %s", md->modname,
               Tcl_GetStringResult(interp));
        return TCL_ERROR;
    }
    Tcl_SetAssocData(interp, "thread:nsd", NULL, (ClientData)md);

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------------
 *
 * Ns_ModuleInit --
 *
 *    Called by the NaviServer/AOLserver when loading shared object file.
 *
 * Results:
 *    Standard NaviServer/AOLserver result
 *
 * Side effects:
 *    Many. Depends on the package.
 *
 *----------------------------------------------------------------------------
 */

int
Ns_ModuleInit(char *srv, char *mod)
{
    NsThreadInterpData *md = NULL;

    md = (NsThreadInterpData*)ns_malloc(sizeof(NsThreadInterpData));
    md->modname = strcpy(ns_malloc(strlen(mod)+1), mod);
    md->server  = strcpy(ns_malloc(strlen(srv)+1), srv);

    return Ns_TclRegisterTrace(srv, NsThread_Init, (void*)md, NS_TCL_TRACE_CREATE);
}

#endif /* NS_AOLSERVER */

/* EOF $RCSfile: aolstub.cpp,v $ */

/* Emacs Setup Variables */
/* Local Variables:      */
/* mode: C               */
/* indent-tabs-mode: nil */
/* c-basic-offset: 4     */
/* End:                  */

#include "tclThreadInt.h"
#include "threadSvCmd.h"

#include "threadSvListCmd.h"    /* Shared variants of list commands */
#include "threadSvKeylistCmd.h" /* Shared variants of list commands */
#include "psGdbm.h"             /* The gdbm persistent store implementation */





/*
 * Number of buckets to spread shared arrays into. Each bucket is
 * associated with one mutex so locking a bucket locks all arrays
 * in that bucket as well. The number of buckets should be a prime.
 */

#define NUMBUCKETS 31

static RegType*   regType;      /* Linked list of registered obj types */
static PsStore*   psStore;      /* Linked list of registered pers. stores */

static Tcl_Mutex  svMutex;      /* Protects inserts into above lists */
static Tcl_Mutex  initMutex;    /* Serializes initialization issues */

/*
 * The standard commands found in NaviServer/AOLserver nsv_* interface.
 * For sharp-eye readers: the implementation of the "lappend" command
 * is moved to new list-command package, since it really belongs there.
 */

static Tcl_ObjCmdProc SvObjObjCmd;
static Tcl_ObjCmdProc SvAppendObjCmd;
static Tcl_ObjCmdProc SvIncrObjCmd;
static Tcl_ObjCmdProc SvSetObjCmd;
static Tcl_ObjCmdProc SvExistsObjCmd;

 * Side effects;
 *      New command will be added to a linked list of registered commands.
 *
 *-----------------------------------------------------------------------------
 */

void
Sv_RegisterCommand(cmdName, objProc, delProc)
    const char *cmdName;                /* Name of command to register */
    Tcl_ObjCmdProc *objProc;            /* Object-based command procedure */
    Tcl_CmdDeleteProc *delProc;         /* Command delete procedure */

{
    int len = strlen(cmdName) + strlen(TSV_CMD_PREFIX) + 1;
    int len2 = strlen(cmdName) + strlen(TSV_CMD2_PREFIX) + 1;
    SvCmdInfo *newCmd = (SvCmdInfo*)Tcl_Alloc(sizeof(SvCmdInfo) + len + len2);

    /*
     * Setup new command structure
     */

    newCmd->cmdName = (char*)((char*)newCmd + sizeof(SvCmdInfo));
    newCmd->cmdName2 = newCmd->cmdName + len;

    newCmd->objProcPtr = objProc;
    newCmd->delProcPtr = delProc;


    /*
     * Rewrite command name. This is needed so we can
     * easily turn-on the compatiblity with NaviServer/AOLserver
     * command names.
     */

    strcpy(newCmd->cmdName, TSV_CMD_PREFIX);
    strcat(newCmd->cmdName, cmdName);
    newCmd->name = newCmd->cmdName + strlen(TSV_CMD_PREFIX);
    strcpy(newCmd->cmdName2, TSV_CMD2_PREFIX);
    strcat(newCmd->cmdName2, cmdName);

    /*
     * Plug-in in shared list of commands.
     */

    Tcl_MutexLock(&svMutex);
    if (svCmdInfo == NULL) {

 * Side effects:
 *      New Tcl command gets created.
 *
 *-----------------------------------------------------------------------------
 */

static int
SvObjObjCmd(arg, interp, objc, objv)
    ClientData arg;                     /* Just passed to subcommands. */
    Tcl_Interp *interp;                 /* Current interpreter. */
    int objc;                           /* Number of arguments. */
    Tcl_Obj *const objv[];              /* Argument objects. */
{
    int new, off, ret, flg;
    char buf[128];
    Tcl_Obj *val = NULL;

    }

    /*
     * Format the command name
     */

    sprintf(buf, "::%p", (int*)svObj);
    Tcl_CreateObjCommand(interp, buf, SvObjDispatchObjCmd, (int*)svObj, arg);
    Tcl_ResetResult(interp);
    Tcl_SetObjResult(interp, Tcl_NewStringObj(buf, -1));

    return Sv_PutContainer(interp, svObj, SV_UNCHANGED);
}

/*

 * Side effects:
 *      See the user documentation.
 *
 *-----------------------------------------------------------------------------
 */

static int
SvNamesObjCmd(aol, interp, objc, objv)
    ClientData aol;                     /* !=0 when running in AOL */
    Tcl_Interp *interp;                 /* Current interpreter. */
    int objc;                           /* Number of arguments. */
    Tcl_Obj *const objv[];              /* Argument objects. */
{
    int i, len;
    const char *pattern = NULL;
    Tcl_HashEntry *hPtr;

    for (i = 0; i < NUMBUCKETS; i++) {
        Bucket *bucketPtr = &buckets[i];
        LOCK_BUCKET(bucketPtr);
        hPtr = Tcl_FirstHashEntry(&bucketPtr->arrays, &search);
        while (hPtr) {
            char *key = Tcl_GetHashKey(&bucketPtr->arrays, hPtr);

            if ((!aol || (*key != '.')) /* Hide .<name> arrays for AOL*/ &&



                (pattern == NULL || Tcl_StringMatch(key, pattern))) {
                Tcl_ListObjAppendElement(interp, resObj,
                        Tcl_NewStringObj(key, -1));
            }
            hPtr = Tcl_NextHashEntry(&search);
        }
        UNLOCK_BUCKET(bucketPtr);

SvRegisterStdCommands(void)
{
    static int initialized = 0;

    if (initialized == 0) {
        Tcl_MutexLock(&initMutex);
        if (initialized == 0) {
            Sv_RegisterCommand("var",    SvObjObjCmd,    NULL);
            Sv_RegisterCommand("object", SvObjObjCmd,    NULL);
            Sv_RegisterCommand("set",    SvSetObjCmd,    NULL);
            Sv_RegisterCommand("unset",  SvUnsetObjCmd,  NULL);
            Sv_RegisterCommand("get",    SvGetObjCmd,    NULL);
            Sv_RegisterCommand("incr",   SvIncrObjCmd,   NULL);
            Sv_RegisterCommand("exists", SvExistsObjCmd, NULL);
            Sv_RegisterCommand("append", SvAppendObjCmd, NULL);
            Sv_RegisterCommand("array",  SvArrayObjCmd,  NULL);
            Sv_RegisterCommand("names",  SvNamesObjCmd,  NULL);
            Sv_RegisterCommand("pop",    SvPopObjCmd,    NULL);
            Sv_RegisterCommand("move",   SvMoveObjCmd,   NULL);
            Sv_RegisterCommand("lock",   SvLockObjCmd,   NULL);
            initialized = 1;
        }
        Tcl_MutexUnlock(&initMutex);
    }
}

/*

    /*
     * Plug-in registered commands in current interpreter
     */

    for (cmdPtr = svCmdInfo; cmdPtr; cmdPtr = cmdPtr->nextPtr) {
        Tcl_CreateObjCommand(interp, cmdPtr->cmdName, cmdPtr->objProcPtr,
                (ClientData)0, (Tcl_CmdDeleteProc*)0);
#ifdef NS_AOLSERVER
        Tcl_CreateObjCommand(interp, cmdPtr->cmdName2, cmdPtr->objProcPtr,
                (ClientData)1, (Tcl_CmdDeleteProc*)0);
#endif
    }

    /*
     * Create array of buckets and initialize each bucket
     */

    if (buckets == NULL) {

 * compatibility with AOLserver nsv_* commands
 */

/* #define NSV_COMPAT 1 */

/*
 * Uncomment following line to force command-line
 * compatibility with older thread::sv_ commands.



 */

/* #define OLD_COMPAT 1 */


#ifdef NSV_COMPAT
# define TSV_CMD2_PREFIX "nsv_"  /* Compatiblity prefix for NaviServer/AOLserver */
#else
# define TSV_CMD2_PREFIX "sv_"   /* Regular command prefix for NaviServer/AOLserver */
#endif

#ifdef OLD_COMPAT
# define TSV_CMD_PREFIX "thread::sv_" /* Old command prefix for Tcl */
#else
# define TSV_CMD_PREFIX "tsv::" /* Regular command prefix for Tcl */

#endif

/*
 * Used when creating arrays/variables
 */

#define FLAGS_CREATEARRAY  1   /* Create the array in bucket if none found */

/*
 * Structure for generating command names in Tcl
 */

typedef struct SvCmdInfo {
    char *name;                 /* The short name of the command */
    char *cmdName;              /* Real (rewritten) name of the command */
    char *cmdName2;             /* Real AOL (rewritten) name of the command */
    Tcl_ObjCmdProc *objProcPtr; /* The object-based command procedure */
    Tcl_CmdDeleteProc *delProcPtr; /* Pointer to command delete function */

    struct SvCmdInfo *nextPtr;  /* Next in chain of registered commands */
} SvCmdInfo;

/*
 * Structure for registering special object duplicator functions.
 * Reason for this is that even some regular Tcl duplicators
 * produce shallow instead of proper deep copies of the object.

} RegType;

/*
 * Limited API functions
 */

MODULE_SCOPE void
Sv_RegisterCommand(const char*,Tcl_ObjCmdProc*,Tcl_CmdDeleteProc*);

MODULE_SCOPE void
Sv_RegisterObjType(const Tcl_ObjType*, Tcl_DupInternalRepProc*);

MODULE_SCOPE void
Sv_RegisterPsStore(PsStore*);

Sv_RegisterKeylistCommands(void)
{
    static int initialized;

    if (initialized == 0) {
        Tcl_MutexLock(&initMutex);
        if (initialized == 0) {
            Sv_RegisterCommand("keylset",  SvKeylsetObjCmd,  NULL);
            Sv_RegisterCommand("keylget",  SvKeylgetObjCmd,  NULL);
            Sv_RegisterCommand("keyldel",  SvKeyldelObjCmd,  NULL);
            Sv_RegisterCommand("keylkeys", SvKeylkeysObjCmd, NULL);
            Sv_RegisterObjType(&keyedListType, DupKeyedListInternalRepShared);
            initialized = 1;
        }
        Tcl_MutexUnlock(&initMutex);
    }
}


Sv_RegisterListCommands(void)
{
    static int initialized = 0;

    if (initialized == 0) {
        Tcl_MutexLock(&initMutex);
        if (initialized == 0) {
            Sv_RegisterCommand("lpop",     SvLpopObjCmd,     NULL);
            Sv_RegisterCommand("lpush",    SvLpushObjCmd,    NULL);
            Sv_RegisterCommand("lappend",  SvLappendObjCmd,  NULL);
            Sv_RegisterCommand("lreplace", SvLreplaceObjCmd, NULL);
            Sv_RegisterCommand("linsert",  SvLinsertObjCmd,  NULL);
            Sv_RegisterCommand("llength",  SvLlengthObjCmd,  NULL);
            Sv_RegisterCommand("lindex",   SvLindexObjCmd,   NULL);
            Sv_RegisterCommand("lrange",   SvLrangeObjCmd,   NULL);
            Sv_RegisterCommand("lsearch",  SvLsearchObjCmd,  NULL);
            Sv_RegisterCommand("lset",     SvLsetObjCmd,     NULL);
            Sv_RegisterObjType(Tcl_GetObjType("list"), DupListObjShared);
            initialized = 1;
        }
        Tcl_MutexUnlock(&initMutex);
    }
}


        interp alias {} [namespace current]::_array   {} tsv::array
        interp alias {} [namespace current]::_incr    {} tsv::incr
        interp alias {} [namespace current]::_lappend {} tsv::lappend
        interp alias {} [namespace current]::_names   {} tsv::names
        interp alias {} [namespace current]::_set     {} tsv::set
        interp alias {} [namespace current]::_unset   {} tsv::unset
    } else {
        error "requires NaviServer/AOLserver or Tcl threading extension"
    }

    # Keep in sync with the Thread package
    package provide Ttrace 2.7.0

    # Package variables
    variable resolvers ""     ; # List of registered resolvers
    variable tracers   ""     ; # List of registered cmd tracers
    variable scripts   ""     ; # List of registered script makers
    variable enables   ""     ; # List of trace-enable callbacks
    variable disables  ""     ; # List of trace-disable callbacks

#------------------------------------------------------------------------
# NS_PATH_AOLSERVER
#
#   Allows the building with support for NaviServer/AOLserver
#
# Arguments:
#   none
#
# Results:
#
#   Adds the following arguments to configure:
#       --with-naviserver=...
#
#   Defines the following vars:
#       NS_DIR Full path to the directory containing NaviServer/AOLserver distro
#       NS_INCLUDES
#       NS_LIBS
#
#   Sets the following vars:
#       NS_AOLSERVER
#
#   Updates following vars:
#------------------------------------------------------------------------

AC_DEFUN(NS_PATH_AOLSERVER, [
    AC_MSG_CHECKING([for NaviServer/AOLserver configuration])
    AC_ARG_WITH(naviserver,
    [  --with-naviserver       directory with NaviServer/AOLserver distribution],\
    with_naviserver=${withval})

    AC_CACHE_VAL(ac_cv_c_naviserver,[
    if test x"${with_naviserver}" != x ; then
        if test -f "${with_naviserver}/include/ns.h" ; then
            ac_cv_c_naviserver=`(cd ${with_naviserver}; pwd)`
        else
            AC_MSG_ERROR([${with_naviserver} directory doesn't contain ns.h])
        fi
    fi
    ])
    if test x"${ac_cv_c_naviserver}" = x ; then
        AC_MSG_RESULT([none found])
    else
        NS_DIR=${ac_cv_c_naviserver}
        AC_MSG_RESULT([found NaviServer/AOLserver in $NS_DIR])
        NS_INCLUDES="-I\"${NS_DIR}/include\""
        if test "`uname -s`" = Darwin ; then
            aollibs=`ls ${NS_DIR}/lib/libns* 2>/dev/null`
            if test x"$aollibs" != x ; then
                NS_LIBS="-L\"${NS_DIR}/lib\" -lnsd -lnsthread"
            fi
        fi
        AC_DEFINE(NS_AOLSERVER)
    fi
])

# EOF

# -*- tcl -*-
# Tcl package index file, version 1.1
#
if {[package vsatisfies [package provide Tcl] 8.4]} {

    if {[llength [info commands apply]]} {
	# We can use a lambda (anon function) and ::tcl::pkgconfig


	if {([info commands ::tcl::pkgconfig] eq "")
		|| ![::tcl::pkgconfig get threaded]} return

	package ifneeded Ttrace @PACKAGE_VERSION@ [list ::apply {{dir} {
	    if {[info exists ::env(TCL_THREAD_LIBRARY)] &&
		[file readable $::env(TCL_THREAD_LIBRARY)/ttrace.tcl]} {
		source $::env(TCL_THREAD_LIBRARY)/ttrace.tcl
	    } elseif {[file readable [file join $dir .. lib ttrace.tcl]]} {
		source [file join $dir .. lib ttrace.tcl]
	    } elseif {[file readable [file join $dir ttrace.tcl]]} {
		source [file join $dir ttrace.tcl]
	    }
	    if {[llength [info commands ttrace::update]]} {
		ttrace::update
	    }
	}} $dir]
    } else {
	# No anon functions available, go with the necessary evil of a
	# named procedure, but use package specific prefix and no
	# hardwired data changing between package versions.

	if {[array names ::tcl_platform threaded] != "threaded"} return

	package ifneeded Ttrace @PACKAGE_VERSION@ [list @PACKAGE_NAME@_source $dir]

	proc @PACKAGE_NAME@_source {dir} {
	    if {[info exists ::env(TCL_THREAD_LIBRARY)] &&
		[file readable $::env(TCL_THREAD_LIBRARY)/ttrace.tcl]} {
		source $::env(TCL_THREAD_LIBRARY)/ttrace.tcl
	    } elseif {[file readable [file join $dir .. lib ttrace.tcl]]} {
		source [file join $dir .. lib ttrace.tcl]
	    } elseif {[file readable [file join $dir ttrace.tcl]]} {
		source [file join $dir ttrace.tcl]
	    }
	    if {[llength [info commands ttrace::update]]} {
		ttrace::update
	    }
	    rename @PACKAGE_NAME@_source {}
	}
    }
    package ifneeded Thread @PACKAGE_VERSION@ [list load [file join $dir @PKG_LIB_FILE@]]
}

# with the exact location, as found in your system:
# 
# ../configure --enable-threads --with-gdbm=/my/gdbm
#
#
# AOLserver 4.X; Uses public Tcl library.
# ----------------------------------------------------
# nsdir="/usr/local/naviserver"
# ../configure --enable-threads \
#   --with-naviserver=$nsdir \
#   --prefix=$nsdir --exec-prefix=$nsdir
#
# NaviServer/AOLserver uses its own package loading mechanism.
# To load, just do "ns_eval package require Thread"
# at the NaviServer/AOLserver startup or later from any thread.
#
#
# Mac OS X; Uses public Tcl library.
# ----------------------------------------------------
# ../configure --enable-threads \
#   --mandir=/usr/local/share/man \
#   --libdir=/Library/Tcl \

You might want to do "make test" before doing the "make install" in order
to run the regression tests on the package. 

To explore other building options, look into the CONFIG file for more
information.


Note for NaviServer/AOLserver users
------------------------

The extension can be compiled as a loadable module for the
NaviServer/AOLserver  version 4.0 or higher. In order to do this,
use "--with-naviserver" configure option to specify the directory
containing the NaviServer/AOLserver distribution. The CONFIG script
has an example how to invoke configure in order to build the
extension as NaviServer/AOLserver module. Note, however, that
"make install" and "make test" targets are still not supported for
NaviServer/AOLserver builds. This will be corrected in one of
the future releases.

To fine-tune, you might also want to make the tsv::* commands replace
the NaviServer/AOLserver built-in nsv_* family of commands, since
they are API  compatible and provide richer command set plus advanced
shared-object storage of shared data. Go to the generic/threadSvCmd.h
file and look at the beginning of the file for the:

/* #define NSV_COMPAT 1 */

So, uncomment the line, recompile and there you go.


II. Building optional support libraries

!include "pkg.vc"

DOTVERSION      = $(PACKAGE_VERSION:"=) #"
VERSION         = $(PACKAGE_MAJOR)$(PACKAGE_MINOR)
STUBPREFIX      = $(PROJECT)stub

DLLOBJS = \
	$(TMP_DIR)\threadNs.obj \
	$(TMP_DIR)\threadCmd.obj \
	$(TMP_DIR)\threadSvCmd.obj \
	$(TMP_DIR)\threadSpCmd.obj \
	$(TMP_DIR)\threadPoolCmd.obj \
	$(TMP_DIR)\psGdbm.obj \
	$(TMP_DIR)\threadSvListCmd.obj \
	$(TMP_DIR)\threadSvKeylistCmd.obj \

.PHONY: $(OUT_DIR)\pkgIndex.tcl

$(OUT_DIR)\pkgIndex.tcl: $(ROOT)\pkgIndex.tcl.in
	@nmakehlp -s << $** > $@
@PACKAGE_NAME@       thread
@PACKAGE_VERSION@    $(DOTVERSION)
@PKG_LIB_FILE@       $(PRJLIBNAME)

<<

#---------------------------------------------------------------------
# Installation. (EDIT)
#
# You may need to modify this section to reflect the final distribution
# of your files and possibly to generate documentation.

	while (fgets(szBuffer, cbBuffer, fp) != NULL) {
	    LPSTR p, q;

	    p = strstr(szBuffer, match);
	    if (p != NULL) {
		/*
		 * Skip to first digit after the match.
		 */

		p += strlen(match);
		while (*p && !isdigit(*p)) {
		    ++p;
		}

		/*
		 * Find ending whitespace.
		 */

# remember to change configure.in as well when these change
# (then re-autoconf)

PACKAGE_MAJOR	= 2
PACKAGE_MINOR	= 7
PACKAGE_VERSION	= "2.7.0"

ROOT=..

# Begin Group "generic"

# PROP Default_Filter ""
# Begin Source File

SOURCE=$(ROOT)\generic\threadNs.c
# End Source File
# Begin Source File

SOURCE=$(ROOT)\generic\psGdbm.c
# End Source File
# Begin Source File