aolserver/nsd/tclinit.c

/*
 * The contents of this file are subject to the AOLserver Public License
 * Version 1.1 (the "License"); you may not use this file except in
 * compliance with the License. You may obtain a copy of the License at
 * http://aolserver.com/.
 *
 * Software distributed under the License is distributed on an "AS IS"
 * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
 * the License for the specific language governing rights and limitations
 * under the License.
 *
 * The Original Code is AOLserver Code and related documentation
 * distributed by AOL.
 * 
 * The Initial Developer of the Original Code is America Online,
 * Inc. Portions created by AOL are Copyright (C) 1999 America Online,
 * Inc. All Rights Reserved.
 *
 * Alternatively, the contents of this file may be used under the terms
 * of the GNU General Public License (the "GPL"), in which case the
 * provisions of GPL are applicable instead of those above.  If you wish
 * to allow use of your version of this file only under the terms of the
 * GPL and not to allow others to use your version of this file under the
 * License, indicate your decision by deleting the provisions above and
 * replace them with the notice and other provisions required by the GPL.
 * If you do not delete the provisions above, a recipient may use your
 * version of this file under either the License or the GPL.
 */

/* 
 * tclinit.c --
 *
 *      Initialization and resource management routines for Tcl.  This
 *      code provides for three types of AOLserver extended Tcl
 *      interps:
 *
 *      1. First, basic interps created with <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclCreateInterp">Ns_TclCreateInterp</a> or
 *      initialized with <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclInit">Ns_TclInit</a>.  These interps include "core" Tcl
 *      and AOLserver commands and are normally used simply to
 *      evaluate the config file.
 *
 *      2. Next, virtual server interps allocated from per-thread
 *      caches using <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclAllocateInterp">Ns_TclAllocateInterp</a> and returned via
 *      <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclDeAllocateInterp">Ns_TclDeAllocateInterp</a>.  These interps include all the
 *      commands of the basic interp, commands useful for virtual
 *      server environments, and any commands added as a result of
 *      loadable module initialization callbacks.  These interps are
 *      normally used during connection processing but can also be
 *      used outside a connection, e.g., in a scheduled procedure or
 *      detached background thread.
 *
 *      3. Finally, connection interps accessed  with
 *      Ns_TclGetConnInterp.  These interps are virtual server interps
 *      but managed along with a connection, having access to
 *      connection specific data structures (e.g., via ns_conn) and
 *      released automatically during connection cleanup.  This type
 *      of interp is used for ns_register_filter and ns_register_proc
 *      callback scripts as well as for ADP pages.  The same interp is
 *      used throughout the connection, for all filters, procs, and/or
 *      ADP pages.
 *
 *      Note the need to initialize Tcl state (i.e., procs, vars,
 *      packages, etc.) specific to a virtual server, later to copy
 *      this state to new interps when created, and garbage collection
 *      and end-of-connection cleanup facilities add quite a bit of
 *      complexity and confusion to the code.  See the comments in
 *      <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclRegisterTrace">Ns_TclRegisterTrace</a>, <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclAllocateInterp">Ns_TclAllocateInterp</a>, and <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_NsTclICtlObjCmd">NsTclICtlObjCmd</a>
 *      and review the code in init.tcl for more details.
 *
 *      Note also the role of the NsInterp structure.  This single
 *      structure provides storage necessary for all AOLserver
 *      commands, core or virtual-server.  The structure is allocated
 *      for each new interp and passed as the ClientData argument to
 *      all AOLserver commands (see <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_InitData">InitData</a> and <a href="/cvs/aolserver/aolserver/nsd/tclcmds.c#A_NsTclAddCmds">NsTclAddCmds</a> in
 *      tclcmds.c for details).  Both for cases where the ClientData
 *      isn't available and to ensure proper cleanup of the structure
 *      when the interp is deleted, the NsInterp is managed by the
 *      interp via the Tcl assoc data interface under the name
 *      "ns:data" and accessible by <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_NsGetInterpData">NsGetInterpData</a>.
 */

static const char *RCSID = "@(#) $Header: /cvsroot-fuse/aolserver/aolserver/nsd/tclinit.c,v 1.52 2006/06/02 18:51:49 jgdavidson Exp $, compiled: " __DATE__ " " __TIME__;

#include "nsd.h"

/*
 * The following structure maintains per-thread context to support Tcl
 * including a table of cached interps by server and a shared async
 * cancel object.
 */

typedef struct TclData {
    Tcl_AsyncHandler cancel;
    Tcl_HashEntry *hPtr;
    Tcl_HashTable interps;
} TclData;

/*
 * The following structure maintains interp callback traces. The traces
 * are normally registered during server startup and invoked later for
 * virutal server interps at specific points in the lifetime of the
 * interp.  Initialization callbacks (create, alloc, getconn) are called
 * in FIFO order while finalization callbacks (freeconn, dealloc,
 * delete) are called in LIFO order. In addition, script callbacks are
 * invoked after non-script callbacks.  A
 * common trace would be an "create" trace to add commands in a loadable
 * C module, e.g., the "ns_accesslog" command in nslog.
 */

typedef struct TclTrace {
    struct TclTrace      *prevPtr;
    struct TclTrace      *nextPtr;
    Ns_TclTraceProc      *proc;
    void                 *arg;  
    int                   when;
} TclTrace;

/*
 * The following structure maintains Tcl-script based traces.
 */

typedef struct ScriptTrace {
    int  length;
    char script[1];
} ScriptTrace;

/*
 * The following structure maintains callbacks registered with the
 * Ns_TclRegisterDeffered rouinte to invoke during interp deallocation
 * Unlike traces, these callbacks are one-shot events and invoked in
 * FIFO order (LIFO would probably have been better). In practice this
 * API is rarely used. Instead, more specific garbage collection schemes
 * should be used with "ns_ictl trace deallocate".
 */

typedef struct Defer {
    struct Defer *nextPtr;
    Ns_TclDeferProc *proc;
    void *arg;
} Defer;

/*
 * The following structure maintains scripts registered via ns_atclose
 * to invoke when the connection is closed.  The scripts are invoked in
 * LIFO order.  As with the Ns_TclRegisteredDeferred callbacks, this
 * interface is rarely used.
 */

typedef struct AtClose {
    struct AtClose *nextPtr;
    Tcl_Obj *objPtr;
} AtClose;

/*
 * The following defines a multi-thread aware Tcl package.
 */

typedef struct Package {
    char *name;
    int exact;
    char version[1];
} Package;

/*
 * Static functions defined in this file.
 */

static TclData *<a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_GetData">GetData</a>(void);
static Ns_TlsCleanup <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_DeleteData">DeleteData</a>;
static Tcl_Interp *<a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_CreateInterp">CreateInterp</a>(NsServer *server);
static int <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_InitData">InitData</a>(Tcl_Interp *interp, NsServer *servPtr);
static Tcl_InterpDeleteProc <a href="/cvs/aolserver/aolserver/nsdb/dbtcl.c#A_FreeData">FreeData</a>;
static NsInterp *<a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_PopInterp">PopInterp</a>(char *server);
static void <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_PushInterp">PushInterp</a>(NsInterp *itPtr);
static Tcl_HashEntry *<a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_GetCacheEntry">GetCacheEntry</a>(NsServer *servPtr);
static void <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_RunTraces">RunTraces</a>(NsInterp *itPtr, int why);
static void <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_ForeachTrace">ForeachTrace</a>(NsInterp *itPtr, int why, int append);
static void <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_DoTrace">DoTrace</a>(Tcl_Interp *interp, TclTrace *tracePtr, int append);
static int <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_EvalTrace">EvalTrace</a>(Tcl_Interp *interp, void *arg);
static int <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_RegisterAt">RegisterAt</a>(Ns_TclTraceProc *proc, void *arg, int when);
static Tcl_AsyncProc <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_AsyncCancel">AsyncCancel</a>;
static Ns_TclTraceProc <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_PkgRequire">PkgRequire</a>;

/*
 * Static variables defined in this file.
 */

static Ns_Tls tls;              /* Slot for per-thread Tcl interp cache. */
static Tcl_HashTable threads;   /* Table of threads with nsd-based interps. */
static Ns_Mutex tlock;          /* Lock around threads table. */


/*
 *----------------------------------------------------------------------
 *
 * <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_NsInitTcl">NsInitTcl</a> --
 *
 *      Initialize the Nsd Tcl package.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */

