Import Tcl 8.6.10

pkgs/thread2.8.5/generic/psGdbm.c

@@ -0,0 +1,399 @@
+/*
+ * This file implements wrappers for persistent gdbm storage for the
+ * shared variable arrays.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ * ----------------------------------------------------------------------------
+ */
+
+#ifdef HAVE_GDBM
+
+#include "threadSvCmd.h"
+#include <gdbm.h>
+#include <stdlib.h> /* For free() */
+
+/*
+ * Functions implementing the persistent store interface
+ */
+
+static ps_open_proc   ps_gdbm_open;
+static ps_close_proc  ps_gdbm_close;
+static ps_get_proc    ps_gdbm_get;
+static ps_put_proc    ps_gdbm_put;
+static ps_first_proc  ps_gdbm_first;
+static ps_next_proc   ps_gdbm_next;
+static ps_delete_proc ps_gdbm_delete;
+static ps_free_proc   ps_gdbm_free;
+static ps_geterr_proc ps_gdbm_geterr;
+
+/*
+ * This structure collects all the various pointers
+ * to the functions implementing the gdbm store.
+ */
+
+const PsStore GdbmStore = {
+    "gdbm",
+    NULL,
+    ps_gdbm_open,
+    ps_gdbm_get,
+    ps_gdbm_put,
+    ps_gdbm_first,
+    ps_gdbm_next,
+    ps_gdbm_delete,
+    ps_gdbm_close,
+    ps_gdbm_free,
+    ps_gdbm_geterr,
+    NULL
+};
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * Sv_RegisterGdbmStore --
+ *
+ *      Register the gdbm store with shared variable implementation.
+ *
+ * Results:
+ *      None.
+ *
+ * Side effects:
+ *      None.
+ *
+ *-----------------------------------------------------------------------------
+ */
+void
+Sv_RegisterGdbmStore(void)
+{
+    Sv_RegisterPsStore(&GdbmStore);
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * ps_gdbm_open --
+ *
+ *      Opens the dbm-based persistent storage.
+ *
+ * Results:
+ *      Opaque handle of the opened dbm storage.
+ *
+ * Side effects:
+ *      The gdbm file might be created if not found.
+ *
+ *-----------------------------------------------------------------------------
+ */
+static ClientData
+ps_gdbm_open(
+    const char *path)
+{
+    GDBM_FILE dbf;
+    char *ext;
+    Tcl_DString toext;
+
+    Tcl_DStringInit(&toext);
+    ext = Tcl_UtfToExternalDString(NULL, path, strlen(path), &toext);
+    dbf = gdbm_open(ext, 512, GDBM_WRCREAT|GDBM_SYNC|GDBM_NOLOCK, 0666, NULL);
+    Tcl_DStringFree(&toext);
+
+    return dbf;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * ps_gdbm_close --
+ *
+ *      Closes the gdbm-based persistent storage.
+ *
+ * Results:
+ *      0 - ok
+ *
+ * Side effects:
+ *      None.
+ *
+ *-----------------------------------------------------------------------------
+ */
+static int
+ps_gdbm_close(
+    ClientData handle)
+{
+    gdbm_close((GDBM_FILE)handle);
+
+    return 0;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * ps_gdbm_get --
+ *
+ *      Retrieves data for the key from the dbm storage.
+ *
+ * Results:
+ *      1 - no such key
+ *      0 - ok
+ *
+ * Side effects:
+ *      Data returned must be freed by the caller.
+ *
+ *-----------------------------------------------------------------------------
+ */
+static int
+ps_gdbm_get(
+     ClientData handle,
+     const char   *key,
+     char **dataptrptr,
+     size_t    *lenptr)
+{
+    GDBM_FILE dbf = (GDBM_FILE)handle;
+    datum drec, dkey;
+
+    dkey.dptr  = (char*)key;
+    dkey.dsize = strlen(key) + 1;
+
+    drec = gdbm_fetch(dbf, dkey);
+    if (drec.dptr == NULL) {
+        return 1;
+    }
+
+    *dataptrptr = drec.dptr;
+    *lenptr = drec.dsize;
+
+    return 0;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * ps_gdbm_first --
+ *
+ *      Starts the iterator over the dbm file and returns the first record.
+ *
+ * Results:
+ *      1 - no more records in the iterator
+ *      0 - ok
+ *
+ * Side effects:
+ *      Data returned must be freed by the caller.
+ *
+ *-----------------------------------------------------------------------------
+ */
+static int
+ps_gdbm_first(
+    ClientData  handle,
+    char   **keyptrptr,
+    char  **dataptrptr,
+    size_t     *lenptr)
+{
+    GDBM_FILE dbf = (GDBM_FILE)handle;
+    datum drec, dkey;
+
+    dkey = gdbm_firstkey(dbf);
+    if (dkey.dptr == NULL) {
+        return 1;
+    }
+    drec = gdbm_fetch(dbf, dkey);
+    if (drec.dptr == NULL) {
+        return 1;
+    }
+
+    *dataptrptr = drec.dptr;
+    *lenptr = drec.dsize;
+    *keyptrptr = dkey.dptr;
+
+    return 0;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * ps_gdbm_next --
+ *
+ *      Uses the iterator over the dbm file and returns the next record.
+ *
+ * Results:
+ *      1 - no more records in the iterator
+ *      0 - ok
+ *
+ * Side effects:
+ *      Data returned must be freed by the caller.
+ *
+ *-----------------------------------------------------------------------------
+ */
+static int ps_gdbm_next(
+    ClientData  handle,
+    char   **keyptrptr,
+    char  **dataptrptr,
+    size_t     *lenptr)
+{
+    GDBM_FILE dbf = (GDBM_FILE)handle;
+    datum drec, dkey, dnext;
+
+    dkey.dptr  = *keyptrptr;
+    dkey.dsize = strlen(*keyptrptr) + 1;
+
+    dnext = gdbm_nextkey(dbf, dkey);
+    free(*keyptrptr), *keyptrptr = NULL;
+
+    if (dnext.dptr == NULL) {
+        return 1;
+    }
+    drec = gdbm_fetch(dbf, dnext);
+    if (drec.dptr == NULL) {
+        return 1;
+    }
+
+    *dataptrptr = drec.dptr;
+    *lenptr = drec.dsize;
+    *keyptrptr = dnext.dptr;
+
+    return 0;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * ps_gdbm_put --
+ *
+ *      Stores used data bound to a key in dbm storage.
+ *
+ * Results:
+ *      0 - ok
+ *     -1 - error; use ps_dbm_geterr to retrieve the error message
+ *
+ * Side effects:
+ *      If the key is already associated with some user data, this will
+ *      be replaced by the new data chunk.
+ *
+ *-----------------------------------------------------------------------------
+ */
+static int
+ps_gdbm_put(
+    ClientData handle,
+    const char   *key,
+    char     *dataptr,
+    size_t        len)
+{
+    GDBM_FILE dbf = (GDBM_FILE)handle;
+    datum drec, dkey;
+    int ret;
+
+    dkey.dptr  = (char*)key;
+    dkey.dsize = strlen(key) + 1;
+
+    drec.dptr  = dataptr;
+    drec.dsize = len;
+
+    ret = gdbm_store(dbf, dkey, drec, GDBM_REPLACE);
+    if (ret == -1) {
+        return -1;
+    }
+
+    return 0;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * ps_gdbm_delete --
+ *
+ *      Deletes the key and associated data from the dbm storage.
+ *
+ * Results:
+ *      0 - ok
+ *     -1 - error; use ps_dbm_geterr to retrieve the error message
+ *
+ * Side effects:
+ *      If the key is already associated with some user data, this will
+ *      be replaced by the new data chunk.
+ *
+ *-----------------------------------------------------------------------------
+ */
+static int
+ps_gdbm_delete(
+    ClientData handle,
+    const char   *key)
+{
+    GDBM_FILE dbf = (GDBM_FILE)handle;
+    datum dkey;
+    int ret;
+
+    dkey.dptr  = (char*)key;
+    dkey.dsize = strlen(key) + 1;
+
+    ret = gdbm_delete(dbf, dkey);
+    if (ret == -1) {
+        return -1;
+    }
+
+    return 0;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * ps_gdbm_free --
+ *
+ *      Frees memory allocated by the gdbm implementation.
+ *
+ * Results:
+ *      None.
+ *
+ * Side effects:
+ *      Memory gets reclaimed.
+ *
+ *-----------------------------------------------------------------------------
+ */
+static void
+ps_gdbm_free(
+    ClientData handle,
+    void        *data)
+{
+    (void)handle;
+    free(data);
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * ps_gdbm_geterr --
+ *
+ *      Retrieves the textual representation of the error caused
+ *      by the last dbm command.
+ *
+ * Results:
+ *      Pointer to the strimg message.
+ *
+ * Side effects:
+ *      None.
+ *
+ *-----------------------------------------------------------------------------
+ */
+static const char*
+ps_gdbm_geterr(
+    ClientData handle)
+{
+   /*
+    * The problem with gdbm interface is that it uses the global
+    * gdbm_errno variable which is not per-thread nor mutex
+    * protected. This variable is used to reference array of gdbm
+    * error text strings. It is very dangeours to use this in the
+    * MT-program without proper locking. For this kind of app
+    * we should not be concerned with that, since all ps_gdbm_xxx
+    * operations are performed under shared variable lock anyway.
+    */
+
+    return gdbm_strerror(gdbm_errno);
+}
+
+#endif  /* HAVE_GDBM */
+
+/* EOF $RCSfile*/
+
+/* Emacs Setup Variables */
+/* Local Variables:      */
+/* mode: C               */
+/* indent-tabs-mode: nil */
+/* c-basic-offset: 4     */
+/* End:                  */

pkgs/thread2.8.5/generic/psGdbm.h

@@ -0,0 +1,24 @@
+/*
+ * psGdbm.h --
+ *
+ * See the file "license.txt" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ * ---------------------------------------------------------------------------
+ */
+
+#ifndef _PSGDBM_H_
+#define _PSGDBM_H_
+
+void Sv_RegisterGdbmStore();
+
+#endif /* _PSGDBM_H_ */
+
+/* EOF $RCSfile */
+
+/* Emacs Setup Variables */
+/* Local Variables:      */
+/* mode: C               */
+/* indent-tabs-mode: nil */
+/* c-basic-offset: 4     */
+/* End:                  */
+

pkgs/thread2.8.5/generic/psLmdb.c

@@ -0,0 +1,545 @@
+/*
+ * This file implements wrappers for persistent lmdb storage for the
+ * shared variable arrays.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ * ----------------------------------------------------------------------------
+ */
+
+#ifdef HAVE_LMDB
+
+#include "threadSvCmd.h"
+#include <lmdb.h>
+
+/*
+ * Structure keeping the lmdb environment context
+ */
+typedef struct {
+    MDB_env    * env; // Environment
+    MDB_txn    * txn; // Last active read transaction
+    MDB_cursor * cur; // Cursor used for ps_lmdb_first and ps_lmdb_next
+    MDB_dbi      dbi; // Open database (default db)
+    int          err; // Last error (used in ps_lmdb_geterr)
+} * LmdbCtx;
+
+/*
+ * Transaction and DB open mode
+ */
+enum LmdbOpenMode { LmdbRead, LmdbWrite };
+
+// Initialize or renew a transaction.
+static void LmdbTxnGet(LmdbCtx ctx, enum LmdbOpenMode mode);
+
+// Commit a transaction.
+static void LmdbTxnCommit(LmdbCtx ctx);
+
+// Abort a transaction
+static void LmdbTxnAbort(LmdbCtx ctx);
+
+void LmdbTxnGet(LmdbCtx ctx, enum LmdbOpenMode mode)
+{
+    // Read transactions are reused, if possible
+    if (ctx->txn && mode == LmdbRead)
+    {
+        ctx->err = mdb_txn_renew(ctx->txn);
+        if (ctx->err)
+        {
+            ctx->txn = NULL;
+        }
+    }
+    else if (ctx->txn && mode == LmdbWrite)
+    {
+        LmdbTxnAbort(ctx);
+    }
+
+    if (ctx->txn == NULL)
+    {
+        ctx->err = mdb_txn_begin(ctx->env, NULL, 0, &ctx->txn);
+    }
+
+    if (ctx->err)
+    {
+        ctx->txn = NULL;
+        return;
+    }
+
+    // Given the setup above, and the arguments given, this won't fail.
+    mdb_dbi_open(ctx->txn, NULL, 0, &ctx->dbi);
+}
+
+void LmdbTxnCommit(LmdbCtx ctx)
+{
+    ctx->err = mdb_txn_commit(ctx->txn);
+    ctx->txn = NULL;
+}
+
+void LmdbTxnAbort(LmdbCtx ctx)
+{
+    mdb_txn_abort(ctx->txn);
+    ctx->txn = NULL;
+}
+
+/*
+ * Functions implementing the persistent store interface
+ */
+
+static ps_open_proc   ps_lmdb_open;
+static ps_close_proc  ps_lmdb_close;
+static ps_get_proc    ps_lmdb_get;
+static ps_put_proc    ps_lmdb_put;
+static ps_first_proc  ps_lmdb_first;
+static ps_next_proc   ps_lmdb_next;
+static ps_delete_proc ps_lmdb_delete;
+static ps_free_proc   ps_lmdb_free;
+static ps_geterr_proc ps_lmdb_geterr;
+
+/*
+ * This structure collects all the various pointers
+ * to the functions implementing the lmdb store.
+ */
+
+const PsStore LmdbStore = {
+    "lmdb",
+    NULL,
+    ps_lmdb_open,
+    ps_lmdb_get,
+    ps_lmdb_put,
+    ps_lmdb_first,
+    ps_lmdb_next,
+    ps_lmdb_delete,
+    ps_lmdb_close,
+    ps_lmdb_free,
+    ps_lmdb_geterr,
+    NULL
+};
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * Sv_RegisterLmdbStore --
+ *
+ *      Register the lmdb store with shared variable implementation.
+ *
+ * Results:
+ *      None.
+ *
+ * Side effects:
+ *      None.
+ *
+ *-----------------------------------------------------------------------------
+ */
+void
+Sv_RegisterLmdbStore(void)
+{
+    Sv_RegisterPsStore(&LmdbStore);
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * ps_lmdb_open --
+ *
+ *      Opens the lmdb-based persistent storage.
+ *
+ * Results:
+ *      Opaque handle for LmdbCtx.
+ *
+ * Side effects:
+ *      The lmdb file might be created if not found.
+ *
+ *-----------------------------------------------------------------------------
+ */
+static ClientData
+ps_lmdb_open(
+    const char *path)
+{
+    LmdbCtx ctx;
+
+    char *ext;
+    Tcl_DString toext;
+
+    ctx = ckalloc(sizeof(*ctx));
+    if (ctx == NULL)
+    {
+        return NULL;
+    }
+
+    ctx->env = NULL;
+    ctx->txn = NULL;
+    ctx->cur = NULL;
+    ctx->dbi = 0;
+
+    ctx->err = mdb_env_create(&ctx->env);
+    if (ctx->err)
+    {
+        ckfree(ctx);
+        return NULL;
+    }
+
+    Tcl_DStringInit(&toext);
+    ext = Tcl_UtfToExternalDString(NULL, path, strlen(path), &toext);
+    ctx->err = mdb_env_open(ctx->env, ext, MDB_NOSUBDIR|MDB_NOLOCK, 0666);
+    Tcl_DStringFree(&toext);
+
+    if (ctx->err)
+    {
+        ckfree(ctx);
+        return NULL;
+    }
+
+    return ctx;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * ps_lmdb_close --
+ *
+ *      Closes the lmdb-based persistent storage.
+ *
+ * Results:
+ *      0 - ok
+ *
+ * Side effects:
+ *      None.
+ *
+ *-----------------------------------------------------------------------------
+ */
+static int
+ps_lmdb_close(
+    ClientData handle)
+{
+    LmdbCtx ctx = (LmdbCtx)handle;
+    if (ctx->cur)
+    {
+        mdb_cursor_close(ctx->cur);
+    }
+    if (ctx->txn)
+    {
+        LmdbTxnAbort(ctx);
+    }
+
+    mdb_env_close(ctx->env);
+    ckfree(ctx);
+
+    return 0;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * ps_lmdb_get --
+ *
+ *      Retrieves data for the key from the lmdb storage.
+ *
+ * Results:
+ *      1 - no such key
+ *      0 - ok
+ *
+ * Side effects:
+ *      Data returned must be copied, then psFree must be called.
+ *
+ *-----------------------------------------------------------------------------
+ */
+static int
+ps_lmdb_get(
+     ClientData  handle,
+     const char *keyptr,
+     char  **dataptrptr,
+     size_t     *lenptr)
+{
+    LmdbCtx ctx = (LmdbCtx)handle;
+    MDB_val key, data;
+
+    LmdbTxnGet(ctx, LmdbRead);
+    if (ctx->err)
+    {
+        return 1;
+    }
+
+    key.mv_data = (void *)keyptr;
+    key.mv_size = strlen(keyptr) + 1;
+
+    ctx->err = mdb_get(ctx->txn, ctx->dbi, &key, &data);
+    if (ctx->err)
+    {
+        mdb_txn_reset(ctx->txn);
+        return 1;
+    }
+
+    *dataptrptr = data.mv_data;
+    *lenptr = data.mv_size;
+
+    /*
+     * Transaction is left open at this point, so that the caller can get ahold
+     * of the data and make a copy of it. Afterwards, it will call ps_lmdb_free
+     * to free the data, and we'll catch the chance to reset the transaction
+     * there.
+     */
+
+    return 0;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * ps_lmdb_first --
+ *
+ *      Starts the iterator over the lmdb file and returns the first record.
+ *
+ * Results:
+ *      1 - no more records in the iterator
+ *      0 - ok
+ *
+ * Side effects:
+ *      Data returned must be copied, then psFree must be called.
+ *
+ *-----------------------------------------------------------------------------
+ */
+static int
+ps_lmdb_first(
+    ClientData  handle,
+    char   **keyptrptr,
+    char  **dataptrptr,
+    size_t     *lenptr)
+{
+    LmdbCtx ctx = (LmdbCtx)handle;
+    MDB_val key, data;
+
+    LmdbTxnGet(ctx, LmdbRead);
+    if (ctx->err)
+    {
+        return 1;
+    }
+
+    ctx->err = mdb_cursor_open(ctx->txn, ctx->dbi, &ctx->cur);
+    if (ctx->err)
+    {
+        return 1;
+    }
+
+    ctx->err = mdb_cursor_get(ctx->cur, &key, &data, MDB_FIRST);
+    if (ctx->err)
+    {
+        mdb_txn_reset(ctx->txn);
+        mdb_cursor_close(ctx->cur);
+        ctx->cur = NULL;
+        return 1;
+    }
+
+    *dataptrptr = data.mv_data;
+    *lenptr = data.mv_size;
+    *keyptrptr = key.mv_data;
+
+    return 0;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * ps_lmdb_next --
+ *
+ *      Uses the iterator over the lmdb file and returns the next record.
+ *
+ * Results:
+ *      1 - no more records in the iterator
+ *      0 - ok
+ *
+ * Side effects:
+ *      Data returned must be copied, then psFree must be called.
+ *
+ *-----------------------------------------------------------------------------
+ */
+static int ps_lmdb_next(
+    ClientData  handle,
+    char   **keyptrptr,
+    char  **dataptrptr,
+    size_t     *lenptr)
+{
+    LmdbCtx ctx = (LmdbCtx)handle;
+    MDB_val key, data;
+
+    ctx->err = mdb_cursor_get(ctx->cur, &key, &data, MDB_NEXT);
+    if (ctx->err)
+    {
+        mdb_txn_reset(ctx->txn);
+        mdb_cursor_close(ctx->cur);
+        ctx->cur = NULL;
+        return 1;
+    }
+
+    *dataptrptr = data.mv_data;
+    *lenptr = data.mv_size;
+    *keyptrptr = key.mv_data;
+
+    return 0;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * ps_lmdb_put --
+ *
+ *      Stores used data bound to a key in lmdb storage.
+ *
+ * Results:
+ *      0 - ok
+ *     -1 - error; use ps_lmdb_geterr to retrieve the error message
+ *
+ * Side effects:
+ *      If the key is already associated with some user data, this will
+ *      be replaced by the new data chunk.
+ *
+ *-----------------------------------------------------------------------------
+ */
+static int
+ps_lmdb_put(
+    ClientData  handle,
+    const char *keyptr,
+    char      *dataptr,
+    size_t         len)
+{
+    LmdbCtx ctx = (LmdbCtx)handle;
+    MDB_val key, data;
+
+    LmdbTxnGet(ctx, LmdbWrite);
+    if (ctx->err)
+    {
+        return -1;
+    }
+
+    key.mv_data = (void*)keyptr;
+    key.mv_size = strlen(keyptr) + 1;
+
+    data.mv_data = dataptr;
+    data.mv_size = len;
+
+    ctx->err = mdb_put(ctx->txn, ctx->dbi, &key, &data, 0);
+    if (ctx->err)
+    {
+        LmdbTxnAbort(ctx);
+    }
+    else
+    {
+        LmdbTxnCommit(ctx);
+    }
+
+    return ctx->err ? -1 : 0;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * ps_lmdb_delete --
+ *
+ *      Deletes the key and associated data from the lmdb storage.
+ *
+ * Results:
+ *      0 - ok
+ *     -1 - error; use ps_lmdb_geterr to retrieve the error message
+ *
+ * Side effects:
+ *      If the key is already associated with some user data, this will
+ *      be replaced by the new data chunk.
+ *
+ *-----------------------------------------------------------------------------
+ */
+static int
+ps_lmdb_delete(
+    ClientData  handle,
+    const char *keyptr)
+{
+    LmdbCtx ctx = (LmdbCtx)handle;
+    MDB_val key;
+
+    LmdbTxnGet(ctx, LmdbWrite);
+    if (ctx->err)
+    {
+        return -1;
+    }
+
+    key.mv_data = (void*)keyptr;
+    key.mv_size = strlen(keyptr) + 1;
+
+    ctx->err = mdb_del(ctx->txn, ctx->dbi, &key, NULL);
+    if (ctx->err)
+    {
+        LmdbTxnAbort(ctx);
+    }
+    else
+    {
+        LmdbTxnCommit(ctx);
+    }
+
+    ctx->txn = NULL;
+    return ctx->err ? -1 : 0;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * ps_lmdb_free --
+ *
+ *      This function is called to free data returned by the persistent store
+ *      after calls to psFirst, psNext, or psGet. Lmdb doesn't need to free any
+ *      data, as the data returned is owned by lmdb. On the other hand, this
+ *      method is required to reset the read transaction. This is done only
+ *      when iteration is over (ctx->cur == NULL).
+ *
+ * Results:
+ *      None.
+ *
+ * Side effects:
+ *      Memory gets reclaimed.
+ *
+ *-----------------------------------------------------------------------------
+ */
+static void
+ps_lmdb_free(
+    ClientData handle,
+    void        *data)
+{
+    LmdbCtx ctx = (LmdbCtx)handle;
+    (void)data;
+
+    if (ctx->cur == NULL)
+    {
+        mdb_txn_reset(ctx->txn);
+    }
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * ps_lmdb_geterr --
+ *
+ *      Retrieves the textual representation of the error caused
+ *      by the last lmdb command.
+ *
+ * Results:
+ *      Pointer to the string message.
+ *
+ * Side effects:
+ *      None.
+ *
+ *-----------------------------------------------------------------------------
+ */
+static const char*
+ps_lmdb_geterr(
+    ClientData handle)
+{
+    LmdbCtx ctx = (LmdbCtx)handle;
+    return mdb_strerror(ctx->err);
+}
+
+#endif  /* HAVE_LMDB */
+
+/* EOF $RCSfile*/
+
+/* Emacs Setup Variables */
+/* Local Variables:      */
+/* mode: C               */
+/* indent-tabs-mode: nil */
+/* c-basic-offset: 4     */
+/* End:                  */

pkgs/thread2.8.5/generic/psLmdb.h

@@ -0,0 +1,24 @@
+/*
+ * psLmdb.h --
+ *
+ * See the file "license.txt" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ * ---------------------------------------------------------------------------
+ */
+
+#ifndef _PSLMDB_H_
+#define _PSLMDB_H_
+
+void Sv_RegisterLmdbStore();
+
+#endif /* _PSLMDB_H_ */
+
+/* EOF $RCSfile */
+
+/* Emacs Setup Variables */
+/* Local Variables:      */
+/* mode: C               */
+/* indent-tabs-mode: nil */
+/* c-basic-offset: 4     */
+/* End:                  */
+

pkgs/thread2.8.5/generic/tclThread.h

@@ -0,0 +1,36 @@
+/*
+ * --------------------------------------------------------------------------
+ * tclthread.h --
+ *
+ * Global header file for the thread extension.
+ *
+ * Copyright (c) 2002 ActiveState Corporation.
+ * 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.
+ * ---------------------------------------------------------------------------
+ */
+
+/*
+ * Thread extension version numbers are not stored here
+ * because this isn't a public export file.
+ */
+
+#ifndef _TCL_THREAD_H_
+#define _TCL_THREAD_H_
+
+#include <tcl.h>
+
+/*
+ * Exported from threadCmd.c file.
+ */
+#ifdef __cplusplus
+extern "C" {
+#endif
+DLLEXPORT int Thread_Init(Tcl_Interp *interp);
+#ifdef __cplusplus
+}
+#endif
+
+#endif /* _TCL_THREAD_H_ */

pkgs/thread2.8.5/generic/tclThreadInt.h

@@ -0,0 +1,193 @@
+/*
+ * --------------------------------------------------------------------------
+ * tclthreadInt.h --
+ *
+ * Global internal header file for the thread extension.
+ *
+ * Copyright (c) 2002 ActiveState Corporation.
+ * 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.
+ * ---------------------------------------------------------------------------
+ */
+
+#ifndef _TCL_THREAD_INT_H_
+#define _TCL_THREAD_INT_H_
+
+#include "tclThread.h"
+#include <stdlib.h> /* For strtoul */
+#include <string.h> /* For memset and friends */
+
+/*
+ * MSVC 8.0 started to mark many standard C library functions depreciated
+ * including the *printf family and others. Tell it to shut up.
+ * (_MSC_VER is 1200 for VC6, 1300 or 1310 for vc7.net, 1400 for 8.0)
+ */
+#if defined(_MSC_VER)
+#   pragma warning(disable:4244)
+#   if _MSC_VER >= 1400
+#	pragma warning(disable:4267)
+#	pragma warning(disable:4996)
+#   endif
+#endif
+
+/*
+ * Used to tag functions that are only to be visible within the module being
+ * built and not outside it (where this is supported by the linker).
+ */
+
+#ifndef MODULE_SCOPE
+#   ifdef __cplusplus
+#       define MODULE_SCOPE extern "C"
+#   else
+#       define MODULE_SCOPE extern
+#   endif
+#endif
+
+/*
+ * 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.
+ * Look into the threadSvCmd.h for more info.
+ */
+
+#define THREAD_CMD_PREFIX "thread::"
+#define TPOOL_CMD_PREFIX  "tpool::"
+
+/*
+ * Exported from threadSvCmd.c file.
+ */
+
+MODULE_SCOPE int Sv_Init(Tcl_Interp *interp);
+
+/*
+ * Exported from threadSpCmd.c file.
+ */
+
+MODULE_SCOPE int Sp_Init(Tcl_Interp *interp);
+
+/*
+ * Exported from threadPoolCmd.c file.
+ */
+
+MODULE_SCOPE int Tpool_Init(Tcl_Interp *interp);
+
+/*
+ * Macros for splicing in/out of linked lists
+ */
+
+#define SpliceIn(a,b)                          \
+    (a)->nextPtr = (b);                        \
+    if ((b) != NULL)                           \
+        (b)->prevPtr = (a);                    \
+    (a)->prevPtr = NULL, (b) = (a)
+
+#define SpliceOut(a,b)                         \
+    if ((a)->prevPtr != NULL)                  \
+        (a)->prevPtr->nextPtr = (a)->nextPtr;  \
+    else                                       \
+        (b) = (a)->nextPtr;                    \
+    if ((a)->nextPtr != NULL)                  \
+        (a)->nextPtr->prevPtr = (a)->prevPtr
+
+/*
+ * Version macros
+ */
+
+#define TCL_MINIMUM_VERSION(major,minor) \
+  ((TCL_MAJOR_VERSION > (major)) || \
+    ((TCL_MAJOR_VERSION == (major)) && (TCL_MINOR_VERSION >= (minor))))
+
+/*
+ * Utility macros
+ */
+
+#define TCL_CMD(a,b,c) \
+  if (Tcl_CreateObjCommand((a),(b),(c),NULL, NULL) == NULL) \
+    return TCL_ERROR
+
+#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.
+ */
+
+MODULE_SCOPE int threadTclVersion;
+
+typedef struct {
+    void *unused1;
+    void *unused2;
+    int errorLine;
+} tclInterpType;
+
+#if defined(TCL_TIP285) && defined(USE_TCL_STUBS)
+# undef Tcl_GetErrorLine
+# define Tcl_GetErrorLine(interp) ((threadTclVersion>85)? \
+    ((int (*)(Tcl_Interp *))((&(tclStubsPtr->tcl_PkgProvideEx))[605]))(interp): \
+    (((tclInterpType *)(interp))->errorLine))
+/* TIP #270 */
+# undef Tcl_AddErrorInfo
+# define Tcl_AddErrorInfo(interp, msg) ((threadTclVersion>85)? \
+    ((void (*)(Tcl_Interp *, Tcl_Obj *))((&(tclStubsPtr->tcl_PkgProvideEx))[574]))(interp, Tcl_NewStringObj(msg, -1)): \
+    ((void (*)(Tcl_Interp *, const char *))((&(tclStubsPtr->tcl_PkgProvideEx))[66]))(interp, msg))
+/* TIP #337 */
+# undef Tcl_BackgroundException
+# define Tcl_BackgroundException(interp, result) ((threadTclVersion>85)? \
+    ((void (*)(Tcl_Interp *, int))((&(tclStubsPtr->tcl_PkgProvideEx))[609]))(interp, result): \
+    ((void (*)(Tcl_Interp *))((&(tclStubsPtr->tcl_PkgProvideEx))[76]))(interp))
+#elif !TCL_MINIMUM_VERSION(8,6)
+  /* 8.5, 8.4, or less - Emulate access to the error-line information */
+# define Tcl_GetErrorLine(interp) (((tclInterpType *)(interp))->errorLine)
+#endif
+
+/* When running on Tcl >= 8.7, make sure that Thread still runs when Tcl is compiled
+ * with -DTCL_NO_DEPRECATED=1. Stub entries for Tcl_SetIntObj/Tcl_NewIntObj are NULL then.
+ * Just use Tcl_SetWideIntObj/Tcl_NewWideIntObj in stead. We don't simply want to use
+ * Tcl_SetWideIntObj/Tcl_NewWideIntObj always, since extensions might not expect to
+ * get an actual "wideInt".
+ */
+#if defined(USE_TCL_STUBS)
+# undef Tcl_SetIntObj
+# define Tcl_SetIntObj(objPtr, value) ((threadTclVersion>86)? \
+  ((void (*)(Tcl_Obj *, Tcl_WideInt))((&(tclStubsPtr->tcl_PkgProvideEx))[489]))(objPtr, (int)(value)): \
+  ((void (*)(Tcl_Obj *, int))((&(tclStubsPtr->tcl_PkgProvideEx))[61]))(objPtr, value))
+# undef Tcl_NewIntObj
+# define Tcl_NewIntObj(value) ((threadTclVersion>86)? \
+  ((Tcl_Obj * (*)(Tcl_WideInt))((&(tclStubsPtr->tcl_PkgProvideEx))[488]))((int)(value)): \
+  ((Tcl_Obj * (*)(int))((&(tclStubsPtr->tcl_PkgProvideEx))[52]))(value))
+# undef Tcl_GetUnicodeFromObj
+# define Tcl_GetUnicodeFromObj ((((&(tclStubsPtr->tcl_PkgProvideEx))[378]) != ((&(tclStubsPtr->tcl_PkgProvideEx))[434])) ? \
+  ((void (*)(Tcl_Obj *, int *))((&(tclStubsPtr->tcl_PkgProvideEx))[434])) : ((void (*)(Tcl_Obj *, int *)) NULL))
+#endif
+
+#endif /* _TCL_THREAD_INT_H_ */

pkgs/thread2.8.5/generic/tclXkeylist.h

@@ -0,0 +1,63 @@
+/*
+ * tclXkeylist.h --
+ *
+ * Extended Tcl keyed list commands and interfaces.
+ *-----------------------------------------------------------------------------
+ * Copyright 1991-1999 Karl Lehenbauer and Mark Diekhans.
+ *
+ * Permission to use, copy, modify, and distribute this software and its
+ * documentation for any purpose and without fee is hereby granted, provided
+ * that the above copyright notice appear in all copies.  Karl Lehenbauer and
+ * Mark Diekhans make no representations about the suitability of this
+ * software for any purpose.  It is provided "as is" without express or
+ * implied warranty.
+ *-----------------------------------------------------------------------------
+ */
+
+#ifndef _KEYLIST_H_
+#define _KEYLIST_H_
+
+#include "tclThreadInt.h"
+
+/*
+ * Keyed list object interface commands
+ */
+
+MODULE_SCOPE Tcl_Obj* TclX_NewKeyedListObj();
+
+MODULE_SCOPE void TclX_KeyedListInit(Tcl_Interp*);
+MODULE_SCOPE int  TclX_KeyedListGet(Tcl_Interp*, Tcl_Obj*, const char*, Tcl_Obj**);
+MODULE_SCOPE int  TclX_KeyedListSet(Tcl_Interp*, Tcl_Obj*, const char*, Tcl_Obj*);
+MODULE_SCOPE int  TclX_KeyedListDelete(Tcl_Interp*, Tcl_Obj*, const char*);
+MODULE_SCOPE int  TclX_KeyedListGetKeys(Tcl_Interp*, Tcl_Obj*, const char*, Tcl_Obj**);
+
+/*
+ * This is defined in keylist.c. We need it here
+ * to be able to plug-in our custom keyed-list
+ * object duplicator which produces proper deep
+ * copies of the keyed-list objects. The standard
+ * one produces shallow copies which are not good
+ * for usage in the thread shared variables code.
+ */
+
+MODULE_SCOPE Tcl_ObjType keyedListType;
+
+/*
+ * Exported for usage in Sv_DuplicateObj. This is slightly
+ * modified version of the DupKeyedListInternalRep() function.
+ * It does a proper deep-copy of the keyed list object.
+ */
+
+MODULE_SCOPE void DupKeyedListInternalRepShared(Tcl_Obj*, Tcl_Obj*);
+
+#endif /* _KEYLIST_H_ */
+
+/* EOF $RCSfile: tclXkeylist.h,v $ */
+
+/* Emacs Setup Variables */
+/* Local Variables:      */
+/* mode: C               */
+/* indent-tabs-mode: nil */
+/* c-basic-offset: 4     */
+/* End:                  */
+

pkgs/thread2.8.5/generic/threadNs.c

@@ -0,0 +1,88 @@
+/*
+ * threadNs.c --
+ *
+ * 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_GetString(Tcl_GetObjResult(interp)));
+        return TCL_ERROR;
+    }
+    Tcl_SetAssocData(interp, "thread:nsd", NULL, 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:                  */

pkgs/thread2.8.5/generic/threadSpCmd.h

@@ -0,0 +1,128 @@
+/*
+ * This is the header file for the module that implements some missing
+ * synchronization primitives from the Tcl API.
+ *
+ * Copyright (c) 2002 by Zoran Vasiljevic.
+ *
+ * See the file "license.txt" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ * ---------------------------------------------------------------------------
+ */
+
+#ifndef _SP_H_
+#define _SP_H_
+
+#include "tclThreadInt.h"
+
+/*
+ * The following structure defines a locking bucket. A locking
+ * bucket is associated with a mutex and protects access to
+ * objects stored in bucket hash table.
+ */
+
+typedef struct SpBucket {
+    Tcl_Mutex lock;            /* For locking the bucket */
+    Tcl_Condition cond;        /* For waiting on threads to release items */
+    Tcl_HashTable handles;     /* Hash table of given-out handles in bucket */
+} SpBucket;
+
+#define NUMSPBUCKETS 32
+
+/*
+ * All types of mutexes share this common part.
+ */
+
+typedef struct Sp_AnyMutex_ {
+    int lockcount;              /* If !=0 mutex is locked */
+    int numlocks;               /* Number of times the mutex got locked */
+    Tcl_Mutex lock;             /* Regular mutex */
+    Tcl_ThreadId owner;         /* Current lock owner thread (-1 = any) */
+} Sp_AnyMutex;
+
+/*
+ * Implementation of the exclusive mutex.
+ */
+
+typedef struct Sp_ExclusiveMutex_ {
+    int lockcount;              /* Flag: 1-locked, 0-not locked */
+    int numlocks;               /* Number of times the mutex got locked */
+    Tcl_Mutex lock;             /* Regular mutex */
+    Tcl_ThreadId owner;         /* Current lock owner thread */
+    /* --- */
+    Tcl_Mutex mutex;            /* Mutex being locked */
+} Sp_ExclusiveMutex_;
+
+typedef Sp_ExclusiveMutex_* Sp_ExclusiveMutex;
+
+/*
+ * Implementation of the recursive mutex.
+ */
+
+typedef struct Sp_RecursiveMutex_ {
+    int lockcount;              /* # of times this mutex is locked */
+    int numlocks;               /* Number of time the mutex got locked */
+    Tcl_Mutex lock;             /* Regular mutex */
+    Tcl_ThreadId owner;         /* Current lock owner thread */
+    /* --- */
+    Tcl_Condition cond;         /* Wait to be allowed to lock the mutex */
+} Sp_RecursiveMutex_;
+
+typedef Sp_RecursiveMutex_* Sp_RecursiveMutex;
+
+/*
+ * Implementation of the read/writer mutex.
+ */
+
+typedef struct Sp_ReadWriteMutex_ {
+    int lockcount;              /* >0: # of readers, -1: sole writer */
+    int numlocks;               /* Number of time the mutex got locked */
+    Tcl_Mutex lock;             /* Regular mutex */
+    Tcl_ThreadId owner;         /* Current lock owner thread */
+    /* --- */
+    unsigned int numrd;         /* # of readers waiting for lock */
+    unsigned int numwr;         /* # of writers waiting for lock */
+    Tcl_Condition rcond;        /* Reader lockers wait here */
+    Tcl_Condition wcond;        /* Writer lockers wait here */
+} Sp_ReadWriteMutex_;
+
+typedef Sp_ReadWriteMutex_* Sp_ReadWriteMutex;
+
+
+/*
+ * API for exclusive mutexes.
+ */
+
+MODULE_SCOPE int  Sp_ExclusiveMutexLock(Sp_ExclusiveMutex *mutexPtr);
+MODULE_SCOPE int  Sp_ExclusiveMutexIsLocked(Sp_ExclusiveMutex *mutexPtr);
+MODULE_SCOPE int  Sp_ExclusiveMutexUnlock(Sp_ExclusiveMutex *mutexPtr);
+MODULE_SCOPE void Sp_ExclusiveMutexFinalize(Sp_ExclusiveMutex *mutexPtr);
+
+/*
+ * API for recursive mutexes.
+ */
+
+MODULE_SCOPE int  Sp_RecursiveMutexLock(Sp_RecursiveMutex *mutexPtr);
+MODULE_SCOPE int  Sp_RecursiveMutexIsLocked(Sp_RecursiveMutex *mutexPtr);
+MODULE_SCOPE int  Sp_RecursiveMutexUnlock(Sp_RecursiveMutex *mutexPtr);
+MODULE_SCOPE void Sp_RecursiveMutexFinalize(Sp_RecursiveMutex *mutexPtr);
+
+/*
+ * API for reader/writer mutexes.
+ */
+
+MODULE_SCOPE int  Sp_ReadWriteMutexRLock(Sp_ReadWriteMutex *mutexPtr);
+MODULE_SCOPE int  Sp_ReadWriteMutexWLock(Sp_ReadWriteMutex *mutexPtr);
+MODULE_SCOPE int  Sp_ReadWriteMutexIsLocked(Sp_ReadWriteMutex *mutexPtr);
+MODULE_SCOPE int  Sp_ReadWriteMutexUnlock(Sp_ReadWriteMutex *mutexPtr);
+MODULE_SCOPE void Sp_ReadWriteMutexFinalize(Sp_ReadWriteMutex *mutexPtr);
+
+#endif /* _SP_H_ */
+
+/* EOF $RCSfile: threadSpCmd.h,v $ */
+
+/* Emacs Setup Variables */
+/* Local Variables:      */
+/* mode: C               */
+/* indent-tabs-mode: nil */
+/* c-basic-offset: 4     */
+/* End:                  */

pkgs/thread2.8.5/generic/threadSvCmd.h

@@ -0,0 +1,225 @@
+/*
+ * This is the header file for the module that implements shared variables.
+ * for protected multithreaded access.
+ *
+ * Copyright (c) 2002 by Zoran Vasiljevic.
+ *
+ * See the file "license.txt" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ * ---------------------------------------------------------------------------
+ */
+
+#ifndef _SV_H_
+#define _SV_H_
+
+#include <tcl.h>
+#include <ctype.h>
+#include <string.h>
+
+#include "threadSpCmd.h" /* For recursive locks */
+
+/*
+ * Uncomment following line to get command-line
+ * 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 */
+#define FLAGS_NOERRMSG     2   /* Do not format error message */
+#define FLAGS_CREATEVAR    4   /* Create the array variable if none found */
+
+/*
+ * Macros for handling locking and unlocking
+ */
+#define LOCK_BUCKET(a)      Sp_RecursiveMutexLock(&(a)->lock)
+#define UNLOCK_BUCKET(a)    Sp_RecursiveMutexUnlock(&(a)->lock)
+
+#define LOCK_CONTAINER(a)   Sp_RecursiveMutexLock(&(a)->bucketPtr->lock)
+#define UNLOCK_CONTAINER(a) Sp_RecursiveMutexUnlock(&(a)->bucketPtr->lock)
+
+/*
+ * This is named synetrically to LockArray as function
+ * rather than as a macro just to improve readability.
+ */
+
+#define UnlockArray(a) UNLOCK_CONTAINER(a)
+
+/*
+ * Mode for Sv_PutContainer, so it knows what
+ * happened with the embedded shared object.
+ */
+
+#define SV_UNCHANGED       0   /* Object has not been modified */
+#define SV_CHANGED         1   /* Object has been modified */
+#define SV_ERROR          -1   /* Object may be in incosistent state */
+
+/*
+ * Definitions of functions implementing simple key/value
+ * persistent storage for shared variable arrays.
+ */
+
+typedef ClientData (ps_open_proc)(const char*);
+
+typedef int (ps_get_proc)   (ClientData, const char*, char**, size_t*);
+typedef int (ps_put_proc)   (ClientData, const char*, char*, size_t);
+typedef int (ps_first_proc) (ClientData, char**, char**, size_t*);
+typedef int (ps_next_proc)  (ClientData, char**, char**, size_t*);
+typedef int (ps_delete_proc)(ClientData, const char*);
+typedef int (ps_close_proc) (ClientData);
+typedef void(ps_free_proc)  (ClientData, void*);
+
+typedef const char* (ps_geterr_proc)(ClientData);
+
+/*
+ * This structure maintains a bunch of pointers to functions implementing
+ * the simple persistence layer for the shared variable arrays.
+ */
+
+typedef struct PsStore {
+    const char *type;          /* Type identifier of the persistent storage */
+    ClientData psHandle;       /* Handle to the opened storage */
+    ps_open_proc   *psOpen;    /* Function to open the persistent key store */
+    ps_get_proc    *psGet;     /* Function to retrieve value bound to key */
+    ps_put_proc    *psPut;     /* Function to store user key and value */
+    ps_first_proc  *psFirst;   /* Function to retrieve the first key/value */
+    ps_next_proc   *psNext;    /* Function to retrieve the next key/value */
+    ps_delete_proc *psDelete;  /* Function to delete user key and value */
+    ps_close_proc  *psClose;   /* Function to close the persistent store */
+    ps_free_proc   *psFree;    /* Fuction to free allocated memory */
+    ps_geterr_proc *psError;   /* Function to return last store error */
+    struct PsStore *nextPtr;   /* For linking into linked lists */
+} PsStore;
+
+/*
+ * The following structure defines a collection of arrays.
+ * Only the arrays within a given bucket share a lock,
+ * allowing for more concurency.
+ */
+
+typedef struct Bucket {
+    Sp_RecursiveMutex lock;    /* */
+    Tcl_HashTable arrays;      /* Hash table of all arrays in bucket */
+    Tcl_HashTable handles;     /* Hash table of given-out handles in bucket */
+    struct Container *freeCt;  /* List of free Tcl-object containers */
+} Bucket;
+
+/*
+ * The following structure maintains the context for each variable array.
+ */
+
+typedef struct Array {
+    char *bindAddr;            /* Array is bound to this address */
+    PsStore *psPtr;            /* Persistent storage functions */
+    Bucket *bucketPtr;         /* Array bucket. */
+    Tcl_HashEntry *entryPtr;   /* Entry in bucket array table. */
+    Tcl_HashEntry *handlePtr;  /* Entry in handles table */
+    Tcl_HashTable vars;        /* Table of variables. */
+} Array;
+
+/*
+ * The object container for Tcl-objects stored within shared arrays.
+ */
+
+typedef struct Container {
+    Bucket *bucketPtr;         /* Bucket holding the array below */
+    Array *arrayPtr;           /* Array with the object container*/
+    Tcl_HashEntry *entryPtr;   /* Entry in array table. */
+    Tcl_HashEntry *handlePtr;  /* Entry in handles table */
+    Tcl_Obj *tclObj;           /* Tcl object to hold shared values */
+    int epoch;                 /* Track object changes */
+    char *chunkAddr;           /* Address of one chunk of object containers */
+    struct Container *nextPtr; /* Next object container in the free list */
+    int aolSpecial;
+} Container;
+
+/*
+ * 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 */
+    int aolSpecial;
+} 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.
+ * While this is considered to be ok in single-threaded apps,
+ * a multithreaded app could have problems when accessing objects
+ * which live in (i.e. are accessed from) different interpreters.
+ * So, for each object type which should be stored in shared object
+ * pools, we must assure that the object is copied properly.
+ */
+
+typedef struct RegType {
+    const Tcl_ObjType *typePtr;       /* Type of the registered object */
+    Tcl_DupInternalRepProc *dupIntRepProc; /* Special deep-copy duper */
+    struct RegType *nextPtr;    /* Next in chain of registered types */
+} RegType;
+
+/*
+ * Limited API functions
+ */
+
+MODULE_SCOPE void
+Sv_RegisterCommand(const char*,Tcl_ObjCmdProc*,Tcl_CmdDeleteProc*, int);
+
+MODULE_SCOPE void
+Sv_RegisterObjType(const Tcl_ObjType*, Tcl_DupInternalRepProc*);
+
+MODULE_SCOPE void
+Sv_RegisterPsStore(const PsStore*);
+
+MODULE_SCOPE int
+Sv_GetContainer(Tcl_Interp*,int,Tcl_Obj*const objv[],Container**,int*,int);
+
+MODULE_SCOPE int
+Sv_PutContainer(Tcl_Interp*, Container*, int);
+
+/*
+ * Private version of Tcl_DuplicateObj which takes care about
+ * copying objects when loaded to and retrieved from shared array.
+ */
+
+MODULE_SCOPE Tcl_Obj* Sv_DuplicateObj(Tcl_Obj*);
+
+#endif /* _SV_H_ */
+
+/* EOF $RCSfile: threadSvCmd.h,v $ */
+
+/* Emacs Setup Variables */
+/* Local Variables:      */
+/* mode: C               */
+/* indent-tabs-mode: nil */
+/* c-basic-offset: 4     */
+/* End:                  */
+

pkgs/thread2.8.5/generic/threadSvKeylistCmd.c

@@ -0,0 +1,349 @@
+/*
+ * threadSvKeylist.c --
+ *
+ * This file implements keyed-list commands as part of the thread
+ * shared variable implementation.
+ *
+ * Keyed list implementation is borrowed from Mark Diekhans and
+ * Karl Lehenbauer "TclX" (extended Tcl) extension. Please look
+ * into the keylist.c file for more information.
+ *
+ * See the file "license.txt" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ * ---------------------------------------------------------------------------
+ */
+
+#include "threadSvCmd.h"
+#include "threadSvKeylistCmd.h"
+#include "tclXkeylist.h"
+
+/*
+ * Wrapped keyed-list commands
+ */
+
+static Tcl_ObjCmdProc SvKeylsetObjCmd;
+static Tcl_ObjCmdProc SvKeylgetObjCmd;
+static Tcl_ObjCmdProc SvKeyldelObjCmd;
+static Tcl_ObjCmdProc SvKeylkeysObjCmd;
+
+/*
+ * This mutex protects a static variable which tracks
+ * registration of commands and object types.
+ */
+
+static Tcl_Mutex initMutex;
+
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * Sv_RegisterKeylistCommands --
+ *
+ *      Register shared variable commands for TclX keyed lists.
+ *
+ * Results:
+ *      A standard Tcl result.
+ *
+ * Side effects:
+ *      Memory gets allocated
+ *
+ *-----------------------------------------------------------------------------
+ */
+void
+Sv_RegisterKeylistCommands(void)
+{
+    static int initialized;
+
+    if (initialized == 0) {
+        Tcl_MutexLock(&initMutex);
+        if (initialized == 0) {
+            Sv_RegisterCommand("keylset",  SvKeylsetObjCmd,  NULL, 0);
+            Sv_RegisterCommand("keylget",  SvKeylgetObjCmd,  NULL, 0);
+            Sv_RegisterCommand("keyldel",  SvKeyldelObjCmd,  NULL, 0);
+            Sv_RegisterCommand("keylkeys", SvKeylkeysObjCmd, NULL, 0);
+            Sv_RegisterObjType(&keyedListType, DupKeyedListInternalRepShared);
+            initialized = 1;
+        }
+        Tcl_MutexUnlock(&initMutex);
+    }
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * SvKeylsetObjCmd --
+ *
+ *      This procedure is invoked to process the "tsv::keylset" command.
+ *      See the user documentation for details on what it does.
+ *
+ * Results:
+ *      A standard Tcl result.
+ *
+ * Side effects:
+ *      See the user documentation.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static int
+SvKeylsetObjCmd(
+    void *arg,                         /* Not used. */
+    Tcl_Interp *interp,                /* Current interpreter. */
+    int objc,                          /* Number of arguments. */
+    Tcl_Obj *const objv[]              /* Argument objects. */
+) {
+    int i, off, ret, flg;
+    char *key;
+    Tcl_Obj *val;
+    Container *svObj = (Container*)arg;
+
+    /*
+     * Syntax:
+     *          sv::keylset array lkey key value ?key value ...?
+     *          $keylist keylset key value ?key value ...?
+     */
+
+    flg = FLAGS_CREATEARRAY | FLAGS_CREATEVAR;
+    ret = Sv_GetContainer(interp, objc, objv, &svObj, &off, flg);
+    if (ret != TCL_OK) {
+        return TCL_ERROR;
+    }
+    if ((objc - off) < 2 || ((objc - off) % 2)) {
+        Tcl_WrongNumArgs(interp, off, objv, "key value ?key value ...?");
+        goto cmd_err;
+    }
+    for (i = off; i < objc; i += 2) {
+        key = Tcl_GetString(objv[i]);
+        val = Sv_DuplicateObj(objv[i+1]);
+        ret = TclX_KeyedListSet(interp, svObj->tclObj, key, val);
+        if (ret != TCL_OK) {
+            goto cmd_err;
+        }
+    }
+
+    return Sv_PutContainer(interp, svObj, SV_CHANGED);
+
+ cmd_err:
+    return Sv_PutContainer(interp, svObj, SV_ERROR);
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * SvKeylgetObjCmd --
+ *
+ *      This procedure is invoked to process the "tsv::keylget" command.
+ *      See the user documentation for details on what it does.
+ *
+ * Results:
+ *      A standard Tcl result.
+ *
+ * Side effects:
+ *      See the user documentation.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static int
+SvKeylgetObjCmd(
+    void *arg,                         /* Not used. */
+    Tcl_Interp *interp,                /* Current interpreter. */
+    int objc,                          /* Number of arguments. */
+    Tcl_Obj *const objv[]              /* Argument objects. */
+) {
+    int ret, flg, off;
+    char *key;
+    Tcl_Obj *varObjPtr = NULL, *valObjPtr = NULL;
+    Container *svObj = (Container*)arg;
+
+    /*
+     * Syntax:
+     *          sv::keylget array lkey ?key? ?var?
+     *          $keylist keylget ?key? ?var?
+     */
+
+    flg = FLAGS_CREATEARRAY | FLAGS_CREATEVAR;
+    ret = Sv_GetContainer(interp, objc, objv, &svObj, &off, flg);
+    if (ret != TCL_OK) {
+        return TCL_ERROR;
+    }
+    if ((objc - off) > 2) {
+        Tcl_WrongNumArgs(interp, off, objv, "?key? ?var?");
+        goto cmd_err;
+    }
+    if ((objc - off) == 0) {
+        if (Sv_PutContainer(interp, svObj, SV_UNCHANGED) != TCL_OK) {
+            return TCL_ERROR;
+        }
+        return SvKeylkeysObjCmd(arg, interp, objc, objv);
+    }
+    if ((objc - off) == 2) {
+        varObjPtr = objv[off+1];
+    } else {
+        varObjPtr = NULL;
+    }
+
+    key = Tcl_GetString(objv[off]);
+    ret = TclX_KeyedListGet(interp, svObj->tclObj, key, &valObjPtr);
+    if (ret == TCL_ERROR) {
+        goto cmd_err;
+    }
+
+    if (ret == TCL_BREAK) {
+        if (varObjPtr) {
+            Tcl_SetObjResult(interp, Tcl_NewIntObj(0));
+        } else {
+            Tcl_AppendResult (interp, "key \"", key, "\" not found", NULL);
+            goto cmd_err;
+        }
+    } else {
+        Tcl_Obj *resObjPtr = Sv_DuplicateObj(valObjPtr);
+        if (varObjPtr) {
+            Tcl_SetObjResult(interp, Tcl_NewIntObj(1));
+            Tcl_GetString(varObjPtr);
+            if (varObjPtr->length) {
+                Tcl_ObjSetVar2(interp, varObjPtr, NULL, resObjPtr, 0);
+            }
+        } else {
+            Tcl_SetObjResult(interp, resObjPtr);
+        }
+    }
+
+    return Sv_PutContainer(interp, svObj, SV_UNCHANGED);
+
+ cmd_err:
+    return Sv_PutContainer(interp, svObj, SV_ERROR);
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * SvKeyldelObjCmd --
+ *
+ *      This procedure is invoked to process the "tsv::keyldel" command.
+ *      See the user documentation for details on what it does.
+ *
+ * Results:
+ *      A standard Tcl result.
+ *
+ * Side effects:
+ *      See the user documentation.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static int
+SvKeyldelObjCmd(
+    void *arg,                         /* Not used. */
+    Tcl_Interp *interp,                /* Current interpreter. */
+    int objc,                          /* Number of arguments. */
+    Tcl_Obj *const objv[]              /* Argument objects. */
+) {
+    int i, off, ret;
+    char *key;
+    Container *svObj = (Container*)arg;
+
+    /*
+     * Syntax:
+     *          sv::keyldel array lkey key ?key ...?
+     *          $keylist keyldel ?key ...?
+     */
+
+    ret = Sv_GetContainer(interp, objc, objv, &svObj, &off, 0);
+    if (ret != TCL_OK) {
+        return TCL_ERROR;
+    }
+    if ((objc - off) < 1) {
+        Tcl_WrongNumArgs(interp, off, objv, "key ?key ...?");
+        goto cmd_err;
+    }
+    for (i = off; i < objc; i++) {
+        key = Tcl_GetString(objv[i]);
+        ret = TclX_KeyedListDelete(interp, svObj->tclObj, key);
+        if (ret == TCL_BREAK) {
+            Tcl_AppendResult(interp, "key \"", key, "\" not found", NULL);
+        }
+        if (ret == TCL_BREAK || ret == TCL_ERROR) {
+            goto cmd_err;
+        }
+    }
+
+    return Sv_PutContainer(interp, svObj, SV_CHANGED);
+
+ cmd_err:
+    return Sv_PutContainer(interp, svObj, SV_ERROR);
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * SvKeylkeysObjCmd --
+ *
+ *      This procedure is invoked to process the "tsv::keylkeys" command.
+ *      See the user documentation for details on what it does.
+ *
+ * Results:
+ *      A standard Tcl result.
+ *
+ * Side effects:
+ *      See the user documentation.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static int
+SvKeylkeysObjCmd(
+    void *arg,                         /* Not used. */
+    Tcl_Interp *interp,                /* Current interpreter. */
+    int objc,                          /* Number of arguments. */
+    Tcl_Obj *const objv[]              /* Argument objects. */
+) {
+    int ret, off;
+    char *key = NULL;
+    Tcl_Obj *listObj = NULL;
+    Container *svObj = (Container*)arg;
+
+    /*
+     * Syntax:
+     *          sv::keylkeys array lkey ?key?
+     *          $keylist keylkeys ?key?
+     */
+
+    ret = Sv_GetContainer(interp, objc, objv, &svObj, &off, 0);
+    if (ret != TCL_OK) {
+        return TCL_ERROR;
+    }
+    if ((objc - off) > 1) {
+         Tcl_WrongNumArgs(interp, 1, objv, "?lkey?");
+         goto cmd_err;
+    }
+    if ((objc - off) == 1) {
+        key = Tcl_GetString(objv[off]);
+    }
+
+    ret = TclX_KeyedListGetKeys(interp, svObj->tclObj, key, &listObj);
+
+    if (key && ret == TCL_BREAK) {
+        Tcl_AppendResult(interp, "key \"", key, "\" not found", NULL);
+    }
+    if (ret == TCL_BREAK || ret == TCL_ERROR) {
+        goto cmd_err;
+    }
+
+    Tcl_SetObjResult (interp, listObj); /* listObj allocated by API !*/
+
+    return Sv_PutContainer(interp, svObj, SV_UNCHANGED);
+
+ cmd_err:
+    return Sv_PutContainer(interp, svObj, SV_ERROR);
+}
+
+/* EOF $RCSfile: threadSvKeylistCmd.c,v $ */
+
+/* Emacs Setup Variables */
+/* Local Variables:      */
+/* mode: C               */
+/* indent-tabs-mode: nil */
+/* c-basic-offset: 4     */
+/* End:                  */
+

pkgs/thread2.8.5/generic/threadSvKeylistCmd.h

@@ -0,0 +1,27 @@
+/*
+ * threadSvKeylistCmd.h --
+ *
+ * See the file "license.txt" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ * ---------------------------------------------------------------------------
+ */
+
+#ifndef _KEYLISTCMDS_H_
+#define _KEYLISTCMDS_H_
+
+#include "tclThreadInt.h"
+
+MODULE_SCOPE void Sv_RegisterKeylistCommands(void);
+MODULE_SCOPE void TclX_KeyedListInit(Tcl_Interp *interp);
+
+#endif /* _KEYLISTCMDS_H_ */
+
+/* EOF $RCSfile: threadSvKeylistCmd.h,v $ */
+
+/* Emacs Setup Variables */
+/* Local Variables:      */
+/* mode: C               */
+/* indent-tabs-mode: nil */
+/* c-basic-offset: 4     */
+/* End:                  */
+

pkgs/thread2.8.5/generic/threadSvListCmd.h

@@ -0,0 +1,24 @@
+/*
+ * Copyright (c) 2002 by Zoran Vasiljevic.
+ *
+ * See the file "license.txt" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ * ---------------------------------------------------------------------------
+ */
+
+#ifndef _SV_LIST_H_
+#define _SV_LIST_H_
+
+MODULE_SCOPE void Sv_RegisterListCommands();
+
+#endif /* _SV_LIST_H_ */
+
+/* EOF $RCSfile: threadSvListCmd.h,v $ */
+
+/* Emacs Setup Variables */
+/* Local Variables:      */
+/* mode: C               */
+/* indent-tabs-mode: nil */
+/* c-basic-offset: 4     */
+/* End:                  */
+