void
<a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_NsInitTcl">NsInitTcl</a>(void)
{
    /*
     * Allocate the thread storage slot for the table of interps
     * per-thread. At thread exit, <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_DeleteData">DeleteData</a> will be called
     * to free any interps remaining on the thread cache
     * and remove the async cancel handler.
     */

    Ns_TlsAlloc(&tls, <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_DeleteData">DeleteData</a>);

    /*
     * Initialize the table of all threads with active TclData
     * and the one-time init table.
     */

    Tcl_InitHashTable(&threads, TCL_ONE_WORD_KEYS);
    Ns_MutexSetName(&tlock, "ns:threads");
}


/*
 *----------------------------------------------------------------------
 *
 * <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclCreateInterp">Ns_TclCreateInterp</a> --
 *
 *      Create a new interp with basic Nsd package.
 *
 * Results:
 *      Pointer to new interp.
 *
 * Side effects:
 *      See <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_CreateInterp">CreateInterp</a>.
 *
 *----------------------------------------------------------------------
 */

Tcl_Interp *
<a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclCreateInterp">Ns_TclCreateInterp</a>(void)
{
    return <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclAllocateInterp">Ns_TclAllocateInterp</a>(NULL);
}


/*
 *----------------------------------------------------------------------
 *
 * <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclInit">Ns_TclInit</a> --
 *
 *      Initialize an interp with the global server context.
 *
 * Results:
 *      TCL_OK or TCL_ERROR on init error.
 *
 * Side effects:
 *      See <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_InitData">InitData</a>.
 *
 *----------------------------------------------------------------------
 */

int
<a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclInit">Ns_TclInit</a>(Tcl_Interp *interp)
{
    NsServer *servPtr = <a href="/cvs/aolserver/aolserver/nsd/server.c#A_NsGetServer">NsGetServer</a>(NULL);

    return <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_InitData">InitData</a>(interp, servPtr);
}


/*
 *----------------------------------------------------------------------
 *
 * <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Nsd_Init">Nsd_Init</a> --
 *
 *      Init routine called when libnsd is loaded via the Tcl
 *      load command. This simply calls <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclInit">Ns_TclInit</a>.
 *
 * Results:
 *      See <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclInit">Ns_TclInit</a>.
 *
 * Side effects:
 *      See <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclInit">Ns_TclInit</a>.
 *
 *----------------------------------------------------------------------
 */

int
<a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Nsd_Init">Nsd_Init</a>(Tcl_Interp *interp)
{
    return <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclInit">Ns_TclInit</a>(interp);
}


/*
 *----------------------------------------------------------------------
 *
 * <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclEval">Ns_TclEval</a> --
 *
 *      Execute a Tcl script in the context of the the given server.
 *
 * Results:
 *      Tcl return code. 
 *
 * Side effects:
 *      String results or error are placed in dsPtr if not NULL.
 *
 *----------------------------------------------------------------------
 */

int
<a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclEval">Ns_TclEval</a>(Ns_DString *dsPtr, char *server, char *script)
{
    int         retcode;
    Tcl_Interp *interp;
    CONST char *result;

    retcode = NS_ERROR;
    interp = <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclAllocateInterp">Ns_TclAllocateInterp</a>(server);
    if (interp != NULL) {
        if (Tcl_EvalEx(interp, script, -1, 0) != TCL_OK) {
            result = <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclLogError">Ns_TclLogError</a>(interp);
        } else {
            result = Tcl_GetStringResult(interp);
            retcode = NS_OK;
        }
        if (dsPtr != NULL) {
            <a href="/cvs/aolserver/aolserver/nsd/dstring.c#A_Ns_DStringAppend">Ns_DStringAppend</a>(dsPtr, result);
        }
        <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclDeAllocateInterp">Ns_TclDeAllocateInterp</a>(interp);
    }
    return retcode;
}


/*
 *----------------------------------------------------------------------
 *
 * <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclAllocateInterp">Ns_TclAllocateInterp</a> --
 *
 *      Allocate an interpreter from the per-thread list.  Note that a
 *      single thread can have multiple interps for multiple virtual
 *      servers.
 *
 * Results:
 *      Pointer to Tcl_Interp.
 *
 * Side effects:
 *      See <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_PopInterp">PopInterp</a> for details on various traces which may be
 *      called.
 *
 *----------------------------------------------------------------------
 */

Tcl_Interp *
<a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclAllocateInterp">Ns_TclAllocateInterp</a>(char *server)
{
    NsInterp *itPtr;

    itPtr = <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_PopInterp">PopInterp</a>(server);
    return (itPtr ? itPtr->interp : NULL);
}

/*
 *----------------------------------------------------------------------
 *
 * <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclDeAllocateInterp">Ns_TclDeAllocateInterp</a> --
 *
 *      Get the NsInterp for the given interp and return the interp to
 *      the per-thread cache.  If the interp is associated with a
 *      connection, silently do nothing as cleanup will occur later
 *      with connection cleanup.  Also, if the interp is not actually
 *      an AOLserver interp, i.e., missing the NsInterp structure,
 *      simply delete the interp directly.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      See notes on garbage collection in <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_PushInterp">PushInterp</a>.
 *
 *----------------------------------------------------------------------
 */

void
<a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclDeAllocateInterp">Ns_TclDeAllocateInterp</a>(Tcl_Interp *interp)
{
    NsInterp *itPtr;

    itPtr = <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_NsGetInterpData">NsGetInterpData</a>(interp);
    if (itPtr == NULL) {
        Tcl_DeleteInterp(interp);
    } else if (itPtr->conn == NULL) {
        <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_PushInterp">PushInterp</a>(itPtr);
    }
}


/*
 *----------------------------------------------------------------------
 *
 * <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_GetConnInterp">Ns_GetConnInterp</a> --
 *
 *      Get the interp for the given connection.  When first called
 *      for a connection, the interp data is allocated and associated
 *      with the given connection.  The interp will be automatically
 *      cleaned up at the end of the connection via a call to via
 *      <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_NsFreeConnInterp">NsFreeConnInterp</a>().
 *
 * Results:
 *      Pointer to Tcl interp data initialized for given connection.
 *
 * Side effects:
 *      See NsGetInputEncodings for details on connection encoding setup
 *      required to ensure proper UTF-8 input and output.
 *
 *----------------------------------------------------------------------
 */

Tcl_Interp *
<a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_GetConnInterp">Ns_GetConnInterp</a>(Ns_Conn *conn)
{
    Conn *connPtr = (Conn *) conn;
    NsInterp *itPtr;

    if (connPtr->itPtr == NULL) {
        itPtr = <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_PopInterp">PopInterp</a>(connPtr->server);
        itPtr->conn = conn;
        itPtr->nsconn.flags = 0;
        connPtr->itPtr = itPtr;
        Tcl_SetVar2(itPtr->interp, "conn", NULL, connPtr->idstr,
                    TCL_GLOBAL_ONLY);
        <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_RunTraces">RunTraces</a>(itPtr, NS_TCL_TRACE_GETCONN);
    }
    return connPtr->itPtr->interp;
}


/*
 *----------------------------------------------------------------------
 *
 * <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_FreeConnInterp">Ns_FreeConnInterp</a> --
 *
 *      Release and cleanup the interp associated with given
 *      connection.  This routine no longer does actual cleanup.  The
 *      connection cleanup code will call <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_NsFreeConnInterp">NsFreeConnInterp</a> if needed.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */

void
<a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_FreeConnInterp">Ns_FreeConnInterp</a>(Ns_Conn *conn)
{
    return;
}


/*
 *----------------------------------------------------------------------
 *
 * <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclGetConn">Ns_TclGetConn</a> --
 *
 *      Get the Ns_Conn structure associated with this tcl interp.
 *
 * Results:
 *      An Ns_Conn. 
 *
 * Side effects:
 *      None. 
 *
 *----------------------------------------------------------------------
 */

Ns_Conn *
<a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclGetConn">Ns_TclGetConn</a>(Tcl_Interp *interp)
{
    NsInterp *itPtr = <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_NsGetInterpData">NsGetInterpData</a>(interp);

    return (itPtr ? itPtr->conn : NULL);
}


/*
 *----------------------------------------------------------------------
 *
 * <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclDestroyInterp">Ns_TclDestroyInterp</a> --
 *
 *      Delete an interp.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */

void
<a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclDestroyInterp">Ns_TclDestroyInterp</a>(Tcl_Interp *interp)
{
    NsInterp *itPtr = <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_NsGetInterpData">NsGetInterpData</a>(interp);

    if (itPtr != NULL) {
        <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_RunTraces">RunTraces</a>(itPtr, NS_TCL_TRACE_DELETE);
    }
    Tcl_DeleteInterp(interp);
}


/*
 *----------------------------------------------------------------------
 *
 * <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclMarkForDelete">Ns_TclMarkForDelete</a> --
 *
 *      Mark the interp to be deleted at the  next deallocation.  This
 *      routine is useful to destory interps after they've been
 *      modified in weird ways, e.g., by the TclPro debugger.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Interp will be deleted on next de-allocate.
 *
 *----------------------------------------------------------------------
 */

void
<a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclMarkForDelete">Ns_TclMarkForDelete</a>(Tcl_Interp *interp)
{
    NsInterp *itPtr = <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_NsGetInterpData">NsGetInterpData</a>(interp);
    
    if (itPtr != NULL) {
        itPtr->delete = 1;
    }
}


/*
 *----------------------------------------------------------------------
 *
 * <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclRegisterTrace">Ns_TclRegisterTrace</a> --
 *
 *      Add a Tcl trace.  Traces are called in FIFO order.
 *
 * Results:
 *      NS_OK if called with a non-NULL server, NS_ERROR otherwise.
 *
 * Side effects:
 *      Will modify server trace list.
 *
 *----------------------------------------------------------------------
 */
 
int
<a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclRegisterTrace">Ns_TclRegisterTrace</a>(char *server, Ns_TclTraceProc *proc, void *arg, int when)
{
    TclTrace *tracePtr;
    NsServer *servPtr;

    servPtr = <a href="/cvs/aolserver/aolserver/nsd/server.c#A_NsGetServer">NsGetServer</a>(server);
    if (servPtr == NULL) {
        return NS_ERROR;
    }
    tracePtr = ns_malloc(sizeof(TclTrace));
    tracePtr->proc = proc;
    tracePtr->arg = arg;
    tracePtr->when = when;
    tracePtr->nextPtr = NULL;
    Ns_RWLockWrLock(&servPtr->tcl.tlock);
    tracePtr->prevPtr = servPtr->tcl.lastTracePtr;
    servPtr->tcl.lastTracePtr = tracePtr;
    if (tracePtr->prevPtr != NULL) {
        tracePtr->prevPtr->nextPtr = tracePtr;
    } else {
        servPtr->tcl.firstTracePtr = tracePtr;
    }
    Ns_RWLockUnlock(&servPtr->tcl.tlock);
    return NS_OK;
}


/*
 *----------------------------------------------------------------------
 *
 * <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclRegisterAtCreate">Ns_TclRegisterAtCreate</a>, <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclRegisterAtCleanup">Ns_TclRegisterAtCleanup</a>,
 * <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclRegisterAtDelete">Ns_TclRegisterAtDelete</a> --
 *
 *      Register callbacks for interp create, cleanup, and delete at
 *      startup.  These routines are deprecated in favor of the more
 *      general <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclRegisterTrace">Ns_TclRegisterTrace</a>. In particular, they do not take a
 *      virtual server argument so must assume the currently
 *      initializing server is the intended server.
 *
 * Results:
 *      See <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclRegisterTrace">Ns_TclRegisterTrace</a>.
 *
 * Side effects:
 *      See <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclRegisterTrace">Ns_TclRegisterTrace</a>.
 *
 *----------------------------------------------------------------------
 */

int
<a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclRegisterAtCreate">Ns_TclRegisterAtCreate</a>(Ns_TclTraceProc *proc, void *arg)
{
    return <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_RegisterAt">RegisterAt</a>(proc, arg, NS_TCL_TRACE_CREATE);
}

int
<a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclRegisterAtCleanup">Ns_TclRegisterAtCleanup</a>(Ns_TclTraceProc *proc, void *arg)
{
    return <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_RegisterAt">RegisterAt</a>(proc, arg, NS_TCL_TRACE_DEALLOCATE);
}

int
<a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclRegisterAtDelete">Ns_TclRegisterAtDelete</a>(Ns_TclTraceProc *proc, void *arg)
{
    return <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_RegisterAt">RegisterAt</a>(proc, arg, NS_TCL_TRACE_DELETE);
}

static int
<a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_RegisterAt">RegisterAt</a>(Ns_TclTraceProc *proc, void *arg, int when)
{
    NsServer *servPtr;

    servPtr = <a href="/cvs/aolserver/aolserver/nsd/server.c#A_NsGetInitServer">NsGetInitServer</a>();
    if (servPtr == NULL) {
        return NS_ERROR;
    }
    return <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclRegisterTrace">Ns_TclRegisterTrace</a>(servPtr->server, proc, arg, when);
}


/*
 *----------------------------------------------------------------------
 *
 * <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclInitInterps">Ns_TclInitInterps</a> --
 *
 *      Arrange for the given proc to be called on newly created
 *      interps.  This routine now simply uses the more general Tcl
 *      interp tracing facility.  Earlier versions of AOLserver would
 *      invoke the given proc immediately on each interp in a shared
 *      pool which explains this otherwise misnamed API.
 *
 * Results:
 *      See <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclRegisterTrace">Ns_TclRegisterTrace</a>.
 *
 * Side effects:
 *      See <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclRegisterTrace">Ns_TclRegisterTrace</a>.
 *
 *----------------------------------------------------------------------
 */

int
<a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclInitInterps">Ns_TclInitInterps</a>(char *server, Ns_TclInterpInitProc *proc, void *arg)
{
    return <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclRegisterTrace">Ns_TclRegisterTrace</a>(server, proc, arg, NS_TCL_TRACE_CREATE);
}


/*
 *----------------------------------------------------------------------
 *
 * <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclRegisterDeferred">Ns_TclRegisterDeferred</a> --
 *
 *      Register a procedure to be called when the interp is deallocated.
 *      This is on-shot FIFO order callback mechanism which is seldom
 *      used.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Procedure will be called later.
 *
 *----------------------------------------------------------------------
 */

void
<a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclRegisterDeferred">Ns_TclRegisterDeferred</a>(Tcl_Interp *interp, Ns_TclDeferProc *proc, void *arg)
{
    NsInterp   *itPtr = <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_NsGetInterpData">NsGetInterpData</a>(interp);
    Defer      *deferPtr, **nextPtrPtr;

    if (itPtr == NULL) {
        return;
    }
    deferPtr = ns_malloc(sizeof(Defer));
    deferPtr->proc = proc;
    deferPtr->arg = arg;
    deferPtr->nextPtr = NULL;
    nextPtrPtr = &itPtr->firstDeferPtr;
    while (*nextPtrPtr != NULL) {
        nextPtrPtr = &((*nextPtrPtr)->nextPtr);
    }
    *nextPtrPtr = deferPtr;
}


/*
 *----------------------------------------------------------------------
 *
 * <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclLibrary">Ns_TclLibrary</a> --
 *
 *      Return the name of the private tcl lib 
 *
 * Results:
 *      Tcl lib name. 
 *
 * Side effects:
 *      None. 
 *
 *----------------------------------------------------------------------
 */

char *
<a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclLibrary">Ns_TclLibrary</a>(char *server)
{
    NsServer *servPtr = <a href="/cvs/aolserver/aolserver/nsd/server.c#A_NsGetServer">NsGetServer</a>(server);

    return (servPtr ? servPtr->tcl.library : NULL);
}


/*
 *----------------------------------------------------------------------
 *
 * <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclInterpServer">Ns_TclInterpServer</a> --
 *
 *      Return the name of the server. 
 *
 * Results:
 *      Server name. 
 *
 * Side effects:
 *      None. 
 *
 *----------------------------------------------------------------------
 */

char *
<a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclInterpServer">Ns_TclInterpServer</a>(Tcl_Interp *interp)
{
    NsInterp *itPtr = <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_NsGetInterpData">NsGetInterpData</a>(interp);
    
    return (itPtr ? itPtr->servPtr->server : NULL);
}


/*
 *----------------------------------------------------------------------
 *
 * <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclLogError">Ns_TclLogError</a> --
 *
 *      <a href="/cvs/aolserver/aolserver/nsd/log.c#A_Log">Log</a> the global errorInfo variable to the server log. 
 *
 * Results:
 *      Returns a pointer to the errorInfo. 
 *
 * Side effects:
 *      None. 
 *
 *----------------------------------------------------------------------
 */

char *
<a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclLogError">Ns_TclLogError</a>(Tcl_Interp *interp)
{
    CONST char *errorInfo;

    errorInfo = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY);
    if (errorInfo == NULL) {
        errorInfo = Tcl_GetStringResult(interp);
    }
    <a href="/cvs/aolserver/aolserver/nsd/log.c#A_Ns_Log">Ns_Log</a>(Error, "Tcl exception:\n%s", errorInfo);
    return (char *) errorInfo;
}


/*
 *----------------------------------------------------------------------
 *
 * <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclLogErrorRequest">Ns_TclLogErrorRequest</a> --
 *
 *      <a href="/cvs/aolserver/aolserver/nsd/log.c#A_Log">Log</a> both errorInfo and info about the HTTP request that led 
 *      to it. 
 *
 * Results:
 *      Returns a pointer to the errorInfo. 
 *
 * Side effects:
 *      None. 
 *
 *----------------------------------------------------------------------
 */

char *
<a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclLogErrorRequest">Ns_TclLogErrorRequest</a>(Tcl_Interp *interp, Ns_Conn *conn)
{
    char *agent;
    CONST char *errorInfo;

    errorInfo = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY);
    if (errorInfo == NULL) {
        errorInfo = Tcl_GetStringResult(interp);
    }
    agent = <a href="/cvs/aolserver/aolserver/nsd/set.c#A_Ns_SetIGet">Ns_SetIGet</a>(conn->headers, "user-agent");
    if (agent == NULL) {
        agent = "?";
    }
    <a href="/cvs/aolserver/aolserver/nsd/log.c#A_Ns_Log">Ns_Log</a>(Error, "error for %s %s, "
           "User-Agent: %s, PeerAddress: %s\n%s", 
           conn->request->method, conn->request->url,
           agent, <a href="/cvs/aolserver/aolserver/nsd/conn.c#A_Ns_ConnPeer">Ns_ConnPeer</a>(conn), errorInfo);
    return (char*)errorInfo;
}


/*
 *----------------------------------------------------------------------
 *
 * <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclInitModule">Ns_TclInitModule</a> --
 *
 *      Add a module name to the init list.
 *
 * Results:
 *      Always TCL_OK.
 *
 * Side effects:
 *      Module will be initialized by the init script later.
 *
 *----------------------------------------------------------------------
 */

int
<a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclInitModule">Ns_TclInitModule</a>(char *server, char *module)
{
    NsServer *servPtr = <a href="/cvs/aolserver/aolserver/nsd/server.c#A_NsGetServer">NsGetServer</a>(server);

    if (servPtr == NULL) {
        return NS_ERROR;
    }
    Tcl_DStringAppendElement(&servPtr->tcl.modules, module);
    return NS_OK;
}


/*
 *----------------------------------------------------------------------
 *
 * NsGetInterpServer --
 *
 *      Get server for given interp.
 *
 * Results:
 *      TCL_OK if interp has a server, TCL_ERROR otherwise.
 *
 * Side effects:
 *      Given serverPtr will be updated with pointer to server string.
 *
 *----------------------------------------------------------------------
 */

int
<a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_NsTclGetServer">NsTclGetServer</a>(NsInterp *itPtr, char **serverPtr)
{
    if (itPtr->servPtr->server == NULL) {
        Tcl_SetResult(itPtr->interp, "no server", TCL_STATIC);
        return TCL_ERROR;
    }
    *serverPtr = itPtr->servPtr->server;
    return NS_OK;
}


/*
 *----------------------------------------------------------------------
 *
 * <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_NsTclICtlObjCmd">NsTclICtlObjCmd</a> --
 *
 *      Implements ns_ictl command to control interp state for
 *      virtual server interps.  This command provide internal control
 *      functions required by the init.tcl script and is not intended
 *      to be called by a user directly.  It supports four activities:
 *      1. Managing the list of "modules" to initialize.
 *      2. Saving the init script for evaluation with new interps.
 *      3. Checking for change of the init script.
 *      4. Register script-level traces.
 *
 *      See init.tcl for details.
 *
 * Results:
 *      Standard Tcl result.
 *
 * Side effects:
 *      May update current saved server Tcl state.
 *
 *----------------------------------------------------------------------
 */

int
<a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_NsTclICtlObjCmd">NsTclICtlObjCmd</a>(ClientData arg, Tcl_Interp *interp, int objc, Tcl_Obj **objv)
{
    NsInterp *itPtr = arg;
    NsServer *servPtr = itPtr->servPtr;
    Defer    *deferPtr;
    ScriptTrace *stPtr;
    Tcl_HashEntry *hPtr;
    Tcl_HashSearch search;
    TclData *dataPtr;
    Tcl_Obj *objPtr, *listPtr;
    Package *pkgPtr;
    int       when, length, result, tid, new, exact;
    char     *script, *name, *pattern, *version;
    static CONST char *opts[] = {
        "addmodule", "cleanup", "epoch", "get", "getmodules", "save",
        "update", "oncreate", "oncleanup", "oninit", "ondelete", "trace",
        "threads", "cancel", "runtraces", "gettraces", "package", "once",
        NULL
    };
    enum {
        IAddModuleIdx, ICleanupIdx, IEpochIdx, IGetIdx, IGetModulesIdx,
        ISaveIdx, IUpdateIdx, IOnCreateIdx, IOnCleanupIdx, IOnInitIdx,
        IOnDeleteIdx, ITraceIdx, IThreadsIdx, ICancelIdx, IRunIdx, 
        IGetTracesIdx, IPackageIdx, IOnceIdx
    } opt;
    static CONST char *popts[] = {
        "require", "names", NULL
    };
    enum {
        PRequireIdx, PNamesIdx
    } _nsmayalias popt;
    static CONST char *topts[] = {
        "create", "delete", "allocate",
        "deallocate", "getconn", "freeconn", NULL
    };
    static int twhen[] = {
        NS_TCL_TRACE_CREATE, NS_TCL_TRACE_DELETE, NS_TCL_TRACE_ALLOCATE,
        NS_TCL_TRACE_DEALLOCATE, NS_TCL_TRACE_GETCONN, NS_TCL_TRACE_FREECONN
    };
    enum {
        TCreateIdx, TDeleteIdx, TAllocateIdx,
        TDeAllocateIdx, TGetConnIdx, TFreeConnIdx
    } _nsmayalias topt;

    if (objc < 2) {
        Tcl_WrongNumArgs(interp, 1, objv, "option ?arg?");
        return TCL_ERROR;
    }
    if (Tcl_GetIndexFromObj(interp, objv[1], opts, "option", 0,
                            (int *) &opt) != TCL_OK) {
        return TCL_ERROR;
    }

    result = TCL_OK;
    switch (opt) {
    case IAddModuleIdx:
        /*
         * Add a Tcl module to the list of for later initialization.
         */

        if (objc != 3) {
            Tcl_WrongNumArgs(interp, 2, objv, "module");
            return TCL_ERROR;
        }
        <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclInitModule">Ns_TclInitModule</a>(servPtr->server, Tcl_GetString(objv[2]));
        break;

    case IGetModulesIdx:
        /*
         * Get the list of modules for initialization.  See init.tcl
         * for expected use.
         */

        if (objc != 2) {
            Tcl_WrongNumArgs(interp, 2, objv, NULL);
            return TCL_ERROR;
        }
        Tcl_SetResult(interp, servPtr->tcl.modules.string, TCL_VOLATILE);
        break;

    case IGetIdx:
        /*
         * Get the current init script to evaluate in new interps.
         */

        if (objc != 2) {
            Tcl_WrongNumArgs(interp, 2, objv, NULL);
            return TCL_ERROR;
        }
        Ns_RWLockRdLock(&servPtr->tcl.slock);
        objPtr = Tcl_NewStringObj(servPtr->tcl.script, servPtr->tcl.length);
        Ns_RWLockUnlock(&servPtr->tcl.slock);
        Tcl_SetObjResult(interp, objPtr);
        break;

    case IEpochIdx:
        /*
         * Check the version of this interp against current init script.
         */

        if (objc != 2) {
            Tcl_WrongNumArgs(interp, 2, objv, NULL);
            return TCL_ERROR;
        }
        Ns_RWLockRdLock(&servPtr->tcl.slock);
        Tcl_SetIntObj(Tcl_GetObjResult(interp), servPtr->tcl.epoch);
        Ns_RWLockUnlock(&servPtr->tcl.slock);
        break;
   
    case ISaveIdx:
        /*
         * Save the init script.
         */

        if (objc != 3) {
            Tcl_WrongNumArgs(interp, 2, objv, "script");
            return TCL_ERROR;
        }
        script = ns_strdup(Tcl_GetStringFromObj(objv[2], &length));
        Ns_RWLockWrLock(&servPtr->tcl.slock);
        ns_free(servPtr->tcl.script);
        servPtr->tcl.script = script;
        servPtr->tcl.length = length;
        if (++servPtr->tcl.epoch == 0) {
            /* NB: Epoch zero reserved for new interps. */
            ++servPtr->tcl.epoch;
        }
        Ns_RWLockUnlock(&servPtr->tcl.slock);
        break;

    case IUpdateIdx:
        /*
         * Check for and process possible change in the init script.
         */

        if (objc != 2) {
            Tcl_WrongNumArgs(interp, 2, objv, NULL);
            return TCL_ERROR;
        }
        Ns_RWLockRdLock(&servPtr->tcl.slock);
        if (itPtr->epoch != servPtr->tcl.epoch) {
            result = Tcl_EvalEx(itPtr->interp, servPtr->tcl.script,
                                servPtr->tcl.length, TCL_EVAL_GLOBAL);
            itPtr->epoch = servPtr->tcl.epoch;
        }
        Ns_RWLockUnlock(&servPtr->tcl.slock);
        break;

    case ICleanupIdx:
        /*
         * Invoke the legacy defer callbacks.
         */

        if (objc != 2) {
            Tcl_WrongNumArgs(interp, 2, objv, NULL);
            return TCL_ERROR;
        }
        while ((deferPtr = itPtr->firstDeferPtr) != NULL) {
            itPtr->firstDeferPtr = deferPtr->nextPtr;
            (*deferPtr->proc)(interp, deferPtr->arg);
            ns_free(deferPtr);
        }
        break;

    case IPackageIdx:
        if (objc < 3) {
            Tcl_WrongNumArgs(interp, 2, objv, "option ?args?");
            return TCL_ERROR;
        }
        if (Tcl_GetIndexFromObj(interp, objv[2], popts, "option", 0,
                            (int *) &popt) != TCL_OK) {
            return TCL_ERROR;
        }
        switch (popt) {
        case PNamesIdx:
            if (objc > 3) {
                pattern = Tcl_GetString(objv[3]);
            } else {
                pattern = NULL;
            }
            listPtr = Tcl_NewObj();
            Ns_MutexLock(&servPtr->tcl.plock);
            hPtr = Tcl_FirstHashEntry(&servPtr->tcl.packages, &search);
            while (hPtr != NULL) {
                name = Tcl_GetHashKey(&servPtr->tcl.packages, hPtr);
                if (pattern == NULL || Tcl_StringMatch(name, pattern)) {
                    Tcl_ListObjAppendElement(interp, listPtr,
                                             Tcl_NewStringObj(name, -1));
                }
                hPtr = Tcl_NextHashEntry(&search);
            }
            Ns_MutexUnlock(&servPtr->tcl.plock);
            Tcl_SetObjResult(interp, listPtr);
            break;

        case PRequireIdx:
            if (objc < 4 || objc > 6) {
badargs:
                Tcl_WrongNumArgs(interp, 3, objv, "?-exact? package ?version?");
                return TCL_ERROR;
            }
            exact = 0;
            name = Tcl_GetString(objv[3]);
            if (STREQ(name, "-exact")) {
                if (objc < 5) {
                    goto badargs;
                }
                --objc;
                ++objv;
                exact = 1;
                name = Tcl_GetString(objv[3]);
            }
            if (objc < 5) {
                version = NULL;
            } else {
                version = Tcl_GetString(objv[4]);
            }

            /*
             * Confirm the package can be loaded and determine version.
             */

            version = Tcl_PkgRequire(interp, name, version, exact);
            if (version == NULL) {
                return TCL_ERROR;
            }
            Ns_MutexLock(&servPtr->tcl.plock);
            hPtr = Tcl_CreateHashEntry(&servPtr->tcl.packages, name, &new);
            if (!new) {
                /*
                 * Confirm current registered package is the same version.
                 */

                pkgPtr = Tcl_GetHashValue(hPtr);
                if (!STREQ(pkgPtr->version, version)) {
                    Tcl_AppendResult(interp, "version conflict for package \"",
                        name, "\": have ", pkgPtr->version, ", need ",
                        version, NULL);
                    pkgPtr = NULL;
                }
            } else {
                /*
                 * Register new package.
                 */
                pkgPtr = ns_malloc(sizeof(Package) + strlen(version));
                strcpy(pkgPtr->version, version);
                pkgPtr->name = Tcl_GetHashKey(&servPtr->tcl.packages, hPtr);
                pkgPtr->exact = exact;
                Tcl_SetHashValue(hPtr, pkgPtr);
                <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclRegisterTrace">Ns_TclRegisterTrace</a>(servPtr->server, <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_PkgRequire">PkgRequire</a>, pkgPtr,
                                    NS_TCL_TRACE_ALLOCATE);
            }
            Ns_MutexUnlock(&servPtr->tcl.plock);
            if (pkgPtr == NULL) {
                return TCL_ERROR;
            }
            Tcl_SetResult(interp, pkgPtr->version, TCL_STATIC);
            break;
        }
        break;

    case IOnceIdx:
        if (objc < 4) {
            Tcl_WrongNumArgs(interp, 3, objv, "name script");
            return TCL_ERROR;
        }
        name = Tcl_GetString(objv[2]);
        Ns_CsEnter(&servPtr->tcl.olock);
        hPtr = Tcl_CreateHashEntry(&servPtr->tcl.once, name, &new);
        if (new) {
            result = Tcl_EvalObjEx(interp, objv[3], TCL_EVAL_DIRECT);
            if (result != TCL_OK) {
                Tcl_DeleteHashEntry(hPtr);
            }
        }
        Ns_CsLeave(&servPtr->tcl.olock);
        if (result != TCL_OK) {
            return TCL_ERROR;
        }
        Tcl_SetBooleanObj(Tcl_GetObjResult(interp), new);
        break;

    case IOnInitIdx:
    case IOnCreateIdx:
    case IOnCleanupIdx:
    case IOnDeleteIdx:
        /*
         * Register script-level interp traces.
         */

        if (objc != 3) {
            Tcl_WrongNumArgs(interp, 2, objv, "script");
            return TCL_ERROR;
        }
        switch (opt) {
        case IOnInitIdx:
        case IOnCreateIdx:
            when = NS_TCL_TRACE_CREATE;
            break;
        case IOnCleanupIdx:
            when = NS_TCL_TRACE_DEALLOCATE;
            break;
        case IOnDeleteIdx:
            when = NS_TCL_TRACE_DELETE;
            break;
        default:
            /* NB: Silence compiler. */
            when = 0;
            break;
        }
        goto trace;
        break;

    case ITraceIdx:
        if (objc != 4) {
            Tcl_WrongNumArgs(interp, 2, objv, "when script");
            return TCL_ERROR;
        }
        if (Tcl_GetIndexFromObj(interp, objv[2], topts, "when", 0,
                            (int *) &topt) != TCL_OK) {
            return TCL_ERROR;
        }
        when = twhen[topt];
    trace:
        script = Tcl_GetString(objv[objc-1]);
        length = strlen(script);
        stPtr = ns_malloc(sizeof(ScriptTrace) + length);
        stPtr->length = length;
        strcpy(stPtr->script,  script);
        (void) <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclRegisterTrace">Ns_TclRegisterTrace</a>(servPtr->server, <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_EvalTrace">EvalTrace</a>, stPtr, when);
        break;

    case IGetTracesIdx:
    case IRunIdx:
        if (objc != 3) {
            Tcl_WrongNumArgs(interp, 2, objv, "which");
            return TCL_ERROR;
        }
        if (Tcl_GetIndexFromObj(interp, objv[2], topts, "traces", 0,
                            (int *) &topt) != TCL_OK) {
            return TCL_ERROR;
        }
        <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_ForeachTrace">ForeachTrace</a>(itPtr, twhen[topt], (opt == IGetTracesIdx));
        break;

    case IThreadsIdx:
        if (objc > 2) {
            Tcl_WrongNumArgs(interp, 2, objv, NULL);
            return TCL_ERROR;
        }
        listPtr = Tcl_NewObj();
        Ns_MutexLock(&tlock);
        hPtr = Tcl_FirstHashEntry(&threads, &search);
        while (hPtr != NULL) {
            tid = (int) Tcl_GetHashKey(&threads, hPtr);
            objPtr = Tcl_NewIntObj(tid);
            Tcl_ListObjAppendElement(interp, listPtr, objPtr);
            hPtr = Tcl_NextHashEntry(&search);
        }
        Ns_MutexUnlock(&tlock);
        Tcl_SetObjResult(interp, listPtr);
        break;

    case ICancelIdx:
        if (objc != 3) {
            Tcl_WrongNumArgs(interp, 2, objv, "tid");
            return TCL_ERROR;
        }
        if (Tcl_GetIntFromObj(interp, objv[2], &tid) != TCL_OK) {
            return TCL_ERROR;
        }
        Ns_MutexLock(&tlock);
        hPtr = Tcl_FindHashEntry(&threads, (char *) tid);
        if (hPtr != NULL) {
            dataPtr = Tcl_GetHashValue(hPtr);
            Tcl_AsyncMark(dataPtr->cancel);
        }
        Ns_MutexUnlock(&tlock);
        if (hPtr == NULL) {
            Tcl_AppendResult(interp, "no such active thread: ",
                             Tcl_GetString(objv[2]), NULL);
            return TCL_ERROR;
        }
        break;
    }
    return result;
}


/*
 *----------------------------------------------------------------------
 *
 * <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_NsTclAtCloseObjCmd">NsTclAtCloseObjCmd</a> --
 *
 *      Implements ns_atclose. 
 *
 * Results:
 *      Tcl result. 
 *
 * Side effects:
 *      Script will be invoked when the connection is closed.  Note
 *      the connection may continue execution, e.g., with continued
 *      ADP code, traces, etc.
 *
 *----------------------------------------------------------------------
 */

int
<a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_NsTclAtCloseObjCmd">NsTclAtCloseObjCmd</a>(ClientData arg, Tcl_Interp *interp, int objc,
                   CONST Tcl_Obj **objv)
{
    NsInterp *itPtr = arg;
    AtClose *atPtr;

    if (objc < 2) {
        Tcl_WrongNumArgs(interp, 1, objv, "script ?args?");
        return TCL_ERROR;
    }
    if (<a href="/cvs/aolserver/aolserver/nsd/tclresp.c#A_NsTclGetConn">NsTclGetConn</a>(itPtr, NULL) != TCL_OK) {
        return TCL_ERROR;
    }
    atPtr = ns_malloc(sizeof(AtClose));
    atPtr->nextPtr = itPtr->firstAtClosePtr;
    itPtr->firstAtClosePtr = atPtr;
    atPtr->objPtr = Tcl_ConcatObj(objc-1, objv+1);
    Tcl_IncrRefCount(atPtr->objPtr);
    return TCL_OK;
}


/*
 *----------------------------------------------------------------------
 *
 * <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_NsTclMarkForDeleteObjCmd">NsTclMarkForDeleteObjCmd</a> --
 *
 *      Implements ns_markfordelete. 
 *
 * Results:
 *      Tcl result. 
 *
 * Side effects:
 *      See <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclMarkForDelete">Ns_TclMarkForDelete</a>. 
 *
 *----------------------------------------------------------------------
 */

int
<a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_NsTclMarkForDeleteObjCmd">NsTclMarkForDeleteObjCmd</a>(ClientData arg, Tcl_Interp *interp, int objc, Tcl_Obj **objv)
{
    NsInterp *itPtr = arg;

    if (objc != 1) {
        Tcl_WrongNumArgs(interp, 1, objv, "");
        return TCL_ERROR;
    }
    itPtr->delete = 1;
    return TCL_OK;
}


/*
 *----------------------------------------------------------------------
 *
 * <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_NsTclInitServer">NsTclInitServer</a> --
 *
 *      Evaluate server initialization script at startup.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      See init script (normally init.tcl).
 *
 *----------------------------------------------------------------------
 */

void
<a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_NsTclInitServer">NsTclInitServer</a>(char *server)
{
    NsServer *servPtr = <a href="/cvs/aolserver/aolserver/nsd/server.c#A_NsGetServer">NsGetServer</a>(server);
    Tcl_Interp *interp;

    if (servPtr != NULL) {
        interp = <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclAllocateInterp">Ns_TclAllocateInterp</a>(server);
        if (Tcl_EvalFile(interp, servPtr->tcl.initfile) != TCL_OK) {
            <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclLogError">Ns_TclLogError</a>(interp);
        }
        <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclDeAllocateInterp">Ns_TclDeAllocateInterp</a>(interp);
    }
}


/*
 *----------------------------------------------------------------------
 *
 * <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_NsGetInterpData">NsGetInterpData</a> --
 *
 *      Return the interp's NsInterp structure from assoc data.
 *      This routine is used when the NsInterp is needed and
 *      not available as command ClientData.
 *
 * Results:
 *      Pointer to NsInterp or NULL if none.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */

NsInterp *
<a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_NsGetInterpData">NsGetInterpData</a>(Tcl_Interp *interp)
{
    return (interp ? Tcl_GetAssocData(interp, "ns:data", NULL) : NULL);
}


/*
 *----------------------------------------------------------------------
 *
 * <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_NsFreeConnInterp">NsFreeConnInterp</a> --
 *
 *      Free the interp data, if any, for given connection.  This
 *      routine is called at the end of connection processing.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      See <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_PushInterp">PushInterp</a>.
 *
 *----------------------------------------------------------------------
 */

void
<a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_NsFreeConnInterp">NsFreeConnInterp</a>(Conn *connPtr)
{
    NsInterp *itPtr = connPtr->itPtr;

    if (itPtr != NULL) {
        <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_RunTraces">RunTraces</a>(itPtr, NS_TCL_TRACE_FREECONN);
        itPtr->conn = NULL;
        itPtr->nsconn.flags = 0;
        connPtr->itPtr = NULL;
        <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_PushInterp">PushInterp</a>(itPtr);
    }
}


/*
 *----------------------------------------------------------------------
 *
 * <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_NsTclRunAtClose">NsTclRunAtClose</a> --
 *
 *      Run any registered connection at-close scripts. 
 *
 * Results:
 *      None. 
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */

void
<a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_NsTclRunAtClose">NsTclRunAtClose</a>(NsInterp *itPtr)
{
    Tcl_Interp    *interp = itPtr->interp;
    AtClose       *atPtr;

    while ((atPtr = itPtr->firstAtClosePtr) != NULL) {
        itPtr->firstAtClosePtr = atPtr->nextPtr;
        if (Tcl_EvalObjEx(interp, atPtr->objPtr, TCL_EVAL_DIRECT) != TCL_OK) {
            <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclLogError">Ns_TclLogError</a>(interp);
        }
        Tcl_DecrRefCount(atPtr->objPtr);
        ns_free(atPtr);
    }
}


/*
 *----------------------------------------------------------------------
 *
 * <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_PopInterp">PopInterp</a> --
 *
 *      Pop next avaialble virtual-server interp from the per-thread
 *      cache, allocating a new interp if necessary.
 *
 * Results:
 *      Pointer to next available NsInterp.
 *
 * Side effects:
 *      Will invoke alloc traces and, if the interp is new, create
 *      traces.
 *
 *----------------------------------------------------------------------
 */

static NsInterp *
<a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_PopInterp">PopInterp</a>(char *server)
{
    static Ns_Cs lock;
    NsServer *servPtr;
    NsInterp *itPtr;
    Tcl_HashEntry *hPtr;
    Tcl_Interp *interp;
    int epoch;

    /*
     * Verify the server.  NULL (i.e., no server) is valid but
     * a non-null, unknown server is an error and get the current
     * epoch.
     */

    servPtr = <a href="/cvs/aolserver/aolserver/nsd/server.c#A_NsGetServer">NsGetServer</a>(server);
    if (servPtr == NULL) {
        return NULL;
    }
    Ns_RWLockRdLock(&servPtr->tcl.slock);
    epoch = servPtr->tcl.epoch;
    Ns_RWLockUnlock(&servPtr->tcl.slock);

    /*
     * Dump any interps with an invalid epoch and then pop the first
     * available interp or create a new interp.
     */

    hPtr = <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_GetCacheEntry">GetCacheEntry</a>(servPtr);
    if (epoch == 0) {
        /* NB: Epoch 0 indicates legacy module config disabled. */
        itPtr = Tcl_GetHashValue(hPtr);
    } else {
        NsInterp *validPtr = NULL;
        while ((itPtr = Tcl_GetHashValue(hPtr)) != NULL) {
            Tcl_SetHashValue(hPtr, itPtr->nextPtr);
            if (itPtr->epoch != epoch) {
                <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclDestroyInterp">Ns_TclDestroyInterp</a>(itPtr->interp);
            } else {
                itPtr->nextPtr = validPtr;
                validPtr = itPtr;
            }
        }
        itPtr = validPtr;
    }
    if (itPtr != NULL) {
        Tcl_SetHashValue(hPtr, itPtr->nextPtr);
    } else {
        if (nsconf.tcl.lockoninit) {
            Ns_CsEnter(&lock);
        }
        interp = <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_CreateInterp">CreateInterp</a>(servPtr);
        itPtr = <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_NsGetInterpData">NsGetInterpData</a>(interp);
        <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_RunTraces">RunTraces</a>(itPtr, NS_TCL_TRACE_CREATE);
        if (nsconf.tcl.lockoninit) {
            Ns_CsLeave(&lock);
        }
    }
    itPtr->nextPtr = NULL;
    interp = itPtr->interp;

    /*
     * Clear any pending async cancel message, run the traces and
     * set the epoch if a create and/or allocate traces hasn't
     * already done so.
     */

    (void) Tcl_AsyncInvoke(interp, TCL_OK);
    <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_RunTraces">RunTraces</a>(itPtr, NS_TCL_TRACE_ALLOCATE);
    if (itPtr->epoch != epoch) {
        itPtr->epoch = epoch;
    }
    return itPtr;
}


/*
 *----------------------------------------------------------------------
 *
 * <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_PushInterp">PushInterp</a> --
 *
 *      Return a virtual-server interp to the per-thread interp
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Will invoke de-alloc traces.
 *
 *----------------------------------------------------------------------
 */

static void
<a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_PushInterp">PushInterp</a>(NsInterp *itPtr)
{
    Tcl_Interp *interp = itPtr->interp;
    Tcl_HashEntry *hPtr;

    /*
     * Evaluate the cleanup script to perform various garbage collection
     * and then either delete the interp or push it back on the
     * per-thread list.
     */

    <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_RunTraces">RunTraces</a>(itPtr, NS_TCL_TRACE_DEALLOCATE);
    if (itPtr->delete) {
        <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclDestroyInterp">Ns_TclDestroyInterp</a>(interp);
    } else {
        hPtr = <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_GetCacheEntry">GetCacheEntry</a>(itPtr->servPtr);
        itPtr->nextPtr = Tcl_GetHashValue(hPtr);
        Tcl_SetHashValue(hPtr, itPtr);
    }
}


/*
 *----------------------------------------------------------------------
 *
 * <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_GetCacheEntry">GetCacheEntry</a> --
 *
 *      Get hash entry in per-thread interp cache for given virtual
 *       server
 *
 * Results:
 *      Pointer to hash entry.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */

static Tcl_HashEntry *
<a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_GetCacheEntry">GetCacheEntry</a>(NsServer *servPtr)
{
    TclData *dataPtr = <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_GetData">GetData</a>();
    int new;

    return Tcl_CreateHashEntry(&dataPtr->interps, (char *) servPtr, &new);
}


/*
 *----------------------------------------------------------------------
 *
 * <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_EvalTrace">EvalTrace</a> --
 *
 *      Eval the given script from being called as a Tcl Init callback.
 *
 * Results:
 *      Status from script eval.
 *
 * Side effects:
 *      Depends on script.
 *
 *----------------------------------------------------------------------
 */

static int
<a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_EvalTrace">EvalTrace</a>(Tcl_Interp *interp, void *arg)
{
    ScriptTrace *stPtr = arg;

    return Tcl_EvalEx(interp, stPtr->script, stPtr->length, 0);
}


/*
 *----------------------------------------------------------------------
 *
 * <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_CreateInterp">CreateInterp</a> --
 *
 *      Create a new interp with the Nsd package.
 *
 * Results:
 *      Pointer to new Tcl_Interp.
 *
 * Side effects:
 *      Will log an error message on core Tcl and/or Nsd package init
 *      failure.
 *
 *----------------------------------------------------------------------
 */

static Tcl_Interp *
<a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_CreateInterp">CreateInterp</a>(NsServer *servPtr)
{
    Tcl_Interp *interp;

    interp = Tcl_CreateInterp();
    Tcl_InitMemory(interp);
    if (Tcl_Init(interp) != TCL_OK || <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_InitData">InitData</a>(interp, servPtr) != TCL_OK) {
        <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclLogError">Ns_TclLogError</a>(interp);
    }
    return interp;
}


/*
 *----------------------------------------------------------------------
 *
 * <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_InitData">InitData</a> --
 *
 *      Initialize and provide the Nsd package for given interp,
 *      associating it with a specific virtual server, if any.
 *
 * Results:
 *      Return code of Tcl_PkgProvide.
 *
 * Side effects:
 *      Will add Nsd package commands to given interp.
 *
 *----------------------------------------------------------------------
 */

static int
<a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_InitData">InitData</a>(Tcl_Interp *interp, NsServer *servPtr)
{
    static volatile int initialized = 0;
    NsInterp *itPtr;

    /*
     * Core one-time AOLserver initialization to add a few Tcl_Obj
     * types.  These calls cannot be in NsTclInit above because
     * Tcl is not fully initialized at libnsd load time.
     */

    if (!initialized) {
        <a href="/cvs/aolserver/aolserver/nsd/init.c#A_Ns_LibInit">Ns_LibInit</a>();
        Ns_MasterLock();
        if (!initialized) {
            <a href="/cvs/aolserver/aolserver/nsd/tcljob.c#A_NsTclInitQueueType">NsTclInitQueueType</a>();
            <a href="/cvs/aolserver/aolserver/nsd/tclthread.c#A_NsTclInitAddrType">NsTclInitAddrType</a>();
            <a href="/cvs/aolserver/aolserver/nsd/tclobj.c#A_NsTclInitTimeType">NsTclInitTimeType</a>();
            <a href="/cvs/aolserver/aolserver/nsd/tclcache.c#A_NsTclInitCacheType">NsTclInitCacheType</a>();
            NsTclInitKeylistType();
            initialized = 1;
        }
        Ns_MasterUnlock();
    }

    /*
     * Allocate and initialize a new NsInterp struct.
     */

    itPtr = ns_calloc(1, sizeof(NsInterp));
    itPtr->interp = interp;
    itPtr->servPtr = servPtr;
    Tcl_InitHashTable(&itPtr->sets, TCL_STRING_KEYS);
    Tcl_InitHashTable(&itPtr->chans, TCL_STRING_KEYS);  
    Tcl_InitHashTable(&itPtr->https, TCL_STRING_KEYS);  
    <a href="/cvs/aolserver/aolserver/nsd/adpeval.c#A_NsAdpInit">NsAdpInit</a>(itPtr);
    itPtr->adp.cwd = <a href="/cvs/aolserver/aolserver/nsd/fastpath.c#A_Ns_PageRoot">Ns_PageRoot</a>(servPtr->server);

    /*
     * Associate the new NsInterp with this interp.  At interp delete
     * time, Tcl will call <a href="/cvs/aolserver/aolserver/nsdb/dbtcl.c#A_FreeData">FreeData</a> to cleanup the struct.
     */

    Tcl_SetAssocData(interp, "ns:data", <a href="/cvs/aolserver/aolserver/nsdb/dbtcl.c#A_FreeData">FreeData</a>, itPtr);

    /*
     * Ensure the per-thread data with async cancel handle is allocated.
     */

    (void) <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_GetData">GetData</a>();

    /*
     * Add core AOLserver commands.
     */

    <a href="/cvs/aolserver/aolserver/nsd/tclcmds.c#A_NsTclAddCmds">NsTclAddCmds</a>(interp, itPtr);
    return Tcl_PkgProvide(interp, "Nsd", NS_VERSION);
}


/*
 *----------------------------------------------------------------------
 *
 * <a href="/cvs/aolserver/aolserver/nsdb/dbtcl.c#A_FreeData">FreeData</a> --
 *
 *      Tcl assoc data callback to destroy the per-interp NsInterp
 *      structure at interp delete time.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */

static void
<a href="/cvs/aolserver/aolserver/nsdb/dbtcl.c#A_FreeData">FreeData</a>(ClientData arg, Tcl_Interp *interp)
{
    NsInterp *itPtr = arg;

    <a href="/cvs/aolserver/aolserver/nsd/adpeval.c#A_NsAdpFree">NsAdpFree</a>(itPtr);
    Tcl_DeleteHashTable(&itPtr->sets);
    Tcl_DeleteHashTable(&itPtr->chans);
    Tcl_DeleteHashTable(&itPtr->https);
    ns_free(itPtr);
}


/*
 *----------------------------------------------------------------------
 *
 * <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_GetData">GetData</a> --
 *
 *      Return the per-thread Tcl data structure for current thread.
 *
 * Results:
 *      Pointer to TclData structure.
 *
 * Side effects:
 *      Will allocate and initialize TclData struct if necessary.
 *
 *----------------------------------------------------------------------
 */

static TclData *
<a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_GetData">GetData</a>(void)
{
    TclData *dataPtr;
    int tid, new;

    dataPtr = Ns_TlsGet(&tls);
    if (dataPtr == NULL) {
        dataPtr = ns_malloc(sizeof(TclData));
        dataPtr->cancel = Tcl_AsyncCreate(<a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_AsyncCancel">AsyncCancel</a>, NULL);
        Tcl_InitHashTable(&dataPtr->interps, TCL_ONE_WORD_KEYS);
        tid = Ns_ThreadId();
        Ns_MutexLock(&tlock);
        dataPtr->hPtr = Tcl_CreateHashEntry(&threads, (char *) tid, &new);
        Tcl_SetHashValue(dataPtr->hPtr, dataPtr);
        Ns_MutexUnlock(&tlock);
        Ns_TlsSet(&tls, dataPtr);
    }
    return dataPtr;
}


/*
 *----------------------------------------------------------------------
 *
 * <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_DeleteData">DeleteData</a> --
 *
 *      Delete all per-thread data at thread exit time.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */

static void
<a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_DeleteData">DeleteData</a>(void *arg)
{
    TclData *dataPtr = arg;
    Tcl_HashEntry *hPtr;
    Tcl_HashSearch search;
    NsInterp *itPtr;

    Ns_MutexLock(&tlock);
    Tcl_DeleteHashEntry(dataPtr->hPtr);
    Ns_MutexUnlock(&tlock);
    hPtr = Tcl_FirstHashEntry(&dataPtr->interps, &search);
    while (hPtr != NULL) {
        while ((itPtr = Tcl_GetHashValue(hPtr)) != NULL) {
            Tcl_SetHashValue(hPtr, itPtr->nextPtr);
            <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclDestroyInterp">Ns_TclDestroyInterp</a>(itPtr->interp);
        }
        hPtr = Tcl_NextHashEntry(&search);
    }
    Tcl_DeleteHashTable(&dataPtr->interps);
    Tcl_AsyncDelete(dataPtr->cancel);
    ns_free(dataPtr);
}


/*
 *----------------------------------------------------------------------
 *
 * <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_RunTraces">RunTraces</a> --
 *
 *      Execute script and C-level trace callbacks
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Depeneds on callbacks.
 *
 *----------------------------------------------------------------------
 */
 
static void
<a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_RunTraces">RunTraces</a>(NsInterp *itPtr, int why)
{
    <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_ForeachTrace">ForeachTrace</a>(itPtr, why, 0);
}

static void
<a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_ForeachTrace">ForeachTrace</a>(NsInterp *itPtr, int why, int append)
{
    Tcl_Interp *interp = itPtr->interp;
    TclTrace *tracePtr;

    /*
     * Finalization traces are invoked in LIFO order with script-traces
     * before C-level traces.  Otherwise, traces are invoked in FIFO
     * order, with C-level traces before script-traces.
     */

    Tcl_ResetResult(interp);
    Ns_RWLockRdLock(&itPtr->servPtr->tcl.tlock);
    switch (why) {
    case NS_TCL_TRACE_FREECONN:
    case NS_TCL_TRACE_DEALLOCATE:
    case NS_TCL_TRACE_DELETE:
        tracePtr = itPtr->servPtr->tcl.lastTracePtr;
        while (tracePtr != NULL) {
            if (tracePtr->proc == <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_EvalTrace">EvalTrace</a> && (tracePtr->when & why)) {
                <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_DoTrace">DoTrace</a>(interp, tracePtr, append);
            }
            tracePtr = tracePtr->prevPtr;
        }
        tracePtr = itPtr->servPtr->tcl.lastTracePtr;
        while (tracePtr != NULL) {
            if (tracePtr->proc != <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_EvalTrace">EvalTrace</a> && (tracePtr->when & why)) {
                <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_DoTrace">DoTrace</a>(interp, tracePtr, append);
            }
            tracePtr = tracePtr->prevPtr;
        }
        break;

    default:
        tracePtr = itPtr->servPtr->tcl.firstTracePtr;
        while (tracePtr != NULL) {
            if (tracePtr->proc != <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_EvalTrace">EvalTrace</a> && (tracePtr->when & why)) {
                <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_DoTrace">DoTrace</a>(interp, tracePtr, append);
            }
            tracePtr = tracePtr->nextPtr;
        }
        tracePtr = itPtr->servPtr->tcl.firstTracePtr;
        while (tracePtr != NULL) {
            if (tracePtr->proc == <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_EvalTrace">EvalTrace</a> && (tracePtr->when & why)) {
                <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_DoTrace">DoTrace</a>(interp, tracePtr, append);
            }
            tracePtr = tracePtr->nextPtr;
        }
        break;
    }
    Ns_RWLockUnlock(&itPtr->servPtr->tcl.tlock);
    if (!append) {
        Tcl_ResetResult(interp);
    }
}


/*
 *----------------------------------------------------------------------
 *
 * <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_DoTrace">DoTrace</a> --
 *
 *      Invoke or append a trace, logging any error message.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
 
static void
<a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_DoTrace">DoTrace</a>(Tcl_Interp *interp, TclTrace *tracePtr, int append)
{
    Tcl_Obj *procPtr;
    ScriptTrace *stPtr;
    char buf[100];
    int result;

    if (!append) {
        result = (*tracePtr->proc)(interp, tracePtr->arg);
        if (result != TCL_OK) {
            <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_Ns_TclLogError">Ns_TclLogError</a>(interp);
        }
    } else {
        if (tracePtr->proc == <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_EvalTrace">EvalTrace</a>) {
            stPtr = tracePtr->arg;
            procPtr = Tcl_NewStringObj(stPtr->script, stPtr->length);
        } else {
            sprintf(buf, "C {p:%p a:%p}", tracePtr->proc, tracePtr->arg);
            procPtr = Tcl_NewStringObj(buf, -1);
        }
        Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp), procPtr);
    }
}


/*
 *----------------------------------------------------------------------
 *
 * <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_PkgRequire">PkgRequire</a> --
 *
 *      Trace callback to add a registered package to given interp.
 *
 * Results:
 *      TCL_OK if package added, TCL_ERROR otherwise.
 *
 * Side effects:
 *      Depends on package, typically new namespaces and/or commands.
 *
 *----------------------------------------------------------------------
 */

static int
<a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_PkgRequire">PkgRequire</a>(Tcl_Interp *interp, void *arg)
{
    Package *pkgPtr = arg;

    if (Tcl_PkgRequire(interp, pkgPtr->name, pkgPtr->version,
                         pkgPtr->exact) == NULL) {
        return TCL_ERROR;
    }
    return TCL_OK;
}


/*
 *----------------------------------------------------------------------
 *
 * <a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_AsyncCancel">AsyncCancel</a> --
 *
 *      Callback which cancels Tcl execution in the given thread.
 *
 * Results:
 *      TCL_ERROR.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */

static int
<a href="/cvs/aolserver/aolserver/nsd/tclinit.c#A_AsyncCancel">AsyncCancel</a>(ClientData ignored, Tcl_Interp *interp, int code)
{
    Tcl_ResetResult(interp);
    Tcl_SetResult(interp, "async cancel", TCL_STATIC);
    return TCL_ERROR;
}