diff options
| author | William Joye <wjoye@cfa.harvard.edu> | 2018-12-25 17:48:54 (GMT) |
|---|---|---|
| committer | William Joye <wjoye@cfa.harvard.edu> | 2018-12-25 17:48:54 (GMT) |
| commit | 8eb0f61e2e27ef6594eee8bcf68d574fb087fe66 (patch) | |
| tree | fc0f3692516c8c3e8090df20223d342a1b64df93 /tcl8.6/pkgs/thread2.8.4 | |
| parent | 5f5fd2864a3193a8d5da12fcb92ba7379084c286 (diff) | |
| download | blt-8eb0f61e2e27ef6594eee8bcf68d574fb087fe66.zip blt-8eb0f61e2e27ef6594eee8bcf68d574fb087fe66.tar.gz blt-8eb0f61e2e27ef6594eee8bcf68d574fb087fe66.tar.bz2 | |
update tcl/tk
Diffstat (limited to 'tcl8.6/pkgs/thread2.8.4')
75 files changed, 49303 insertions, 0 deletions
diff --git a/tcl8.6/pkgs/thread2.8.4/ChangeLog b/tcl8.6/pkgs/thread2.8.4/ChangeLog new file mode 100644 index 0000000..79452cc --- /dev/null +++ b/tcl8.6/pkgs/thread2.8.4/ChangeLog @@ -0,0 +1,1914 @@ +2016-06-03 Pietro Cerutti <gahr@gahr.ch> + + * doc/*: Bump version to 2.8 in docs [Tkt b35544d2c8] + +2016-06-03 Pietro Cerutti <gahr@gahr.ch> + + * generic/threadCmd.c: Add parenthesis to bit-shift macros [Tkt 957dbe231c] + +2016-05-31 Pietro Cerutti <gahr@gahr.ch> + + * generic/threadSvCmd.c: Implement [tsv::handlers] command [Tkt 72b8ee4c76] + * doc/html/tsv.html + * doc/man/tsv.n + * doc/tsv.man + * tests/tsv.test + +2016-05-31 Pietro Cerutti <gahr@gahr.ch> + + * generic/threadCmd.c: Add status arg to [thread::exit] [Tkt 3407860fff] + * tests/thread.test + * doc/thread.man + * doc/man/thread.n + * doc/html/thread.html + +2016-05-18 Pietro Cerutti <gahr@gahr.ch> + + * generic/threadSvCmd.c: Fix race condition in thread finalization routine + [Tkt 3532972fff] + * tests/tkt-84be1b5a73.test: Add a test for [Tkt 84be1b5a73] + +2016-05-17 Pietro Cerutti <gahr@gahr.ch> + + * generic/threadCmd.c: Fix -async and result trace [Tkt 84be1b5a73] + * doc/thread.man: Remove "id" arg from [thread::broadcast]'s manpage + * doc/man/thread.n: Regenerate documentation + * doc/html/thread.html + +2016-05-13 Pietro Cerutti <gahr@gahr.ch> + + * aclocal.m4: Add support for LMDB persistent storage [Tkt 9378bb6795] + * configure + * configure.ac + * doc/html/tsv.html + * doc/man/tsv.n + * doc/tsv.man + * generic/psGdbm.c + * generic/psLmdb.c + * generic/psLmdb.h + * generic/threadSvCmd.c + * generic/threadSvCmd.h + * tests/French.txt version + * tests/store-load.tcl + * tests/tsv.test + + * generic/tclThreadInt.h: Use spaces for indentation everywhere + * generic/tclXkeylist.c + * generic/threadCmd.c + * generic/threadNs.c + * generic/threadSpCmd.c + * generic/threadSpCmd.h + * generic/threadSvCmd.c + +2016-04-20 Pietro Cerutti <gahr@gahr.ch> + + * configure, aclocal.m4: Correctly handle --without-gdbm [Tkt f8ff429a39] + * doc/tsv.man: Document side-effect of [tsv::array unbind] [Tkt be135da5f9] + * doc/*.(html|n): Regenerate documentation [Tkt 41922d3bb7] + * generic/threadSvCmd.c: Avoid double query to persistent storage in + tsv::array bind [Tkt a135697d8c] + +2013-05-23 Jan Nijtmans <nijtmans@users.sf.net> + + * generic/threadSvKeylistCmd.c: Change a few internal variable + * generic/threadSvListCmd.c: from type int to type size_t. + * generic/threadCmd.c: Simplify determination of whether + Tcl is compiled with thread support. + * configure: re-generate with latest TEA. + +2012-12-21 Jan Nijtmans <nijtmans@users.sf.net> + + * generic/tclThreadInt.h: Add runtime detection of Tcl_AddErrorInfo + * generic/*.c: vs. Tcl_AppendObjToErrorInfo and Tcl_GetErrorLine vs. + interp->errorLine. + +2012-12-16 Jan Nijtmans <nijtmans@users.sf.net> + + * generic/*.c: Rename Tcl_Free -> ckfree and Tcl_Alloc -> ckalloc, + which allows a debug build of Thread use the debug versions of + those functions. + +2012-12-13 Jan Nijtmans <nijtmans@users.sf.net> + + * generic/threadCmd.c: Tcl_Free cannot be used directly as + freeProc (will break in "novem"), so use a small wrapper. + +2012-11-08 Don Porter <dgp@users.sourceforge.net> + + *** 2.7.0 TAGGED FOR RELEASE (thread-2-7-0) *** + + * README: Update for stable release. + +2012-11-14 Jan Nijtmans <nijtmans@users.sf.net> + + * generic/threadCmd.c: Move back test for core threaded functionality + * pkgIndex.tcl.in: from pkgIndex.tcl to threadCmd.c, so it cannot + be escaped any more. + +2012-11-13 Joe Mistachkin <joe@mistachkin.com> + + * generic/threadCmd.c: merge compileTipCheck to trunk. Additional + functionality to switch off TIP 143/285 functionality for static + builds. + +2012-11-10 Zoran Vasiljevic <zv@archiware.com> + + * genric/threadCmd.c: fixed race condition on + thread-local storage in ThreadCancel(). + +2012-11-10 Zoran Vasiljevic <zv@archiware.com> + + *** Merged "thread-2-7for84+" branch *** + +2012-11-08 Don Porter <dgp@users.sourceforge.net> + + * configure.in: Bump to version 2.7.0 + * lib/ttrace.tcl: + * win/pkg.vc: + +2012-09-13 Zoran Vasiljevic <zv@archiware.com> + + *** 2.7b1 TAGGED FOR RELEASE (thread-2-7-b1) *** + + * doc/html/tpool.html + * doc/man/tpool.n + * doc/tpool.man: fixed "tpool::create -idletime" description + [Tcl Bug 3534442] + + * generic/threadSpCmd.h + * generic/threadSvCmd.h: removed some unused structure members + [Tcl Feature Request 3563391] + +2012-09-11 Jan Nijtmans <nijtmans@users.sf.net> + + * Makefile.in: Use "::tcltest::loadTestedCommands" to make + * tests/all.tcl: sure that the right Thread version is tested, + * tests/thread.test: without requiring explicit version numbers + +2012-08-29 Jan Nijtmans <nijtmans@users.sf.net> + + * generic/*.c: Remove all (deprecated) usages of + _ANSI_ARGS_ and TCL_PARSE_PART1 + * generic/threadSpCmd.c: Fix [Tcl Bug #3562640]: problem loading Thread + * generic/threadSvCmd.c: in 8.5, when compiled for 8.6. + * win/makefile.vc + * Makefile.in + +2012-07-17 Jan Nijtmans <nijtmans@users.sf.net> + + * win/makefile.vc: [Bug 3544932]: Visual studio compiler check fails + +2012-07-05 Zoran Vasiljevic <zv@archiware.com> + + * generic/threadCmd.c: Fixed leaking callback data in ThreadSend() + plus some minor cosmetic changes (tx to Gustaf Neumann). + +2012-07-03 Zoran Vasiljevic <zv@archiware.com> + + * generic/threadPoolCmd.c: [Bugs 3534440, 3534581] fixed. + Also, promoted jobId to be Tcl_WideInt (was uint). + +2012-04-26 Don Porter <dgp@users.sourceforge.net> + + * generic/threadSpCmd.c: Eliminate some tricky finalization + problems by converting the SpBucket arrays from dynamic storage to + static storage so they no longer need to be finalized. Since they + have fixed size of NUMSPBUCKETS, I don't see any strong reason not + to do this. + +2012-04-24 Don Porter <dgp@users.sourceforge.net> + + * generic/threadCmd.c: [Bug 1603234] Stop leak in [thread::transfer]. + +2011-12-05 Joe Mistachkin <joe@mistachkin.com> + + * generic/threadCmd.c: Fix #define issue when compiling for Tcl 8.5. + +2011-11-24 Jan Nijtmans <nijtmans@users.sourceforge.net> + + * generic/tclThread.h: Only export Thread_Init(), nothing more. + * generic/tclXkeylist.h + * generic/threadSpCmd.h + * generic/threadSvCmd.h + * generic/threadSvCmd.c + * generic/threadSvKeylistCmd.h + * generic/threadSvListCmd.h + +2011-11-20 Joe Mistachkin <joe@mistachkin.com> + + * generic/threadCmd.c: Correct check for current thread in the + ThreadReserve function [Bug 3411244]. Correct the order for releasing + the interpreter and freeing memory, see check-in [6067508840]. + +2011-11-17 Joe Mistachkin <joe@mistachkin.com> + + * generic/threadCmd.c: Refactor ThreadEventProc to make sure all paths + out of the function call Tcl_Release on the necessary Tcl interpreters. + Also, call ThreadErrorProc consistently whenever the return code is not + TCL_OK (i.e. do not check for it to be equal to TCL_ERROR). + +2011-11-17 Joe Mistachkin <joe@mistachkin.com> + + * generic/threadCmd.c: The [thread::wait] command should use the + TCL_CANCEL_UNWIND flag when calling Tcl_Canceled because it manages its + own event processing loop. Also, if the event processing loop is + terminated due to a script in progress being canceled or exceeding a + runtime limit, the registered error script should be evaluated, if any. + +2011-11-17 Joe Mistachkin <joe@mistachkin.com> + + * generic/threadCmd.c: The [thread::wait] command must cooperate with + the interpreter resource limiting (TIP #143) and asynchronous script + cancellation (TIP #285) functionality, when available. + +2011-11-17 Joe Mistachkin <joe@mistachkin.com> + + * generic/threadCmd.c: For [thread::cancel], avoid creating a new + Tcl_Obj when the default script cancellation result is desired. + + * doc/thread.man: Update all remaining versions to 2.7b1. + * doc/tpool.man: + * doc/tsv.man: + * doc/ttrace.man: + * lib/ttrace.tcl: + * win/vc/pkg.vc: + * win/vc/thread_win.dsp: + + * win/vc/makefile.vc: Stop using -debug:full as it causes an error + with the MSVC10 compiler. + +2011-09-12 Joe Mistachkin <joe@mistachkin.com> + + * generic/threadCmd.c: Add support for TIP #285 (asynchronous script + cancellation) via a new [thread::cancel] command (available only for + Tcl 8.6). + * win/vc/makefile.vc: Correct path to root of source checkout. + +2011-08-01 Don Porter <dgp@users.sourceforge.net> + + * win/vc/rules.vc: Extend support to MSVC10. Thanks to Twylite. + +2011-06-27 Don Porter <dgp@users.sourceforge.net> + + * configure.in: Copied revisions from the "sampleextension" package + * Makefile.in: to keep compatible with the latest INSTALL changes + in TEA 3.9. + * configure: autoconf-2.59 + +2010-12-08 Zoran Vasiljevic <zv@archiware.com> + + * generic/threadCmd.c: Fixed Bug #3129844 + +2010-11-18 Don Porter <dgp@users.sourceforge.net> + + * Makefile.in: Revised the `make dist` target so that the + * win/README.txt: files under thread/win/vc in CVS are copied to + * win/vc/makefile.vc: thread/win in the release, where tcl/pkgs/ + * win/vc/thread_win.dsp: expects to find them. + + * configure: autoconf-2.59 + +2010-10-04 Zoran Vasiljevic <zv@archiware.com> + + * generic/configure Regenrated for TEA 3.9. Bumped version string + * generic/configiue.in in all relevant files to 2.6.7 and autoconf'ed. + * win/vc/pkg.vc + +2010-09-28 Zoran Vasiljevic <zv@archiware.com> + + * generic/threadCmd.c: Initialize tsdPtr->interp to NULL immediately after + releasing the interp on thread-exit that should hopefully resolve the + Tcl Bug #3026061 + + * generic/threadCmd.c: Removed safe-init so safe-interps should not be + able to run thread commands directly. + + * lib/ttrace.tcl: Changed version to 2.6.7 to be in sync with main pkg. + + * configure.in: Bumped version to 2.6.7 and autoconf'ed. + +2010-09-05 Donal K. Fellows <dkf@users.sf.net> + + * doc/tpool.man, doc/tsv.man: Remove spaces in titledesc declaration; + doctools currently does not like it at all when generating correct + nroff output. + +2010-08-12 Andreas Kupries <andreask@activestate.com> + + * lib/ttrace.tcl (_serializensp, _serializeproc): Fixed typos which + smashed namespace name and opening brace of a script together, leading + to a syntax error for 'namespace eval' and preventing the use of + package Ttrace. + +2010-07-25 Donal K. Fellows <dkf@users.sf.net> + + * lib/ttrace.tcl: [Bug 3033206]: Be careful with variables outside of + procedures; Tcl's variable resolution rules can jump in if a variable + is not declared, which can be at best surprising. + Also rewrote the namespace serialization code to be more robust. + +2010-05-31 Andreas Kupries <andreask@activestate.com> + + * pkgIndex.tcl.in: Fixed procedure collisions for Thread package by + inlining the load command into the ifneeded script, as is standard for + most binary packages. Tweaked the procedure for Ttrace a bit, as the + result of [info commands] is a list, and using ::apply when possible. + A named procedure is only a fallback. + +2010-05-27 Andreas Kupries <andreask@activestate.com> + + * lib/ttrace.tcl: Resynchronized version number with Thread. + +2010-05-26 Andreas Kupries <andreask@activestate.com> + + * generic/threadSpCmd.c (ThreadMutexObjCmd, ThreadRWMutexObjCmd): + [Bug 3007426]: Dropped trailing commas in enum definitions which + choked the strictly C89 AIX compiler. + +2010-04-01 Zoran Vasiljevic <zv@archiware.com> + + * generic/tclXkeylist.c: Removed declaration of global TclX keylist + commands. + +2010-03-30 Zoran Vasiljevic <zv@archiware.com> + + *** 2.6.6 TAGGED FOR RELEASE (thread-2-6-6) *** + + * configure: Redo for TEA 3.7 + * configure.in: + + * generic/tclThread.h: Cosmetic changes for the inclusion + * generic/threadCmd.c: in standard Tcl distribution. + * generic/threadPoolCmd.c: + * generic/threadSpCmd.c: + * generic/threadSvCmd.c: + * generic/threadSvCmd.h: + +2010-03-19 Jan Nijtmans <nijtmans@users.sourceforge.net> + + * generic/threadSpCmd.c: Silence gcc warning: dereferencing + * .cvsignore: type-punned pointer will break + strict-aliasing rules. + * configure: Regenerated using latest TEA + +2009-08-19 Zoran Vasiljevic <zv@archiware.com> + + * generic/threadPoolCmd.c: Implemented [tpool::suspend] + * doc/tpool.man: and [tpool::resume] commands + as per [RFE #2835615]. + Also fixed [Bug #2833864]. + +2009-07-22 Jan Nijtmans <nijtmans@users.sourceforge.net> + + * generic/tclThread.h: Remove unnecessary ';'s + * generic/tclXkeylist.c: Constify remaining of thread extension, + * generic/tclXkeylist.h: bringing it at the same level as Tcl 8.6 + * generic/threadCmd.c: + * generic/threadPoolCmd.c: + * generic/threadSpCmd.c: + * generic/threadSvCmd.c: + * generic/threadSvCmd.h: + * generic/threadSvKeylistCmd.c: + * generic/threadSvKeylistCmd.h: + * generic/threadSvListCmd.c: + +2009-07-16 Alexandre Ferrieux <ferrieux@sourceforge.net> + + * generic/tclXkeylist.c: Constify Tcl_ObjGetType return values to + * generic/threadSvCmd.c: get rid of const warnings; #if 0 of + * generic/threadSvCmd.h: SvFinalize which is unused. + +2009-05-04 Pat Thoyts <patthoyts@users.sourceforge.net> + + * win/vc/makefile.vc: Updated the MSVC build to work with MSCV 8 + * win/vc/rules.vc: and 9 on both intel and amd64 targets. + * win/vc/nmakehlp.c: + +2009-05-03 Alexandre Ferrieux <ferrieux@sourceforge.net> + + * generic/threadSpCmd.c: Reorder things in RemoveMutex and RemoveCondv + [Bugs 2511424,2511408]; fix a Put* leak in an error path of rwmutexes + [Bug 2511420]. + +2008-12-03 Jeff Hobbs <jeffh@ActiveState.com> + + * generic/threadSvCmd.c: Handle TIP#336 addition of API to access + * generic/threadSpCmd.c: interp->errorLine + +2008-11-03 Jeff Hobbs <jeffh@ActiveState.com> + + * generic/threadSvCmd.c (SvObjObjCmd): safely set interp result obj + + * generic/threadCmd.c (ThreadCutChannel): fix const warning + (ThreadSend): safely set interp result object [Bug #1988779] + +2009-10-22 Zoran Vasiljevic <zv@archiware.com> + + * generic/threadPool.c: fixed race condition when + creating minworkers worker thread upfront. + Failure to create one results in partial pool teardown. + Fix for [Bug #2005794]. + +2008-05-22 Zoran Vasiljevic <zv@archiware.com> + + * generic/threadSpCmd.h: Added one cond variable per + sync bucket to wait for item deletion. + + * generic/threadSpCmd.c: Threads that want to delete + any sync primitive now wait properly until the last + thread that references the primitive detaches. + + Fixed (broken) reference counting of items. + + Fixed wrong release of an condition variable that is + about to be time-waited. + +2008-05-18 Zoran Vasiljevic <zv@archiware.com> + + * generic/threadPoolCmd.c: Corrected potential race condition + in TpoolWorker(). + +2007-06-30 Zoran Vasiljevic <zv@archiware.com> + + * generic/threadPoolCmd.c: Fixed signedness compiler warning + on jobId in TpoolWaitObjCmd(). + +2007-06-30 Zoran Vasiljevic <zv@archiware.com> + + * generic/threadSvKeylistCmd.c: Fixed off-by-1 error in argument + parsing for SvKeylkeysObjCmd(). See [Tcl Bug #1575342]. + + * generic/threadPoolCmd.c: Fixed [Tcl Bug #1512225] (tpool::wait and + tpool::cancel setting wrong values to passed variables) + +2007-05-26 Zoran Vasiljevic <zv@archiware.com> + + * generic/threadPoolCmd.c: Fixed [tpool::post -nowait] to start + one new worker thread only if there are none started. + +2007-05-03 Pat Thoyts <patthoyts@users.sourceforge.net> + + * win/vc/rules.vc: Updated the nmake build system to match + * win/vc/nmakehlp.c: current 8.5. (support for non-intel build + * win/vc/makefile.vc: and recent versions of msvc compiler) + * win/thread.rc: Fixed line endings. + +2006-12-26 Zoran Vasiljevic <zv@archiware.com> + + * generic/threadCmd.c: Fixed race condition for + creating preserved threads. + + * generic/threadSv.c: Removed memory leak. + +2006-10-07 Zoran Vasiljevic <zv@archiware.com> + + *** 2.6.5 TAGGED FOR RELEASE (thread-2-6-5) *** + + Main changes since the last release: + ------------------------------------ + + Set versioning of (embedded) Ttrace package to + the same revision level as the main Thread package. + + The Ttrace must now explicitly be loaded in every + new thread created by [thread::create] command. + + The [package require Ttrace] automatically loads + Thread package as well. + + NOTE: be sure to configure/make/make install + because the pkgIndex.tcl loader file is modified. + + +2006-10-06 Zoran Vasiljevic <zv@archiware.com> + + * generic/threadPool.c: + * generic/threadCmd.c: Removed Tcl_PkgRequire + from the new thread initialization and just + initialize the C-aspect of the extension by + calling Therad_Init. This basically discards + the last checkin, which was in a sense bad + as it made thread creation very expensive + operation. + + * pkgIndex.tcl.in: Added separate handling for + Ttrace loading. Now, users needing Ttrace caps + must "package require Ttrace" which in turn + automatically calls "package require Thread". + Also, each new thread created by [thread::create] + must be initialized for Ttrace by calling the + [package require Ttrace]. + On the other hand, the "package require Thread" + is only necessary to first-load the package in + the startup thread. It is not necessary to call + this explicitly in every thread created by the + [thread::create] command as the C-code will + do that automatically as the first thing. + + * doc/ttrace.man: Updated example usage to reflect + above changes. + + * lib/ttrace.tcl: Spliced version numbering of the + Ttrace package to the version of the Thread package + because of the weirdness of the Tcl package loading + mechanism. Also, the broadcast script used within + the ttrace::eval now explicitly loads Ttrace package + in every broadcasted thread. + +2006-10-05 Zoran Vasiljevic <zv@archiware.com> + + * generic/threadPool.c: + * generic/threadCmd.c: Call Tcl_PkgRequire() in the + NewThread() to properly initialize the extension + in any new thread. + + * doc/ttrace.man: Add small example of ttrace usage. + + * lib/ttrace.tcl: Fixed [ttrace:eval] to not to call + [package require Ttrace] in the broadcast script as + this is now done implicitly for all new threads. + +2006-08-06 Zoran Vasiljevic <zv@archiware.com> + + *** 2.6.4 TAGGED FOR RELEASE (thread-2-6-4) *** + + * generic/tclXkeylist.c: Silenced various + * generic/threadCmd.c compiler warnings. + * generic/threadSvCmd.c: + + * README: Removed version information. + * configure.in: Bumped to 2.6.4 version. + * confiigure: Regenerated. + +2006-06-04 Zoran Vasiljevic <zv@archiware.com> + + * generic/threadSvCmd.c: SvIncrObjCmd() now implicitly creates + shared array and/or element and initializes it to zero if the + array and/or the element were not found. + + * generic/tclThread.h: Removed some unusded debugging defs + +2006-04-05 Jeff Hobbs <jeffh@ActiveState.com> + + * win/vc/pkg.vc (PACKAGE_VERSION): correct to 2.6.3 for MSVC make. + +2006-03-28 Jeff Hobbs <jeffh@ActiveState.com> + + * generic/threadPoolCmd.c (AppExitHandler): fix teardown to + destruct pool list correctly. [Bug 1427570] + +2006-03-16 Zoran Vasiljevic <zv@archiware.com> + + *** 2.6.3 TAGGED FOR RELEASE (thread-2-6-3) *** + + * README: Bumped to 2.6.3 + +2006-03-15 Zoran Vasiljevic <zv@archiware.com> + + + * configure.in: Changed BUILD_sample to + BUILD_thread for Windows compile under MinGW. + + + configure: regen + +2006-03-14 Zoran Vasiljevic <zv@archiware.com> + + * configure.in: Moved to 2.6.3 release + * configure: regen + +2006-02-09 Zoran Vasiljevic <zv@archiware.com> + + * generic/threadSpCmd.c: fixed race condition when testing + constraints (mutex being locked by the caller thread) when + waiting on the condition variable. Also, fixed exclusive + mutex ownership and usage counting. + * configure.in: uses TEA 3.5 + * tclconfig: updated to TEA3.5 + +2006-01-28 Zoran Vasiljevic <zv@archiware.com> + + * generic/threadSpCmd.c: Revamped handling because of the deep + * generic/threadSpCmd.h: race condition which resulted in + * tests/thread.test: deadlocks when using exclusive mutexes. + +200i-10-15 Zoran Vasiljevic <zv@archiware.com> + + * generic/threadCmd.c: channel transfer code cleans + ready-to-fire events from the thread event queue + prior to cutting the channel out of the interp. + + * tests/thread.test: allows channel transfer tests + for all Unices and Windows using Tcl 8.4.10+ core. + +2005-09-23 Zoran Vasiljevic <zv@archiware.com> + + * generic/threadCmd.c: ThreadDetach() sets the both + source and target thread ID's for the detached + channel to zero, thus signalizing the cleanup code + to leave the channel in the cleanup-list when the + thread who detached it exits. + +2005-08-24 Zoran Vasiljevic <zv@archiware.com> + + * generic/tclXkeylist.c: made some calls static + so they do not interfere for static linking with + certain extensions. + +2005-08-08 Zoran Vasiljevic <zv@archiware.com> + + * generic/threadSvCmd.c: fixed traversing the list + of registered object types in Sv_DuplicateObj() + (thx to eric.melbardis@netkitsolutions.com) + +2005-07-27 Zoran Vasiljevic <zv@archiware.com> + + *** 2.6.2 TAGGED FOR RELEASE (thread-2-6-2) *** + + * configure: regen + * unix/README: added some clarifications about usage + of --with-gdbm switch + * README: + * configure.in: bumped version to 2.6.2 + * aclocal.m4: fixed for alternate gdbm lib location + as per patch request #1245204 + * generic/tclThread.c: removed Thread_Unload and + Thread_SafeUnload because we can't really be unloaded. + * html/thread.html: regen + * html/tpool.html: regen + * html/tsv.html: regen + * html/ttrace.html: regen + * man/thread.n: regen + * man/tpool.n: regen + * man/tsv.n: regen + * man/ttrace.n: regen + +2005-07-26 Mo DeJong <mdejong@users.sourceforge.net> + + * Makefile.in: Remove SYSTEM_TCLSH and any + code that tries to run tclsh at build time + aside from running the test cases. + * configure: Regen. + * configure.in: Remove calls to TEA_BUILD_TCLSH + and TEA_BUILD_WISH since these were removed + from tcl.m4. This fixes up the build when + --with-tcl indicates either a build dir or + and install dir. + +2005-07-25 Zoran Vasiljevic <zv@archiware.com> + + * pkgIndex.tcl.in: simplified by introducing a + helper procedure, thus avoiding too much quoting. + +2005-07-24 Mo DeJong <mdejong@users.sourceforge.net> + + * Makefile.in: Subst TCLSH_PROG as SYSTEM_TCLSH + and subst BUILD_TCLSH and BUILD_TCLSH_PROG. + * configure: Regen. + * configure.in: Invoke TEA_BUILD_TCLSH from + tcl.m4 to correctly determine BUILD_TCLSH. + +2005-04-12 Zoran Vasiljevic <zv@archiware.com> + + * generic/tclThread.h: + * generic/threadCmd.c: reverted some changes by the + last checkin which slipped in by mistake + +2005-04-09 Zoran Vasiljevic <zv@archiware.com> + + * generic/tclThread.h: + * generic/threadCmd.c: added Thread_Unload and + Thread_SafeUnload to be able to load into the + 8.5 shell. Both calls are still no-ops. + +2005-03-18 Jeff Hobbs <jeffh@ActiveState.com> + + * Makefile.in (AR): use @AR@ + (TCLSH_ENV): add TCL_THREAD_LIBRARY var + * pkgIndex.tcl.in: grok TCL_THREAD_LIBRARY var + + * configure, configure.in: update to TEA 3.2 + +2005-03-15 Zoran Vasiljevic <zv@archiware.com> + + * pkgIndex.tcl.in: Applied patch for Bug #1163357. + Also, fixed the case when directory path contains blanks. + +2005-03-05 Zoran Vasiljevic <zv@archiware.com> + + * generic/threadSvCmd.c: fixed potential access + to the unlocked (and thus eventually freed) container + + * lib/ttrace.tcl: the overloaded [info] command now + does the right thing when applied to non-existing + procedures. We now transparently resolve them and + then allow the [info] to operate on them. + + The ttrace::enable can now be called recursively. + + Also, fixed stript generation issues for namespaced + variables containing wild escape sequences. + +2005-01-03 Zoran Vasiljevic <zv@archiware.com> + + * generic/threadPoolCmd.c: fixed Tcl Bug #1095370. + We were wrongly tearing down workers on idle timer + expiry *below* the number of workers set by the + "-minworkers" option. + + * lib/ttrace.tcl: added [ttrace::config] to control + some runtime options. The only option it allows now + is "-doepochs". This is a boolean flag turning the + epoch generation off/on. + Also, improved handling of XOTcl introspections in + regard to namespaced objects/classes. + +2005-01-03 Zoran Vasiljevic <zv@archiware.com> + + * lib/ttrace.tcl: added [ttrace::isenabled] and modified + the [ttrace::addtrace] to dynamically activate the tracer + if the tracing is already enabled. This way we can dynamically + load tracer scripts. + +2005-01-03 Zoran Vasiljevic <zv@archiware.com> + + **** RELEASE: 2.6.1 Tagged **** + + * aolserver.m4: + * configure.in: + * configure: rebuild and include conditional compilation + for AOLserver which was wrongly ommited since the switch + to the TEA3 build system. + Also, we will now revert to <major>.<minor>.<patch> + version numbers for all releases. + + * generic/threadCmd.c: added new option "-head" to the + [thread::send] command so scripts can be placed on the + head of the thread event queue instead of the tail only. + + * doc: rebuild html/nroff files from doctools sources + + * generic/threadPoolCmd.c: + * generic/threadSvCmd.h: + * generic/tclThread.h: removed compat macros for 8.3 core + + * test/thread.test: added case for [thread::send -head] + +2004-12-23 Zoran Vasiljevic <zv@archiware.com> + + **** RELEASE: 2.6 Tagged **** + + * tcl/cmdsrv/cmdsrv.tcl: example command server listens on + loopback interface (127.0.0.1) only + + * README: removed stuff about (now unsupported) Tcl8.3 core + * unix/README: clarified usage of the CONFIG file + * win/vc: adjusted MSVC files for changes introduced by TEA3 + +2004-12-18 Zoran Vasiljevic <zv@archiware.com> + + **** COMPATIBILITY: Dropped support for Tcl8.3 **** + + * aclocal.m4: Adjusted for TEA3 + * Makefile.in: + * configure.in: + * pkgIndex.tcl.in: + + * configure: Rebuild with autoconf 2.59 + + * tests/all.tcl: Removed extra handling for Tcl 8.3 + * tests/thread.tcl: since we do not support 8.3 any more + * generic/psGdbm.c: + * generic/threadCmd.c: + * generic/threadSvCmd.c: + + * doc/thread.man: Updated docs for the 2.6 release + * doc/tpool.man: + * doc/tsv.man: + * doc/ttrace.man: + +2004-11-27 Zoran Vasiljevic <zv@archiware.com> + + * generic/threadPoolCmd.c: Fixed race condition which resulted + in blocking at pool creation with high -minworkers threads. + This fixes the Tcl Bug #933975. + +2004-11-25 Zoran Vasiljevic <zv@archiware.com> + + * tests/thread.tcl: Disabled all tests handling channel transfer + for Windows ports until core is capable of handling this correctly. + + * generic/threadSpCmd.c: Fixed segmentation problems observed on + Windows ports and related to notification of an uninitialized + condition variable(s). This closes Bug #1051068 (wrongly posted + under Tcl Patches at SF). + + * doc/thread.man: Fixed mutex/condvar code example. Thanks to + Gustaf Neumann of XOTcl for the tip. + +2004-10-21 Andreas Kupries <andreask@activestate.com> + + * tests/thread.test: Added two tests checking the working of + fileevents after a pipe channel has been transfered. The second + has to fail for any core where TIP #218 is not applied, because + the incoming alert is directed to the wrong thread for event + processing. + +2004-10-20 Zoran Vasiljevic <zv@archiware.com> + + * generic/threadCmd.c (ThreadSetResult): adjusted handling of + interp result to accomodate for recent changes in Tcl core. + This closes Tcl Bug# 1050490. + +2004-10-19 Andreas Kupries <andreask@activestate.com> + + * generic/threadSvCmd.c: Added a prototype for + SvObjDispatchObjCmd. Prevented compilation of debug variant on + Windows due to warning as error. + + * tests/thread.test: Added more tests transfering channels between + threads for in-core drivers. + +2004-10-18 Andreas Kupries <andreask@activestate.com> + + * generic/threadCmd.c (ThreadErrorProc): Added code to explicitly + initialize the field 'interp' in ThreadSendData. This was ok + (NULL) for a regular build, but when build with symbols the + guard pattern forced a crash in test thread-16.2. + + * tests/thread.test: Duplicate test id thread-16.1 renamed to + thread-16.2. + +2004-08-14 Zoran Vasiljevic <zv@archiware.com> + + * generic/threadPoolCmd.c: fixed broken parsing of + pool handles. Pool handles are now generated in the + same format as thread handles. + + * generic/threadCmd.c: thread handles are now cased to + (void*) and sprint/sscanf calls are used to generate thread + handles. This concludes the effort of correcting broken + handles on 64-bit machines since the problem was actually + in Tcl itself, rather than here. + +2004-07-21 Zoran Vasiljevic <zv@archiware.com> + + * generic/tclThread.h: corrected namespace prefix for + AOLserver 4.x or higher, since namespaced commands are + now supported. + + * generic/threadCmd.c: allows for re-initializing of package + commands for AOLserver 4.x (or higheri) interpreters. This way + we assure to have correct set of commands even if nobody + loaded the package on server startup. + Also, thread handles returned by the package now have the form: + "tid<number>" in (yet another) attempt to rectify problems found + on Cray computers. + + * generic/threadPoolCmd.c: adjusted handles of the pools to + match ones of threads (see above). + +2004-07-21 Zoran Vasiljevic <zv@archiware.com> + + * doc/*: reformatted docs and added some clarifications + about mutex handling. + + * generic/threadCmd.c: rewritten handling of thread handles + as passed to Tcl. Instead of casting Tcl_ThreadId to unsigned int + which brought some problems on Cray machines, we're now generating + opaque handles and match them to Tcl_ThreadId internally. + + NOTE: this is not supposed to be a compatibility issue since + thread-handles should have been treated as opaque anyways. + + * generic/threadSpCmd.*: improved behaviour when destroying locked + mutexes and locking the same mutex twice from the same thread. + In both cases we throw Tcl error instead of coring the process + or deadlocking the (naive) application. + + * generic/threadSvCmd.*: number of tsv buckets is now compile + time constant. + + * lib/ttrace.tcl: Fixed error in unknown wrapper when the passed + command was empty string. + + * tests/all.tcl + * tests/thread.test: rewritten from scratch. + + * tests/tpool.test: + * tests/ttrace.test: + * tests/tsv.test: new files, currently no-ops. + +2004-01-31 Zoran Vasiljevic <zv@archiware.com> + + * lib/ttrace.tcl: added unconditional "package require" + call to ttrace::eval so we need not explicitly load the + Ttrace package in each and every thread. Also, fixed some + issues with errorInfo/errorCode handling. + + * pkgIndex.tcl.in: fixed Tcl Bug #918137 + * doc/format.tcl: fixed inclusion of man.macros in + every *.n doc file + +2004-01-31 Zoran Vasiljevic <zv@archiware.com> + + * generic/threadCmd.c: fixed incorrect handling of return + codes from the scripts passed to threads. We were wrongly + triggering error for non-error return codes such as TCL_RETURN, + TCL_BREAK, TCL_CONTINUE etc. Now we trigger error only for + TCL_ERROR and return other codes (as-is) to the caller. + This also fixes the Tcl Bug #884549. + +2003-12-22 Zoran Vasiljevic <zv@archiware.com> + + * generic/threadSpCmd.c: added recursive and reader/writer locks + and associated commands + + * generic/threadSpCmd.h: added new file + + * generic/lib/ttrace.tcl: added Ttrace package implementation + + * doc: added documentation for Ttrace package and synced other + doc files to match the release 2.6 state. + + +2003-12-01 Zoran Vasiljevic <zv@archiware.com> + + * generic/threadCmd.c: removed the concept of foreign + thread since it broke our async message bouncing. We + still have to find the way how we should avoid broadcasting + non-package threads (like for aolserver). + +2003-11-27 Zoran Vasiljevic <zv@archiware.com> + + * generic/threadCmd.c: fixed mutex release in ThreadSend + when refusing to send message to foreign thread. + Also, clear the result of the thread::broadcast since it + should not return anything to the caller, no matter the + outcome of the command. + +2003-11-27 Zoran Vasiljevic <zv@archiware.com> + + * generic/threadCmd.c: mark threads created by the package + to distinguish them from "foreign" threads. We will forbid + sending messages to those since they will probably never listen. + + * generic/threadSvCmd.c: corrected some typos + + * generic/threadSvListCmd.c: added implementation for the + "tsv::lset" command + + * generic/threadPoolCmd.c: added optional varname argument + (last arg) to the tpool::cancel + +2003-11-25 Zoran Vasiljevic <zv@archiware.com> + + * doc/format.tcl: new file with a simple poor man's + documentation formatter. + + * doc/thread.man + * doc/tpool.man + * doc/tsv.man: new doctools source files for building + the package documentation. + + * Makefile.in: added support for building nroff and html + files out of doctools sources found in doc directory. + +2003-11-18 Zoran Vasiljevic <zv@archiware.com> + + * generic/threadCmd.c: added implementation of the + thread::broadcast command. This one asynchronously + sends a script to all known threads, except the caller. + +2003-09-03 Zoran Vasiljevic <zv@archiware.com> + + * generic/tclXkeylist.(c|h): added keyed-list datatype + implementation borrowed from the TclX package. This is + now part of the shared variable command set. + + * generic/threadSvCmd.(c|h): modified to support persistent + shared variables with plugin-architecture for different + persistent store implementations. + + * generic/threadSvlistCmd.(c|h): modified to reflect added + support for persistent shared variables. + + * generic/psGdbm.(c|h): added persistent store wrapper + for the GNU gdbm package. + + * configure et al: regenerated with autoconf because of + added optional comilation with GNU gdbm. Updated makefiles + to process newly added files for keyed lists and persistent + stores. + +2003-08-27 Zoran Vasiljevic <zv@archiware.com> + + * generic/threadPoolCmd.c: after expiration of the idle + timer, all idle workers exit unconditionaly. Before the + change, idle threads exited after getting the first job + posted. This way we were loosing work. + +2003-08-26 Zoran Vasiljevic <zv@archiware.com> + + * generic/threadPoolCmd.c: fixed result list corruption + in TpoolCancelObjCmd. + +2003-07-27 Zoran Vasiljevic <zv@archiware.com> + + * generic/threadPoolCmd.c: added "-nowait" option + to the "tpool::post" commandi. This allows the + caller to post jobs to the threadpool queue without + waiting for an idle thread. The implementation will + start at least one worker thread if there is none + available to satisfy the first request. + Added "tpool::cancel" command. See docs for info. + +2003-05-31 Zoran Vasiljevic <zv@archiware.com> + + * generic/threadCmd.c: fixed ListRemoveInner for + the Tcl Bug #746352 + + * generic/threadSpCmd.c: modified Sp_Init to + return a proper value for Tcl Bug #746352 + +2003-05-17 Zoran Vasiljevic <zv@archiware.com> + + * generic/threadCmd.c: sets the name of the new thread + to "-tclthread-" when compiled for AOLserver + +2003-04-29 Zoran Vasiljevic <zv@archiware.com> + + Tagged interim 2.5.2 release. + + * configure.in + * configure: Added quick fix for autoconf issues + related to $srcdir and building of the package + from the top-level dir instead of unix/win subdir. + Thanks to Mo DeJong for the fix. + +2003-04-10 Zoran Vasiljevic <zv@archiware.com> + + * generic/threadCmd.c: removed checking of stopped flag + during walk of the list of active threads. This + solves some subtle thread reservation problems + with threads marked to unwind on error. + Also, added new "-errorstate" configuration option + to set/get error state of reserved unwinding thread. + +2003-04-02 Zoran Vasiljevic <zv@archiware.com> + + * generic/threadCmd.c: + * generic/threadPoolCmd.c: + * generic/threadSpCmd.c: + * generic/threadSvCmd.c: always call registered exit callbacks + with non-NULL clientData, otherwise Tcl won't invoke + the registered callback. + +2003-03-28 Zoran Vasiljevic <zv@archiware.com> + + * generic/threadSvList.c + * generic/threadSvCmd.c: fixed some rare cases + where we incorrectly deep-copied the list object + having zero elements. + + * generic/threadCmd.c: fixed broken AOLserver 3.x + compatibility mode introduced by last 4.x changes. + +2003-03-17 Zoran Vasiljevic <zv@archiware.com> + + * generic/threadSvCmd.c: fixed incompatibility + with Tcl 8.4.2 filepath object + + * generic/threadCmd.c: + * aolstub.cpp: adjusted for AOLserver 4.0 + +2003-02-24 Zoran Vasiljevic <zv@archiware.com> + + * generic/threadCmd.c: fixed ThreadSetResult + to correctly initialize all elements of the + result structure. + +2003-02-08 Zoran Vasiljevic <zv@archiware.com> + + * generic/threadCmd.c: fixed ListRemoveInner + to correctly update global threadList ptr when + the last referenced thread exits. This was not + the case before and we were trashing memory + leading to process exitus. + +2003-01-25 Mo DeJong <mdejong@users.sourceforge.net> + + * generic/threadCmd.c (ThreadSendObjCmd): + The thread::send command was not working + under Win32 because threads that had an id + that was a negative number were generating + a usage error in the thread::send command. + * tests/thread.test: Add test for negative + number as thread id. + +2003-01-22 Zoran Vasiljevic <zv@archiware.com> + + * generic/threadCmd.c: fixed reference to errorInfo + when reporting error from the passed script. + +2003-01-21 Mo DeJong <mdejong@users.sourceforge.net> + + * configure: Regenerate to include recent fixes + for mingw build support in tclconfig module. + +2002-12-18 Zoran Vasiljevic <zv@archiware.com> + + * README: added some AOLserver info + * tcl/tpool/tpool.tcl: added missing tpool::names command + +2002-12-14 Zoran Vasiljevic <zv@archiware.com> + + * doc/*: finished docs for the 2.5 release + +2002-12-09 Zoran Vasiljevic <zv@archiware.com> + + * generic/threadPoolCmd.c: added tpool::names command + added -exitscript for tpool::create + + * doc/tpool.tmml + * doc/man/tpool.n + * doc/html/tpool.html: added files. This is still the + work in progress. + +2002-12-06 Zoran Vasiljevic <zv@archiware.com> + + * configure.in + * configure + * Makefile.in + * aolserver.m4: added support for compilation under + AOLserver as loadable module. + +2002-12-06 Zoran Vasiljevic <zv@archiware.com> + + * generic/threadSvCmd.c: the tsv::lock now allows + for unsetting the shared array within the script argument. + + * generic/threadPoolCmd.c: fixed one missing mutex unlock + in the ThreadRelease. + + * tcl/tpool/tpool.tcl: implemented missing API calls found + in the C-level implementation. + + * tcl/phttpd/phttpd.tcl: simplified switching to Tcl-level + threadpool implementation. + +2002-12-04 Zoran Vasiljevic <zv@archiware.com> + + * generic/threadPoolcmd.c: rewritten to use + worker threads sitting on the cond var instead of + in the event loop. The poster thread still respects + i.e. does not block the event loop while posting jobs. + +2002-12-03 Zoran Vasiljevic <zv@archiware.com> + + * generic/tclthread.h: added SpliceIn/SpliceOut macros. + Fixed to include exports from threadPoolCmd.c + + * generic/threadSpCmd.c: does regular namespace handling + over the NS variable instead of hard-coding the "thread" + prefix for mutex/cond commands. + + * generic/threadCmd.c: rewritten to use SpliceIn/SpliceOut + macros instead of hand-fiddling with linked lists. + + * generic/threadPoolCmd.c: new file + + * Makefile.in: added threadPoolCmd.c to list of source files. + +2002-11-25 Zoran Vasiljevic <zv@archiware.com> + + * tcl/phttpd/phttpd.tcl: added raw file; no thread support + * tcl/cmdsrv/cmdsrv.tcl: first working version + +2002-11-24 Zoran Vasiljevic <zv@archiware.com> + + * tcl/tpool/tpool.tcl: added threadpool implementation in Tcl + * tcl/phttpd: added directory for later mt-enabled pico-httpd + * tcl/cmdsrv: added directory for later socket command server + * doc/man/thread.n + * doc/thread.tmml + * doc/html/thread.html: new tsv::eval, thread::attach, thread::detach + + * generic/threadSvCmd.h + * generic/threadSvCmd.c: added tsv::eval command + + * generic/threadCmd.c: added thread::attach, thread::detach + Also, fixed thread::preserve and thread::release to accept + the thread id as the optional paramter. + +2002-11-23 Zoran Vasiljevic <zv@archiware.com> + + * generic/threadCmd.c: fixed ListRemoveInner() to recognize + and ignore already removed tsd thread structures. + Fixed some invalid TCL_OK returns which masked serious errors. + +2002-11-07 Zoran Vasiljevic <zv@archiware.com> + + * generic/threadCmd.c: fixes problem when trying to report + the error from an async callback when the stderr channel is + not available (wish/tclkit on windows). Thanks to + Wojciech Kocjan <wojciech@kocjan.org> for the correction. + +2002-10-23 Zoran Vasiljevic <zv@archiware.com> + + * generic/threadCmd.c: added handling of background errors + while doing an async callback. + +2002-10-20 Zoran Vasiljevic <zv@archiware.com> + + * doc/html/thread.html + * doc/man/thread.n + * doc/thread.tmml: fixed "thread::send" command summary. + It was showing the wrong position of the "-async" argument. + + * generic/threadSpCmd.c: adjusted mutex/cond handles to + use the same format and handling as AOLserver counterparts + when compiled for AOLserver support. This way one can mix + and match primitives declared with ns_mutex and thread::mutex + and/or ns_event and thread::cond commands. + Added thread::eval command. See documentation for syntax and usage. + +2002-10-15 Jeff Hobbs <jeffh@ActiveState.com> + + * configure: + * configure.in: move the CFLAGS definition into TEA_ENABLE_SHARED + and make it pick up the env CFLAGS at configure time. + +2002-08-23 Zoran Vasiljevic <zv@archiware.com> + + * threadCmd.c: fixed potential memory corruption + when releasing preserved interpreter. + [Tcl bug 599290] + +2002-08-19 Zoran Vasiljevic <zv@archiware.com> + + * generic/threadSvCmd.c: we now properly invalidate + duped object string rep if the internal rep has been + regenerated. + +2002-08-18 Zoran Vasiljevic <zv@archiware.com> + + * generic/threadCmd.c: updated some comments + * generic/threadSvCmd.c: + * generic/threadSvListCmd.c: fixed silly mem leak + where we were registering commands and object types + for each new thread, resulting in unnecessary table + grow. Not a memory leak per-se, therefore not found + by Purify, but shows itself by observing the size + of the process using the top utility. Gosh! + +2002-08-03 Zoran Vasiljevic <zv@archiware.com> + + * generic/threadSvListCmd.c: corrected "tsv::lpush" + to correctly make a copy of the object pushed into + the list in shared array element. + +2002-07-22 Mo DeJong <mdejong@users.sourceforge.net> + + * README: Fix typo. + * doc/man/thread.n: Note that thread::join and + thread::transfer are only available with Tcl 8.4. + +2002-07-20 Mo DeJong <mdejong@users.sourceforge.net> + + * generic/threadSvCmd.c (Sv_tclEmptyStringRep, Sv_Init): + Avoid linking to the tclEmptyStringRep variable defined + in Tcl since this makes it very difficult to load + the Thread package into an executable that has + also loaded Tcl. The previous approach used a hack + under Windows, we now use this same hack on all systems. + [Tcl patch 584123] + +2002-07-19 Zoran Vasiljevic <zv@archiware.com> + + * threadCmd.c: added some macros to simplify + adding and removing result structure in and + out of the corresponding lists + +2002-07-18 Zoran Vasiljevic <zv@archiware.com> + + * threadCmd.c: modified thread::release to allow + for optional "-wait" argument. This will result in + the thread waiting until the target thread has really + exited. Otherwise, the command exits immediately and + target thread may exit asynchronously some time later. + This is not techically needed since one can always join + the exiting thread, but the join command is not + available for some older Tcl versions. + +2002-07-13 Zoran Vasiljevic <zv@archiware.com> + + * doc/man: + * doc/html: added two directories with TMML generated files + * doc/thread.tmml: fixed for the final 2.4 release + * Makefile.in: updated install-doc target to look for man files + under doc/man instead only under doc directory + +2002-07-12 Zoran Vasiljevic <zv@archiware.com> + + * generic/threadSvCmd.s: fixed handling of string rep + in shared var object duplicator + +2002-07-09 Zoran Vasiljevic <zv@archiware.com> + * README: added this file + * license.terms: added this file + +2002-07-05 Zoran Vasiljevic <zv@archiware.com> + + * tclconfig/tcl.m4: fixed reference to MINGW so we can + compile w/o MSVC under windows. + +2002-07-03 Zoran Vasiljevic <zv@archiware.com> + + * generic/threadSvCmd.c: simplified object duplicator + +2002-06-17 Zoran Vasiljevic <zv@archiware.com> + + * generic/threadCmd.c: cleanup of some unused variables + * generic/threadSvCmd.c: + * generic/ThreadSpCmd.c: + * generic/threadSvList.c: added CONST qualifiers to avoid warnings + when compiling against 8.4 core. + +2002-05-25 Zoran Vasiljevic <zv@archiware.com> + * generic/threadCmd.c: added some typecasts to satisfy Windows + * generic/threadSvCmd.h: added some typecasts to satisfy Windows + +2002-05-04 Zoran Vasiljevic <zv@archiware.com> + * generic/threadSvCmd.c: removed errant reference to (still not) + supported shared dictionary and shared keylist datatypes. + +2002-04-27 Zoran Vasiljevic <zv@archiware.com> + + * generic/threadCmd.c: fixed processing of -eventmark. We now + properly wait for target thread to catch up with processing events. + +2002-04-07 Zoran Vasiljevic <zv@archiware.com> + + * generic/threadCmd.c: added call to Ns_TclMarkForDelete(interp) + when compiled for AOLserver support, otherwise we were leaking std + channels on thread exit. + +2002-04-03 Jeff Hobbs <jeffh@ActiveState.com> + + * Makefile.in: improved use of DESTDIR in install targets. + Removed need for installdirs target. + Broke TCLSH_PROG into TCLSH_ENV and TCLSH_PROG with TCLSH var and + added comments about TCLSH_ENV. + Added default shell and gdb targets. + + * configure: + * configure.in: updated to new TEA base that: prefixes all macros + with TEA_* instead of SC_*; adds TEA_PREFIX, which defaults the + prefix and exec_prefix values to what Tcl used; adds + TEA_SETUP_COMPILER, which handles basic compiler / support program + checks and simplifies the configure.in. Turn on --enable-threads + by default and do sanity checking as well. + +2002-04-01 Jeff Hobbs <jeffh@ActiveState.com> + + * Makefile.in (install-lib-binaries): ensure that binary files are + installed with executable bit set (use INSTALL_PROGRAM) + +2002-03-28 Jeff Hobbs <jeffh@ActiveState.com> + + * configure: + * configure.in: BUILD_${PACKAGE} had to be static BUILD_thread in + AC_DEFINE because autoconf wasn't substituting ${PACKAGE}. + +2002-03-27 Jeff Hobbs <jeffh@ActiveState.com> + + * Makefile.in (TCLSH_PROG): moved and updated env var definitions + to have tclsh work from build dir. Removed TCL_EXTRA_CFLAGS, + TCL_LD_FLAGS, TCL_SHLIB_LD_LIBS, TCL_DBGX, TCL_STUB_LIB_FILE, + TCL_STUB_LIB_SPEC as they aren't needed (configure acquires all + that info for us). TCL_LIBS is also not needed, but left in as a + reference to the libs Tcl used. + + * configure: regen based on updated tclconfig/tcl.m4 + * configure.in: moved the SHLIB_LD_LIBS magic into + tclconfig/tcl.m4 and noted where users can modify (SHLIB_LD_)LIBS. + +2002-03-19 Jeff Hobbs <jeffh@ActiveState.com> + + * generic/tclThread.h: + * generic/threadCmd.c: added stub voodoo magic to allow building + against Tcl 8.3 and still get all the 8.4+ functionality when later + loaded into an 8.4+ interp. + + * pkgIndex.tcl.in: simplified auto-generated pkgIndex.tcl file. + + * tests/all.tcl: + * tests/thread.test: improved to detect 8.3/8.4 pkg differences + + * tclconfig/tcl.m4,install-sh (new): + * config/* (removed): + * aclocal.m4: + * configure: + * configure.in: + * Makefile.in: Updated build system to use tclconfig (TEA 2002) + structure. + +2002-03-09 Zoran Vasiljevic <zv@archiware.com> + + * generic/threadSvCmd.c: fixed memory leak when copying objects + using custom object duplicator. If a duplicator was registered + more than once, we were leaking memory. + +2002-03-08 Zoran Vasiljevic <zv@archiware.com> + + * generic/threadCmd.c: added thread::configure -unwindonerror + configuration option. See docs for usage. + + * doc/thread.n: added docs for thread::configure -unwindonerror + +2002-03-07 Zoran Vasiljevic <zv@archiware.com> + + * generic/threadSvCmd.c: tsv::names will skip reporting shared + arrays with leading dot in their names. This is turned-on + only for AOLserver builds with the HIDE_DOTNAMES. For the + regular Tcl builds, all arrays are reported, regardless of + the name. Motivation behind this feature is to allow certain + data privacy. It is not name-clash proof, though. + +2002-02-12 Zoran Vasiljevic <zv@archiware.com> + + * generic/threadCmd.c: fixed thread::preserve glitch. We never + actually did bump the reservation counter by a silly mistake. + +2002-02-12 Zoran Vasiljevic <zv@archiware.com> + + * generic/threadCmd.c: added thread::preserve and thread::release + commands. These allow for a simple reference counting when creating + and/or tearing-down threads. Instead of calling thread::unwind in + the target thread, one can use "thread::release id" to dispose it. + This is much easier to use and it can be coupled with calls to + thread::preserve to implement simple thread reservation mechanism. + + * doc/thread.n: added docs for thread::preserve/thread::release + +2002-02-09 Zoran Vasiljevic <zv@archiware.com> + + * generic/threadCmd.c: added thread::configure interface. + Currently only "-eventmark" option is supported. + Allows for AOLserver builds to change the "thread::" prefix + by re-defining the "NS" compile-time constant. + + * doc/thread.n: added docs for thread::configure + +2002-02-06 Zoran Vasiljevic <zv@archiware.com> + + * generic/aolserv.cpp: (new) added for loading into the AOLserver. + Still needs to fix the Makefile and friends to get it up and + running. + + * generic/threadCmd.c: added conditional setup of the command + prefix. Now, the "NS" can be used to select the command prefix + for thread::* commands. + +2002-01-26 David Gravereaux <davygrvy@pobox.com> + + * generic/threadSvCmd.c: A small 'const' qualifier change to remove a + warning. It's a bit more wordy now, but reads a little clearer to me. + Unscambling pointer math gives me a headache and combined with a cast + tends to get dangerous. + + * win/threadWin.c: new idea for thread::kill added. It's wrapped in an + #if 0/#endif for now. I do notice that tcl.h is now typedef'ing + ClientData as an 'int *'. It used to 'void *', didn't it?? The + ISO/ANSI/CLEAN C style of setting a typed pointer to a void* now doesn't + want to work. Maybe I do too much C++ to have noticed this before... + +2002-01-23 Zoran Vasiljevic <zv@archiware.com> + + * generic/threadCmd.c: fixed address of the target interpreter when + doing the callback async script processing. All messages went to the + main interpreter instead of the selected interpreter, causing process + to hung when posting callbacks to more that one interp at the same time. + (thanks Jean-Luc Fontaine for the tip) + +2002-01-20 Zoran Vasiljevic <zv@archiware.com> + + * generic/threadCmd.c: fixed multiple async reporting of error events + (thanks Jean-Luc Fontaine for the tip) + +2002-01-02 Zoran Vasiljevic <zv@archiware.com> + + * generic/threadSvListCmd.* (new): added for the new implementation + of the thread-shared-variable (tsv) interface. + * generic/threadSvCmd.c: now uses shared Tcl objects instead of strings + for storing data in shared arrays. This improves performance on large + shared data structures. + Added new tsv::* syntax, per request. This replaces older thread::sv_* + interface. Older commands are still present but will be removed as + soon we hit the 3.0 version. + * generic/threadCmd.c: revamped to support asynchronous backfiring + of scripts so we can vwait on the results of thread processing. + This also corrected the bug #464340. Affected command is thread::send. + * doc/thread.n: added docs for all thread::* and tsv::* commands. + This fixes #416850 bug report. The html/tmml files are still out of date. + * configure: built with autoconf 2.52 + * config/config.guess (new): needed for the new configure + * config/config.sub (new): needed for the new configure + * Makefile.in: added lines for new generic/threadSvListCmd.c + * configure.in: moving to 2.4 version. + * unix/threadUnix.c: removed traces of ThreadKill. It is still not clear + wether we should implement this functionality or not. + * win/threadWin.c: see above. + * pkgIndex.tcl.in: fixed to correctly handle version for different Tcl core + versions. + +2001-09-05 David Gravereaux <davygrvy@pobox.com> + + * generic/*: + * win/threadWin.c (new): updated for a new threadWin.c and finished + replacing use of thread.h with tclThread.h. threadWin.c is an + experiment to add a 'thread::kill' command. Not done yet. + + * win/vc/thread.rc (removed): + * win/thread.rc (new): moved it up a directory. + +2001-09-04 David Gravereaux <davygrvy@pobox.com> + + * generic/thread.h (deleted): + * generic/tclThread.h (new): + * generic/threadCmd.c: decided to change the name of 'thread.h' to + 'tclThread.h', per request. + + * generic/thread.h: + * generic/threadCmd.c: Re-added original implimentation of [thread::exit]. + for `emergency use only`. You have been warned ;) + + * configure.in: + * configure: + * win/vc/thread.dsp: + * win/vc/pkg.vc: Upped version numbers to 2.3 and 2.1.3 because I just cut + a release. + +2001-09-04 David Gravereaux <davygrvy@pobox.com> + + -=[ Official 2.2 Tagged and cut. ]=- + +2001-05-27 David Gravereaux <davygrvy@pobox.com> + + * tests/thread.test: fixed small typo in comments. + +2001-08-03 Jeff Hobbs <jeffh@ActiveState.com> + + * Makefile.in: corrected handling of VERSION + + * generic/threadCmd.c: + * generic/thread.h: added Thread_SafeInit + + * win/vc/makefile.vc: added -DBUILD_thread to cflags. + +2001-05-27 David Gravereaux <davygrvy@pobox.com> + + * configure: + * configure.in: + * Makefile.in: + Added package versions to the compile flags. [bug #421246] + +2001-04-28 David Gravereaux <davygrvy@pobox.com> + + * generic/threadCmd.c (NewThread): removed the previous addition of + Tcl_FinalizeThread. Tcl_ExitThread calls it anyways (my mistake). + The resource leak was in the core. See -> + http://sourceforge.net/tracker/?func=detail&atid=110894&aid=419683&group_id=10894 + for the fix. That patch is pending approval. + + To acheive the same behavior of emptying the event loop the way + thread::wait used to work, use the following: + set T [thread::create {thread::wait; update}] + thread::send -async $T thread::unwind + + * generic/thread.h: + * win/vc/makefile.vc: + * win/vc/thread.rc: + * win/vc/pkg.vc (new): Moved version numbers from the header file. It isn't + an export API or anything. Moved version numbers to the build files. I'll + modify configure.in and makefile.in a little later. + +2001-04-26 David Gravereaux <davygrvy@pobox.com> + + * config/* (new): old site-wide config directory re-added. + + * generic/threadCmd.c (ThreadEventProc): ThreadErrorProc now + supported in asyncronous sends when Tcl_Eval returns other than + TCL_OK. Errors were silently ignored prior to this. Bug #219324 + + ==== INTERFACE CHANGE ==== + * generic/threadCmd.c: + * generic/thread.h: thread::exit renamed to thread::unwind. The + name of 'exit' is misleading. An exit implies an unconditional + return. But there are conditions. 'unwind' describes with more + clarity what's happening to the prior thread::wait. For example: + + # parent thread + set T [thread::create {source worker.tcl}] + .... + thread::send -async $T doStuff + .... + thread::send -async $T doStuff + .... + thread::send -async $T thread::unwind + + # worker.tcl + proc init {} {#do initialization} + proc cleanup {} {#do cleanup} + proc doStuff {} {#the work} + init + thread::wait + cleanup + + When worker.tcl is sourced, the execution stops at thread::wait and + the event loop is entered. When thread::unwind is sent to the worker, + thread::wait falls-out and cleanup is called. The condition for + thread::unwind to cause an exit is determined by the script. If + thread::wait was the last Tcl command in the script, yes the thread + will exit. But if thread::wait is not the last, the execution of the + script is just continued. Hence, the name change to clarify this fact. + + Package version has not been changed. There hasn't been an official + release of 2.2, so it stays. + + * doc/thread.n: + * tests/thread.test: Replaced thread::exit with thread::unwind and + documented the change and clarified the subtleties. + + * win/vc/makefile.vc: + * win/vc/thread.dsp: Changed NODEBUG macro to be DEBUG instead. + Double negatives give me a headache. DEBUG=1 makes more sense + to me than NODEBUG=0. Not that I didn't think you wouldn't have + disagreed it was confusing, no? + + * win/vc/config.vc: Added a reminder to edit before using. + * win/vc/thread.rc: Added authors and removed the Ajuba branding. + +2001-04-25 David Gravereaux <davygrvy@pobox.com> + + * generic/threadCmd.c (ThreadWait)(NewThread): Removed the event + loop sinking which was probably done because Tcl_FinalizeThread + was missing from NewThread(). Now the event loop is cleaned + by Tcl_FinalizeThread and ThreadWait doesn't manipulate events + that don't belong to it. Bug #418689 and #418693 + + * generic/threadCmd.c (Thread_Init): logic fix in a version check + for determining the 8.3 package subset. + +2000-11-02 David Gravereaux <davygrvy@ajubasolutions.com> + + * generic/threadCmd.c (NewThread): Added logic to test for a + working Tcl_Init() based on the core version at runtime and ignore + its failure in versions 8.3.[1,2] and 8.4a1. [BUG: 5301] + +2000-10-26 David Gravereaux <davygrvy@ajubasolutions.com> + + * generic/thread.h: + * win/vc/config.vc: + * win/vc/makefile.vc: + * win/vc/thread.dsp: upped version numbers to 2.2 along with adding + a new macro (THREAD_VERSION_SUBSET83) defining the version when + loaded into an 8.3 core. Which happens to be "2.1.1" at this time. + + * generic/threadCmd.c (Thread_Init): Added logic to allow setting + the package version at runtime to "2.2" when compiled against 8.4 + and loaded into 8.4. When compiled against 8.4, yet loaded into + 8.3, thread::join and thread::transfer are not added to the interp + and the package version is set to "2.1.1" instead from the single + binary. [ie. multiple interfaces in one binary] When compiled + against 8.3, thread::join and thread::transfer are non-existant and + the package version is always "2.1.1" to maintain a consistent + interface in all combinations (as per discussions with Don Porter). + +2000-10-16 Zoran Vasiljevic <zv@munich.com> + + * generic/threadSvCmd.c ThreadSvUnsetObjCmd(): deadlocked. + Forgot to release shared-array lock which resulted in + deadlock after first successful unset of the variable. + +2000-08-29 David Gravereaux <davygrvy@ajubasolutions.com> + + * generic/threadCmd.c (NewThread): Tcl_Init return value wasn't + being verified. Added a check and failure logic to fall-out. + [Bug: 5301] + +2000-08-28 David Gravereaux <davygrvy@ajubasolutions.com> + + * generic/threadCmds.c (Thread_Init): Added logic to enable + thread::join and thread::transfer when loaded into an 8.4+ core. + We don't want a seg fault when the Stubs tables don't match for + the functions that don't exist in an 8.3 core. + +2000-08-23 Brent Welch <welch@ajubasolutions.com> + + * configure.in: + * win/vc/makefile.vc: Changed to version 2.1 + * generic/threadCmds.c: Made the code that uses new Tcl 8.4 APIs + conditional using #ifdef. Tested with 8.3.2 + * Applied thread-2-1 tag for use with tclhttpd bundled release. + +2000-08-21 David Gravereaux <davygrvy@ajubasolutions.com> + + * win/vc/makefile.vc: + * win/vc/thread.rc: added version numbers to filename to follow + Tcl standards. + + * doc/thread.tmml(new): Initial TMML document. + +2000-08-20 David Gravereaux <davygrvy@ajubasolutions.com> + + * win/vc/config.vc: + * win/vc/makefile.vc: + * win/vc/README.txt: + * win/vc/thread.dsp: A near top down rewrite that adds + four more build configurations. See README.TXT for the + details. + + * win/vc/.cvsignore: A few more glob patterns added to match + the new build directories. + +2000-08-09 David Gravereaux <davygrvy@ajubasolutions.com> + + * win/vc/thread.rc: swapped "Scriptics Corp" for "Ajuba + Solutions" + + * win/vc/config.vc: + * win/vc/makefile.vc: cleaned-up old cruft. Added new files + from Zoran's patches. made swapping to MSDev 6.0 easier. + Removed the '!if $(_NMAKE_VER) > 162' test for 2 reasons. + + 1) batchmode inference rules are valid since MSDev 5.0 and + the core can't be built with less. So don't bother testing. + + 2) nmake.exe that comes with MSDev 6.0 has a bug with the + meaning of that macro and MS decided to use a string instead + breaking the integer comparison test. + + Also added vcvars32.bat to a new setup rule and got config.vc + much smaller. + + * win/vc/thread.dsp: Added new files from Zoran's patch. + + * win/.cvsignore(deleted): + * win/vc/.cvsignore(added): moved file to help keep a cleaner + build environment. + + * generic/threadSvCmd.c: Added some additional casting of + Tcl_GetHashValue to prevent compiler warnings. + + * generic/threadCmd.c(ThreadWait): Removed the event loop + sinking after the "while(..) Tcl_DoOneEvent();" because this + extension is only responsible for it's own events in the event + loop. Any other extension that's queueing events must be + responsible for it's own cleanup and should be aware of when + the interp (ie. this thread) is going away when we fall-out + to Tcl_DeleteInterp from the Tcl_Eval in NewThread(). If other + extensions (like Tk) don't become aware, then they need to add + a Tcl_CallWhenDeleted handler. + +2000-07-14 Zoran Vasiljevic <zv@munich.com> + + * generic/threadCmd.c: improved thread::exit behaviour + now does a better job of draining the event loop before exit. + may have some wishes open, though - see ThreadWait(). + + * generic/threadSpCmd.c, generic/threadSvCmd.c: + added some comments in function headers. + docs/tests for above still pending. + +2000-07-03 Zoran Vasiljevic <zv@munich.com> + + Summary of changes: + + * generic/threadSpCmd.c: new file with implementation of + "thread::mutex" and "thread::cond" commands. Documentation + and tests are still pending. + + * generic/threadSvCmd.c: new file with implementation of + "thread::sv_*" family of commands modeled after AOLserver + nsv_* ones. Documentation and tests are still pending. + + * Makefile.in: fixed for the two above + + * doc/thread.html + * doc/thread.n: added 'thread::exists' docs + + * generic/thread.h added declarations for new commands (above) + + * generic/threadCmd.c: + + Added "thread::exists" command. + + Moved most of internal functions in threadCmd.c to statics, + except the Thread*ObjCmd(). + + Changed behaviour of "thread::exit". It now simply flips the + bit to signal thread stuck in thread::wait to gracefuly exit. + Consequence: command now does not trigger error on thread exit. + Also, thread event queue is now properly cleared. + ThreadWait() and ThreadStop() are newly added to support this. + Also the ThreadSpecificData has one more integer: "stopped" + + Replaced ref's to obsolete Tcl_GlobalEval() with Tcl_EvalEx(). + + Fixed broken 'thread::create -joinable script'; + was missing initialization of script variable + + Added calls to initialize new commands in threadSpCmd.c + and threadSvCmd.c files. + +2000-05-18 Brent Welch <welch@scriptics.com> + + * Restored Andreas' changes for transferring sockets. + +2000-05-16 Brent Welch <welch@scriptics.com> + + * Temprarily rolled back Andreas' changes so I can fix up + the 2.0 release (configure and Make). Also need to apply + a 2.0 tag. + +2000-05-09 Andreas Kupries <a.kupries@westend.com> + + * tests/thread.test: Removed dependency on aclocals.m4. Using a + real temporary file now, as created by a call to + tcltest::makeFile. Updated test 6.3 to use the correct length + information. + +2000-05-04 Andreas Kupries <a.kupries@westend.com> + + * Overall changes: + (1) Added joinable threads. + (2) Added transfer of channels between threads. + + * generic/threadCmd.c: Added functions Thread_Join and + ThreadJoinObjCmd. + + Extended function ThreadCreateObjCmd to handle a + -joinable flag. + + Fixed bug in Thread_Create, the argument 'stacksize' was not + used. + + Removed declaration of ThreadObjCmd, which was not used anywhere + else in the code. + + Added functions Thread_Transfer, ThreadTransferEventProc and + ThreadTransferObjCmd. Extended behaviour of ThreadDeleteEvent + and ThreadExitProc to deal with the new class of events. + + Changed usage of ckfree to the more canonical Tcl_Free. Same for + ckalloc and Tcl_Alloc. + + * Makefile.in: Fixed bug with regard to the installation of + documentation. + + * doc/thread.*: Added documentation of create -joinable, + thread::join and thread::transfer. + + * tests/thread.test: Added tests for joining of threads and moving + channels between threads. + +2000-04-19 Brent Welch <welch@scriptics.com> + + * win/vc/config.rc, Makefile.vc: Fixes from David Gravereaux + +2000-04-18 Brent Welch <welch@scriptics.com> + + * Makefile.in: Fixes for make install + +2000-04-17 Brent Welch <welch@scriptics.com> + + * generic/threadCmd.c + Added Tcl_CreateThreadType and TCL_RETURN_THREAD_TYPE + macros for declaring the NewThread callback proc. + +2000-04-11 Brent Welch <welch@scriptics.com> + + * Picked up minor changes from David Gravereaux <davygrvy@bigfoot.com> + * for compilation on windows with his alternate project files. + +2000-04-10 Brent Welch <welch@scriptics.com> + + * Moved all the configure.in, Makefile.in etc. up to the top level out + * of the unix (and win) subdirectories. These are now shared. + * If you are using CVS, you'll want to get the "config" module into + * this directory, or do the checkout of thread again so the config + * module is brought in. You should have a "config" subdirectory of + * your main thread workspace directory. + +2000-04-09 Brent Welch <welch@scriptics.com> + + * Updated to compile against 8.3.1 export thread APIs + * Added Windows makefiles + +2000-03-27 Brent Welch <welch@scriptics.com> (proxy for Andreas Kupries) + + * tests/all.tcl: Added this file + * tests/thread.test: fixed to use tcltest + * doc/thread.n: Added this file as clone of thread.html + # doc/thread.html: fixed typo diff --git a/tcl8.6/pkgs/thread2.8.4/Makefile.in b/tcl8.6/pkgs/thread2.8.4/Makefile.in new file mode 100644 index 0000000..8356eea --- /dev/null +++ b/tcl8.6/pkgs/thread2.8.4/Makefile.in @@ -0,0 +1,462 @@ +# Makefile.in -- +# +# This file is a Makefile for the Thread Extension. If it has the name +# "Makefile.in" then it is a template for a Makefile; to generate the +# actual Makefile, run "./configure", which is a configuration script +# generated by the "autoconf" program (constructs like "@foo@" will get +# replaced in the actual Makefile. +# +# Copyright (c) 1999 Scriptics Corporation. +# Copyright (c) 2002-2005 ActiveState Corporation. +# +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. + +#======================================================================== +# Add additional lines to handle any additional AC_SUBST cases that +# have been added in a customized configure script. +#======================================================================== + +#SAMPLE_NEW_VAR = @SAMPLE_NEW_VAR@ + +#======================================================================== +# Nothing of the variables below this line should need to be changed. +# Please check the TARGETS section below to make sure the make targets +# are correct. +#======================================================================== + +#======================================================================== +# The names of the source files is defined in the configure script. +# The object files are used for linking into the final library. +# This will be used when a dist target is added to the Makefile. +# It is not important to specify the directory, as long as it is the +# $(srcdir) or in the generic, win or unix subdirectory. +#======================================================================== + +PKG_SOURCES = @PKG_SOURCES@ +PKG_OBJECTS = @PKG_OBJECTS@ + +PKG_STUB_SOURCES = @PKG_STUB_SOURCES@ +PKG_STUB_OBJECTS = @PKG_STUB_OBJECTS@ + +#======================================================================== +# PKG_TCL_SOURCES identifies Tcl runtime files that are associated with +# this package that need to be installed, if any. +#======================================================================== + +PKG_TCL_SOURCES = @PKG_TCL_SOURCES@ + +#======================================================================== +# This is a list of public header files to be installed, if any. +#======================================================================== + +PKG_HEADERS = @PKG_HEADERS@ + +#======================================================================== +# "PKG_LIB_FILE" refers to the library (dynamic or static as per +# configuration options) composed of the named objects. +#======================================================================== + +PKG_LIB_FILE = @PKG_LIB_FILE@ +PKG_STUB_LIB_FILE = @PKG_STUB_LIB_FILE@ + +lib_BINARIES = $(PKG_LIB_FILE) +BINARIES = $(lib_BINARIES) + +SHELL = @SHELL@ + +srcdir = @srcdir@ +prefix = @prefix@ +exec_prefix = @exec_prefix@ + +bindir = @bindir@ +libdir = @libdir@ +includedir = @includedir@ +datarootdir = @datarootdir@ +datadir = @datadir@ +mandir = @mandir@ + +DESTDIR = + +PKG_DIR = $(PACKAGE_NAME)$(PACKAGE_VERSION) +pkgdatadir = $(datadir)/$(PKG_DIR) +pkglibdir = $(libdir)/$(PKG_DIR) +pkgincludedir = $(includedir)/$(PKG_DIR) + +top_builddir = . + +INSTALL_OPTIONS = +INSTALL = @INSTALL@ $(INSTALL_OPTIONS) +INSTALL_DATA_DIR = @INSTALL_DATA_DIR@ +INSTALL_DATA = @INSTALL_DATA@ +INSTALL_PROGRAM = @INSTALL_PROGRAM@ +INSTALL_SCRIPT = @INSTALL_SCRIPT@ +INSTALL_LIBRARY = @INSTALL_LIBRARY@ + +PACKAGE_NAME = @PACKAGE_NAME@ +PACKAGE_VERSION = @PACKAGE_VERSION@ +CC = @CC@ +CFLAGS_DEFAULT = @CFLAGS_DEFAULT@ +CFLAGS_WARNING = @CFLAGS_WARNING@ +EXEEXT = @EXEEXT@ +LDFLAGS_DEFAULT = @LDFLAGS_DEFAULT@ +MAKE_LIB = @MAKE_LIB@ +MAKE_SHARED_LIB = @MAKE_SHARED_LIB@ +MAKE_STATIC_LIB = @MAKE_STATIC_LIB@ +MAKE_STUB_LIB = @MAKE_STUB_LIB@ +OBJEXT = @OBJEXT@ +RANLIB = @RANLIB@ +RANLIB_STUB = @RANLIB_STUB@ +SHLIB_CFLAGS = @SHLIB_CFLAGS@ +SHLIB_LD = @SHLIB_LD@ +SHLIB_LD_LIBS = @SHLIB_LD_LIBS@ +STLIB_LD = @STLIB_LD@ +#TCL_DEFS = @TCL_DEFS@ +TCL_BIN_DIR = @TCL_BIN_DIR@ +TCL_SRC_DIR = @TCL_SRC_DIR@ +#TK_BIN_DIR = @TK_BIN_DIR@ +#TK_SRC_DIR = @TK_SRC_DIR@ + +# Not used, but retained for reference of what libs Tcl required +#TCL_LIBS = @TCL_LIBS@ + +#======================================================================== +# TCLLIBPATH seeds the auto_path in Tcl's init.tcl so we can test our +# package without installing. The other environment variables allow us +# to test against an uninstalled Tcl. Add special env vars that you +# require for testing here (like TCLX_LIBRARY). +#======================================================================== + +EXTRA_PATH = $(top_builddir):$(TCL_BIN_DIR) +#EXTRA_PATH = $(top_builddir):$(TCL_BIN_DIR):$(TK_BIN_DIR) +TCLLIBPATH = $(top_builddir) +TCLSH_ENV = TCL_LIBRARY=`@CYGPATH@ $(TCL_SRC_DIR)/library` +PKG_ENV = TCL_THREAD_LIBRARY=`@CYGPATH@ $(srcdir)/lib` \ + @LD_LIBRARY_PATH_VAR@="$(EXTRA_PATH):$(@LD_LIBRARY_PATH_VAR@)" \ + PATH="$(EXTRA_PATH):$(PATH)" \ + TCLLIBPATH="$(TCLLIBPATH) $(top_builddir)/../lib" + +TCLSH_PROG = @TCLSH_PROG@ +TCLSH = $(PKG_ENV) $(TCLSH_ENV) $(TCLSH_PROG) + +#WISH_ENV = TK_LIBRARY=`@CYGPATH@ $(TK_SRC_DIR)/library` +#WISH_PROG = @WISH_PROG@ +#WISH = $(PKG_ENV) $(TCLSH_ENV) $(WISH_ENV) $(WISH_PROG) + +SHARED_BUILD = @SHARED_BUILD@ + +INCLUDES = @PKG_INCLUDES@ @TCL_INCLUDES@ +#INCLUDES = @PKG_INCLUDES@ @TCL_INCLUDES@ @TK_INCLUDES@ @TK_XINCLUDES@ + +PKG_CFLAGS = @PKG_CFLAGS@ + +# TCL_DEFS is not strictly need here, but if you remove it, then you +# must make sure that configure.ac checks for the necessary components +# that your library may use. TCL_DEFS can actually be a problem if +# you do not compile with a similar machine setup as the Tcl core was +# compiled with. +#DEFS = $(TCL_DEFS) @DEFS@ $(PKG_CFLAGS) +DEFS = @DEFS@ $(PKG_CFLAGS) -DTCL_NO_DEPRECATED=1 + +# Move pkgIndex.tcl to 'BINARIES' var if it is generated in the Makefile +CONFIG_CLEAN_FILES = Makefile pkgIndex.tcl +CLEANFILES = @CLEANFILES@ + +CPPFLAGS = @CPPFLAGS@ +LIBS = @PKG_LIBS@ @LIBS@ +AR = @AR@ +CFLAGS = @CFLAGS@ +COMPILE = $(CC) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) + +.SUFFIXES: .c .$(OBJEXT) + +#======================================================================== +# Start of user-definable TARGETS section +#======================================================================== + +#======================================================================== +# TEA TARGETS. Please note that the "libraries:" target refers to platform +# independent files, and the "binaries:" target includes executable programs and +# platform-dependent libraries. Modify these targets so that they install +# the various pieces of your package. The make and install rules +# for the BINARIES that you specified above have already been done. +#======================================================================== + +all: binaries libraries doc + +#======================================================================== +# The binaries target builds executable programs, Windows .dll's, unix +# shared/static libraries, and any other platform-dependent files. +# The list of targets to build for "binaries:" is specified at the top +# of the Makefile, in the "BINARIES" variable. +#======================================================================== + +binaries: $(BINARIES) + +libraries: + +#======================================================================== +# Your doc target should differentiate from doc builds (by the developer) +# and doc installs (see install-doc), which just install the docs on the +# end user machine when building from source. +#======================================================================== + +doc: + +install: all install-binaries install-libraries install-doc + +install-binaries: binaries install-lib-binaries install-bin-binaries + +#======================================================================== +# This rule installs platform-independent files, such as header files. +# The list=...; for p in $$list handles the empty list case x-platform. +#======================================================================== + +install-libraries: libraries + @$(INSTALL_DATA_DIR) $(DESTDIR)$(includedir) + @echo "Installing header files in $(DESTDIR)$(includedir)" + @list='$(PKG_HEADERS)'; for i in $$list; do \ + echo "Installing $(srcdir)/$$i" ; \ + $(INSTALL_DATA) $(srcdir)/$$i $(DESTDIR)$(includedir) ; \ + done; + +#======================================================================== +# Install documentation. Unix manpages should go in the $(mandir) +# directory. +#======================================================================== + +install-doc: doc + @$(INSTALL_DATA_DIR) $(DESTDIR)$(mandir)/mann + @echo "Installing documentation in $(DESTDIR)$(mandir)" + @list='$(srcdir)/doc/man/*.n'; for i in $$list; do \ + echo "Installing $$i"; \ + $(INSTALL_DATA) $$i $(DESTDIR)$(mandir)/mann ; \ + done + +test: binaries libraries + $(TCLSH) `@CYGPATH@ $(srcdir)/tests/all.tcl` $(TESTFLAGS) \ + -load "package ifneeded $(PACKAGE_NAME) $(PACKAGE_VERSION) \ + [list load `@CYGPATH@ $(PKG_LIB_FILE)` $(PACKAGE_NAME)]" + +shell: binaries libraries + @$(TCLSH) $(SCRIPT) + +gdb: + $(TCLSH_ENV) gdb $(TCLSH_PROG) $(SCRIPT) + +VALGRINDARGS = --tool=memcheck --num-callers=8 --leak-resolution=high \ + --leak-check=yes --show-reachable=yes -v + +valgrind: binaries libraries + $(TCLSH_ENV) valgrind $(VALGRINDARGS) $(TCLSH_PROG) \ + `@CYGPATH@ $(srcdir)/tests/all.tcl` $(TESTFLAGS) + +valgrindshell: binaries libraries + $(TCLSH_ENV) valgrind $(VALGRINDARGS) $(TCLSH_PROG) $(SCRIPT) + +depend: + +#======================================================================== +# $(PKG_LIB_FILE) should be listed as part of the BINARIES variable +# mentioned above. That will ensure that this target is built when you +# run "make binaries". +# +# The $(PKG_OBJECTS) objects are created and linked into the final +# library. In most cases these object files will correspond to the +# source files above. +#======================================================================== + +$(PKG_LIB_FILE): $(PKG_OBJECTS) + -rm -f $(PKG_LIB_FILE) + ${MAKE_LIB} + $(RANLIB) $(PKG_LIB_FILE) + +$(PKG_STUB_LIB_FILE): $(PKG_STUB_OBJECTS) + -rm -f $(PKG_STUB_LIB_FILE) + ${MAKE_STUB_LIB} + $(RANLIB_STUB) $(PKG_STUB_LIB_FILE) + +#======================================================================== +# We need to enumerate the list of .c to .o lines here. +# +# In the following lines, $(srcdir) refers to the toplevel directory +# containing your extension. If your sources are in a subdirectory, +# you will have to modify the paths to reflect this: +# +# sample.$(OBJEXT): $(srcdir)/generic/sample.c +# $(COMPILE) -c `@CYGPATH@ $(srcdir)/generic/sample.c` -o $@ +# +# Setting the VPATH variable to a list of paths will cause the makefile +# to look into these paths when resolving .c to .obj dependencies. +# As necessary, add $(srcdir):$(srcdir)/compat:.... +#======================================================================== + +VPATH = $(srcdir):$(srcdir)/generic:$(srcdir)/unix:$(srcdir)/win:$(srcdir)/macosx + +.c.@OBJEXT@: + $(COMPILE) -c `@CYGPATH@ $<` -o $@ + +#======================================================================== +# Distribution creation +# You may need to tweak this target to make it work correctly. +#======================================================================== + +#COMPRESS = tar cvf $(PKG_DIR).tar $(PKG_DIR); compress $(PKG_DIR).tar +COMPRESS = tar zcvf $(PKG_DIR).tar.gz $(PKG_DIR) +DIST_ROOT = /tmp/dist +DIST_DIR = $(DIST_ROOT)/$(PKG_DIR) + +DIST_INSTALL_DATA = CPPROG='cp -p' $(INSTALL) -m 644 +DIST_INSTALL_SCRIPT = CPPROG='cp -p' $(INSTALL) -m 755 + +dist-clean: + rm -rf $(DIST_DIR) $(DIST_ROOT)/$(PKG_DIR).tar.* + +dist: dist-clean + $(INSTALL_DATA_DIR) $(DIST_DIR) + $(DIST_INSTALL_DATA) $(srcdir)/license.terms \ + $(srcdir)/ChangeLog $(srcdir)/README \ + $(srcdir)/aclocal.m4 $(srcdir)/configure.ac \ + $(srcdir)/Makefile.in $(srcdir)/pkgIndex.tcl.in \ + $(srcdir)/naviserver.m4 \ + $(DIST_DIR)/ + $(DIST_INSTALL_SCRIPT) $(srcdir)/configure $(DIST_DIR)/ + + $(INSTALL_DATA_DIR) $(DIST_DIR)/tclconfig + $(DIST_INSTALL_DATA) $(srcdir)/tclconfig/README.txt \ + $(srcdir)/tclconfig/tcl.m4 $(srcdir)/tclconfig/install-sh \ + $(DIST_DIR)/tclconfig/ + + $(INSTALL_DATA_DIR) $(DIST_DIR)/unix + $(DIST_INSTALL_DATA) $(srcdir)/unix/README $(srcdir)/unix/CONFIG \ + $(srcdir)/unix/threadUnix.c \ + $(DIST_DIR)/unix/ + + $(INSTALL_DATA_DIR) $(DIST_DIR)/win + $(DIST_INSTALL_DATA) \ + $(srcdir)/win/README.txt $(srcdir)/win/CONFIG $(srcdir)/win/thread.rc \ + $(srcdir)/win/threadWin.c $(srcdir)/win/makefile.vc \ + $(srcdir)/win/nmakehlp.c $(srcdir)/win/pkg.vc \ + $(srcdir)/win/targets.vc $(srcdir)/win/rules-ext.vc \ + $(srcdir)/win/rules.vc $(srcdir)/win/thread_win.dsw \ + $(srcdir)/win/thread_win.dsp \ + $(DIST_DIR)/win/ + + $(INSTALL_DATA_DIR) $(DIST_DIR)/tcl + $(DIST_INSTALL_DATA) $(srcdir)/tcl/README $(DIST_DIR)/tcl/ + + list='tests doc doc/man doc/html generic lib tcl/cmdsrv tcl/phttpd tcl/tpool';\ + for p in $$list; do \ + if test -d $(srcdir)/$$p ; then \ + $(INSTALL_DATA_DIR) $(DIST_DIR)/$$p; \ + $(DIST_INSTALL_DATA) $(srcdir)/$$p/*.* $(DIST_DIR)/$$p/; \ + fi; \ + done + + (cd $(DIST_ROOT); $(COMPRESS);) + +#======================================================================== +# End of user-definable section +#======================================================================== + +#======================================================================== +# Don't modify the file to clean here. Instead, set the "CLEANFILES" +# variable in configure.ac +#======================================================================== + +clean: + -test -z "$(BINARIES)" || rm -f $(BINARIES) + -rm -f *.$(OBJEXT) core *.core + -test -z "$(CLEANFILES)" || rm -f $(CLEANFILES) + +distclean: clean + -rm -f *.tab.c + -rm -f $(CONFIG_CLEAN_FILES) + -rm -f config.cache config.log config.status + +#======================================================================== +# Install binary object libraries. On Windows this includes both .dll and +# .lib files. Because the .lib files are not explicitly listed anywhere, +# we need to deduce their existence from the .dll file of the same name. +# Library files go into the lib directory. +# In addition, this will generate the pkgIndex.tcl +# file in the install location (assuming it can find a usable tclsh shell) +# +# You should not have to modify this target. +#======================================================================== + +install-lib-binaries: binaries + @$(INSTALL_DATA_DIR) $(DESTDIR)$(pkglibdir) + @list='$(lib_BINARIES)'; for p in $$list; do \ + if test -f $$p; then \ + echo " $(INSTALL_LIBRARY) $$p $(DESTDIR)$(pkglibdir)/$$p"; \ + $(INSTALL_LIBRARY) $$p $(DESTDIR)$(pkglibdir)/$$p; \ + stub=`echo $$p|sed -e "s/.*\(stub\).*/\1/"`; \ + if test "x$$stub" = "xstub"; then \ + echo " $(RANLIB_STUB) $(DESTDIR)$(pkglibdir)/$$p"; \ + $(RANLIB_STUB) $(DESTDIR)$(pkglibdir)/$$p; \ + else \ + echo " $(RANLIB) $(DESTDIR)$(pkglibdir)/$$p"; \ + $(RANLIB) $(DESTDIR)$(pkglibdir)/$$p; \ + fi; \ + ext=`echo $$p|sed -e "s/.*\.//"`; \ + if test "x$$ext" = "xdll"; then \ + lib=`basename $$p|sed -e 's/.[^.]*$$//'`.lib; \ + if test -f $$lib; then \ + echo " $(INSTALL_DATA) $$lib $(DESTDIR)$(pkglibdir)/$$lib"; \ + $(INSTALL_DATA) $$lib $(DESTDIR)$(pkglibdir)/$$lib; \ + fi; \ + fi; \ + fi; \ + done + @list='$(PKG_TCL_SOURCES)'; for p in $$list; do \ + if test -f $(srcdir)/$$p; then \ + destp=`basename $$p`; \ + echo " Install $$destp $(DESTDIR)$(pkglibdir)/$$destp"; \ + $(INSTALL_DATA) $(srcdir)/$$p $(DESTDIR)$(pkglibdir)/$$destp; \ + fi; \ + done + @if test "x$(SHARED_BUILD)" = "x1"; then \ + echo " Install pkgIndex.tcl $(DESTDIR)$(pkglibdir)"; \ + $(INSTALL_DATA) pkgIndex.tcl $(DESTDIR)$(pkglibdir); \ + fi + +#======================================================================== +# Install binary executables (e.g. .exe files and dependent .dll files) +# This is for files that must go in the bin directory (located next to +# wish and tclsh), like dependent .dll files on Windows. +# +# You should not have to modify this target, except to define bin_BINARIES +# above if necessary. +#======================================================================== + +install-bin-binaries: binaries + @$(INSTALL_DATA_DIR) $(DESTDIR)$(bindir) + @list='$(bin_BINARIES)'; for p in $$list; do \ + if test -f $$p; then \ + echo " $(INSTALL_PROGRAM) $$p $(DESTDIR)$(bindir)/$$p"; \ + $(INSTALL_PROGRAM) $$p $(DESTDIR)$(bindir)/$$p; \ + fi; \ + done + +Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status + cd $(top_builddir) \ + && CONFIG_FILES=$@ CONFIG_HEADERS= $(SHELL) ./config.status + +uninstall-binaries: + list='$(lib_BINARIES)'; for p in $$list; do \ + rm -f $(DESTDIR)$(pkglibdir)/$$p; \ + done + list='$(PKG_TCL_SOURCES)'; for p in $$list; do \ + p=`basename $$p`; \ + rm -f $(DESTDIR)$(pkglibdir)/$$p; \ + done + list='$(bin_BINARIES)'; for p in $$list; do \ + rm -f $(DESTDIR)$(bindir)/$$p; \ + done + +.PHONY: all binaries clean depend distclean doc install libraries test + +# Tell versions [3.59,3.63) of GNU make to not export all variables. +# Otherwise a system limit (for SysV at least) may be exceeded. +.NOEXPORT: diff --git a/tcl8.6/pkgs/thread2.8.4/README b/tcl8.6/pkgs/thread2.8.4/README new file mode 100644 index 0000000..7ec98db --- /dev/null +++ b/tcl8.6/pkgs/thread2.8.4/README @@ -0,0 +1,55 @@ + +WHAT IS THIS ? +============== + +This is the source distribution of the Tcl Thread extension. +You can use this extension to gain script-level access to Tcl +threading capabilities. +The extension can be used with Tcl cores starting from Tcl8.4 and later. +Also, this extension supports, i.e. can be used as a loadable module of, +AOLserver 4.x series of the highly-scalable web server from America Online. + +You need to have your Tcl core compiled with "--enable-threads" in order +to turn on internal directives supporting thread-specific details of the +Tcl API. The extension will not load in an Tcl shell built w/o thread +support. + +This extension is a freely available open source package. You can do +virtually anything you like with it, such as modifying it, redistributing +it, and selling it either in whole or in part. See the "license.terms" +file in the top-level distribution directory for complete information. + + +HOW TO COMPILE ? +================ + +Only Unix-like and Windows platforms are supported at the moment. Depending +on your platform (Unix-like or Windows) go to the appropriate directory +(unix or win) and start with the README file. Macintosh platform is supported +with the Mac OS X only. The Mac OS 9 (and previous) are not supported. + + +WHERE IS THE DOCUMENTATION ? +============================ + +Documentation in Unix man and standard HTML format is available in the +doc/man and doc/html directories respectively. +Currently, documentation is in reference-style only. The tutorial-style +documentation will be provided with future releases of the extension. +That is, if I ever get time to do that. Everybody is more than welcome +to jump in and help with the docs. + + +HOW TO GET SUPPORT ? +==================== + +The extension is maintained, enhanced, and distributed freely by the Tcl +community. The home for sources and bug/patch database is on SourceForge: + + http://tcl.sourceforge.net/ + +Alternatively, you are always welcome to post your questions, problems +and/or suggestions relating the extension (or any other Tcl issue) +to news:comp.lang.tcl newsgroup. + +-EOF- diff --git a/tcl8.6/pkgs/thread2.8.4/aclocal.m4 b/tcl8.6/pkgs/thread2.8.4/aclocal.m4 new file mode 100644 index 0000000..9a825fb --- /dev/null +++ b/tcl8.6/pkgs/thread2.8.4/aclocal.m4 @@ -0,0 +1,135 @@ +# +# Pull in the standard Tcl autoconf macros. +# If you don't have the "tclconfig" subdirectory, it is a dependent CVS +# module. Either "cvs -d <root> checkout tclconfig" right here, or +# re-checkout the thread module +# +builtin(include,tclconfig/tcl.m4) +builtin(include,naviserver.m4) + +# +# Handle the "--with-gdbm" option for linking-in +# the gdbm-based peristent store for shared arrays. +# It tries to locate gdbm files in couple of standard +# system directories and/or common install locations +# in addition to the directory passed by the user. +# In the latter case, expect all gdbm lib files and +# include files located in the same directory. +# + +AC_DEFUN(TCLTHREAD_WITH_GDBM, [ + AC_ARG_WITH(gdbm, + [ --with-gdbm link with optional GDBM support],\ + with_gdbm=${withval}) + + if test x"${with_gdbm}" != x -a "${with_gdbm}" != no; then + + AC_MSG_CHECKING([for GNU gdbm library]) + + AC_CACHE_VAL(ac_cv_c_gdbm,[ + if test x"${with_gdbm}" != x -a "${with_gdbm}" != "yes"; then + if test -f "${with_gdbm}/gdbm.h" -a x"`ls ${with_gdbm}/libgdbm* 2>/dev/null`" != x; then + ac_cv_c_gdbm=`(cd ${with_gdbm}; pwd)` + gincdir=$ac_cv_c_gdbm + glibdir=$ac_cv_c_gdbm + AC_MSG_RESULT([found in $glibdir]) + else + AC_MSG_ERROR([${with_gdbm} directory doesn't contain gdbm library]) + fi + fi + ]) + if test x"${gincdir}" = x -o x"${glibdir}" = x; then + for i in \ + `ls -d ${exec_prefix}/lib 2>/dev/null`\ + `ls -d ${prefix}/lib 2>/dev/null`\ + `ls -d /usr/local/lib 2>/dev/null`\ + `ls -d /usr/lib 2>/dev/null` ; do + if test x"`ls $i/libgdbm* 2>/dev/null`" != x ; then + glibdir=`(cd $i; pwd)` + break + fi + done + for i in \ + `ls -d ${prefix}/include 2>/dev/null`\ + `ls -d /usr/local/include 2>/dev/null`\ + `ls -d /usr/include 2>/dev/null` ; do + if test -f "$i/gdbm.h" ; then + gincdir=`(cd $i; pwd)` + break + fi + done + if test x"$glibdir" = x -o x"$gincdir" = x ; then + AC_MSG_ERROR([none found]) + else + AC_MSG_RESULT([found in $glibdir, includes in $gincdir]) + AC_DEFINE(HAVE_GDBM) + GDBM_CFLAGS="-I\"$gincdir\"" + GDBM_LIBS="-L\"$glibdir\" -lgdbm" + fi + fi + fi +]) + + +# +# Handle the "--with-lmdb" option for linking-in +# the LMDB-based peristent store for shared arrays. +# It tries to locate LMDB files in couple of standard +# system directories and/or common install locations +# in addition to the directory passed by the user. +# In the latter case, expect all LMDB lib files and +# include files located in the same directory. +# + +AC_DEFUN(TCLTHREAD_WITH_LMDB, [ + AC_ARG_WITH(lmdb, + [ --with-lmdb link with optional LMDB support], + with_lmdb=${withval}) + + if test x"${with_lmdb}" != "x" -a "${with_lmdb}" != no; then + AC_MSG_CHECKING([for LMDB library]) + AC_CACHE_VAL(ac_cv_c_lmdb,[ + if test x"${with_lmdb}" != x -a "${with_lmdb}" != "yes"; then + if test -f "${with_lmdb}/lmdb.h" -a x"`ls ${with_lmdb}/liblmdb* 2>/dev/null`" != x; then + ac_cv_c_lmdb=`(cd ${with_lmdb}; pwd)` + lincdir=$ac_cv_c_lmdb + llibdir=$ac_cv_c_lmdb + AC_MSG_RESULT([found in $llibdir]) + else + AC_MSG_ERROR([${with_lmdb} directory doesn't contain lmdb library]) + fi + fi + ]) + if test x"${lincdir}" = x -o x"${llibdir}" = x; then + for i in \ + `ls -d ${exec_prefix}/lib 2>/dev/null`\ + `ls -d ${prefix}/lib 2>/dev/null`\ + `ls -d /usr/local/lib 2>/dev/null`\ + `ls -d /usr/lib 2>/dev/null` ; do + if test x"`ls $i/liblmdb* 2>/dev/null`" != x ; then + llibdir=`(cd $i; pwd)` + break + fi + done + for i in \ + `ls -d ${prefix}/include 2>/dev/null`\ + `ls -d /usr/local/include 2>/dev/null`\ + `ls -d /usr/include 2>/dev/null` ; do + if test -f "$i/lmdb.h" ; then + lincdir=`(cd $i; pwd)` + break + fi + done + if test x"$llibdir" = x -o x"$lincdir" = x ; then + AC_MSG_ERROR([none found]) + else + AC_MSG_RESULT([found in $llibdir, includes in $lincdir]) + AC_DEFINE(HAVE_LMDB) + LMDB_CFLAGS="-I\"$lincdir\"" + LMDB_LIBS="-L\"$llibdir\" -llmdb" + fi + fi + fi +]) + +# EOF diff --git a/tcl8.6/pkgs/thread2.8.4/configure b/tcl8.6/pkgs/thread2.8.4/configure new file mode 100755 index 0000000..1323630 --- /dev/null +++ b/tcl8.6/pkgs/thread2.8.4/configure @@ -0,0 +1,9619 @@ +#! /bin/sh +# Guess values for system-dependent variables and create Makefiles. +# Generated by GNU Autoconf 2.69 for thread 2.8.4. +# +# +# Copyright (C) 1992-1996, 1998-2012 Free Software Foundation, Inc. +# +# +# This configure script is free software; the Free Software Foundation +# gives unlimited permission to copy, distribute and modify it. +## -------------------- ## +## M4sh Initialization. ## +## -------------------- ## + +# Be more Bourne compatible +DUALCASE=1; export DUALCASE # for MKS sh +if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then : + emulate sh + NULLCMD=: + # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which + # is contrary to our usage. Disable this feature. + alias -g '${1+"$@"}'='"$@"' + setopt NO_GLOB_SUBST +else + case `(set -o) 2>/dev/null` in #( + *posix*) : + set -o posix ;; #( + *) : + ;; +esac +fi + + +as_nl=' +' +export as_nl +# Printing a long string crashes Solaris 7 /usr/bin/printf. +as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\' +as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo +as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo +# Prefer a ksh shell builtin over an external printf program on Solaris, +# but without wasting forks for bash or zsh. +if test -z "$BASH_VERSION$ZSH_VERSION" \ + && (test "X`print -r -- $as_echo`" = "X$as_echo") 2>/dev/null; then + as_echo='print -r --' + as_echo_n='print -rn --' +elif (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then + as_echo='printf %s\n' + as_echo_n='printf %s' +else + if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then + as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"' + as_echo_n='/usr/ucb/echo -n' + else + as_echo_body='eval expr "X$1" : "X\\(.*\\)"' + as_echo_n_body='eval + arg=$1; + case $arg in #( + *"$as_nl"*) + expr "X$arg" : "X\\(.*\\)$as_nl"; + arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;; + esac; + expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl" + ' + export as_echo_n_body + as_echo_n='sh -c $as_echo_n_body as_echo' + fi + export as_echo_body + as_echo='sh -c $as_echo_body as_echo' +fi + +# The user is always right. +if test "${PATH_SEPARATOR+set}" != set; then + PATH_SEPARATOR=: + (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && { + (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 || + PATH_SEPARATOR=';' + } +fi + + +# IFS +# We need space, tab and new line, in precisely that order. Quoting is +# there to prevent editors from complaining about space-tab. +# (If _AS_PATH_WALK were called with IFS unset, it would disable word +# splitting by setting IFS to empty value.) +IFS=" "" $as_nl" + +# Find who we are. Look in the path if we contain no directory separator. +as_myself= +case $0 in #(( + *[\\/]* ) as_myself=$0 ;; + *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break + done +IFS=$as_save_IFS + + ;; +esac +# We did not find ourselves, most probably we were run as `sh COMMAND' +# in which case we are not to be found in the path. +if test "x$as_myself" = x; then + as_myself=$0 +fi +if test ! -f "$as_myself"; then + $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2 + exit 1 +fi + +# Unset variables that we do not need and which cause bugs (e.g. in +# pre-3.0 UWIN ksh). But do not cause bugs in bash 2.01; the "|| exit 1" +# suppresses any "Segmentation fault" message there. '((' could +# trigger a bug in pdksh 5.2.14. +for as_var in BASH_ENV ENV MAIL MAILPATH +do eval test x\${$as_var+set} = xset \ + && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || : +done +PS1='$ ' +PS2='> ' +PS4='+ ' + +# NLS nuisances. +LC_ALL=C +export LC_ALL +LANGUAGE=C +export LANGUAGE + +# CDPATH. +(unset CDPATH) >/dev/null 2>&1 && unset CDPATH + +# Use a proper internal environment variable to ensure we don't fall + # into an infinite loop, continuously re-executing ourselves. + if test x"${_as_can_reexec}" != xno && test "x$CONFIG_SHELL" != x; then + _as_can_reexec=no; export _as_can_reexec; + # We cannot yet assume a decent shell, so we have to provide a +# neutralization value for shells without unset; and this also +# works around shells that cannot unset nonexistent variables. +# Preserve -v and -x to the replacement shell. +BASH_ENV=/dev/null +ENV=/dev/null +(unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV +case $- in # (((( + *v*x* | *x*v* ) as_opts=-vx ;; + *v* ) as_opts=-v ;; + *x* ) as_opts=-x ;; + * ) as_opts= ;; +esac +exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"} +# Admittedly, this is quite paranoid, since all the known shells bail +# out after a failed `exec'. +$as_echo "$0: could not re-execute with $CONFIG_SHELL" >&2 +as_fn_exit 255 + fi + # We don't want this to propagate to other subprocesses. + { _as_can_reexec=; unset _as_can_reexec;} +if test "x$CONFIG_SHELL" = x; then + as_bourne_compatible="if test -n \"\${ZSH_VERSION+set}\" && (emulate sh) >/dev/null 2>&1; then : + emulate sh + NULLCMD=: + # Pre-4.2 versions of Zsh do word splitting on \${1+\"\$@\"}, which + # is contrary to our usage. Disable this feature. + alias -g '\${1+\"\$@\"}'='\"\$@\"' + setopt NO_GLOB_SUBST +else + case \`(set -o) 2>/dev/null\` in #( + *posix*) : + set -o posix ;; #( + *) : + ;; +esac +fi +" + as_required="as_fn_return () { (exit \$1); } +as_fn_success () { as_fn_return 0; } +as_fn_failure () { as_fn_return 1; } +as_fn_ret_success () { return 0; } +as_fn_ret_failure () { return 1; } + +exitcode=0 +as_fn_success || { exitcode=1; echo as_fn_success failed.; } +as_fn_failure && { exitcode=1; echo as_fn_failure succeeded.; } +as_fn_ret_success || { exitcode=1; echo as_fn_ret_success failed.; } +as_fn_ret_failure && { exitcode=1; echo as_fn_ret_failure succeeded.; } +if ( set x; as_fn_ret_success y && test x = \"\$1\" ); then : + +else + exitcode=1; echo positional parameters were not saved. +fi +test x\$exitcode = x0 || exit 1 +test -x / || exit 1" + as_suggested=" as_lineno_1=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_1a=\$LINENO + as_lineno_2=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_2a=\$LINENO + eval 'test \"x\$as_lineno_1'\$as_run'\" != \"x\$as_lineno_2'\$as_run'\" && + test \"x\`expr \$as_lineno_1'\$as_run' + 1\`\" = \"x\$as_lineno_2'\$as_run'\"' || exit 1 +test \$(( 1 + 1 )) = 2 || exit 1" + if (eval "$as_required") 2>/dev/null; then : + as_have_required=yes +else + as_have_required=no +fi + if test x$as_have_required = xyes && (eval "$as_suggested") 2>/dev/null; then : + +else + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +as_found=false +for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + as_found=: + case $as_dir in #( + /*) + for as_base in sh bash ksh sh5; do + # Try only shells that exist, to save several forks. + as_shell=$as_dir/$as_base + if { test -f "$as_shell" || test -f "$as_shell.exe"; } && + { $as_echo "$as_bourne_compatible""$as_required" | as_run=a "$as_shell"; } 2>/dev/null; then : + CONFIG_SHELL=$as_shell as_have_required=yes + if { $as_echo "$as_bourne_compatible""$as_suggested" | as_run=a "$as_shell"; } 2>/dev/null; then : + break 2 +fi +fi + done;; + esac + as_found=false +done +$as_found || { if { test -f "$SHELL" || test -f "$SHELL.exe"; } && + { $as_echo "$as_bourne_compatible""$as_required" | as_run=a "$SHELL"; } 2>/dev/null; then : + CONFIG_SHELL=$SHELL as_have_required=yes +fi; } +IFS=$as_save_IFS + + + if test "x$CONFIG_SHELL" != x; then : + export CONFIG_SHELL + # We cannot yet assume a decent shell, so we have to provide a +# neutralization value for shells without unset; and this also +# works around shells that cannot unset nonexistent variables. +# Preserve -v and -x to the replacement shell. +BASH_ENV=/dev/null +ENV=/dev/null +(unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV +case $- in # (((( + *v*x* | *x*v* ) as_opts=-vx ;; + *v* ) as_opts=-v ;; + *x* ) as_opts=-x ;; + * ) as_opts= ;; +esac +exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"} +# Admittedly, this is quite paranoid, since all the known shells bail +# out after a failed `exec'. +$as_echo "$0: could not re-execute with $CONFIG_SHELL" >&2 +exit 255 +fi + + if test x$as_have_required = xno; then : + $as_echo "$0: This script requires a shell more modern than all" + $as_echo "$0: the shells that I found on your system." + if test x${ZSH_VERSION+set} = xset ; then + $as_echo "$0: In particular, zsh $ZSH_VERSION has bugs and should" + $as_echo "$0: be upgraded to zsh 4.3.4 or later." + else + $as_echo "$0: Please tell bug-autoconf@gnu.org about your system, +$0: including any error possibly output before this +$0: message. Then install a modern shell, or manually run +$0: the script under such a shell if you do have one." + fi + exit 1 +fi +fi +fi +SHELL=${CONFIG_SHELL-/bin/sh} +export SHELL +# Unset more variables known to interfere with behavior of common tools. +CLICOLOR_FORCE= GREP_OPTIONS= +unset CLICOLOR_FORCE GREP_OPTIONS + +## --------------------- ## +## M4sh Shell Functions. ## +## --------------------- ## +# as_fn_unset VAR +# --------------- +# Portably unset VAR. +as_fn_unset () +{ + { eval $1=; unset $1;} +} +as_unset=as_fn_unset + +# as_fn_set_status STATUS +# ----------------------- +# Set $? to STATUS, without forking. +as_fn_set_status () +{ + return $1 +} # as_fn_set_status + +# as_fn_exit STATUS +# ----------------- +# Exit the shell with STATUS, even in a "trap 0" or "set -e" context. +as_fn_exit () +{ + set +e + as_fn_set_status $1 + exit $1 +} # as_fn_exit + +# as_fn_mkdir_p +# ------------- +# Create "$as_dir" as a directory, including parents if necessary. +as_fn_mkdir_p () +{ + + case $as_dir in #( + -*) as_dir=./$as_dir;; + esac + test -d "$as_dir" || eval $as_mkdir_p || { + as_dirs= + while :; do + case $as_dir in #( + *\'*) as_qdir=`$as_echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'( + *) as_qdir=$as_dir;; + esac + as_dirs="'$as_qdir' $as_dirs" + as_dir=`$as_dirname -- "$as_dir" || +$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$as_dir" : 'X\(//\)[^/]' \| \ + X"$as_dir" : 'X\(//\)$' \| \ + X"$as_dir" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X"$as_dir" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ + s//\1/ + q + } + /^X\(\/\/\)[^/].*/{ + s//\1/ + q + } + /^X\(\/\/\)$/{ + s//\1/ + q + } + /^X\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + test -d "$as_dir" && break + done + test -z "$as_dirs" || eval "mkdir $as_dirs" + } || test -d "$as_dir" || as_fn_error $? "cannot create directory $as_dir" + + +} # as_fn_mkdir_p + +# as_fn_executable_p FILE +# ----------------------- +# Test if FILE is an executable regular file. +as_fn_executable_p () +{ + test -f "$1" && test -x "$1" +} # as_fn_executable_p +# as_fn_append VAR VALUE +# ---------------------- +# Append the text in VALUE to the end of the definition contained in VAR. Take +# advantage of any shell optimizations that allow amortized linear growth over +# repeated appends, instead of the typical quadratic growth present in naive +# implementations. +if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null; then : + eval 'as_fn_append () + { + eval $1+=\$2 + }' +else + as_fn_append () + { + eval $1=\$$1\$2 + } +fi # as_fn_append + +# as_fn_arith ARG... +# ------------------ +# Perform arithmetic evaluation on the ARGs, and store the result in the +# global $as_val. Take advantage of shells that can avoid forks. The arguments +# must be portable across $(()) and expr. +if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null; then : + eval 'as_fn_arith () + { + as_val=$(( $* )) + }' +else + as_fn_arith () + { + as_val=`expr "$@" || test $? -eq 1` + } +fi # as_fn_arith + + +# as_fn_error STATUS ERROR [LINENO LOG_FD] +# ---------------------------------------- +# Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are +# provided, also output the error to LOG_FD, referencing LINENO. Then exit the +# script with STATUS, using 1 if that was 0. +as_fn_error () +{ + as_status=$1; test $as_status -eq 0 && as_status=1 + if test "$4"; then + as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + $as_echo "$as_me:${as_lineno-$LINENO}: error: $2" >&$4 + fi + $as_echo "$as_me: error: $2" >&2 + as_fn_exit $as_status +} # as_fn_error + +if expr a : '\(a\)' >/dev/null 2>&1 && + test "X`expr 00001 : '.*\(...\)'`" = X001; then + as_expr=expr +else + as_expr=false +fi + +if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then + as_basename=basename +else + as_basename=false +fi + +if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then + as_dirname=dirname +else + as_dirname=false +fi + +as_me=`$as_basename -- "$0" || +$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ + X"$0" : 'X\(//\)$' \| \ + X"$0" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X/"$0" | + sed '/^.*\/\([^/][^/]*\)\/*$/{ + s//\1/ + q + } + /^X\/\(\/\/\)$/{ + s//\1/ + q + } + /^X\/\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + +# Avoid depending upon Character Ranges. +as_cr_letters='abcdefghijklmnopqrstuvwxyz' +as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' +as_cr_Letters=$as_cr_letters$as_cr_LETTERS +as_cr_digits='0123456789' +as_cr_alnum=$as_cr_Letters$as_cr_digits + + + as_lineno_1=$LINENO as_lineno_1a=$LINENO + as_lineno_2=$LINENO as_lineno_2a=$LINENO + eval 'test "x$as_lineno_1'$as_run'" != "x$as_lineno_2'$as_run'" && + test "x`expr $as_lineno_1'$as_run' + 1`" = "x$as_lineno_2'$as_run'"' || { + # Blame Lee E. McMahon (1931-1989) for sed's syntax. :-) + sed -n ' + p + /[$]LINENO/= + ' <$as_myself | + sed ' + s/[$]LINENO.*/&-/ + t lineno + b + :lineno + N + :loop + s/[$]LINENO\([^'$as_cr_alnum'_].*\n\)\(.*\)/\2\1\2/ + t loop + s/-\n.*// + ' >$as_me.lineno && + chmod +x "$as_me.lineno" || + { $as_echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2; as_fn_exit 1; } + + # If we had to re-execute with $CONFIG_SHELL, we're ensured to have + # already done that, so ensure we don't try to do so again and fall + # in an infinite loop. This has already happened in practice. + _as_can_reexec=no; export _as_can_reexec + # Don't try to exec as it changes $[0], causing all sort of problems + # (the dirname of $[0] is not the place where we might find the + # original and so on. Autoconf is especially sensitive to this). + . "./$as_me.lineno" + # Exit status is that of the last command. + exit +} + +ECHO_C= ECHO_N= ECHO_T= +case `echo -n x` in #((((( +-n*) + case `echo 'xy\c'` in + *c*) ECHO_T=' ';; # ECHO_T is single tab character. + xy) ECHO_C='\c';; + *) echo `echo ksh88 bug on AIX 6.1` > /dev/null + ECHO_T=' ';; + esac;; +*) + ECHO_N='-n';; +esac + +rm -f conf$$ conf$$.exe conf$$.file +if test -d conf$$.dir; then + rm -f conf$$.dir/conf$$.file +else + rm -f conf$$.dir + mkdir conf$$.dir 2>/dev/null +fi +if (echo >conf$$.file) 2>/dev/null; then + if ln -s conf$$.file conf$$ 2>/dev/null; then + as_ln_s='ln -s' + # ... but there are two gotchas: + # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail. + # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable. + # In both cases, we have to default to `cp -pR'. + ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || + as_ln_s='cp -pR' + elif ln conf$$.file conf$$ 2>/dev/null; then + as_ln_s=ln + else + as_ln_s='cp -pR' + fi +else + as_ln_s='cp -pR' +fi +rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file +rmdir conf$$.dir 2>/dev/null + +if mkdir -p . 2>/dev/null; then + as_mkdir_p='mkdir -p "$as_dir"' +else + test -d ./-p && rmdir ./-p + as_mkdir_p=false +fi + +as_test_x='test -x' +as_executable_p=as_fn_executable_p + +# Sed expression to map a string onto a valid CPP name. +as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" + +# Sed expression to map a string onto a valid variable name. +as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" + + +test -n "$DJDIR" || exec 7<&0 </dev/null +exec 6>&1 + +# Name of the host. +# hostname on some systems (SVR3.2, old GNU/Linux) returns a bogus exit status, +# so uname gets run too. +ac_hostname=`(hostname || uname -n) 2>/dev/null | sed 1q` + +# +# Initializations. +# +ac_default_prefix=/usr/local +ac_clean_files= +ac_config_libobj_dir=. +LIBOBJS= +cross_compiling=no +subdirs= +MFLAGS= +MAKEFLAGS= + +# Identity of this package. +PACKAGE_NAME='thread' +PACKAGE_TARNAME='thread' +PACKAGE_VERSION='2.8.4' +PACKAGE_STRING='thread 2.8.4' +PACKAGE_BUGREPORT='' +PACKAGE_URL='' + +# Factoring default headers for most tests. +ac_includes_default="\ +#include <stdio.h> +#ifdef HAVE_SYS_TYPES_H +# include <sys/types.h> +#endif +#ifdef HAVE_SYS_STAT_H +# include <sys/stat.h> +#endif +#ifdef STDC_HEADERS +# include <stdlib.h> +# include <stddef.h> +#else +# ifdef HAVE_STDLIB_H +# include <stdlib.h> +# endif +#endif +#ifdef HAVE_STRING_H +# if !defined STDC_HEADERS && defined HAVE_MEMORY_H +# include <memory.h> +# endif +# include <string.h> +#endif +#ifdef HAVE_STRINGS_H +# include <strings.h> +#endif +#ifdef HAVE_INTTYPES_H +# include <inttypes.h> +#endif +#ifdef HAVE_STDINT_H +# include <stdint.h> +#endif +#ifdef HAVE_UNISTD_H +# include <unistd.h> +#endif" + +ac_subst_vars='LTLIBOBJS +LIBOBJS +TCLSH_PROG +VC_MANIFEST_EMBED_EXE +VC_MANIFEST_EMBED_DLL +RANLIB_STUB +MAKE_STUB_LIB +MAKE_STATIC_LIB +MAKE_SHARED_LIB +MAKE_LIB +TCL_DBGX +LDFLAGS_DEFAULT +CFLAGS_DEFAULT +LD_LIBRARY_PATH_VAR +SHLIB_CFLAGS +SHLIB_LD_LIBS +SHLIB_LD +STLIB_LD +CFLAGS_WARNING +CFLAGS_OPTIMIZE +CFLAGS_DEBUG +RC +CELIB_DIR +AR +STUBS_BUILD +SHARED_BUILD +TCL_THREADS +TCL_INCLUDES +PKG_OBJECTS +PKG_SOURCES +EGREP +GREP +RANLIB +SET_MAKE +CPP +TCL_SHLIB_LD_LIBS +TCL_LD_FLAGS +TCL_EXTRA_CFLAGS +TCL_DEFS +TCL_LIBS +CLEANFILES +OBJEXT +ac_ct_CC +CPPFLAGS +LDFLAGS +CFLAGS +CC +TCL_STUB_LIB_SPEC +TCL_STUB_LIB_FLAG +TCL_STUB_LIB_FILE +TCL_LIB_SPEC +TCL_LIB_FLAG +TCL_LIB_FILE +TCL_SRC_DIR +TCL_BIN_DIR +TCL_PATCH_LEVEL +TCL_VERSION +INSTALL_LIBRARY +INSTALL_SCRIPT +INSTALL_PROGRAM +INSTALL_DATA +INSTALL_DATA_DIR +INSTALL +PKG_CFLAGS +PKG_LIBS +PKG_INCLUDES +PKG_HEADERS +PKG_TCL_SOURCES +PKG_STUB_OBJECTS +PKG_STUB_SOURCES +PKG_STUB_LIB_FILE +PKG_LIB_FILE +EXEEXT +CYGPATH +target_alias +host_alias +build_alias +LIBS +ECHO_T +ECHO_N +ECHO_C +DEFS +mandir +localedir +libdir +psdir +pdfdir +dvidir +htmldir +infodir +docdir +oldincludedir +includedir +localstatedir +sharedstatedir +sysconfdir +datadir +datarootdir +libexecdir +sbindir +bindir +program_transform_name +prefix +exec_prefix +PACKAGE_URL +PACKAGE_BUGREPORT +PACKAGE_STRING +PACKAGE_VERSION +PACKAGE_TARNAME +PACKAGE_NAME +PATH_SEPARATOR +SHELL' +ac_subst_files='' +ac_user_opts=' +enable_option_checking +with_tcl +with_gdbm +with_lmdb +with_naviserver +with_tclinclude +enable_threads +enable_shared +enable_stubs +enable_64bit +enable_64bit_vis +enable_rpath +enable_wince +with_celib +enable_symbols +' + ac_precious_vars='build_alias +host_alias +target_alias +CC +CFLAGS +LDFLAGS +LIBS +CPPFLAGS +CPP' + + +# Initialize some variables set by options. +ac_init_help= +ac_init_version=false +ac_unrecognized_opts= +ac_unrecognized_sep= +# The variables have the same names as the options, with +# dashes changed to underlines. +cache_file=/dev/null +exec_prefix=NONE +no_create= +no_recursion= +prefix=NONE +program_prefix=NONE +program_suffix=NONE +program_transform_name=s,x,x, +silent= +site= +srcdir= +verbose= +x_includes=NONE +x_libraries=NONE + +# Installation directory options. +# These are left unexpanded so users can "make install exec_prefix=/foo" +# and all the variables that are supposed to be based on exec_prefix +# by default will actually change. +# Use braces instead of parens because sh, perl, etc. also accept them. +# (The list follows the same order as the GNU Coding Standards.) +bindir='${exec_prefix}/bin' +sbindir='${exec_prefix}/sbin' +libexecdir='${exec_prefix}/libexec' +datarootdir='${prefix}/share' +datadir='${datarootdir}' +sysconfdir='${prefix}/etc' +sharedstatedir='${prefix}/com' +localstatedir='${prefix}/var' +includedir='${prefix}/include' +oldincludedir='/usr/include' +docdir='${datarootdir}/doc/${PACKAGE_TARNAME}' +infodir='${datarootdir}/info' +htmldir='${docdir}' +dvidir='${docdir}' +pdfdir='${docdir}' +psdir='${docdir}' +libdir='${exec_prefix}/lib' +localedir='${datarootdir}/locale' +mandir='${datarootdir}/man' + +ac_prev= +ac_dashdash= +for ac_option +do + # If the previous option needs an argument, assign it. + if test -n "$ac_prev"; then + eval $ac_prev=\$ac_option + ac_prev= + continue + fi + + case $ac_option in + *=?*) ac_optarg=`expr "X$ac_option" : '[^=]*=\(.*\)'` ;; + *=) ac_optarg= ;; + *) ac_optarg=yes ;; + esac + + # Accept the important Cygnus configure options, so we can diagnose typos. + + case $ac_dashdash$ac_option in + --) + ac_dashdash=yes ;; + + -bindir | --bindir | --bindi | --bind | --bin | --bi) + ac_prev=bindir ;; + -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*) + bindir=$ac_optarg ;; + + -build | --build | --buil | --bui | --bu) + ac_prev=build_alias ;; + -build=* | --build=* | --buil=* | --bui=* | --bu=*) + build_alias=$ac_optarg ;; + + -cache-file | --cache-file | --cache-fil | --cache-fi \ + | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c) + ac_prev=cache_file ;; + -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \ + | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*) + cache_file=$ac_optarg ;; + + --config-cache | -C) + cache_file=config.cache ;; + + -datadir | --datadir | --datadi | --datad) + ac_prev=datadir ;; + -datadir=* | --datadir=* | --datadi=* | --datad=*) + datadir=$ac_optarg ;; + + -datarootdir | --datarootdir | --datarootdi | --datarootd | --dataroot \ + | --dataroo | --dataro | --datar) + ac_prev=datarootdir ;; + -datarootdir=* | --datarootdir=* | --datarootdi=* | --datarootd=* \ + | --dataroot=* | --dataroo=* | --dataro=* | --datar=*) + datarootdir=$ac_optarg ;; + + -disable-* | --disable-*) + ac_useropt=`expr "x$ac_option" : 'x-*disable-\(.*\)'` + # Reject names that are not valid shell variable names. + expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && + as_fn_error $? "invalid feature name: $ac_useropt" + ac_useropt_orig=$ac_useropt + ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` + case $ac_user_opts in + *" +"enable_$ac_useropt" +"*) ;; + *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--disable-$ac_useropt_orig" + ac_unrecognized_sep=', ';; + esac + eval enable_$ac_useropt=no ;; + + -docdir | --docdir | --docdi | --doc | --do) + ac_prev=docdir ;; + -docdir=* | --docdir=* | --docdi=* | --doc=* | --do=*) + docdir=$ac_optarg ;; + + -dvidir | --dvidir | --dvidi | --dvid | --dvi | --dv) + ac_prev=dvidir ;; + -dvidir=* | --dvidir=* | --dvidi=* | --dvid=* | --dvi=* | --dv=*) + dvidir=$ac_optarg ;; + + -enable-* | --enable-*) + ac_useropt=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'` + # Reject names that are not valid shell variable names. + expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && + as_fn_error $? "invalid feature name: $ac_useropt" + ac_useropt_orig=$ac_useropt + ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` + case $ac_user_opts in + *" +"enable_$ac_useropt" +"*) ;; + *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--enable-$ac_useropt_orig" + ac_unrecognized_sep=', ';; + esac + eval enable_$ac_useropt=\$ac_optarg ;; + + -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \ + | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \ + | --exec | --exe | --ex) + ac_prev=exec_prefix ;; + -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \ + | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \ + | --exec=* | --exe=* | --ex=*) + exec_prefix=$ac_optarg ;; + + -gas | --gas | --ga | --g) + # Obsolete; use --with-gas. + with_gas=yes ;; + + -help | --help | --hel | --he | -h) + ac_init_help=long ;; + -help=r* | --help=r* | --hel=r* | --he=r* | -hr*) + ac_init_help=recursive ;; + -help=s* | --help=s* | --hel=s* | --he=s* | -hs*) + ac_init_help=short ;; + + -host | --host | --hos | --ho) + ac_prev=host_alias ;; + -host=* | --host=* | --hos=* | --ho=*) + host_alias=$ac_optarg ;; + + -htmldir | --htmldir | --htmldi | --htmld | --html | --htm | --ht) + ac_prev=htmldir ;; + -htmldir=* | --htmldir=* | --htmldi=* | --htmld=* | --html=* | --htm=* \ + | --ht=*) + htmldir=$ac_optarg ;; + + -includedir | --includedir | --includedi | --included | --include \ + | --includ | --inclu | --incl | --inc) + ac_prev=includedir ;; + -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \ + | --includ=* | --inclu=* | --incl=* | --inc=*) + includedir=$ac_optarg ;; + + -infodir | --infodir | --infodi | --infod | --info | --inf) + ac_prev=infodir ;; + -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*) + infodir=$ac_optarg ;; + + -libdir | --libdir | --libdi | --libd) + ac_prev=libdir ;; + -libdir=* | --libdir=* | --libdi=* | --libd=*) + libdir=$ac_optarg ;; + + -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \ + | --libexe | --libex | --libe) + ac_prev=libexecdir ;; + -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \ + | --libexe=* | --libex=* | --libe=*) + libexecdir=$ac_optarg ;; + + -localedir | --localedir | --localedi | --localed | --locale) + ac_prev=localedir ;; + -localedir=* | --localedir=* | --localedi=* | --localed=* | --locale=*) + localedir=$ac_optarg ;; + + -localstatedir | --localstatedir | --localstatedi | --localstated \ + | --localstate | --localstat | --localsta | --localst | --locals) + ac_prev=localstatedir ;; + -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \ + | --localstate=* | --localstat=* | --localsta=* | --localst=* | --locals=*) + localstatedir=$ac_optarg ;; + + -mandir | --mandir | --mandi | --mand | --man | --ma | --m) + ac_prev=mandir ;; + -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*) + mandir=$ac_optarg ;; + + -nfp | --nfp | --nf) + # Obsolete; use --without-fp. + with_fp=no ;; + + -no-create | --no-create | --no-creat | --no-crea | --no-cre \ + | --no-cr | --no-c | -n) + no_create=yes ;; + + -no-recursion | --no-recursion | --no-recursio | --no-recursi \ + | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) + no_recursion=yes ;; + + -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \ + | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \ + | --oldin | --oldi | --old | --ol | --o) + ac_prev=oldincludedir ;; + -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \ + | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \ + | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*) + oldincludedir=$ac_optarg ;; + + -prefix | --prefix | --prefi | --pref | --pre | --pr | --p) + ac_prev=prefix ;; + -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*) + prefix=$ac_optarg ;; + + -program-prefix | --program-prefix | --program-prefi | --program-pref \ + | --program-pre | --program-pr | --program-p) + ac_prev=program_prefix ;; + -program-prefix=* | --program-prefix=* | --program-prefi=* \ + | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*) + program_prefix=$ac_optarg ;; + + -program-suffix | --program-suffix | --program-suffi | --program-suff \ + | --program-suf | --program-su | --program-s) + ac_prev=program_suffix ;; + -program-suffix=* | --program-suffix=* | --program-suffi=* \ + | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*) + program_suffix=$ac_optarg ;; + + -program-transform-name | --program-transform-name \ + | --program-transform-nam | --program-transform-na \ + | --program-transform-n | --program-transform- \ + | --program-transform | --program-transfor \ + | --program-transfo | --program-transf \ + | --program-trans | --program-tran \ + | --progr-tra | --program-tr | --program-t) + ac_prev=program_transform_name ;; + -program-transform-name=* | --program-transform-name=* \ + | --program-transform-nam=* | --program-transform-na=* \ + | --program-transform-n=* | --program-transform-=* \ + | --program-transform=* | --program-transfor=* \ + | --program-transfo=* | --program-transf=* \ + | --program-trans=* | --program-tran=* \ + | --progr-tra=* | --program-tr=* | --program-t=*) + program_transform_name=$ac_optarg ;; + + -pdfdir | --pdfdir | --pdfdi | --pdfd | --pdf | --pd) + ac_prev=pdfdir ;; + -pdfdir=* | --pdfdir=* | --pdfdi=* | --pdfd=* | --pdf=* | --pd=*) + pdfdir=$ac_optarg ;; + + -psdir | --psdir | --psdi | --psd | --ps) + ac_prev=psdir ;; + -psdir=* | --psdir=* | --psdi=* | --psd=* | --ps=*) + psdir=$ac_optarg ;; + + -q | -quiet | --quiet | --quie | --qui | --qu | --q \ + | -silent | --silent | --silen | --sile | --sil) + silent=yes ;; + + -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb) + ac_prev=sbindir ;; + -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \ + | --sbi=* | --sb=*) + sbindir=$ac_optarg ;; + + -sharedstatedir | --sharedstatedir | --sharedstatedi \ + | --sharedstated | --sharedstate | --sharedstat | --sharedsta \ + | --sharedst | --shareds | --shared | --share | --shar \ + | --sha | --sh) + ac_prev=sharedstatedir ;; + -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \ + | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \ + | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \ + | --sha=* | --sh=*) + sharedstatedir=$ac_optarg ;; + + -site | --site | --sit) + ac_prev=site ;; + -site=* | --site=* | --sit=*) + site=$ac_optarg ;; + + -srcdir | --srcdir | --srcdi | --srcd | --src | --sr) + ac_prev=srcdir ;; + -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*) + srcdir=$ac_optarg ;; + + -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \ + | --syscon | --sysco | --sysc | --sys | --sy) + ac_prev=sysconfdir ;; + -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \ + | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*) + sysconfdir=$ac_optarg ;; + + -target | --target | --targe | --targ | --tar | --ta | --t) + ac_prev=target_alias ;; + -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*) + target_alias=$ac_optarg ;; + + -v | -verbose | --verbose | --verbos | --verbo | --verb) + verbose=yes ;; + + -version | --version | --versio | --versi | --vers | -V) + ac_init_version=: ;; + + -with-* | --with-*) + ac_useropt=`expr "x$ac_option" : 'x-*with-\([^=]*\)'` + # Reject names that are not valid shell variable names. + expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && + as_fn_error $? "invalid package name: $ac_useropt" + ac_useropt_orig=$ac_useropt + ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` + case $ac_user_opts in + *" +"with_$ac_useropt" +"*) ;; + *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--with-$ac_useropt_orig" + ac_unrecognized_sep=', ';; + esac + eval with_$ac_useropt=\$ac_optarg ;; + + -without-* | --without-*) + ac_useropt=`expr "x$ac_option" : 'x-*without-\(.*\)'` + # Reject names that are not valid shell variable names. + expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && + as_fn_error $? "invalid package name: $ac_useropt" + ac_useropt_orig=$ac_useropt + ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` + case $ac_user_opts in + *" +"with_$ac_useropt" +"*) ;; + *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--without-$ac_useropt_orig" + ac_unrecognized_sep=', ';; + esac + eval with_$ac_useropt=no ;; + + --x) + # Obsolete; use --with-x. + with_x=yes ;; + + -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \ + | --x-incl | --x-inc | --x-in | --x-i) + ac_prev=x_includes ;; + -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \ + | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*) + x_includes=$ac_optarg ;; + + -x-libraries | --x-libraries | --x-librarie | --x-librari \ + | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l) + ac_prev=x_libraries ;; + -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \ + | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*) + x_libraries=$ac_optarg ;; + + -*) as_fn_error $? "unrecognized option: \`$ac_option' +Try \`$0 --help' for more information" + ;; + + *=*) + ac_envvar=`expr "x$ac_option" : 'x\([^=]*\)='` + # Reject names that are not valid shell variable names. + case $ac_envvar in #( + '' | [0-9]* | *[!_$as_cr_alnum]* ) + as_fn_error $? "invalid variable name: \`$ac_envvar'" ;; + esac + eval $ac_envvar=\$ac_optarg + export $ac_envvar ;; + + *) + # FIXME: should be removed in autoconf 3.0. + $as_echo "$as_me: WARNING: you should use --build, --host, --target" >&2 + expr "x$ac_option" : ".*[^-._$as_cr_alnum]" >/dev/null && + $as_echo "$as_me: WARNING: invalid host type: $ac_option" >&2 + : "${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option}" + ;; + + esac +done + +if test -n "$ac_prev"; then + ac_option=--`echo $ac_prev | sed 's/_/-/g'` + as_fn_error $? "missing argument to $ac_option" +fi + +if test -n "$ac_unrecognized_opts"; then + case $enable_option_checking in + no) ;; + fatal) as_fn_error $? "unrecognized options: $ac_unrecognized_opts" ;; + *) $as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2 ;; + esac +fi + +# Check all directory arguments for consistency. +for ac_var in exec_prefix prefix bindir sbindir libexecdir datarootdir \ + datadir sysconfdir sharedstatedir localstatedir includedir \ + oldincludedir docdir infodir htmldir dvidir pdfdir psdir \ + libdir localedir mandir +do + eval ac_val=\$$ac_var + # Remove trailing slashes. + case $ac_val in + */ ) + ac_val=`expr "X$ac_val" : 'X\(.*[^/]\)' \| "X$ac_val" : 'X\(.*\)'` + eval $ac_var=\$ac_val;; + esac + # Be sure to have absolute directory names. + case $ac_val in + [\\/$]* | ?:[\\/]* ) continue;; + NONE | '' ) case $ac_var in *prefix ) continue;; esac;; + esac + as_fn_error $? "expected an absolute directory name for --$ac_var: $ac_val" +done + +# There might be people who depend on the old broken behavior: `$host' +# used to hold the argument of --host etc. +# FIXME: To remove some day. +build=$build_alias +host=$host_alias +target=$target_alias + +# FIXME: To remove some day. +if test "x$host_alias" != x; then + if test "x$build_alias" = x; then + cross_compiling=maybe + elif test "x$build_alias" != "x$host_alias"; then + cross_compiling=yes + fi +fi + +ac_tool_prefix= +test -n "$host_alias" && ac_tool_prefix=$host_alias- + +test "$silent" = yes && exec 6>/dev/null + + +ac_pwd=`pwd` && test -n "$ac_pwd" && +ac_ls_di=`ls -di .` && +ac_pwd_ls_di=`cd "$ac_pwd" && ls -di .` || + as_fn_error $? "working directory cannot be determined" +test "X$ac_ls_di" = "X$ac_pwd_ls_di" || + as_fn_error $? "pwd does not report name of working directory" + + +# Find the source files, if location was not specified. +if test -z "$srcdir"; then + ac_srcdir_defaulted=yes + # Try the directory containing this script, then the parent directory. + ac_confdir=`$as_dirname -- "$as_myself" || +$as_expr X"$as_myself" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$as_myself" : 'X\(//\)[^/]' \| \ + X"$as_myself" : 'X\(//\)$' \| \ + X"$as_myself" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X"$as_myself" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ + s//\1/ + q + } + /^X\(\/\/\)[^/].*/{ + s//\1/ + q + } + /^X\(\/\/\)$/{ + s//\1/ + q + } + /^X\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + srcdir=$ac_confdir + if test ! -r "$srcdir/$ac_unique_file"; then + srcdir=.. + fi +else + ac_srcdir_defaulted=no +fi +if test ! -r "$srcdir/$ac_unique_file"; then + test "$ac_srcdir_defaulted" = yes && srcdir="$ac_confdir or .." + as_fn_error $? "cannot find sources ($ac_unique_file) in $srcdir" +fi +ac_msg="sources are in $srcdir, but \`cd $srcdir' does not work" +ac_abs_confdir=`( + cd "$srcdir" && test -r "./$ac_unique_file" || as_fn_error $? "$ac_msg" + pwd)` +# When building in place, set srcdir=. +if test "$ac_abs_confdir" = "$ac_pwd"; then + srcdir=. +fi +# Remove unnecessary trailing slashes from srcdir. +# Double slashes in file names in object file debugging info +# mess up M-x gdb in Emacs. +case $srcdir in +*/) srcdir=`expr "X$srcdir" : 'X\(.*[^/]\)' \| "X$srcdir" : 'X\(.*\)'`;; +esac +for ac_var in $ac_precious_vars; do + eval ac_env_${ac_var}_set=\${${ac_var}+set} + eval ac_env_${ac_var}_value=\$${ac_var} + eval ac_cv_env_${ac_var}_set=\${${ac_var}+set} + eval ac_cv_env_${ac_var}_value=\$${ac_var} +done + +# +# Report the --help message. +# +if test "$ac_init_help" = "long"; then + # Omit some internal or obsolete options to make the list less imposing. + # This message is too long to be a string in the A/UX 3.1 sh. + cat <<_ACEOF +\`configure' configures thread 2.8.4 to adapt to many kinds of systems. + +Usage: $0 [OPTION]... [VAR=VALUE]... + +To assign environment variables (e.g., CC, CFLAGS...), specify them as +VAR=VALUE. See below for descriptions of some of the useful variables. + +Defaults for the options are specified in brackets. + +Configuration: + -h, --help display this help and exit + --help=short display options specific to this package + --help=recursive display the short help of all the included packages + -V, --version display version information and exit + -q, --quiet, --silent do not print \`checking ...' messages + --cache-file=FILE cache test results in FILE [disabled] + -C, --config-cache alias for \`--cache-file=config.cache' + -n, --no-create do not create output files + --srcdir=DIR find the sources in DIR [configure dir or \`..'] + +Installation directories: + --prefix=PREFIX install architecture-independent files in PREFIX + [$ac_default_prefix] + --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX + [PREFIX] + +By default, \`make install' will install all the files in +\`$ac_default_prefix/bin', \`$ac_default_prefix/lib' etc. You can specify +an installation prefix other than \`$ac_default_prefix' using \`--prefix', +for instance \`--prefix=\$HOME'. + +For better control, use the options below. + +Fine tuning of the installation directories: + --bindir=DIR user executables [EPREFIX/bin] + --sbindir=DIR system admin executables [EPREFIX/sbin] + --libexecdir=DIR program executables [EPREFIX/libexec] + --sysconfdir=DIR read-only single-machine data [PREFIX/etc] + --sharedstatedir=DIR modifiable architecture-independent data [PREFIX/com] + --localstatedir=DIR modifiable single-machine data [PREFIX/var] + --libdir=DIR object code libraries [EPREFIX/lib] + --includedir=DIR C header files [PREFIX/include] + --oldincludedir=DIR C header files for non-gcc [/usr/include] + --datarootdir=DIR read-only arch.-independent data root [PREFIX/share] + --datadir=DIR read-only architecture-independent data [DATAROOTDIR] + --infodir=DIR info documentation [DATAROOTDIR/info] + --localedir=DIR locale-dependent data [DATAROOTDIR/locale] + --mandir=DIR man documentation [DATAROOTDIR/man] + --docdir=DIR documentation root [DATAROOTDIR/doc/thread] + --htmldir=DIR html documentation [DOCDIR] + --dvidir=DIR dvi documentation [DOCDIR] + --pdfdir=DIR pdf documentation [DOCDIR] + --psdir=DIR ps documentation [DOCDIR] +_ACEOF + + cat <<\_ACEOF +_ACEOF +fi + +if test -n "$ac_init_help"; then + case $ac_init_help in + short | recursive ) echo "Configuration of thread 2.8.4:";; + esac + cat <<\_ACEOF + +Optional Features: + --disable-option-checking ignore unrecognized --enable/--with options + --disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no) + --enable-FEATURE[=ARG] include FEATURE [ARG=yes] + --enable-threads build with threads (default: on) + --enable-shared build and link with shared libraries (default: on) + --enable-stubs build and link with stub libraries. Always true for + shared builds (default: on) + --enable-64bit enable 64bit support (default: off) + --enable-64bit-vis enable 64bit Sparc VIS support (default: off) + --disable-rpath disable rpath support (default: on) + --enable-wince enable Win/CE support (where applicable) + --enable-symbols build with debugging symbols (default: off) + +Optional Packages: + --with-PACKAGE[=ARG] use PACKAGE [ARG=yes] + --without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no) + --with-tcl directory containing tcl configuration + (tclConfig.sh) + --with-gdbm link with optional GDBM support + --with-lmdb link with optional LMDB support + --with-naviserver directory with NaviServer/AOLserver distribution + --with-tclinclude directory containing the public Tcl header files + --with-celib=DIR use Windows/CE support library from DIR + +Some influential environment variables: + CC C compiler command + CFLAGS C compiler flags + LDFLAGS linker flags, e.g. -L<lib dir> if you have libraries in a + nonstandard directory <lib dir> + LIBS libraries to pass to the linker, e.g. -l<library> + CPPFLAGS (Objective) C/C++ preprocessor flags, e.g. -I<include dir> if + you have headers in a nonstandard directory <include dir> + CPP C preprocessor + +Use these variables to override the choices made by `configure' or to help +it to find libraries and programs with nonstandard names/locations. + +Report bugs to the package provider. +_ACEOF +ac_status=$? +fi + +if test "$ac_init_help" = "recursive"; then + # If there are subdirs, report their specific --help. + for ac_dir in : $ac_subdirs_all; do test "x$ac_dir" = x: && continue + test -d "$ac_dir" || + { cd "$srcdir" && ac_pwd=`pwd` && srcdir=. && test -d "$ac_dir"; } || + continue + ac_builddir=. + +case "$ac_dir" in +.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;; +*) + ac_dir_suffix=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'` + # A ".." for each directory in $ac_dir_suffix. + ac_top_builddir_sub=`$as_echo "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'` + case $ac_top_builddir_sub in + "") ac_top_builddir_sub=. ac_top_build_prefix= ;; + *) ac_top_build_prefix=$ac_top_builddir_sub/ ;; + esac ;; +esac +ac_abs_top_builddir=$ac_pwd +ac_abs_builddir=$ac_pwd$ac_dir_suffix +# for backward compatibility: +ac_top_builddir=$ac_top_build_prefix + +case $srcdir in + .) # We are building in place. + ac_srcdir=. + ac_top_srcdir=$ac_top_builddir_sub + ac_abs_top_srcdir=$ac_pwd ;; + [\\/]* | ?:[\\/]* ) # Absolute name. + ac_srcdir=$srcdir$ac_dir_suffix; + ac_top_srcdir=$srcdir + ac_abs_top_srcdir=$srcdir ;; + *) # Relative name. + ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix + ac_top_srcdir=$ac_top_build_prefix$srcdir + ac_abs_top_srcdir=$ac_pwd/$srcdir ;; +esac +ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix + + cd "$ac_dir" || { ac_status=$?; continue; } + # Check for guested configure. + if test -f "$ac_srcdir/configure.gnu"; then + echo && + $SHELL "$ac_srcdir/configure.gnu" --help=recursive + elif test -f "$ac_srcdir/configure"; then + echo && + $SHELL "$ac_srcdir/configure" --help=recursive + else + $as_echo "$as_me: WARNING: no configuration information is in $ac_dir" >&2 + fi || ac_status=$? + cd "$ac_pwd" || { ac_status=$?; break; } + done +fi + +test -n "$ac_init_help" && exit $ac_status +if $ac_init_version; then + cat <<\_ACEOF +thread configure 2.8.4 +generated by GNU Autoconf 2.69 + +Copyright (C) 2012 Free Software Foundation, Inc. +This configure script is free software; the Free Software Foundation +gives unlimited permission to copy, distribute and modify it. +_ACEOF + exit +fi + +## ------------------------ ## +## Autoconf initialization. ## +## ------------------------ ## + +# ac_fn_c_try_compile LINENO +# -------------------------- +# Try to compile conftest.$ac_ext, and return whether this succeeded. +ac_fn_c_try_compile () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + rm -f conftest.$ac_objext + if { { ac_try="$ac_compile" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_compile") 2>conftest.err + ac_status=$? + if test -s conftest.err; then + grep -v '^ *+' conftest.err >conftest.er1 + cat conftest.er1 >&5 + mv -f conftest.er1 conftest.err + fi + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } && { + test -z "$ac_c_werror_flag" || + test ! -s conftest.err + } && test -s conftest.$ac_objext; then : + ac_retval=0 +else + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_retval=1 +fi + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + as_fn_set_status $ac_retval + +} # ac_fn_c_try_compile + +# ac_fn_c_try_cpp LINENO +# ---------------------- +# Try to preprocess conftest.$ac_ext, and return whether this succeeded. +ac_fn_c_try_cpp () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + if { { ac_try="$ac_cpp conftest.$ac_ext" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_cpp conftest.$ac_ext") 2>conftest.err + ac_status=$? + if test -s conftest.err; then + grep -v '^ *+' conftest.err >conftest.er1 + cat conftest.er1 >&5 + mv -f conftest.er1 conftest.err + fi + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } > conftest.i && { + test -z "$ac_c_preproc_warn_flag$ac_c_werror_flag" || + test ! -s conftest.err + }; then : + ac_retval=0 +else + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_retval=1 +fi + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + as_fn_set_status $ac_retval + +} # ac_fn_c_try_cpp + +# ac_fn_c_try_run LINENO +# ---------------------- +# Try to link conftest.$ac_ext, and return whether this succeeded. Assumes +# that executables *can* be run. +ac_fn_c_try_run () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + if { { ac_try="$ac_link" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_link") 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } && { ac_try='./conftest$ac_exeext' + { { case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_try") 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; }; then : + ac_retval=0 +else + $as_echo "$as_me: program exited with status $ac_status" >&5 + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_retval=$ac_status +fi + rm -rf conftest.dSYM conftest_ipa8_conftest.oo + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + as_fn_set_status $ac_retval + +} # ac_fn_c_try_run + +# ac_fn_c_check_header_compile LINENO HEADER VAR INCLUDES +# ------------------------------------------------------- +# Tests whether HEADER exists and can be compiled using the include files in +# INCLUDES, setting the cache variable VAR accordingly. +ac_fn_c_check_header_compile () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 +$as_echo_n "checking for $2... " >&6; } +if eval \${$3+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$4 +#include <$2> +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + eval "$3=yes" +else + eval "$3=no" +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +eval ac_res=\$$3 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + +} # ac_fn_c_check_header_compile + +# ac_fn_c_try_link LINENO +# ----------------------- +# Try to link conftest.$ac_ext, and return whether this succeeded. +ac_fn_c_try_link () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + rm -f conftest.$ac_objext conftest$ac_exeext + if { { ac_try="$ac_link" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_link") 2>conftest.err + ac_status=$? + if test -s conftest.err; then + grep -v '^ *+' conftest.err >conftest.er1 + cat conftest.er1 >&5 + mv -f conftest.er1 conftest.err + fi + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } && { + test -z "$ac_c_werror_flag" || + test ! -s conftest.err + } && test -s conftest$ac_exeext && { + test "$cross_compiling" = yes || + test -x conftest$ac_exeext + }; then : + ac_retval=0 +else + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_retval=1 +fi + # Delete the IPA/IPO (Inter Procedural Analysis/Optimization) information + # created by the PGI compiler (conftest_ipa8_conftest.oo), as it would + # interfere with the next link command; also delete a directory that is + # left behind by Apple's compiler. We do this before executing the actions. + rm -rf conftest.dSYM conftest_ipa8_conftest.oo + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + as_fn_set_status $ac_retval + +} # ac_fn_c_try_link + +# ac_fn_c_check_func LINENO FUNC VAR +# ---------------------------------- +# Tests whether FUNC exists, setting the cache variable VAR accordingly +ac_fn_c_check_func () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 +$as_echo_n "checking for $2... " >&6; } +if eval \${$3+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +/* Define $2 to an innocuous variant, in case <limits.h> declares $2. + For example, HP-UX 11i <limits.h> declares gettimeofday. */ +#define $2 innocuous_$2 + +/* System header to define __stub macros and hopefully few prototypes, + which can conflict with char $2 (); below. + Prefer <limits.h> to <assert.h> if __STDC__ is defined, since + <limits.h> exists even on freestanding compilers. */ + +#ifdef __STDC__ +# include <limits.h> +#else +# include <assert.h> +#endif + +#undef $2 + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char $2 (); +/* The GNU C library defines this for functions which it implements + to always fail with ENOSYS. Some functions are actually named + something starting with __ and the normal name is an alias. */ +#if defined __stub_$2 || defined __stub___$2 +choke me +#endif + +int +main () +{ +return $2 (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + eval "$3=yes" +else + eval "$3=no" +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +fi +eval ac_res=\$$3 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + +} # ac_fn_c_check_func +cat >config.log <<_ACEOF +This file contains any messages produced by compilers while +running configure, to aid debugging if configure makes a mistake. + +It was created by thread $as_me 2.8.4, which was +generated by GNU Autoconf 2.69. Invocation command line was + + $ $0 $@ + +_ACEOF +exec 5>>config.log +{ +cat <<_ASUNAME +## --------- ## +## Platform. ## +## --------- ## + +hostname = `(hostname || uname -n) 2>/dev/null | sed 1q` +uname -m = `(uname -m) 2>/dev/null || echo unknown` +uname -r = `(uname -r) 2>/dev/null || echo unknown` +uname -s = `(uname -s) 2>/dev/null || echo unknown` +uname -v = `(uname -v) 2>/dev/null || echo unknown` + +/usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null || echo unknown` +/bin/uname -X = `(/bin/uname -X) 2>/dev/null || echo unknown` + +/bin/arch = `(/bin/arch) 2>/dev/null || echo unknown` +/usr/bin/arch -k = `(/usr/bin/arch -k) 2>/dev/null || echo unknown` +/usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null || echo unknown` +/usr/bin/hostinfo = `(/usr/bin/hostinfo) 2>/dev/null || echo unknown` +/bin/machine = `(/bin/machine) 2>/dev/null || echo unknown` +/usr/bin/oslevel = `(/usr/bin/oslevel) 2>/dev/null || echo unknown` +/bin/universe = `(/bin/universe) 2>/dev/null || echo unknown` + +_ASUNAME + +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + $as_echo "PATH: $as_dir" + done +IFS=$as_save_IFS + +} >&5 + +cat >&5 <<_ACEOF + + +## ----------- ## +## Core tests. ## +## ----------- ## + +_ACEOF + + +# Keep a trace of the command line. +# Strip out --no-create and --no-recursion so they do not pile up. +# Strip out --silent because we don't want to record it for future runs. +# Also quote any args containing shell meta-characters. +# Make two passes to allow for proper duplicate-argument suppression. +ac_configure_args= +ac_configure_args0= +ac_configure_args1= +ac_must_keep_next=false +for ac_pass in 1 2 +do + for ac_arg + do + case $ac_arg in + -no-create | --no-c* | -n | -no-recursion | --no-r*) continue ;; + -q | -quiet | --quiet | --quie | --qui | --qu | --q \ + | -silent | --silent | --silen | --sile | --sil) + continue ;; + *\'*) + ac_arg=`$as_echo "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;; + esac + case $ac_pass in + 1) as_fn_append ac_configure_args0 " '$ac_arg'" ;; + 2) + as_fn_append ac_configure_args1 " '$ac_arg'" + if test $ac_must_keep_next = true; then + ac_must_keep_next=false # Got value, back to normal. + else + case $ac_arg in + *=* | --config-cache | -C | -disable-* | --disable-* \ + | -enable-* | --enable-* | -gas | --g* | -nfp | --nf* \ + | -q | -quiet | --q* | -silent | --sil* | -v | -verb* \ + | -with-* | --with-* | -without-* | --without-* | --x) + case "$ac_configure_args0 " in + "$ac_configure_args1"*" '$ac_arg' "* ) continue ;; + esac + ;; + -* ) ac_must_keep_next=true ;; + esac + fi + as_fn_append ac_configure_args " '$ac_arg'" + ;; + esac + done +done +{ ac_configure_args0=; unset ac_configure_args0;} +{ ac_configure_args1=; unset ac_configure_args1;} + +# When interrupted or exit'd, cleanup temporary files, and complete +# config.log. We remove comments because anyway the quotes in there +# would cause problems or look ugly. +# WARNING: Use '\'' to represent an apostrophe within the trap. +# WARNING: Do not start the trap code with a newline, due to a FreeBSD 4.0 bug. +trap 'exit_status=$? + # Save into config.log some information that might help in debugging. + { + echo + + $as_echo "## ---------------- ## +## Cache variables. ## +## ---------------- ##" + echo + # The following way of writing the cache mishandles newlines in values, +( + for ac_var in `(set) 2>&1 | sed -n '\''s/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'\''`; do + eval ac_val=\$$ac_var + case $ac_val in #( + *${as_nl}*) + case $ac_var in #( + *_cv_*) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5 +$as_echo "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;; + esac + case $ac_var in #( + _ | IFS | as_nl) ;; #( + BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #( + *) { eval $ac_var=; unset $ac_var;} ;; + esac ;; + esac + done + (set) 2>&1 | + case $as_nl`(ac_space='\'' '\''; set) 2>&1` in #( + *${as_nl}ac_space=\ *) + sed -n \ + "s/'\''/'\''\\\\'\'''\''/g; + s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\''\\2'\''/p" + ;; #( + *) + sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p" + ;; + esac | + sort +) + echo + + $as_echo "## ----------------- ## +## Output variables. ## +## ----------------- ##" + echo + for ac_var in $ac_subst_vars + do + eval ac_val=\$$ac_var + case $ac_val in + *\'\''*) ac_val=`$as_echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;; + esac + $as_echo "$ac_var='\''$ac_val'\''" + done | sort + echo + + if test -n "$ac_subst_files"; then + $as_echo "## ------------------- ## +## File substitutions. ## +## ------------------- ##" + echo + for ac_var in $ac_subst_files + do + eval ac_val=\$$ac_var + case $ac_val in + *\'\''*) ac_val=`$as_echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;; + esac + $as_echo "$ac_var='\''$ac_val'\''" + done | sort + echo + fi + + if test -s confdefs.h; then + $as_echo "## ----------- ## +## confdefs.h. ## +## ----------- ##" + echo + cat confdefs.h + echo + fi + test "$ac_signal" != 0 && + $as_echo "$as_me: caught signal $ac_signal" + $as_echo "$as_me: exit $exit_status" + } >&5 + rm -f core *.core core.conftest.* && + rm -f -r conftest* confdefs* conf$$* $ac_clean_files && + exit $exit_status +' 0 +for ac_signal in 1 2 13 15; do + trap 'ac_signal='$ac_signal'; as_fn_exit 1' $ac_signal +done +ac_signal=0 + +# confdefs.h avoids OS command line length limits that DEFS can exceed. +rm -f -r conftest* confdefs.h + +$as_echo "/* confdefs.h */" > confdefs.h + +# Predefined preprocessor variables. + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_NAME "$PACKAGE_NAME" +_ACEOF + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_TARNAME "$PACKAGE_TARNAME" +_ACEOF + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_VERSION "$PACKAGE_VERSION" +_ACEOF + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_STRING "$PACKAGE_STRING" +_ACEOF + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_BUGREPORT "$PACKAGE_BUGREPORT" +_ACEOF + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_URL "$PACKAGE_URL" +_ACEOF + + +# Let the site file select an alternate cache file if it wants to. +# Prefer an explicitly selected file to automatically selected ones. +ac_site_file1=NONE +ac_site_file2=NONE +if test -n "$CONFIG_SITE"; then + # We do not want a PATH search for config.site. + case $CONFIG_SITE in #(( + -*) ac_site_file1=./$CONFIG_SITE;; + */*) ac_site_file1=$CONFIG_SITE;; + *) ac_site_file1=./$CONFIG_SITE;; + esac +elif test "x$prefix" != xNONE; then + ac_site_file1=$prefix/share/config.site + ac_site_file2=$prefix/etc/config.site +else + ac_site_file1=$ac_default_prefix/share/config.site + ac_site_file2=$ac_default_prefix/etc/config.site +fi +for ac_site_file in "$ac_site_file1" "$ac_site_file2" +do + test "x$ac_site_file" = xNONE && continue + if test /dev/null != "$ac_site_file" && test -r "$ac_site_file"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: loading site script $ac_site_file" >&5 +$as_echo "$as_me: loading site script $ac_site_file" >&6;} + sed 's/^/| /' "$ac_site_file" >&5 + . "$ac_site_file" \ + || { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "failed to load site script $ac_site_file +See \`config.log' for more details" "$LINENO" 5; } + fi +done + +if test -r "$cache_file"; then + # Some versions of bash will fail to source /dev/null (special files + # actually), so we avoid doing that. DJGPP emulates it as a regular file. + if test /dev/null != "$cache_file" && test -f "$cache_file"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: loading cache $cache_file" >&5 +$as_echo "$as_me: loading cache $cache_file" >&6;} + case $cache_file in + [\\/]* | ?:[\\/]* ) . "$cache_file";; + *) . "./$cache_file";; + esac + fi +else + { $as_echo "$as_me:${as_lineno-$LINENO}: creating cache $cache_file" >&5 +$as_echo "$as_me: creating cache $cache_file" >&6;} + >$cache_file +fi + +# Check that the precious variables saved in the cache have kept the same +# value. +ac_cache_corrupted=false +for ac_var in $ac_precious_vars; do + eval ac_old_set=\$ac_cv_env_${ac_var}_set + eval ac_new_set=\$ac_env_${ac_var}_set + eval ac_old_val=\$ac_cv_env_${ac_var}_value + eval ac_new_val=\$ac_env_${ac_var}_value + case $ac_old_set,$ac_new_set in + set,) + { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&5 +$as_echo "$as_me: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&2;} + ac_cache_corrupted=: ;; + ,set) + { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was not set in the previous run" >&5 +$as_echo "$as_me: error: \`$ac_var' was not set in the previous run" >&2;} + ac_cache_corrupted=: ;; + ,);; + *) + if test "x$ac_old_val" != "x$ac_new_val"; then + # differences in whitespace do not lead to failure. + ac_old_val_w=`echo x $ac_old_val` + ac_new_val_w=`echo x $ac_new_val` + if test "$ac_old_val_w" != "$ac_new_val_w"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' has changed since the previous run:" >&5 +$as_echo "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;} + ac_cache_corrupted=: + else + { $as_echo "$as_me:${as_lineno-$LINENO}: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&5 +$as_echo "$as_me: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&2;} + eval $ac_var=\$ac_old_val + fi + { $as_echo "$as_me:${as_lineno-$LINENO}: former value: \`$ac_old_val'" >&5 +$as_echo "$as_me: former value: \`$ac_old_val'" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: current value: \`$ac_new_val'" >&5 +$as_echo "$as_me: current value: \`$ac_new_val'" >&2;} + fi;; + esac + # Pass precious variables to config.status. + if test "$ac_new_set" = set; then + case $ac_new_val in + *\'*) ac_arg=$ac_var=`$as_echo "$ac_new_val" | sed "s/'/'\\\\\\\\''/g"` ;; + *) ac_arg=$ac_var=$ac_new_val ;; + esac + case " $ac_configure_args " in + *" '$ac_arg' "*) ;; # Avoid dups. Use of quotes ensures accuracy. + *) as_fn_append ac_configure_args " '$ac_arg'" ;; + esac + fi +done +if $ac_cache_corrupted; then + { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: error: changes in the environment can compromise the build" >&5 +$as_echo "$as_me: error: changes in the environment can compromise the build" >&2;} + as_fn_error $? "run \`make distclean' and/or \`rm $cache_file' and start over" "$LINENO" 5 +fi +## -------------------- ## +## Main body of script. ## +## -------------------- ## + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + + +#-------------------------------------------------------------------- +# Call TEA_INIT as the first TEA_ macro to set up initial vars. +# This will define a ${TEA_PLATFORM} variable == "unix" or "windows" +# as well as PKG_LIB_FILE and PKG_STUB_LIB_FILE. +#-------------------------------------------------------------------- + + + TEA_VERSION="3.13" + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking TEA configuration" >&5 +$as_echo_n "checking TEA configuration... " >&6; } + if test x"${PACKAGE_NAME}" = x ; then + as_fn_error $? " +The PACKAGE_NAME variable must be defined by your TEA configure.ac" "$LINENO" 5 + fi + { $as_echo "$as_me:${as_lineno-$LINENO}: result: ok (TEA ${TEA_VERSION})" >&5 +$as_echo "ok (TEA ${TEA_VERSION})" >&6; } + + # If the user did not set CFLAGS, set it now to keep macros + # like AC_PROG_CC and AC_TRY_COMPILE from adding "-g -O2". + if test "${CFLAGS+set}" != "set" ; then + CFLAGS="" + fi + + case "`uname -s`" in + *win32*|*WIN32*|*MINGW32_*|*MINGW64_*) + # Extract the first word of "cygpath", so it can be a program name with args. +set dummy cygpath; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_CYGPATH+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$CYGPATH"; then + ac_cv_prog_CYGPATH="$CYGPATH" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_CYGPATH="cygpath -m" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + + test -z "$ac_cv_prog_CYGPATH" && ac_cv_prog_CYGPATH="echo" +fi +fi +CYGPATH=$ac_cv_prog_CYGPATH +if test -n "$CYGPATH"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CYGPATH" >&5 +$as_echo "$CYGPATH" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + EXEEXT=".exe" + TEA_PLATFORM="windows" + ;; + *CYGWIN_*) + EXEEXT=".exe" + # CYGPATH and TEA_PLATFORM are determined later in LOAD_TCLCONFIG + ;; + *) + CYGPATH=echo + # Maybe we are cross-compiling.... + case ${host_alias} in + *mingw32*) + EXEEXT=".exe" + TEA_PLATFORM="windows" + ;; + *) + EXEEXT="" + TEA_PLATFORM="unix" + ;; + esac + ;; + esac + + # Check if exec_prefix is set. If not use fall back to prefix. + # Note when adjusted, so that TEA_PREFIX can correct for this. + # This is needed for recursive configures, since autoconf propagates + # $prefix, but not $exec_prefix (doh!). + if test x$exec_prefix = xNONE ; then + exec_prefix_default=yes + exec_prefix=$prefix + fi + + { $as_echo "$as_me:${as_lineno-$LINENO}: configuring ${PACKAGE_NAME} ${PACKAGE_VERSION}" >&5 +$as_echo "$as_me: configuring ${PACKAGE_NAME} ${PACKAGE_VERSION}" >&6;} + + + + + # This package name must be replaced statically for AC_SUBST to work + + # Substitute STUB_LIB_FILE in case package creates a stub library too. + + + # We AC_SUBST these here to ensure they are subst'ed, + # in case the user doesn't call TEA_ADD_... + + + + + + + + + # Configure the installer. + + INSTALL='$(SHELL) $(srcdir)/tclconfig/install-sh -c' + INSTALL_DATA_DIR='${INSTALL} -d -m 755' + INSTALL_DATA='${INSTALL} -m 644' + INSTALL_PROGRAM='${INSTALL} -m 755' + INSTALL_SCRIPT='${INSTALL} -m 755' + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking system version" >&5 +$as_echo_n "checking system version... " >&6; } +if ${tcl_cv_sys_version+:} false; then : + $as_echo_n "(cached) " >&6 +else + + # TEA specific: + if test "${TEA_PLATFORM}" = "windows" ; then + tcl_cv_sys_version=windows + else + tcl_cv_sys_version=`uname -s`-`uname -r` + if test "$?" -ne 0 ; then + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: can't find uname command" >&5 +$as_echo "$as_me: WARNING: can't find uname command" >&2;} + tcl_cv_sys_version=unknown + else + if test "`uname -s`" = "AIX" ; then + tcl_cv_sys_version=AIX-`uname -v`.`uname -r` + fi + fi + fi + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_sys_version" >&5 +$as_echo "$tcl_cv_sys_version" >&6; } + system=$tcl_cv_sys_version + + case $system in + HP-UX-*) INSTALL_LIBRARY='${INSTALL} -m 755' ;; + *) INSTALL_LIBRARY='${INSTALL} -m 644' ;; + esac + + + + + + + + + + +ac_aux_dir= +for ac_dir in tclconfig "$srcdir"/tclconfig; do + if test -f "$ac_dir/install-sh"; then + ac_aux_dir=$ac_dir + ac_install_sh="$ac_aux_dir/install-sh -c" + break + elif test -f "$ac_dir/install.sh"; then + ac_aux_dir=$ac_dir + ac_install_sh="$ac_aux_dir/install.sh -c" + break + elif test -f "$ac_dir/shtool"; then + ac_aux_dir=$ac_dir + ac_install_sh="$ac_aux_dir/shtool install -c" + break + fi +done +if test -z "$ac_aux_dir"; then + as_fn_error $? "cannot find install-sh, install.sh, or shtool in tclconfig \"$srcdir\"/tclconfig" "$LINENO" 5 +fi + +# These three variables are undocumented and unsupported, +# and are intended to be withdrawn in a future Autoconf release. +# They can cause serious problems if a builder's source tree is in a directory +# whose full name contains unusual characters. +ac_config_guess="$SHELL $ac_aux_dir/config.guess" # Please don't use this var. +ac_config_sub="$SHELL $ac_aux_dir/config.sub" # Please don't use this var. +ac_configure="$SHELL $ac_aux_dir/configure" # Please don't use this var. + + + +#-------------------------------------------------------------------- +# Load the tclConfig.sh file +#-------------------------------------------------------------------- + + + + # + # Ok, lets find the tcl configuration + # First, look for one uninstalled. + # the alternative search directory is invoked by --with-tcl + # + + if test x"${no_tcl}" = x ; then + # we reset no_tcl in case something fails here + no_tcl=true + +# Check whether --with-tcl was given. +if test "${with_tcl+set}" = set; then : + withval=$with_tcl; with_tclconfig="${withval}" +fi + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for Tcl configuration" >&5 +$as_echo_n "checking for Tcl configuration... " >&6; } + if ${ac_cv_c_tclconfig+:} false; then : + $as_echo_n "(cached) " >&6 +else + + + # First check to see if --with-tcl was specified. + if test x"${with_tclconfig}" != x ; then + case "${with_tclconfig}" in + */tclConfig.sh ) + if test -f "${with_tclconfig}"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: --with-tcl argument should refer to directory containing tclConfig.sh, not to tclConfig.sh itself" >&5 +$as_echo "$as_me: WARNING: --with-tcl argument should refer to directory containing tclConfig.sh, not to tclConfig.sh itself" >&2;} + with_tclconfig="`echo "${with_tclconfig}" | sed 's!/tclConfig\.sh$!!'`" + fi ;; + esac + if test -f "${with_tclconfig}/tclConfig.sh" ; then + ac_cv_c_tclconfig="`(cd "${with_tclconfig}"; pwd)`" + else + as_fn_error $? "${with_tclconfig} directory doesn't contain tclConfig.sh" "$LINENO" 5 + fi + fi + + # then check for a private Tcl installation + if test x"${ac_cv_c_tclconfig}" = x ; then + for i in \ + ../tcl \ + `ls -dr ../tcl[8-9].[0-9].[0-9]* 2>/dev/null` \ + `ls -dr ../tcl[8-9].[0-9] 2>/dev/null` \ + `ls -dr ../tcl[8-9].[0-9]* 2>/dev/null` \ + ../../tcl \ + `ls -dr ../../tcl[8-9].[0-9].[0-9]* 2>/dev/null` \ + `ls -dr ../../tcl[8-9].[0-9] 2>/dev/null` \ + `ls -dr ../../tcl[8-9].[0-9]* 2>/dev/null` \ + ../../../tcl \ + `ls -dr ../../../tcl[8-9].[0-9].[0-9]* 2>/dev/null` \ + `ls -dr ../../../tcl[8-9].[0-9] 2>/dev/null` \ + `ls -dr ../../../tcl[8-9].[0-9]* 2>/dev/null` ; do + if test "${TEA_PLATFORM}" = "windows" \ + -a -f "$i/win/tclConfig.sh" ; then + ac_cv_c_tclconfig="`(cd $i/win; pwd)`" + break + fi + if test -f "$i/unix/tclConfig.sh" ; then + ac_cv_c_tclconfig="`(cd $i/unix; pwd)`" + break + fi + done + fi + + # on Darwin, check in Framework installation locations + if test "`uname -s`" = "Darwin" -a x"${ac_cv_c_tclconfig}" = x ; then + for i in `ls -d ~/Library/Frameworks 2>/dev/null` \ + `ls -d /Library/Frameworks 2>/dev/null` \ + `ls -d /Network/Library/Frameworks 2>/dev/null` \ + `ls -d /System/Library/Frameworks 2>/dev/null` \ + `ls -d /Applications/Xcode.app/Contents/Developer/Platforms/MacOSX.platform/Developer/SDKs/MacOSX.sdk/Library/Frameworks/Tcl.framework 2>/dev/null` \ + `ls -d /Applications/Xcode.app/Contents/Developer/Platforms/MacOSX.platform/Developer/SDKs/MacOSX.sdk/Network/Library/Frameworks/Tcl.framework 2>/dev/null` \ + `ls -d /Applications/Xcode.app/Contents/Developer/Platforms/MacOSX.platform/Developer/SDKs/MacOSX.sdk/System/Library/Frameworks/Tcl.framework 2>/dev/null` \ + ; do + if test -f "$i/Tcl.framework/tclConfig.sh" ; then + ac_cv_c_tclconfig="`(cd $i/Tcl.framework; pwd)`" + break + fi + done + fi + + # TEA specific: on Windows, check in common installation locations + if test "${TEA_PLATFORM}" = "windows" \ + -a x"${ac_cv_c_tclconfig}" = x ; then + for i in `ls -d C:/Tcl/lib 2>/dev/null` \ + `ls -d C:/Progra~1/Tcl/lib 2>/dev/null` \ + ; do + if test -f "$i/tclConfig.sh" ; then + ac_cv_c_tclconfig="`(cd $i; pwd)`" + break + fi + done + fi + + # check in a few common install locations + if test x"${ac_cv_c_tclconfig}" = x ; then + for i in `ls -d ${libdir} 2>/dev/null` \ + `ls -d ${exec_prefix}/lib 2>/dev/null` \ + `ls -d ${prefix}/lib 2>/dev/null` \ + `ls -d /usr/local/lib 2>/dev/null` \ + `ls -d /usr/contrib/lib 2>/dev/null` \ + `ls -d /usr/pkg/lib 2>/dev/null` \ + `ls -d /usr/lib 2>/dev/null` \ + `ls -d /usr/lib64 2>/dev/null` \ + `ls -d /usr/lib/tcl8.6 2>/dev/null` \ + `ls -d /usr/lib/tcl8.5 2>/dev/null` \ + `ls -d /usr/local/lib/tcl8.6 2>/dev/null` \ + `ls -d /usr/local/lib/tcl8.5 2>/dev/null` \ + `ls -d /usr/local/lib/tcl/tcl8.6 2>/dev/null` \ + `ls -d /usr/local/lib/tcl/tcl8.5 2>/dev/null` \ + ; do + if test -f "$i/tclConfig.sh" ; then + ac_cv_c_tclconfig="`(cd $i; pwd)`" + break + fi + done + fi + + # check in a few other private locations + if test x"${ac_cv_c_tclconfig}" = x ; then + for i in \ + ${srcdir}/../tcl \ + `ls -dr ${srcdir}/../tcl[8-9].[0-9].[0-9]* 2>/dev/null` \ + `ls -dr ${srcdir}/../tcl[8-9].[0-9] 2>/dev/null` \ + `ls -dr ${srcdir}/../tcl[8-9].[0-9]* 2>/dev/null` ; do + if test "${TEA_PLATFORM}" = "windows" \ + -a -f "$i/win/tclConfig.sh" ; then + ac_cv_c_tclconfig="`(cd $i/win; pwd)`" + break + fi + if test -f "$i/unix/tclConfig.sh" ; then + ac_cv_c_tclconfig="`(cd $i/unix; pwd)`" + break + fi + done + fi + +fi + + + if test x"${ac_cv_c_tclconfig}" = x ; then + TCL_BIN_DIR="# no Tcl configs found" + as_fn_error $? "Can't find Tcl configuration definitions. Use --with-tcl to specify a directory containing tclConfig.sh" "$LINENO" 5 + else + no_tcl= + TCL_BIN_DIR="${ac_cv_c_tclconfig}" + { $as_echo "$as_me:${as_lineno-$LINENO}: result: found ${TCL_BIN_DIR}/tclConfig.sh" >&5 +$as_echo "found ${TCL_BIN_DIR}/tclConfig.sh" >&6; } + fi + fi + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu +if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}gcc", so it can be a program name with args. +set dummy ${ac_tool_prefix}gcc; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_CC+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_CC="${ac_tool_prefix}gcc" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +CC=$ac_cv_prog_CC +if test -n "$CC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 +$as_echo "$CC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + +fi +if test -z "$ac_cv_prog_CC"; then + ac_ct_CC=$CC + # Extract the first word of "gcc", so it can be a program name with args. +set dummy gcc; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_ac_ct_CC+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_CC"; then + ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_CC="gcc" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_CC=$ac_cv_prog_ac_ct_CC +if test -n "$ac_ct_CC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5 +$as_echo "$ac_ct_CC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + if test "x$ac_ct_CC" = x; then + CC="" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + CC=$ac_ct_CC + fi +else + CC="$ac_cv_prog_CC" +fi + +if test -z "$CC"; then + if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}cc", so it can be a program name with args. +set dummy ${ac_tool_prefix}cc; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_CC+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_CC="${ac_tool_prefix}cc" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +CC=$ac_cv_prog_CC +if test -n "$CC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 +$as_echo "$CC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + fi +fi +if test -z "$CC"; then + # Extract the first word of "cc", so it can be a program name with args. +set dummy cc; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_CC+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. +else + ac_prog_rejected=no +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + if test "$as_dir/$ac_word$ac_exec_ext" = "/usr/ucb/cc"; then + ac_prog_rejected=yes + continue + fi + ac_cv_prog_CC="cc" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +if test $ac_prog_rejected = yes; then + # We found a bogon in the path, so make sure we never use it. + set dummy $ac_cv_prog_CC + shift + if test $# != 0; then + # We chose a different compiler from the bogus one. + # However, it has the same basename, so the bogon will be chosen + # first if we set CC to just the basename; use the full file name. + shift + ac_cv_prog_CC="$as_dir/$ac_word${1+' '}$@" + fi +fi +fi +fi +CC=$ac_cv_prog_CC +if test -n "$CC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 +$as_echo "$CC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + +fi +if test -z "$CC"; then + if test -n "$ac_tool_prefix"; then + for ac_prog in cl.exe + do + # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args. +set dummy $ac_tool_prefix$ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_CC+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_CC="$ac_tool_prefix$ac_prog" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +CC=$ac_cv_prog_CC +if test -n "$CC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 +$as_echo "$CC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$CC" && break + done +fi +if test -z "$CC"; then + ac_ct_CC=$CC + for ac_prog in cl.exe +do + # Extract the first word of "$ac_prog", so it can be a program name with args. +set dummy $ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_ac_ct_CC+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_CC"; then + ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_CC="$ac_prog" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_CC=$ac_cv_prog_ac_ct_CC +if test -n "$ac_ct_CC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5 +$as_echo "$ac_ct_CC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$ac_ct_CC" && break +done + + if test "x$ac_ct_CC" = x; then + CC="" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + CC=$ac_ct_CC + fi +fi + +fi + + +test -z "$CC" && { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "no acceptable C compiler found in \$PATH +See \`config.log' for more details" "$LINENO" 5; } + +# Provide some information about the compiler. +$as_echo "$as_me:${as_lineno-$LINENO}: checking for C compiler version" >&5 +set X $ac_compile +ac_compiler=$2 +for ac_option in --version -v -V -qversion; do + { { ac_try="$ac_compiler $ac_option >&5" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_compiler $ac_option >&5") 2>conftest.err + ac_status=$? + if test -s conftest.err; then + sed '10a\ +... rest of stderr output deleted ... + 10q' conftest.err >conftest.er1 + cat conftest.er1 >&5 + fi + rm -f conftest.er1 conftest.err + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } +done + +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +ac_clean_files_save=$ac_clean_files +ac_clean_files="$ac_clean_files a.out a.out.dSYM a.exe b.out" +# Try to create an executable without -o first, disregard a.out. +# It will help us diagnose broken compilers, and finding out an intuition +# of exeext. +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the C compiler works" >&5 +$as_echo_n "checking whether the C compiler works... " >&6; } +ac_link_default=`$as_echo "$ac_link" | sed 's/ -o *conftest[^ ]*//'` + +# The possible output files: +ac_files="a.out conftest.exe conftest a.exe a_out.exe b.out conftest.*" + +ac_rmfiles= +for ac_file in $ac_files +do + case $ac_file in + *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ;; + * ) ac_rmfiles="$ac_rmfiles $ac_file";; + esac +done +rm -f $ac_rmfiles + +if { { ac_try="$ac_link_default" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_link_default") 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; then : + # Autoconf-2.13 could set the ac_cv_exeext variable to `no'. +# So ignore a value of `no', otherwise this would lead to `EXEEXT = no' +# in a Makefile. We should not override ac_cv_exeext if it was cached, +# so that the user can short-circuit this test for compilers unknown to +# Autoconf. +for ac_file in $ac_files '' +do + test -f "$ac_file" || continue + case $ac_file in + *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) + ;; + [ab].out ) + # We found the default executable, but exeext='' is most + # certainly right. + break;; + *.* ) + if test "${ac_cv_exeext+set}" = set && test "$ac_cv_exeext" != no; + then :; else + ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` + fi + # We set ac_cv_exeext here because the later test for it is not + # safe: cross compilers may not add the suffix if given an `-o' + # argument, so we may need to know it at that point already. + # Even if this section looks crufty: it has the advantage of + # actually working. + break;; + * ) + break;; + esac +done +test "$ac_cv_exeext" = no && ac_cv_exeext= + +else + ac_file='' +fi +if test -z "$ac_file"; then : + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +$as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +{ { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error 77 "C compiler cannot create executables +See \`config.log' for more details" "$LINENO" 5; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +$as_echo "yes" >&6; } +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for C compiler default output file name" >&5 +$as_echo_n "checking for C compiler default output file name... " >&6; } +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_file" >&5 +$as_echo "$ac_file" >&6; } +ac_exeext=$ac_cv_exeext + +rm -f -r a.out a.out.dSYM a.exe conftest$ac_cv_exeext b.out +ac_clean_files=$ac_clean_files_save +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for suffix of executables" >&5 +$as_echo_n "checking for suffix of executables... " >&6; } +if { { ac_try="$ac_link" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_link") 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; then : + # If both `conftest.exe' and `conftest' are `present' (well, observable) +# catch `conftest.exe'. For instance with Cygwin, `ls conftest' will +# work properly (i.e., refer to `conftest.exe'), while it won't with +# `rm'. +for ac_file in conftest.exe conftest conftest.*; do + test -f "$ac_file" || continue + case $ac_file in + *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ;; + *.* ) ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` + break;; + * ) break;; + esac +done +else + { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "cannot compute suffix of executables: cannot compile and link +See \`config.log' for more details" "$LINENO" 5; } +fi +rm -f conftest conftest$ac_cv_exeext +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_exeext" >&5 +$as_echo "$ac_cv_exeext" >&6; } + +rm -f conftest.$ac_ext +EXEEXT=$ac_cv_exeext +ac_exeext=$EXEEXT +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <stdio.h> +int +main () +{ +FILE *f = fopen ("conftest.out", "w"); + return ferror (f) || fclose (f) != 0; + + ; + return 0; +} +_ACEOF +ac_clean_files="$ac_clean_files conftest.out" +# Check that the compiler produces executables we can run. If not, either +# the compiler is broken, or we cross compile. +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are cross compiling" >&5 +$as_echo_n "checking whether we are cross compiling... " >&6; } +if test "$cross_compiling" != yes; then + { { ac_try="$ac_link" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_link") 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } + if { ac_try='./conftest$ac_cv_exeext' + { { case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_try") 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; }; then + cross_compiling=no + else + if test "$cross_compiling" = maybe; then + cross_compiling=yes + else + { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "cannot run C compiled programs. +If you meant to cross compile, use \`--host'. +See \`config.log' for more details" "$LINENO" 5; } + fi + fi +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $cross_compiling" >&5 +$as_echo "$cross_compiling" >&6; } + +rm -f conftest.$ac_ext conftest$ac_cv_exeext conftest.out +ac_clean_files=$ac_clean_files_save +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for suffix of object files" >&5 +$as_echo_n "checking for suffix of object files... " >&6; } +if ${ac_cv_objext+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +rm -f conftest.o conftest.obj +if { { ac_try="$ac_compile" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_compile") 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; then : + for ac_file in conftest.o conftest.obj conftest.*; do + test -f "$ac_file" || continue; + case $ac_file in + *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM ) ;; + *) ac_cv_objext=`expr "$ac_file" : '.*\.\(.*\)'` + break;; + esac +done +else + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +{ { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "cannot compute suffix of object files: cannot compile +See \`config.log' for more details" "$LINENO" 5; } +fi +rm -f conftest.$ac_cv_objext conftest.$ac_ext +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_objext" >&5 +$as_echo "$ac_cv_objext" >&6; } +OBJEXT=$ac_cv_objext +ac_objext=$OBJEXT +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are using the GNU C compiler" >&5 +$as_echo_n "checking whether we are using the GNU C compiler... " >&6; } +if ${ac_cv_c_compiler_gnu+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ +#ifndef __GNUC__ + choke me +#endif + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_compiler_gnu=yes +else + ac_compiler_gnu=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +ac_cv_c_compiler_gnu=$ac_compiler_gnu + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_compiler_gnu" >&5 +$as_echo "$ac_cv_c_compiler_gnu" >&6; } +if test $ac_compiler_gnu = yes; then + GCC=yes +else + GCC= +fi +ac_test_CFLAGS=${CFLAGS+set} +ac_save_CFLAGS=$CFLAGS +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $CC accepts -g" >&5 +$as_echo_n "checking whether $CC accepts -g... " >&6; } +if ${ac_cv_prog_cc_g+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_save_c_werror_flag=$ac_c_werror_flag + ac_c_werror_flag=yes + ac_cv_prog_cc_g=no + CFLAGS="-g" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_prog_cc_g=yes +else + CFLAGS="" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + +else + ac_c_werror_flag=$ac_save_c_werror_flag + CFLAGS="-g" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_prog_cc_g=yes +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + ac_c_werror_flag=$ac_save_c_werror_flag +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_g" >&5 +$as_echo "$ac_cv_prog_cc_g" >&6; } +if test "$ac_test_CFLAGS" = set; then + CFLAGS=$ac_save_CFLAGS +elif test $ac_cv_prog_cc_g = yes; then + if test "$GCC" = yes; then + CFLAGS="-g -O2" + else + CFLAGS="-g" + fi +else + if test "$GCC" = yes; then + CFLAGS="-O2" + else + CFLAGS= + fi +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $CC option to accept ISO C89" >&5 +$as_echo_n "checking for $CC option to accept ISO C89... " >&6; } +if ${ac_cv_prog_cc_c89+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_cv_prog_cc_c89=no +ac_save_CC=$CC +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <stdarg.h> +#include <stdio.h> +struct stat; +/* Most of the following tests are stolen from RCS 5.7's src/conf.sh. */ +struct buf { int x; }; +FILE * (*rcsopen) (struct buf *, struct stat *, int); +static char *e (p, i) + char **p; + int i; +{ + return p[i]; +} +static char *f (char * (*g) (char **, int), char **p, ...) +{ + char *s; + va_list v; + va_start (v,p); + s = g (p, va_arg (v,int)); + va_end (v); + return s; +} + +/* OSF 4.0 Compaq cc is some sort of almost-ANSI by default. It has + function prototypes and stuff, but not '\xHH' hex character constants. + These don't provoke an error unfortunately, instead are silently treated + as 'x'. The following induces an error, until -std is added to get + proper ANSI mode. Curiously '\x00'!='x' always comes out true, for an + array size at least. It's necessary to write '\x00'==0 to get something + that's true only with -std. */ +int osf4_cc_array ['\x00' == 0 ? 1 : -1]; + +/* IBM C 6 for AIX is almost-ANSI by default, but it replaces macro parameters + inside strings and character constants. */ +#define FOO(x) 'x' +int xlc6_cc_array[FOO(a) == 'x' ? 1 : -1]; + +int test (int i, double x); +struct s1 {int (*f) (int a);}; +struct s2 {int (*f) (double a);}; +int pairnames (int, char **, FILE *(*)(struct buf *, struct stat *, int), int, int); +int argc; +char **argv; +int +main () +{ +return f (e, argv, 0) != argv[0] || f (e, argv, 1) != argv[1]; + ; + return 0; +} +_ACEOF +for ac_arg in '' -qlanglvl=extc89 -qlanglvl=ansi -std \ + -Ae "-Aa -D_HPUX_SOURCE" "-Xc -D__EXTENSIONS__" +do + CC="$ac_save_CC $ac_arg" + if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_prog_cc_c89=$ac_arg +fi +rm -f core conftest.err conftest.$ac_objext + test "x$ac_cv_prog_cc_c89" != "xno" && break +done +rm -f conftest.$ac_ext +CC=$ac_save_CC + +fi +# AC_CACHE_VAL +case "x$ac_cv_prog_cc_c89" in + x) + { $as_echo "$as_me:${as_lineno-$LINENO}: result: none needed" >&5 +$as_echo "none needed" >&6; } ;; + xno) + { $as_echo "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5 +$as_echo "unsupported" >&6; } ;; + *) + CC="$CC $ac_cv_prog_cc_c89" + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c89" >&5 +$as_echo "$ac_cv_prog_cc_c89" >&6; } ;; +esac +if test "x$ac_cv_prog_cc_c89" != xno; then : + +fi + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for existence of ${TCL_BIN_DIR}/tclConfig.sh" >&5 +$as_echo_n "checking for existence of ${TCL_BIN_DIR}/tclConfig.sh... " >&6; } + + if test -f "${TCL_BIN_DIR}/tclConfig.sh" ; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: loading" >&5 +$as_echo "loading" >&6; } + . "${TCL_BIN_DIR}/tclConfig.sh" + else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: could not find ${TCL_BIN_DIR}/tclConfig.sh" >&5 +$as_echo "could not find ${TCL_BIN_DIR}/tclConfig.sh" >&6; } + fi + + # eval is required to do the TCL_DBGX substitution + eval "TCL_LIB_FILE=\"${TCL_LIB_FILE}\"" + eval "TCL_STUB_LIB_FILE=\"${TCL_STUB_LIB_FILE}\"" + + # If the TCL_BIN_DIR is the build directory (not the install directory), + # then set the common variable name to the value of the build variables. + # For example, the variable TCL_LIB_SPEC will be set to the value + # of TCL_BUILD_LIB_SPEC. An extension should make use of TCL_LIB_SPEC + # instead of TCL_BUILD_LIB_SPEC since it will work with both an + # installed and uninstalled version of Tcl. + if test -f "${TCL_BIN_DIR}/Makefile" ; then + TCL_LIB_SPEC="${TCL_BUILD_LIB_SPEC}" + TCL_STUB_LIB_SPEC="${TCL_BUILD_STUB_LIB_SPEC}" + TCL_STUB_LIB_PATH="${TCL_BUILD_STUB_LIB_PATH}" + elif test "`uname -s`" = "Darwin"; then + # If Tcl was built as a framework, attempt to use the libraries + # from the framework at the given location so that linking works + # against Tcl.framework installed in an arbitrary location. + case ${TCL_DEFS} in + *TCL_FRAMEWORK*) + if test -f "${TCL_BIN_DIR}/${TCL_LIB_FILE}"; then + for i in "`cd "${TCL_BIN_DIR}"; pwd`" \ + "`cd "${TCL_BIN_DIR}"/../..; pwd`"; do + if test "`basename "$i"`" = "${TCL_LIB_FILE}.framework"; then + TCL_LIB_SPEC="-F`dirname "$i" | sed -e 's/ /\\\\ /g'` -framework ${TCL_LIB_FILE}" + break + fi + done + fi + if test -f "${TCL_BIN_DIR}/${TCL_STUB_LIB_FILE}"; then + TCL_STUB_LIB_SPEC="-L`echo "${TCL_BIN_DIR}" | sed -e 's/ /\\\\ /g'` ${TCL_STUB_LIB_FLAG}" + TCL_STUB_LIB_PATH="${TCL_BIN_DIR}/${TCL_STUB_LIB_FILE}" + fi + ;; + esac + fi + + # eval is required to do the TCL_DBGX substitution + eval "TCL_LIB_FLAG=\"${TCL_LIB_FLAG}\"" + eval "TCL_LIB_SPEC=\"${TCL_LIB_SPEC}\"" + eval "TCL_STUB_LIB_FLAG=\"${TCL_STUB_LIB_FLAG}\"" + eval "TCL_STUB_LIB_SPEC=\"${TCL_STUB_LIB_SPEC}\"" + + + + + + + + + + + + + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking platform" >&5 +$as_echo_n "checking platform... " >&6; } + hold_cc=$CC; CC="$TCL_CC" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + #ifdef _WIN32 + #error win32 + #endif + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + + TEA_PLATFORM="unix" + CYGPATH=echo + +else + + TEA_PLATFORM="windows" + # Extract the first word of "cygpath", so it can be a program name with args. +set dummy cygpath; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_CYGPATH+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$CYGPATH"; then + ac_cv_prog_CYGPATH="$CYGPATH" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_CYGPATH="cygpath -m" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + + test -z "$ac_cv_prog_CYGPATH" && ac_cv_prog_CYGPATH="echo" +fi +fi +CYGPATH=$ac_cv_prog_CYGPATH +if test -n "$CYGPATH"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CYGPATH" >&5 +$as_echo "$CYGPATH" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + CC=$hold_cc + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $TEA_PLATFORM" >&5 +$as_echo "$TEA_PLATFORM" >&6; } + + # The BUILD_$pkg is to define the correct extern storage class + # handling when making this package + +cat >>confdefs.h <<_ACEOF +#define BUILD_${PACKAGE_NAME} /**/ +_ACEOF + + # Do this here as we have fully defined TEA_PLATFORM now + if test "${TEA_PLATFORM}" = "windows" ; then + EXEEXT=".exe" + CLEANFILES="$CLEANFILES *.lib *.dll *.pdb *.exp" + fi + + # TEA specific: + + + + + + + + +if test "${TCL_MAJOR_VERSION}" -ne 8 ; then + as_fn_error $? "${PACKAGE_NAME} ${PACKAGE_VERSION} requires Tcl 8.4+ +Found config for Tcl ${TCL_VERSION}" "$LINENO" 5 +fi +if test "${TCL_MINOR_VERSION}" -lt 4 ; then + as_fn_error $? "${PACKAGE_NAME} ${PACKAGE_VERSION} requires Tcl 8.4+ +Found config for Tcl ${TCL_VERSION}" "$LINENO" 5 +fi + +#-------------------------------------------------------------------- +# Load the tkConfig.sh file if necessary (Tk extension) +#-------------------------------------------------------------------- + +#TEA_PATH_TKCONFIG +#TEA_LOAD_TKCONFIG + +#----------------------------------------------------------------------- +# Handle the --prefix=... option by defaulting to what Tcl gave. +# Must be called after TEA_LOAD_TCLCONFIG and before TEA_SETUP_COMPILER. +#----------------------------------------------------------------------- + + + if test "${prefix}" = "NONE"; then + prefix_default=yes + if test x"${TCL_PREFIX}" != x; then + { $as_echo "$as_me:${as_lineno-$LINENO}: --prefix defaulting to TCL_PREFIX ${TCL_PREFIX}" >&5 +$as_echo "$as_me: --prefix defaulting to TCL_PREFIX ${TCL_PREFIX}" >&6;} + prefix=${TCL_PREFIX} + else + { $as_echo "$as_me:${as_lineno-$LINENO}: --prefix defaulting to /usr/local" >&5 +$as_echo "$as_me: --prefix defaulting to /usr/local" >&6;} + prefix=/usr/local + fi + fi + if test "${exec_prefix}" = "NONE" -a x"${prefix_default}" = x"yes" \ + -o x"${exec_prefix_default}" = x"yes" ; then + if test x"${TCL_EXEC_PREFIX}" != x; then + { $as_echo "$as_me:${as_lineno-$LINENO}: --exec-prefix defaulting to TCL_EXEC_PREFIX ${TCL_EXEC_PREFIX}" >&5 +$as_echo "$as_me: --exec-prefix defaulting to TCL_EXEC_PREFIX ${TCL_EXEC_PREFIX}" >&6;} + exec_prefix=${TCL_EXEC_PREFIX} + else + { $as_echo "$as_me:${as_lineno-$LINENO}: --exec-prefix defaulting to ${prefix}" >&5 +$as_echo "$as_me: --exec-prefix defaulting to ${prefix}" >&6;} + exec_prefix=$prefix + fi + fi + + +#----------------------------------------------------------------------- +# Standard compiler checks. +# This sets up CC by using the CC env var, or looks for gcc otherwise. +# This also calls AC_PROG_CC and a few others to create the basic setup +# necessary to compile executables. +#----------------------------------------------------------------------- + + + # Don't put any macros that use the compiler (e.g. AC_TRY_COMPILE) + # in this macro, they need to go into TEA_SETUP_COMPILER instead. + + ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu +if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}gcc", so it can be a program name with args. +set dummy ${ac_tool_prefix}gcc; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_CC+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_CC="${ac_tool_prefix}gcc" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +CC=$ac_cv_prog_CC +if test -n "$CC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 +$as_echo "$CC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + +fi +if test -z "$ac_cv_prog_CC"; then + ac_ct_CC=$CC + # Extract the first word of "gcc", so it can be a program name with args. +set dummy gcc; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_ac_ct_CC+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_CC"; then + ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_CC="gcc" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_CC=$ac_cv_prog_ac_ct_CC +if test -n "$ac_ct_CC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5 +$as_echo "$ac_ct_CC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + if test "x$ac_ct_CC" = x; then + CC="" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + CC=$ac_ct_CC + fi +else + CC="$ac_cv_prog_CC" +fi + +if test -z "$CC"; then + if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}cc", so it can be a program name with args. +set dummy ${ac_tool_prefix}cc; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_CC+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_CC="${ac_tool_prefix}cc" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +CC=$ac_cv_prog_CC +if test -n "$CC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 +$as_echo "$CC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + fi +fi +if test -z "$CC"; then + # Extract the first word of "cc", so it can be a program name with args. +set dummy cc; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_CC+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. +else + ac_prog_rejected=no +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + if test "$as_dir/$ac_word$ac_exec_ext" = "/usr/ucb/cc"; then + ac_prog_rejected=yes + continue + fi + ac_cv_prog_CC="cc" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +if test $ac_prog_rejected = yes; then + # We found a bogon in the path, so make sure we never use it. + set dummy $ac_cv_prog_CC + shift + if test $# != 0; then + # We chose a different compiler from the bogus one. + # However, it has the same basename, so the bogon will be chosen + # first if we set CC to just the basename; use the full file name. + shift + ac_cv_prog_CC="$as_dir/$ac_word${1+' '}$@" + fi +fi +fi +fi +CC=$ac_cv_prog_CC +if test -n "$CC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 +$as_echo "$CC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + +fi +if test -z "$CC"; then + if test -n "$ac_tool_prefix"; then + for ac_prog in cl.exe + do + # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args. +set dummy $ac_tool_prefix$ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_CC+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_CC="$ac_tool_prefix$ac_prog" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +CC=$ac_cv_prog_CC +if test -n "$CC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 +$as_echo "$CC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$CC" && break + done +fi +if test -z "$CC"; then + ac_ct_CC=$CC + for ac_prog in cl.exe +do + # Extract the first word of "$ac_prog", so it can be a program name with args. +set dummy $ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_ac_ct_CC+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_CC"; then + ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_CC="$ac_prog" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_CC=$ac_cv_prog_ac_ct_CC +if test -n "$ac_ct_CC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5 +$as_echo "$ac_ct_CC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$ac_ct_CC" && break +done + + if test "x$ac_ct_CC" = x; then + CC="" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + CC=$ac_ct_CC + fi +fi + +fi + + +test -z "$CC" && { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "no acceptable C compiler found in \$PATH +See \`config.log' for more details" "$LINENO" 5; } + +# Provide some information about the compiler. +$as_echo "$as_me:${as_lineno-$LINENO}: checking for C compiler version" >&5 +set X $ac_compile +ac_compiler=$2 +for ac_option in --version -v -V -qversion; do + { { ac_try="$ac_compiler $ac_option >&5" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_compiler $ac_option >&5") 2>conftest.err + ac_status=$? + if test -s conftest.err; then + sed '10a\ +... rest of stderr output deleted ... + 10q' conftest.err >conftest.er1 + cat conftest.er1 >&5 + fi + rm -f conftest.er1 conftest.err + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } +done + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are using the GNU C compiler" >&5 +$as_echo_n "checking whether we are using the GNU C compiler... " >&6; } +if ${ac_cv_c_compiler_gnu+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ +#ifndef __GNUC__ + choke me +#endif + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_compiler_gnu=yes +else + ac_compiler_gnu=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +ac_cv_c_compiler_gnu=$ac_compiler_gnu + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_compiler_gnu" >&5 +$as_echo "$ac_cv_c_compiler_gnu" >&6; } +if test $ac_compiler_gnu = yes; then + GCC=yes +else + GCC= +fi +ac_test_CFLAGS=${CFLAGS+set} +ac_save_CFLAGS=$CFLAGS +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $CC accepts -g" >&5 +$as_echo_n "checking whether $CC accepts -g... " >&6; } +if ${ac_cv_prog_cc_g+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_save_c_werror_flag=$ac_c_werror_flag + ac_c_werror_flag=yes + ac_cv_prog_cc_g=no + CFLAGS="-g" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_prog_cc_g=yes +else + CFLAGS="" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + +else + ac_c_werror_flag=$ac_save_c_werror_flag + CFLAGS="-g" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_prog_cc_g=yes +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + ac_c_werror_flag=$ac_save_c_werror_flag +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_g" >&5 +$as_echo "$ac_cv_prog_cc_g" >&6; } +if test "$ac_test_CFLAGS" = set; then + CFLAGS=$ac_save_CFLAGS +elif test $ac_cv_prog_cc_g = yes; then + if test "$GCC" = yes; then + CFLAGS="-g -O2" + else + CFLAGS="-g" + fi +else + if test "$GCC" = yes; then + CFLAGS="-O2" + else + CFLAGS= + fi +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $CC option to accept ISO C89" >&5 +$as_echo_n "checking for $CC option to accept ISO C89... " >&6; } +if ${ac_cv_prog_cc_c89+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_cv_prog_cc_c89=no +ac_save_CC=$CC +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <stdarg.h> +#include <stdio.h> +struct stat; +/* Most of the following tests are stolen from RCS 5.7's src/conf.sh. */ +struct buf { int x; }; +FILE * (*rcsopen) (struct buf *, struct stat *, int); +static char *e (p, i) + char **p; + int i; +{ + return p[i]; +} +static char *f (char * (*g) (char **, int), char **p, ...) +{ + char *s; + va_list v; + va_start (v,p); + s = g (p, va_arg (v,int)); + va_end (v); + return s; +} + +/* OSF 4.0 Compaq cc is some sort of almost-ANSI by default. It has + function prototypes and stuff, but not '\xHH' hex character constants. + These don't provoke an error unfortunately, instead are silently treated + as 'x'. The following induces an error, until -std is added to get + proper ANSI mode. Curiously '\x00'!='x' always comes out true, for an + array size at least. It's necessary to write '\x00'==0 to get something + that's true only with -std. */ +int osf4_cc_array ['\x00' == 0 ? 1 : -1]; + +/* IBM C 6 for AIX is almost-ANSI by default, but it replaces macro parameters + inside strings and character constants. */ +#define FOO(x) 'x' +int xlc6_cc_array[FOO(a) == 'x' ? 1 : -1]; + +int test (int i, double x); +struct s1 {int (*f) (int a);}; +struct s2 {int (*f) (double a);}; +int pairnames (int, char **, FILE *(*)(struct buf *, struct stat *, int), int, int); +int argc; +char **argv; +int +main () +{ +return f (e, argv, 0) != argv[0] || f (e, argv, 1) != argv[1]; + ; + return 0; +} +_ACEOF +for ac_arg in '' -qlanglvl=extc89 -qlanglvl=ansi -std \ + -Ae "-Aa -D_HPUX_SOURCE" "-Xc -D__EXTENSIONS__" +do + CC="$ac_save_CC $ac_arg" + if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_prog_cc_c89=$ac_arg +fi +rm -f core conftest.err conftest.$ac_objext + test "x$ac_cv_prog_cc_c89" != "xno" && break +done +rm -f conftest.$ac_ext +CC=$ac_save_CC + +fi +# AC_CACHE_VAL +case "x$ac_cv_prog_cc_c89" in + x) + { $as_echo "$as_me:${as_lineno-$LINENO}: result: none needed" >&5 +$as_echo "none needed" >&6; } ;; + xno) + { $as_echo "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5 +$as_echo "unsupported" >&6; } ;; + *) + CC="$CC $ac_cv_prog_cc_c89" + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c89" >&5 +$as_echo "$ac_cv_prog_cc_c89" >&6; } ;; +esac +if test "x$ac_cv_prog_cc_c89" != xno; then : + +fi + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking how to run the C preprocessor" >&5 +$as_echo_n "checking how to run the C preprocessor... " >&6; } +# On Suns, sometimes $CPP names a directory. +if test -n "$CPP" && test -d "$CPP"; then + CPP= +fi +if test -z "$CPP"; then + if ${ac_cv_prog_CPP+:} false; then : + $as_echo_n "(cached) " >&6 +else + # Double quotes because CPP needs to be expanded + for CPP in "$CC -E" "$CC -E -traditional-cpp" "/lib/cpp" + do + ac_preproc_ok=false +for ac_c_preproc_warn_flag in '' yes +do + # Use a header file that comes with gcc, so configuring glibc + # with a fresh cross-compiler works. + # Prefer <limits.h> to <assert.h> if __STDC__ is defined, since + # <limits.h> exists even on freestanding compilers. + # On the NeXT, cc -E runs the code through the compiler's parser, + # not just through cpp. "Syntax error" is here to catch this case. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#ifdef __STDC__ +# include <limits.h> +#else +# include <assert.h> +#endif + Syntax error +_ACEOF +if ac_fn_c_try_cpp "$LINENO"; then : + +else + # Broken: fails on valid input. +continue +fi +rm -f conftest.err conftest.i conftest.$ac_ext + + # OK, works on sane cases. Now check whether nonexistent headers + # can be detected and how. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <ac_nonexistent.h> +_ACEOF +if ac_fn_c_try_cpp "$LINENO"; then : + # Broken: success on invalid input. +continue +else + # Passes both tests. +ac_preproc_ok=: +break +fi +rm -f conftest.err conftest.i conftest.$ac_ext + +done +# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. +rm -f conftest.i conftest.err conftest.$ac_ext +if $ac_preproc_ok; then : + break +fi + + done + ac_cv_prog_CPP=$CPP + +fi + CPP=$ac_cv_prog_CPP +else + ac_cv_prog_CPP=$CPP +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $CPP" >&5 +$as_echo "$CPP" >&6; } +ac_preproc_ok=false +for ac_c_preproc_warn_flag in '' yes +do + # Use a header file that comes with gcc, so configuring glibc + # with a fresh cross-compiler works. + # Prefer <limits.h> to <assert.h> if __STDC__ is defined, since + # <limits.h> exists even on freestanding compilers. + # On the NeXT, cc -E runs the code through the compiler's parser, + # not just through cpp. "Syntax error" is here to catch this case. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#ifdef __STDC__ +# include <limits.h> +#else +# include <assert.h> +#endif + Syntax error +_ACEOF +if ac_fn_c_try_cpp "$LINENO"; then : + +else + # Broken: fails on valid input. +continue +fi +rm -f conftest.err conftest.i conftest.$ac_ext + + # OK, works on sane cases. Now check whether nonexistent headers + # can be detected and how. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <ac_nonexistent.h> +_ACEOF +if ac_fn_c_try_cpp "$LINENO"; then : + # Broken: success on invalid input. +continue +else + # Passes both tests. +ac_preproc_ok=: +break +fi +rm -f conftest.err conftest.i conftest.$ac_ext + +done +# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. +rm -f conftest.i conftest.err conftest.$ac_ext +if $ac_preproc_ok; then : + +else + { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "C preprocessor \"$CPP\" fails sanity check +See \`config.log' for more details" "$LINENO" 5; } +fi + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + + #-------------------------------------------------------------------- + # Checks to see if the make program sets the $MAKE variable. + #-------------------------------------------------------------------- + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether ${MAKE-make} sets \$(MAKE)" >&5 +$as_echo_n "checking whether ${MAKE-make} sets \$(MAKE)... " >&6; } +set x ${MAKE-make} +ac_make=`$as_echo "$2" | sed 's/+/p/g; s/[^a-zA-Z0-9_]/_/g'` +if eval \${ac_cv_prog_make_${ac_make}_set+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat >conftest.make <<\_ACEOF +SHELL = /bin/sh +all: + @echo '@@@%%%=$(MAKE)=@@@%%%' +_ACEOF +# GNU make sometimes prints "make[1]: Entering ...", which would confuse us. +case `${MAKE-make} -f conftest.make 2>/dev/null` in + *@@@%%%=?*=@@@%%%*) + eval ac_cv_prog_make_${ac_make}_set=yes;; + *) + eval ac_cv_prog_make_${ac_make}_set=no;; +esac +rm -f conftest.make +fi +if eval test \$ac_cv_prog_make_${ac_make}_set = yes; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +$as_echo "yes" >&6; } + SET_MAKE= +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } + SET_MAKE="MAKE=${MAKE-make}" +fi + + + #-------------------------------------------------------------------- + # Find ranlib + #-------------------------------------------------------------------- + + if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}ranlib", so it can be a program name with args. +set dummy ${ac_tool_prefix}ranlib; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_RANLIB+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$RANLIB"; then + ac_cv_prog_RANLIB="$RANLIB" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_RANLIB="${ac_tool_prefix}ranlib" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +RANLIB=$ac_cv_prog_RANLIB +if test -n "$RANLIB"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $RANLIB" >&5 +$as_echo "$RANLIB" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + +fi +if test -z "$ac_cv_prog_RANLIB"; then + ac_ct_RANLIB=$RANLIB + # Extract the first word of "ranlib", so it can be a program name with args. +set dummy ranlib; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_ac_ct_RANLIB+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_RANLIB"; then + ac_cv_prog_ac_ct_RANLIB="$ac_ct_RANLIB" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_RANLIB="ranlib" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_RANLIB=$ac_cv_prog_ac_ct_RANLIB +if test -n "$ac_ct_RANLIB"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_RANLIB" >&5 +$as_echo "$ac_ct_RANLIB" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + if test "x$ac_ct_RANLIB" = x; then + RANLIB="" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + RANLIB=$ac_ct_RANLIB + fi +else + RANLIB="$ac_cv_prog_RANLIB" +fi + + + #-------------------------------------------------------------------- + # Determines the correct binary file extension (.o, .obj, .exe etc.) + #-------------------------------------------------------------------- + + + + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for grep that handles long lines and -e" >&5 +$as_echo_n "checking for grep that handles long lines and -e... " >&6; } +if ${ac_cv_path_GREP+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -z "$GREP"; then + ac_path_GREP_found=false + # Loop through the user's path and test for each of PROGNAME-LIST + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_prog in grep ggrep; do + for ac_exec_ext in '' $ac_executable_extensions; do + ac_path_GREP="$as_dir/$ac_prog$ac_exec_ext" + as_fn_executable_p "$ac_path_GREP" || continue +# Check for GNU ac_path_GREP and select it if it is found. + # Check for GNU $ac_path_GREP +case `"$ac_path_GREP" --version 2>&1` in +*GNU*) + ac_cv_path_GREP="$ac_path_GREP" ac_path_GREP_found=:;; +*) + ac_count=0 + $as_echo_n 0123456789 >"conftest.in" + while : + do + cat "conftest.in" "conftest.in" >"conftest.tmp" + mv "conftest.tmp" "conftest.in" + cp "conftest.in" "conftest.nl" + $as_echo 'GREP' >> "conftest.nl" + "$ac_path_GREP" -e 'GREP$' -e '-(cannot match)-' < "conftest.nl" >"conftest.out" 2>/dev/null || break + diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break + as_fn_arith $ac_count + 1 && ac_count=$as_val + if test $ac_count -gt ${ac_path_GREP_max-0}; then + # Best one so far, save it but keep looking for a better one + ac_cv_path_GREP="$ac_path_GREP" + ac_path_GREP_max=$ac_count + fi + # 10*(2^10) chars as input seems more than enough + test $ac_count -gt 10 && break + done + rm -f conftest.in conftest.tmp conftest.nl conftest.out;; +esac + + $ac_path_GREP_found && break 3 + done + done + done +IFS=$as_save_IFS + if test -z "$ac_cv_path_GREP"; then + as_fn_error $? "no acceptable grep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" "$LINENO" 5 + fi +else + ac_cv_path_GREP=$GREP +fi + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_GREP" >&5 +$as_echo "$ac_cv_path_GREP" >&6; } + GREP="$ac_cv_path_GREP" + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for egrep" >&5 +$as_echo_n "checking for egrep... " >&6; } +if ${ac_cv_path_EGREP+:} false; then : + $as_echo_n "(cached) " >&6 +else + if echo a | $GREP -E '(a|b)' >/dev/null 2>&1 + then ac_cv_path_EGREP="$GREP -E" + else + if test -z "$EGREP"; then + ac_path_EGREP_found=false + # Loop through the user's path and test for each of PROGNAME-LIST + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_prog in egrep; do + for ac_exec_ext in '' $ac_executable_extensions; do + ac_path_EGREP="$as_dir/$ac_prog$ac_exec_ext" + as_fn_executable_p "$ac_path_EGREP" || continue +# Check for GNU ac_path_EGREP and select it if it is found. + # Check for GNU $ac_path_EGREP +case `"$ac_path_EGREP" --version 2>&1` in +*GNU*) + ac_cv_path_EGREP="$ac_path_EGREP" ac_path_EGREP_found=:;; +*) + ac_count=0 + $as_echo_n 0123456789 >"conftest.in" + while : + do + cat "conftest.in" "conftest.in" >"conftest.tmp" + mv "conftest.tmp" "conftest.in" + cp "conftest.in" "conftest.nl" + $as_echo 'EGREP' >> "conftest.nl" + "$ac_path_EGREP" 'EGREP$' < "conftest.nl" >"conftest.out" 2>/dev/null || break + diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break + as_fn_arith $ac_count + 1 && ac_count=$as_val + if test $ac_count -gt ${ac_path_EGREP_max-0}; then + # Best one so far, save it but keep looking for a better one + ac_cv_path_EGREP="$ac_path_EGREP" + ac_path_EGREP_max=$ac_count + fi + # 10*(2^10) chars as input seems more than enough + test $ac_count -gt 10 && break + done + rm -f conftest.in conftest.tmp conftest.nl conftest.out;; +esac + + $ac_path_EGREP_found && break 3 + done + done + done +IFS=$as_save_IFS + if test -z "$ac_cv_path_EGREP"; then + as_fn_error $? "no acceptable egrep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" "$LINENO" 5 + fi +else + ac_cv_path_EGREP=$EGREP +fi + + fi +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_EGREP" >&5 +$as_echo "$ac_cv_path_EGREP" >&6; } + EGREP="$ac_cv_path_EGREP" + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for ANSI C header files" >&5 +$as_echo_n "checking for ANSI C header files... " >&6; } +if ${ac_cv_header_stdc+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <stdlib.h> +#include <stdarg.h> +#include <string.h> +#include <float.h> + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_header_stdc=yes +else + ac_cv_header_stdc=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + +if test $ac_cv_header_stdc = yes; then + # SunOS 4.x string.h does not declare mem*, contrary to ANSI. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <string.h> + +_ACEOF +if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | + $EGREP "memchr" >/dev/null 2>&1; then : + +else + ac_cv_header_stdc=no +fi +rm -f conftest* + +fi + +if test $ac_cv_header_stdc = yes; then + # ISC 2.0.2 stdlib.h does not declare free, contrary to ANSI. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <stdlib.h> + +_ACEOF +if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | + $EGREP "free" >/dev/null 2>&1; then : + +else + ac_cv_header_stdc=no +fi +rm -f conftest* + +fi + +if test $ac_cv_header_stdc = yes; then + # /bin/cc in Irix-4.0.5 gets non-ANSI ctype macros unless using -ansi. + if test "$cross_compiling" = yes; then : + : +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <ctype.h> +#include <stdlib.h> +#if ((' ' & 0x0FF) == 0x020) +# define ISLOWER(c) ('a' <= (c) && (c) <= 'z') +# define TOUPPER(c) (ISLOWER(c) ? 'A' + ((c) - 'a') : (c)) +#else +# define ISLOWER(c) \ + (('a' <= (c) && (c) <= 'i') \ + || ('j' <= (c) && (c) <= 'r') \ + || ('s' <= (c) && (c) <= 'z')) +# define TOUPPER(c) (ISLOWER(c) ? ((c) | 0x40) : (c)) +#endif + +#define XOR(e, f) (((e) && !(f)) || (!(e) && (f))) +int +main () +{ + int i; + for (i = 0; i < 256; i++) + if (XOR (islower (i), ISLOWER (i)) + || toupper (i) != TOUPPER (i)) + return 2; + return 0; +} +_ACEOF +if ac_fn_c_try_run "$LINENO"; then : + +else + ac_cv_header_stdc=no +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + +fi +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_header_stdc" >&5 +$as_echo "$ac_cv_header_stdc" >&6; } +if test $ac_cv_header_stdc = yes; then + +$as_echo "#define STDC_HEADERS 1" >>confdefs.h + +fi + +# On IRIX 5.3, sys/types and inttypes.h are conflicting. +for ac_header in sys/types.h sys/stat.h stdlib.h string.h memory.h strings.h \ + inttypes.h stdint.h unistd.h +do : + as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh` +ac_fn_c_check_header_compile "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default +" +if eval test \"x\$"$as_ac_Header"\" = x"yes"; then : + cat >>confdefs.h <<_ACEOF +#define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1 +_ACEOF + +fi + +done + + + + # Any macros that use the compiler (e.g. AC_TRY_COMPILE) have to go here. + + + #------------------------------------------------------------------------ + # If we're using GCC, see if the compiler understands -pipe. If so, use it. + # It makes compiling go faster. (This is only a performance feature.) + #------------------------------------------------------------------------ + + if test -z "$no_pipe" -a -n "$GCC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking if the compiler understands -pipe" >&5 +$as_echo_n "checking if the compiler understands -pipe... " >&6; } +if ${tcl_cv_cc_pipe+:} false; then : + $as_echo_n "(cached) " >&6 +else + + hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -pipe" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + tcl_cv_cc_pipe=yes +else + tcl_cv_cc_pipe=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + CFLAGS=$hold_cflags +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_cc_pipe" >&5 +$as_echo "$tcl_cv_cc_pipe" >&6; } + if test $tcl_cv_cc_pipe = yes; then + CFLAGS="$CFLAGS -pipe" + fi + fi + + #-------------------------------------------------------------------- + # Common compiler flag setup + #-------------------------------------------------------------------- + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether byte ordering is bigendian" >&5 +$as_echo_n "checking whether byte ordering is bigendian... " >&6; } +if ${ac_cv_c_bigendian+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_cv_c_bigendian=unknown + # See if we're dealing with a universal compiler. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#ifndef __APPLE_CC__ + not a universal capable compiler + #endif + typedef int dummy; + +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + + # Check for potential -arch flags. It is not universal unless + # there are at least two -arch flags with different values. + ac_arch= + ac_prev= + for ac_word in $CC $CFLAGS $CPPFLAGS $LDFLAGS; do + if test -n "$ac_prev"; then + case $ac_word in + i?86 | x86_64 | ppc | ppc64) + if test -z "$ac_arch" || test "$ac_arch" = "$ac_word"; then + ac_arch=$ac_word + else + ac_cv_c_bigendian=universal + break + fi + ;; + esac + ac_prev= + elif test "x$ac_word" = "x-arch"; then + ac_prev=arch + fi + done +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + if test $ac_cv_c_bigendian = unknown; then + # See if sys/param.h defines the BYTE_ORDER macro. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <sys/types.h> + #include <sys/param.h> + +int +main () +{ +#if ! (defined BYTE_ORDER && defined BIG_ENDIAN \ + && defined LITTLE_ENDIAN && BYTE_ORDER && BIG_ENDIAN \ + && LITTLE_ENDIAN) + bogus endian macros + #endif + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + # It does; now see whether it defined to BIG_ENDIAN or not. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <sys/types.h> + #include <sys/param.h> + +int +main () +{ +#if BYTE_ORDER != BIG_ENDIAN + not big endian + #endif + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_c_bigendian=yes +else + ac_cv_c_bigendian=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + fi + if test $ac_cv_c_bigendian = unknown; then + # See if <limits.h> defines _LITTLE_ENDIAN or _BIG_ENDIAN (e.g., Solaris). + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <limits.h> + +int +main () +{ +#if ! (defined _LITTLE_ENDIAN || defined _BIG_ENDIAN) + bogus endian macros + #endif + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + # It does; now see whether it defined to _BIG_ENDIAN or not. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <limits.h> + +int +main () +{ +#ifndef _BIG_ENDIAN + not big endian + #endif + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_c_bigendian=yes +else + ac_cv_c_bigendian=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + fi + if test $ac_cv_c_bigendian = unknown; then + # Compile a test program. + if test "$cross_compiling" = yes; then : + # Try to guess by grepping values from an object file. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +short int ascii_mm[] = + { 0x4249, 0x4765, 0x6E44, 0x6961, 0x6E53, 0x7953, 0 }; + short int ascii_ii[] = + { 0x694C, 0x5454, 0x656C, 0x6E45, 0x6944, 0x6E61, 0 }; + int use_ascii (int i) { + return ascii_mm[i] + ascii_ii[i]; + } + short int ebcdic_ii[] = + { 0x89D3, 0xE3E3, 0x8593, 0x95C5, 0x89C4, 0x9581, 0 }; + short int ebcdic_mm[] = + { 0xC2C9, 0xC785, 0x95C4, 0x8981, 0x95E2, 0xA8E2, 0 }; + int use_ebcdic (int i) { + return ebcdic_mm[i] + ebcdic_ii[i]; + } + extern int foo; + +int +main () +{ +return use_ascii (foo) == use_ebcdic (foo); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + if grep BIGenDianSyS conftest.$ac_objext >/dev/null; then + ac_cv_c_bigendian=yes + fi + if grep LiTTleEnDian conftest.$ac_objext >/dev/null ; then + if test "$ac_cv_c_bigendian" = unknown; then + ac_cv_c_bigendian=no + else + # finding both strings is unlikely to happen, but who knows? + ac_cv_c_bigendian=unknown + fi + fi +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$ac_includes_default +int +main () +{ + + /* Are we little or big endian? From Harbison&Steele. */ + union + { + long int l; + char c[sizeof (long int)]; + } u; + u.l = 1; + return u.c[sizeof (long int) - 1] == 1; + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_run "$LINENO"; then : + ac_cv_c_bigendian=no +else + ac_cv_c_bigendian=yes +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + + fi +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_bigendian" >&5 +$as_echo "$ac_cv_c_bigendian" >&6; } + case $ac_cv_c_bigendian in #( + yes) + $as_echo "#define WORDS_BIGENDIAN 1" >>confdefs.h +;; #( + no) + ;; #( + universal) + +$as_echo "#define AC_APPLE_UNIVERSAL_BUILD 1" >>confdefs.h + + ;; #( + *) + as_fn_error $? "unknown endianness + presetting ac_cv_c_bigendian=no (or yes) will help" "$LINENO" 5 ;; + esac + + + +#-------------------------------------------------------------------- +# Check if building with optional Gdbm package. This will declare +# GDBM_CFLAGS and GDBM_LIBS variables. +#-------------------------------------------------------------------- + + + +# Check whether --with-gdbm was given. +if test "${with_gdbm+set}" = set; then : + withval=$with_gdbm; \ + with_gdbm=${withval} +fi + + + if test x"${with_gdbm}" != x -a "${with_gdbm}" != no; then + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for GNU gdbm library" >&5 +$as_echo_n "checking for GNU gdbm library... " >&6; } + + if ${ac_cv_c_gdbm+:} false; then : + $as_echo_n "(cached) " >&6 +else + + if test x"${with_gdbm}" != x -a "${with_gdbm}" != "yes"; then + if test -f "${with_gdbm}/gdbm.h" -a x"`ls ${with_gdbm}/libgdbm* 2>/dev/null`" != x; then + ac_cv_c_gdbm=`(cd ${with_gdbm}; pwd)` + gincdir=$ac_cv_c_gdbm + glibdir=$ac_cv_c_gdbm + { $as_echo "$as_me:${as_lineno-$LINENO}: result: found in $glibdir" >&5 +$as_echo "found in $glibdir" >&6; } + else + as_fn_error $? "${with_gdbm} directory doesn't contain gdbm library" "$LINENO" 5 + fi + fi + +fi + + if test x"${gincdir}" = x -o x"${glibdir}" = x; then + for i in \ + `ls -d ${exec_prefix}/lib 2>/dev/null`\ + `ls -d ${prefix}/lib 2>/dev/null`\ + `ls -d /usr/local/lib 2>/dev/null`\ + `ls -d /usr/lib 2>/dev/null` ; do + if test x"`ls $i/libgdbm* 2>/dev/null`" != x ; then + glibdir=`(cd $i; pwd)` + break + fi + done + for i in \ + `ls -d ${prefix}/include 2>/dev/null`\ + `ls -d /usr/local/include 2>/dev/null`\ + `ls -d /usr/include 2>/dev/null` ; do + if test -f "$i/gdbm.h" ; then + gincdir=`(cd $i; pwd)` + break + fi + done + if test x"$glibdir" = x -o x"$gincdir" = x ; then + as_fn_error $? "none found" "$LINENO" 5 + else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: found in $glibdir, includes in $gincdir" >&5 +$as_echo "found in $glibdir, includes in $gincdir" >&6; } + $as_echo "#define HAVE_GDBM 1" >>confdefs.h + + GDBM_CFLAGS="-I\"$gincdir\"" + GDBM_LIBS="-L\"$glibdir\" -lgdbm" + fi + fi + fi + + +#-------------------------------------------------------------------- +# Check if building with optional lmdb package. This will declare +# LMDB_CFLAGS and LMDB_LIBS variables. +#-------------------------------------------------------------------- + + + +# Check whether --with-lmdb was given. +if test "${with_lmdb+set}" = set; then : + withval=$with_lmdb; with_lmdb=${withval} +fi + + + if test x"${with_lmdb}" != "x" -a "${with_lmdb}" != no; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for LMDB library" >&5 +$as_echo_n "checking for LMDB library... " >&6; } + if ${ac_cv_c_lmdb+:} false; then : + $as_echo_n "(cached) " >&6 +else + + if test x"${with_lmdb}" != x -a "${with_lmdb}" != "yes"; then + if test -f "${with_lmdb}/lmdb.h" -a x"`ls ${with_lmdb}/liblmdb* 2>/dev/null`" != x; then + ac_cv_c_lmdb=`(cd ${with_lmdb}; pwd)` + lincdir=$ac_cv_c_lmdb + llibdir=$ac_cv_c_lmdb + { $as_echo "$as_me:${as_lineno-$LINENO}: result: found in $llibdir" >&5 +$as_echo "found in $llibdir" >&6; } + else + as_fn_error $? "${with_lmdb} directory doesn't contain lmdb library" "$LINENO" 5 + fi + fi + +fi + + if test x"${lincdir}" = x -o x"${llibdir}" = x; then + for i in \ + `ls -d ${exec_prefix}/lib 2>/dev/null`\ + `ls -d ${prefix}/lib 2>/dev/null`\ + `ls -d /usr/local/lib 2>/dev/null`\ + `ls -d /usr/lib 2>/dev/null` ; do + if test x"`ls $i/liblmdb* 2>/dev/null`" != x ; then + llibdir=`(cd $i; pwd)` + break + fi + done + for i in \ + `ls -d ${prefix}/include 2>/dev/null`\ + `ls -d /usr/local/include 2>/dev/null`\ + `ls -d /usr/include 2>/dev/null` ; do + if test -f "$i/lmdb.h" ; then + lincdir=`(cd $i; pwd)` + break + fi + done + if test x"$llibdir" = x -o x"$lincdir" = x ; then + as_fn_error $? "none found" "$LINENO" 5 + else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: found in $llibdir, includes in $lincdir" >&5 +$as_echo "found in $llibdir, includes in $lincdir" >&6; } + $as_echo "#define HAVE_LMDB 1" >>confdefs.h + + LMDB_CFLAGS="-I\"$lincdir\"" + LMDB_LIBS="-L\"$llibdir\" -llmdb" + fi + fi + fi + + +#-------------------------------------------------------------------- +# Locate the NaviServer/AOLserver dir for compilation as NaviServer/AOLserver module. +# This will declare NS_INCLUDES, NS_LIBS and define NS_AOLSERVER. +#-------------------------------------------------------------------- + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for NaviServer/AOLserver configuration" >&5 +$as_echo_n "checking for NaviServer/AOLserver configuration... " >&6; } + +# Check whether --with-naviserver was given. +if test "${with_naviserver+set}" = set; then : + withval=$with_naviserver; \ + with_naviserver=${withval} +fi + + + if ${ac_cv_c_naviserver+:} false; then : + $as_echo_n "(cached) " >&6 +else + + if test x"${with_naviserver}" != x ; then + if test -f "${with_naviserver}/include/ns.h" ; then + ac_cv_c_naviserver=`(cd ${with_naviserver}; pwd)` + else + as_fn_error $? "${with_naviserver} directory doesn't contain ns.h" "$LINENO" 5 + fi + fi + +fi + + if test x"${ac_cv_c_naviserver}" = x ; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: none found" >&5 +$as_echo "none found" >&6; } + else + NS_DIR=${ac_cv_c_naviserver} + { $as_echo "$as_me:${as_lineno-$LINENO}: result: found NaviServer/AOLserver in $NS_DIR" >&5 +$as_echo "found NaviServer/AOLserver in $NS_DIR" >&6; } + NS_INCLUDES="-I\"${NS_DIR}/include\"" + if test "`uname -s`" = Darwin ; then + aollibs=`ls ${NS_DIR}/lib/libns* 2>/dev/null` + if test x"$aollibs" != x ; then + NS_LIBS="-L\"${NS_DIR}/lib\" -lnsd -lnsthread" + fi + fi + $as_echo "#define NS_AOLSERVER 1" >>confdefs.h + + fi + + +#----------------------------------------------------------------------- +# __CHANGE__ +# Specify the C source files to compile in TEA_ADD_SOURCES, +# public headers that need to be installed in TEA_ADD_HEADERS, +# stub library C source files to compile in TEA_ADD_STUB_SOURCES, +# and runtime Tcl library files in TEA_ADD_TCL_SOURCES. +# This defines PKG(_STUB)_SOURCES, PKG(_STUB)_OBJECTS, PKG_HEADERS +# and PKG_TCL_SOURCES. +#----------------------------------------------------------------------- + + + vars="generic/threadNs.c \ + generic/threadCmd.c \ + generic/threadSvCmd.c \ + generic/threadSpCmd.c \ + generic/threadPoolCmd.c \ + generic/psGdbm.c \ + generic/psLmdb.c \ + generic/threadSvListCmd.c \ + generic/threadSvKeylistCmd.c \ + generic/tclXkeylist.c \ +" + for i in $vars; do + case $i in + \$*) + # allow $-var names + PKG_SOURCES="$PKG_SOURCES $i" + PKG_OBJECTS="$PKG_OBJECTS $i" + ;; + *) + # check for existence - allows for generic/win/unix VPATH + # To add more dirs here (like 'src'), you have to update VPATH + # in Makefile.in as well + if test ! -f "${srcdir}/$i" -a ! -f "${srcdir}/generic/$i" \ + -a ! -f "${srcdir}/win/$i" -a ! -f "${srcdir}/unix/$i" \ + -a ! -f "${srcdir}/macosx/$i" \ + ; then + as_fn_error $? "could not find source file '$i'" "$LINENO" 5 + fi + PKG_SOURCES="$PKG_SOURCES $i" + # this assumes it is in a VPATH dir + i=`basename $i` + # handle user calling this before or after TEA_SETUP_COMPILER + if test x"${OBJEXT}" != x ; then + j="`echo $i | sed -e 's/\.[^.]*$//'`.${OBJEXT}" + else + j="`echo $i | sed -e 's/\.[^.]*$//'`.\${OBJEXT}" + fi + PKG_OBJECTS="$PKG_OBJECTS $j" + ;; + esac + done + + + + + + vars="generic/tclThread.h" + for i in $vars; do + # check for existence, be strict because it is installed + if test ! -f "${srcdir}/$i" ; then + as_fn_error $? "could not find header file '${srcdir}/$i'" "$LINENO" 5 + fi + PKG_HEADERS="$PKG_HEADERS $i" + done + + + + vars="${NS_INCLUDES}" + for i in $vars; do + PKG_INCLUDES="$PKG_INCLUDES $i" + done + + + + vars="${GDBM_LIBS} ${LMDB_LIBS} ${NS_LIBS}" + for i in $vars; do + if test "${TEA_PLATFORM}" = "windows" -a "$GCC" = "yes" ; then + # Convert foo.lib to -lfoo for GCC. No-op if not *.lib + i=`echo "$i" | sed -e 's/^\([^-].*\)\.lib$/-l\1/i'` + fi + PKG_LIBS="$PKG_LIBS $i" + done + + + + PKG_CFLAGS="$PKG_CFLAGS ${GDBM_CFLAGS} ${LMDB_CFLAGS}" + + + + vars="" + for i in $vars; do + # check for existence - allows for generic/win/unix VPATH + if test ! -f "${srcdir}/$i" -a ! -f "${srcdir}/generic/$i" \ + -a ! -f "${srcdir}/win/$i" -a ! -f "${srcdir}/unix/$i" \ + -a ! -f "${srcdir}/macosx/$i" \ + ; then + as_fn_error $? "could not find stub source file '$i'" "$LINENO" 5 + fi + PKG_STUB_SOURCES="$PKG_STUB_SOURCES $i" + # this assumes it is in a VPATH dir + i=`basename $i` + # handle user calling this before or after TEA_SETUP_COMPILER + if test x"${OBJEXT}" != x ; then + j="`echo $i | sed -e 's/\.[^.]*$//'`.${OBJEXT}" + else + j="`echo $i | sed -e 's/\.[^.]*$//'`.\${OBJEXT}" + fi + PKG_STUB_OBJECTS="$PKG_STUB_OBJECTS $j" + done + + + + + vars="lib/ttrace.tcl" + for i in $vars; do + # check for existence, be strict because it is installed + if test ! -f "${srcdir}/$i" ; then + as_fn_error $? "could not find tcl source file '${srcdir}/$i'" "$LINENO" 5 + fi + PKG_TCL_SOURCES="$PKG_TCL_SOURCES $i" + done + + + +#-------------------------------------------------------------------- +# __CHANGE__ +# A few miscellaneous platform-specific items: +# +# Define a special symbol for Windows (BUILD_sample in this case) so +# that we create the export library with the dll. +# +# Windows creates a few extra files that need to be cleaned up. +# You can add more files to clean if your extension creates any extra +# files. +# +# TEA_ADD_* any platform specific compiler/build info here. +#-------------------------------------------------------------------- + +if test "${TEA_PLATFORM}" = "windows" ; then + + vars="win/threadWin.c" + for i in $vars; do + case $i in + \$*) + # allow $-var names + PKG_SOURCES="$PKG_SOURCES $i" + PKG_OBJECTS="$PKG_OBJECTS $i" + ;; + *) + # check for existence - allows for generic/win/unix VPATH + # To add more dirs here (like 'src'), you have to update VPATH + # in Makefile.in as well + if test ! -f "${srcdir}/$i" -a ! -f "${srcdir}/generic/$i" \ + -a ! -f "${srcdir}/win/$i" -a ! -f "${srcdir}/unix/$i" \ + -a ! -f "${srcdir}/macosx/$i" \ + ; then + as_fn_error $? "could not find source file '$i'" "$LINENO" 5 + fi + PKG_SOURCES="$PKG_SOURCES $i" + # this assumes it is in a VPATH dir + i=`basename $i` + # handle user calling this before or after TEA_SETUP_COMPILER + if test x"${OBJEXT}" != x ; then + j="`echo $i | sed -e 's/\.[^.]*$//'`.${OBJEXT}" + else + j="`echo $i | sed -e 's/\.[^.]*$//'`.\${OBJEXT}" + fi + PKG_OBJECTS="$PKG_OBJECTS $j" + ;; + esac + done + + + + + vars="-I\"$(${CYGPATH} ${srcdir}/win)\"" + for i in $vars; do + PKG_INCLUDES="$PKG_INCLUDES $i" + done + + +else + + vars="unix/threadUnix.c" + for i in $vars; do + case $i in + \$*) + # allow $-var names + PKG_SOURCES="$PKG_SOURCES $i" + PKG_OBJECTS="$PKG_OBJECTS $i" + ;; + *) + # check for existence - allows for generic/win/unix VPATH + # To add more dirs here (like 'src'), you have to update VPATH + # in Makefile.in as well + if test ! -f "${srcdir}/$i" -a ! -f "${srcdir}/generic/$i" \ + -a ! -f "${srcdir}/win/$i" -a ! -f "${srcdir}/unix/$i" \ + -a ! -f "${srcdir}/macosx/$i" \ + ; then + as_fn_error $? "could not find source file '$i'" "$LINENO" 5 + fi + PKG_SOURCES="$PKG_SOURCES $i" + # this assumes it is in a VPATH dir + i=`basename $i` + # handle user calling this before or after TEA_SETUP_COMPILER + if test x"${OBJEXT}" != x ; then + j="`echo $i | sed -e 's/\.[^.]*$//'`.${OBJEXT}" + else + j="`echo $i | sed -e 's/\.[^.]*$//'`.\${OBJEXT}" + fi + PKG_OBJECTS="$PKG_OBJECTS $j" + ;; + esac + done + + + +fi + +#-------------------------------------------------------------------- +# __CHANGE__ +# Choose which headers you need. Extension authors should try very +# hard to only rely on the Tcl public header files. Internal headers +# contain private data structures and are subject to change without +# notice. +# This MUST be called after TEA_LOAD_TCLCONFIG / TEA_LOAD_TKCONFIG +#-------------------------------------------------------------------- + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for Tcl public headers" >&5 +$as_echo_n "checking for Tcl public headers... " >&6; } + + +# Check whether --with-tclinclude was given. +if test "${with_tclinclude+set}" = set; then : + withval=$with_tclinclude; with_tclinclude=${withval} +fi + + + if ${ac_cv_c_tclh+:} false; then : + $as_echo_n "(cached) " >&6 +else + + # Use the value from --with-tclinclude, if it was given + + if test x"${with_tclinclude}" != x ; then + if test -f "${with_tclinclude}/tcl.h" ; then + ac_cv_c_tclh=${with_tclinclude} + else + as_fn_error $? "${with_tclinclude} directory does not contain tcl.h" "$LINENO" 5 + fi + else + list="" + if test "`uname -s`" = "Darwin"; then + # If Tcl was built as a framework, attempt to use + # the framework's Headers directory + case ${TCL_DEFS} in + *TCL_FRAMEWORK*) + list="`ls -d ${TCL_BIN_DIR}/Headers 2>/dev/null`" + ;; + esac + fi + + # Look in the source dir only if Tcl is not installed, + # and in that situation, look there before installed locations. + if test -f "${TCL_BIN_DIR}/Makefile" ; then + list="$list `ls -d ${TCL_SRC_DIR}/generic 2>/dev/null`" + fi + + # Check order: pkg --prefix location, Tcl's --prefix location, + # relative to directory of tclConfig.sh. + + eval "temp_includedir=${includedir}" + list="$list \ + `ls -d ${temp_includedir} 2>/dev/null` \ + `ls -d ${TCL_PREFIX}/include 2>/dev/null` \ + `ls -d ${TCL_BIN_DIR}/../include 2>/dev/null`" + if test "${TEA_PLATFORM}" != "windows" -o "$GCC" = "yes"; then + list="$list /usr/local/include /usr/include" + if test x"${TCL_INCLUDE_SPEC}" != x ; then + d=`echo "${TCL_INCLUDE_SPEC}" | sed -e 's/^-I//'` + list="$list `ls -d ${d} 2>/dev/null`" + fi + fi + for i in $list ; do + if test -f "$i/tcl.h" ; then + ac_cv_c_tclh=$i + break + fi + done + fi + +fi + + + # Print a message based on how we determined the include path + + if test x"${ac_cv_c_tclh}" = x ; then + as_fn_error $? "tcl.h not found. Please specify its location with --with-tclinclude" "$LINENO" 5 + else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: ${ac_cv_c_tclh}" >&5 +$as_echo "${ac_cv_c_tclh}" >&6; } + fi + + # Convert to a native path and substitute into the output files. + + INCLUDE_DIR_NATIVE=`${CYGPATH} ${ac_cv_c_tclh}` + + TCL_INCLUDES=-I\"${INCLUDE_DIR_NATIVE}\" + + + +#TEA_PRIVATE_TCL_HEADERS + +#TEA_PUBLIC_TK_HEADERS +#TEA_PRIVATE_TK_HEADERS +#TEA_PATH_X + +#-------------------------------------------------------------------- +# Check whether --enable-threads or --disable-threads was given. +# This auto-enables if Tcl was compiled threaded. +#-------------------------------------------------------------------- + + + # Check whether --enable-threads was given. +if test "${enable_threads+set}" = set; then : + enableval=$enable_threads; tcl_ok=$enableval +else + tcl_ok=yes +fi + + + if test "${enable_threads+set}" = set; then + enableval="$enable_threads" + tcl_ok=$enableval + else + tcl_ok=yes + fi + + if test "$tcl_ok" = "yes" -o "${TCL_THREADS}" = 1; then + TCL_THREADS=1 + + if test "${TEA_PLATFORM}" != "windows" ; then + # We are always OK on Windows, so check what this platform wants: + + # USE_THREAD_ALLOC tells us to try the special thread-based + # allocator that significantly reduces lock contention + +$as_echo "#define USE_THREAD_ALLOC 1" >>confdefs.h + + +$as_echo "#define _REENTRANT 1" >>confdefs.h + + if test "`uname -s`" = "SunOS" ; then + +$as_echo "#define _POSIX_PTHREAD_SEMANTICS 1" >>confdefs.h + + fi + +$as_echo "#define _THREAD_SAFE 1" >>confdefs.h + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for pthread_mutex_init in -lpthread" >&5 +$as_echo_n "checking for pthread_mutex_init in -lpthread... " >&6; } +if ${ac_cv_lib_pthread_pthread_mutex_init+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lpthread $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char pthread_mutex_init (); +int +main () +{ +return pthread_mutex_init (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_pthread_pthread_mutex_init=yes +else + ac_cv_lib_pthread_pthread_mutex_init=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_pthread_pthread_mutex_init" >&5 +$as_echo "$ac_cv_lib_pthread_pthread_mutex_init" >&6; } +if test "x$ac_cv_lib_pthread_pthread_mutex_init" = xyes; then : + tcl_ok=yes +else + tcl_ok=no +fi + + if test "$tcl_ok" = "no"; then + # Check a little harder for __pthread_mutex_init in the same + # library, as some systems hide it there until pthread.h is + # defined. We could alternatively do an AC_TRY_COMPILE with + # pthread.h, but that will work with libpthread really doesn't + # exist, like AIX 4.2. [Bug: 4359] + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for __pthread_mutex_init in -lpthread" >&5 +$as_echo_n "checking for __pthread_mutex_init in -lpthread... " >&6; } +if ${ac_cv_lib_pthread___pthread_mutex_init+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lpthread $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char __pthread_mutex_init (); +int +main () +{ +return __pthread_mutex_init (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_pthread___pthread_mutex_init=yes +else + ac_cv_lib_pthread___pthread_mutex_init=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_pthread___pthread_mutex_init" >&5 +$as_echo "$ac_cv_lib_pthread___pthread_mutex_init" >&6; } +if test "x$ac_cv_lib_pthread___pthread_mutex_init" = xyes; then : + tcl_ok=yes +else + tcl_ok=no +fi + + fi + + if test "$tcl_ok" = "yes"; then + # The space is needed + THREADS_LIBS=" -lpthread" + else + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for pthread_mutex_init in -lpthreads" >&5 +$as_echo_n "checking for pthread_mutex_init in -lpthreads... " >&6; } +if ${ac_cv_lib_pthreads_pthread_mutex_init+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lpthreads $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char pthread_mutex_init (); +int +main () +{ +return pthread_mutex_init (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_pthreads_pthread_mutex_init=yes +else + ac_cv_lib_pthreads_pthread_mutex_init=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_pthreads_pthread_mutex_init" >&5 +$as_echo "$ac_cv_lib_pthreads_pthread_mutex_init" >&6; } +if test "x$ac_cv_lib_pthreads_pthread_mutex_init" = xyes; then : + tcl_ok=yes +else + tcl_ok=no +fi + + if test "$tcl_ok" = "yes"; then + # The space is needed + THREADS_LIBS=" -lpthreads" + else + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for pthread_mutex_init in -lc" >&5 +$as_echo_n "checking for pthread_mutex_init in -lc... " >&6; } +if ${ac_cv_lib_c_pthread_mutex_init+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lc $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char pthread_mutex_init (); +int +main () +{ +return pthread_mutex_init (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_c_pthread_mutex_init=yes +else + ac_cv_lib_c_pthread_mutex_init=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_c_pthread_mutex_init" >&5 +$as_echo "$ac_cv_lib_c_pthread_mutex_init" >&6; } +if test "x$ac_cv_lib_c_pthread_mutex_init" = xyes; then : + tcl_ok=yes +else + tcl_ok=no +fi + + if test "$tcl_ok" = "no"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for pthread_mutex_init in -lc_r" >&5 +$as_echo_n "checking for pthread_mutex_init in -lc_r... " >&6; } +if ${ac_cv_lib_c_r_pthread_mutex_init+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lc_r $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char pthread_mutex_init (); +int +main () +{ +return pthread_mutex_init (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_c_r_pthread_mutex_init=yes +else + ac_cv_lib_c_r_pthread_mutex_init=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_c_r_pthread_mutex_init" >&5 +$as_echo "$ac_cv_lib_c_r_pthread_mutex_init" >&6; } +if test "x$ac_cv_lib_c_r_pthread_mutex_init" = xyes; then : + tcl_ok=yes +else + tcl_ok=no +fi + + if test "$tcl_ok" = "yes"; then + # The space is needed + THREADS_LIBS=" -pthread" + else + TCL_THREADS=0 + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Do not know how to find pthread lib on your system - thread support disabled" >&5 +$as_echo "$as_me: WARNING: Do not know how to find pthread lib on your system - thread support disabled" >&2;} + fi + fi + fi + fi + fi + else + TCL_THREADS=0 + fi + # Do checking message here to not mess up interleaved configure output + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for building with threads" >&5 +$as_echo_n "checking for building with threads... " >&6; } + if test "${TCL_THREADS}" = 1; then + +$as_echo "#define TCL_THREADS 1" >>confdefs.h + + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes (default)" >&5 +$as_echo "yes (default)" >&6; } + else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } + fi + # TCL_THREADS sanity checking. See if our request for building with + # threads is the same as the way Tcl was built. If not, warn the user. + case ${TCL_DEFS} in + *THREADS=1*) + if test "${TCL_THREADS}" = "0"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: + Building ${PACKAGE_NAME} without threads enabled, but building against Tcl + that IS thread-enabled. It is recommended to use --enable-threads." >&5 +$as_echo "$as_me: WARNING: + Building ${PACKAGE_NAME} without threads enabled, but building against Tcl + that IS thread-enabled. It is recommended to use --enable-threads." >&2;} + fi + ;; + *) + if test "${TCL_THREADS}" = "1"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: + --enable-threads requested, but building against a Tcl that is NOT + thread-enabled. This is an OK configuration that will also run in + a thread-enabled core." >&5 +$as_echo "$as_me: WARNING: + --enable-threads requested, but building against a Tcl that is NOT + thread-enabled. This is an OK configuration that will also run in + a thread-enabled core." >&2;} + fi + ;; + esac + + + +#-------------------------------------------------------------------- +# The statement below defines a collection of symbols related to +# building as a shared library instead of a static library. +#-------------------------------------------------------------------- + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking how to build libraries" >&5 +$as_echo_n "checking how to build libraries... " >&6; } + # Check whether --enable-shared was given. +if test "${enable_shared+set}" = set; then : + enableval=$enable_shared; shared_ok=$enableval +else + shared_ok=yes +fi + + + if test "${enable_shared+set}" = set; then + enableval="$enable_shared" + shared_ok=$enableval + else + shared_ok=yes + fi + + # Check whether --enable-stubs was given. +if test "${enable_stubs+set}" = set; then : + enableval=$enable_stubs; stubs_ok=$enableval +else + stubs_ok=yes +fi + + + if test "${enable_stubs+set}" = set; then + enableval="$enable_stubs" + stubs_ok=$enableval + else + stubs_ok=yes + fi + + # Stubs are always enabled for shared builds + if test "$shared_ok" = "yes" ; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: shared" >&5 +$as_echo "shared" >&6; } + SHARED_BUILD=1 + STUBS_BUILD=1 + else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: static" >&5 +$as_echo "static" >&6; } + SHARED_BUILD=0 + +$as_echo "#define STATIC_BUILD 1" >>confdefs.h + + if test "$stubs_ok" = "yes" ; then + STUBS_BUILD=1 + else + STUBS_BUILD=0 + fi + fi + if test "${STUBS_BUILD}" = "1" ; then + +$as_echo "#define USE_TCL_STUBS 1" >>confdefs.h + + +$as_echo "#define USE_TCLOO_STUBS 1" >>confdefs.h + + if test "${TEA_WINDOWINGSYSTEM}" != ""; then + +$as_echo "#define USE_TK_STUBS 1" >>confdefs.h + + fi + fi + + + + + +#-------------------------------------------------------------------- +# This macro figures out what flags to use with the compiler/linker +# when building shared/static debug/optimized objects. This information +# can be taken from the tclConfig.sh file, but this figures it all out. +#-------------------------------------------------------------------- + +if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}ranlib", so it can be a program name with args. +set dummy ${ac_tool_prefix}ranlib; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_RANLIB+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$RANLIB"; then + ac_cv_prog_RANLIB="$RANLIB" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_RANLIB="${ac_tool_prefix}ranlib" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +RANLIB=$ac_cv_prog_RANLIB +if test -n "$RANLIB"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $RANLIB" >&5 +$as_echo "$RANLIB" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + +fi +if test -z "$ac_cv_prog_RANLIB"; then + ac_ct_RANLIB=$RANLIB + # Extract the first word of "ranlib", so it can be a program name with args. +set dummy ranlib; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_ac_ct_RANLIB+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_RANLIB"; then + ac_cv_prog_ac_ct_RANLIB="$ac_ct_RANLIB" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_RANLIB="ranlib" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_RANLIB=$ac_cv_prog_ac_ct_RANLIB +if test -n "$ac_ct_RANLIB"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_RANLIB" >&5 +$as_echo "$ac_ct_RANLIB" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + if test "x$ac_ct_RANLIB" = x; then + RANLIB=":" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + RANLIB=$ac_ct_RANLIB + fi +else + RANLIB="$ac_cv_prog_RANLIB" +fi + + + + + # Step 0.a: Enable 64 bit support? + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking if 64bit support is requested" >&5 +$as_echo_n "checking if 64bit support is requested... " >&6; } + # Check whether --enable-64bit was given. +if test "${enable_64bit+set}" = set; then : + enableval=$enable_64bit; do64bit=$enableval +else + do64bit=no +fi + + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $do64bit" >&5 +$as_echo "$do64bit" >&6; } + + # Step 0.b: Enable Solaris 64 bit VIS support? + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking if 64bit Sparc VIS support is requested" >&5 +$as_echo_n "checking if 64bit Sparc VIS support is requested... " >&6; } + # Check whether --enable-64bit-vis was given. +if test "${enable_64bit_vis+set}" = set; then : + enableval=$enable_64bit_vis; do64bitVIS=$enableval +else + do64bitVIS=no +fi + + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $do64bitVIS" >&5 +$as_echo "$do64bitVIS" >&6; } + # Force 64bit on with VIS + if test "$do64bitVIS" = "yes"; then : + do64bit=yes +fi + + # Step 0.c: Check if visibility support is available. Do this here so + # that platform specific alternatives can be used below if this fails. + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking if compiler supports visibility \"hidden\"" >&5 +$as_echo_n "checking if compiler supports visibility \"hidden\"... " >&6; } +if ${tcl_cv_cc_visibility_hidden+:} false; then : + $as_echo_n "(cached) " >&6 +else + + hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -Werror" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + + extern __attribute__((__visibility__("hidden"))) void f(void); + void f(void) {} +int +main () +{ +f(); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + tcl_cv_cc_visibility_hidden=yes +else + tcl_cv_cc_visibility_hidden=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + CFLAGS=$hold_cflags +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_cc_visibility_hidden" >&5 +$as_echo "$tcl_cv_cc_visibility_hidden" >&6; } + if test $tcl_cv_cc_visibility_hidden = yes; then : + + +$as_echo "#define MODULE_SCOPE extern __attribute__((__visibility__(\"hidden\")))" >>confdefs.h + + +$as_echo "#define HAVE_HIDDEN 1" >>confdefs.h + + +fi + + # Step 0.d: Disable -rpath support? + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking if rpath support is requested" >&5 +$as_echo_n "checking if rpath support is requested... " >&6; } + # Check whether --enable-rpath was given. +if test "${enable_rpath+set}" = set; then : + enableval=$enable_rpath; doRpath=$enableval +else + doRpath=yes +fi + + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $doRpath" >&5 +$as_echo "$doRpath" >&6; } + + # TEA specific: Cross-compiling options for Windows/CE builds? + + if test "${TEA_PLATFORM}" = windows; then : + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking if Windows/CE build is requested" >&5 +$as_echo_n "checking if Windows/CE build is requested... " >&6; } + # Check whether --enable-wince was given. +if test "${enable_wince+set}" = set; then : + enableval=$enable_wince; doWince=$enableval +else + doWince=no +fi + + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $doWince" >&5 +$as_echo "$doWince" >&6; } + +fi + + # Set the variable "system" to hold the name and version number + # for the system. + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking system version" >&5 +$as_echo_n "checking system version... " >&6; } +if ${tcl_cv_sys_version+:} false; then : + $as_echo_n "(cached) " >&6 +else + + # TEA specific: + if test "${TEA_PLATFORM}" = "windows" ; then + tcl_cv_sys_version=windows + else + tcl_cv_sys_version=`uname -s`-`uname -r` + if test "$?" -ne 0 ; then + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: can't find uname command" >&5 +$as_echo "$as_me: WARNING: can't find uname command" >&2;} + tcl_cv_sys_version=unknown + else + if test "`uname -s`" = "AIX" ; then + tcl_cv_sys_version=AIX-`uname -v`.`uname -r` + fi + fi + fi + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_sys_version" >&5 +$as_echo "$tcl_cv_sys_version" >&6; } + system=$tcl_cv_sys_version + + + # Require ranlib early so we can override it in special cases below. + + + + # Set configuration options based on system name and version. + # This is similar to Tcl's unix/tcl.m4 except that we've added a + # "windows" case and removed some core-only vars. + + do64bit_ok=no + # default to '{$LIBS}' and set to "" on per-platform necessary basis + SHLIB_LD_LIBS='${LIBS}' + # When ld needs options to work in 64-bit mode, put them in + # LDFLAGS_ARCH so they eventually end up in LDFLAGS even if [load] + # is disabled by the user. [Bug 1016796] + LDFLAGS_ARCH="" + UNSHARED_LIB_SUFFIX="" + # TEA specific: use PACKAGE_VERSION instead of VERSION + TCL_TRIM_DOTS='`echo ${PACKAGE_VERSION} | tr -d .`' + ECHO_VERSION='`echo ${PACKAGE_VERSION}`' + TCL_LIB_VERSIONS_OK=ok + CFLAGS_DEBUG=-g + if test "$GCC" = yes; then : + + CFLAGS_OPTIMIZE=-O2 + CFLAGS_WARNING="-Wall" + +else + + CFLAGS_OPTIMIZE=-O + CFLAGS_WARNING="" + +fi + if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}ar", so it can be a program name with args. +set dummy ${ac_tool_prefix}ar; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_AR+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$AR"; then + ac_cv_prog_AR="$AR" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_AR="${ac_tool_prefix}ar" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +AR=$ac_cv_prog_AR +if test -n "$AR"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $AR" >&5 +$as_echo "$AR" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + +fi +if test -z "$ac_cv_prog_AR"; then + ac_ct_AR=$AR + # Extract the first word of "ar", so it can be a program name with args. +set dummy ar; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_ac_ct_AR+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_AR"; then + ac_cv_prog_ac_ct_AR="$ac_ct_AR" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_AR="ar" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_AR=$ac_cv_prog_ac_ct_AR +if test -n "$ac_ct_AR"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_AR" >&5 +$as_echo "$ac_ct_AR" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + if test "x$ac_ct_AR" = x; then + AR="" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + AR=$ac_ct_AR + fi +else + AR="$ac_cv_prog_AR" +fi + + STLIB_LD='${AR} cr' + LD_LIBRARY_PATH_VAR="LD_LIBRARY_PATH" + if test "x$SHLIB_VERSION" = x; then : + SHLIB_VERSION="" +else + SHLIB_VERSION=".$SHLIB_VERSION" +fi + case $system in + # TEA specific: + windows) + # This is a 2-stage check to make sure we have the 64-bit SDK + # We have to know where the SDK is installed. + # This magic is based on MS Platform SDK for Win2003 SP1 - hobbs + # MACHINE is IX86 for LINK, but this is used by the manifest, + # which requires x86|amd64|ia64. + MACHINE="X86" + if test "$do64bit" != "no" ; then + if test "x${MSSDK}x" = "xx" ; then + MSSDK="C:/Progra~1/Microsoft Platform SDK" + fi + MSSDK=`echo "$MSSDK" | sed -e 's!\\\!/!g'` + PATH64="" + case "$do64bit" in + amd64|x64|yes) + MACHINE="AMD64" ; # default to AMD64 64-bit build + PATH64="${MSSDK}/Bin/Win64/x86/AMD64" + ;; + ia64) + MACHINE="IA64" + PATH64="${MSSDK}/Bin/Win64" + ;; + esac + if test "$GCC" != "yes" -a ! -d "${PATH64}" ; then + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Could not find 64-bit $MACHINE SDK to enable 64bit mode" >&5 +$as_echo "$as_me: WARNING: Could not find 64-bit $MACHINE SDK to enable 64bit mode" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Ensure latest Platform SDK is installed" >&5 +$as_echo "$as_me: WARNING: Ensure latest Platform SDK is installed" >&2;} + do64bit="no" + else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: Using 64-bit $MACHINE mode" >&5 +$as_echo " Using 64-bit $MACHINE mode" >&6; } + do64bit_ok="yes" + fi + fi + + if test "$doWince" != "no" ; then + if test "$do64bit" != "no" ; then + as_fn_error $? "Windows/CE and 64-bit builds incompatible" "$LINENO" 5 + fi + if test "$GCC" = "yes" ; then + as_fn_error $? "Windows/CE and GCC builds incompatible" "$LINENO" 5 + fi + + # First, look for one uninstalled. + # the alternative search directory is invoked by --with-celib + + if test x"${no_celib}" = x ; then + # we reset no_celib in case something fails here + no_celib=true + +# Check whether --with-celib was given. +if test "${with_celib+set}" = set; then : + withval=$with_celib; with_celibconfig=${withval} +fi + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for Windows/CE celib directory" >&5 +$as_echo_n "checking for Windows/CE celib directory... " >&6; } + if ${ac_cv_c_celibconfig+:} false; then : + $as_echo_n "(cached) " >&6 +else + + # First check to see if --with-celibconfig was specified. + if test x"${with_celibconfig}" != x ; then + if test -d "${with_celibconfig}/inc" ; then + ac_cv_c_celibconfig=`(cd ${with_celibconfig}; pwd)` + else + as_fn_error $? "${with_celibconfig} directory doesn't contain inc directory" "$LINENO" 5 + fi + fi + + # then check for a celib library + if test x"${ac_cv_c_celibconfig}" = x ; then + for i in \ + ../celib-palm-3.0 \ + ../celib \ + ../../celib-palm-3.0 \ + ../../celib \ + `ls -dr ../celib-*3.[0-9]* 2>/dev/null` \ + ${srcdir}/../celib-palm-3.0 \ + ${srcdir}/../celib \ + `ls -dr ${srcdir}/../celib-*3.[0-9]* 2>/dev/null` \ + ; do + if test -d "$i/inc" ; then + ac_cv_c_celibconfig=`(cd $i; pwd)` + break + fi + done + fi + +fi + + if test x"${ac_cv_c_celibconfig}" = x ; then + as_fn_error $? "Cannot find celib support library directory" "$LINENO" 5 + else + no_celib= + CELIB_DIR=${ac_cv_c_celibconfig} + CELIB_DIR=`echo "$CELIB_DIR" | sed -e 's!\\\!/!g'` + { $as_echo "$as_me:${as_lineno-$LINENO}: result: found $CELIB_DIR" >&5 +$as_echo "found $CELIB_DIR" >&6; } + fi + fi + + # Set defaults for common evc4/PPC2003 setup + # Currently Tcl requires 300+, possibly 420+ for sockets + CEVERSION=420; # could be 211 300 301 400 420 ... + TARGETCPU=ARMV4; # could be ARMV4 ARM MIPS SH3 X86 ... + ARCH=ARM; # could be ARM MIPS X86EM ... + PLATFORM="Pocket PC 2003"; # or "Pocket PC 2002" + if test "$doWince" != "yes"; then + # If !yes then the user specified something + # Reset ARCH to allow user to skip specifying it + ARCH= + eval `echo $doWince | awk -F, '{ \ + if (length($1)) { printf "CEVERSION=\"%s\"\n", $1; \ + if ($1 < 400) { printf "PLATFORM=\"Pocket PC 2002\"\n" } }; \ + if (length($2)) { printf "TARGETCPU=\"%s\"\n", toupper($2) }; \ + if (length($3)) { printf "ARCH=\"%s\"\n", toupper($3) }; \ + if (length($4)) { printf "PLATFORM=\"%s\"\n", $4 }; \ + }'` + if test "x${ARCH}" = "x" ; then + ARCH=$TARGETCPU; + fi + fi + OSVERSION=WCE$CEVERSION; + if test "x${WCEROOT}" = "x" ; then + WCEROOT="C:/Program Files/Microsoft eMbedded C++ 4.0" + if test ! -d "${WCEROOT}" ; then + WCEROOT="C:/Program Files/Microsoft eMbedded Tools" + fi + fi + if test "x${SDKROOT}" = "x" ; then + SDKROOT="C:/Program Files/Windows CE Tools" + if test ! -d "${SDKROOT}" ; then + SDKROOT="C:/Windows CE Tools" + fi + fi + WCEROOT=`echo "$WCEROOT" | sed -e 's!\\\!/!g'` + SDKROOT=`echo "$SDKROOT" | sed -e 's!\\\!/!g'` + if test ! -d "${SDKROOT}/${OSVERSION}/${PLATFORM}/Lib/${TARGETCPU}" \ + -o ! -d "${WCEROOT}/EVC/${OSVERSION}/bin"; then + as_fn_error $? "could not find PocketPC SDK or target compiler to enable WinCE mode $CEVERSION,$TARGETCPU,$ARCH,$PLATFORM" "$LINENO" 5 + doWince="no" + else + # We could PATH_NOSPACE these, but that's not important, + # as long as we quote them when used. + CEINCLUDE="${SDKROOT}/${OSVERSION}/${PLATFORM}/include" + if test -d "${CEINCLUDE}/${TARGETCPU}" ; then + CEINCLUDE="${CEINCLUDE}/${TARGETCPU}" + fi + CELIBPATH="${SDKROOT}/${OSVERSION}/${PLATFORM}/Lib/${TARGETCPU}" + fi + fi + + if test "$GCC" != "yes" ; then + if test "${SHARED_BUILD}" = "0" ; then + runtime=-MT + else + runtime=-MD + fi + case "x`echo \${VisualStudioVersion}`" in + x1[4-9]*) + lflags="${lflags} -nodefaultlib:libucrt.lib" + + vars="ucrt.lib" + for i in $vars; do + if test "${TEA_PLATFORM}" = "windows" -a "$GCC" = "yes" ; then + # Convert foo.lib to -lfoo for GCC. No-op if not *.lib + i=`echo "$i" | sed -e 's/^\([^-].*\)\.lib$/-l\1/i'` + fi + PKG_LIBS="$PKG_LIBS $i" + done + + + ;; + *) + ;; + esac + + if test "$do64bit" != "no" ; then + # All this magic is necessary for the Win64 SDK RC1 - hobbs + CC="\"${PATH64}/cl.exe\"" + CFLAGS="${CFLAGS} -I\"${MSSDK}/Include\" -I\"${MSSDK}/Include/crt\" -I\"${MSSDK}/Include/crt/sys\"" + RC="\"${MSSDK}/bin/rc.exe\"" + lflags="${lflags} -nologo -MACHINE:${MACHINE} -LIBPATH:\"${MSSDK}/Lib/${MACHINE}\"" + LINKBIN="\"${PATH64}/link.exe\"" + CFLAGS_DEBUG="-nologo -Zi -Od -W3 ${runtime}d" + CFLAGS_OPTIMIZE="-nologo -O2 -W2 ${runtime}" + # Avoid 'unresolved external symbol __security_cookie' + # errors, c.f. http://support.microsoft.com/?id=894573 + + vars="bufferoverflowU.lib" + for i in $vars; do + if test "${TEA_PLATFORM}" = "windows" -a "$GCC" = "yes" ; then + # Convert foo.lib to -lfoo for GCC. No-op if not *.lib + i=`echo "$i" | sed -e 's/^\([^-].*\)\.lib$/-l\1/i'` + fi + PKG_LIBS="$PKG_LIBS $i" + done + + + elif test "$doWince" != "no" ; then + CEBINROOT="${WCEROOT}/EVC/${OSVERSION}/bin" + if test "${TARGETCPU}" = "X86"; then + CC="\"${CEBINROOT}/cl.exe\"" + else + CC="\"${CEBINROOT}/cl${ARCH}.exe\"" + fi + CFLAGS="$CFLAGS -I\"${CELIB_DIR}/inc\" -I\"${CEINCLUDE}\"" + RC="\"${WCEROOT}/Common/EVC/bin/rc.exe\"" + arch=`echo ${ARCH} | awk '{print tolower($0)}'` + defs="${ARCH} _${ARCH}_ ${arch} PALM_SIZE _MT _WINDOWS" + if test "${SHARED_BUILD}" = "1" ; then + # Static CE builds require static celib as well + defs="${defs} _DLL" + fi + for i in $defs ; do + +cat >>confdefs.h <<_ACEOF +#define $i 1 +_ACEOF + + done + +cat >>confdefs.h <<_ACEOF +#define _WIN32_WCE $CEVERSION +_ACEOF + + +cat >>confdefs.h <<_ACEOF +#define UNDER_CE $CEVERSION +_ACEOF + + CFLAGS_DEBUG="-nologo -Zi -Od" + CFLAGS_OPTIMIZE="-nologo -Ox" + lversion=`echo ${CEVERSION} | sed -e 's/\(.\)\(..\)/\1\.\2/'` + lflags="${lflags} -MACHINE:${ARCH} -LIBPATH:\"${CELIBPATH}\" -subsystem:windowsce,${lversion} -nologo" + LINKBIN="\"${CEBINROOT}/link.exe\"" + + else + RC="rc" + lflags="${lflags} -nologo" + LINKBIN="link" + CFLAGS_DEBUG="-nologo -Z7 -Od -W3 -WX ${runtime}d" + CFLAGS_OPTIMIZE="-nologo -O2 -W2 ${runtime}" + fi + fi + + if test "$GCC" = "yes"; then + # mingw gcc mode + if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}windres", so it can be a program name with args. +set dummy ${ac_tool_prefix}windres; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_RC+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$RC"; then + ac_cv_prog_RC="$RC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_RC="${ac_tool_prefix}windres" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +RC=$ac_cv_prog_RC +if test -n "$RC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $RC" >&5 +$as_echo "$RC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + +fi +if test -z "$ac_cv_prog_RC"; then + ac_ct_RC=$RC + # Extract the first word of "windres", so it can be a program name with args. +set dummy windres; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_ac_ct_RC+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_RC"; then + ac_cv_prog_ac_ct_RC="$ac_ct_RC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_RC="windres" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_RC=$ac_cv_prog_ac_ct_RC +if test -n "$ac_ct_RC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_RC" >&5 +$as_echo "$ac_ct_RC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + if test "x$ac_ct_RC" = x; then + RC="" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + RC=$ac_ct_RC + fi +else + RC="$ac_cv_prog_RC" +fi + + CFLAGS_DEBUG="-g" + CFLAGS_OPTIMIZE="-O2 -fomit-frame-pointer" + SHLIB_LD='${CC} -shared' + UNSHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.a' + LDFLAGS_CONSOLE="-wl,--subsystem,console ${lflags}" + LDFLAGS_WINDOW="-wl,--subsystem,windows ${lflags}" + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for cross-compile version of gcc" >&5 +$as_echo_n "checking for cross-compile version of gcc... " >&6; } +if ${ac_cv_cross+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + + #ifdef _WIN32 + #error cross-compiler + #endif + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_cross=yes +else + ac_cv_cross=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_cross" >&5 +$as_echo "$ac_cv_cross" >&6; } + if test "$ac_cv_cross" = "yes"; then + case "$do64bit" in + amd64|x64|yes) + CC="x86_64-w64-mingw32-gcc" + LD="x86_64-w64-mingw32-ld" + AR="x86_64-w64-mingw32-ar" + RANLIB="x86_64-w64-mingw32-ranlib" + RC="x86_64-w64-mingw32-windres" + ;; + *) + CC="i686-w64-mingw32-gcc" + LD="i686-w64-mingw32-ld" + AR="i686-w64-mingw32-ar" + RANLIB="i686-w64-mingw32-ranlib" + RC="i686-w64-mingw32-windres" + ;; + esac + fi + + else + SHLIB_LD="${LINKBIN} -dll ${lflags}" + # link -lib only works when -lib is the first arg + STLIB_LD="${LINKBIN} -lib ${lflags}" + UNSHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.lib' + PATHTYPE=-w + # For information on what debugtype is most useful, see: + # http://msdn.microsoft.com/library/en-us/dnvc60/html/gendepdebug.asp + # and also + # http://msdn2.microsoft.com/en-us/library/y0zzbyt4%28VS.80%29.aspx + # This essentially turns it all on. + LDFLAGS_DEBUG="-debug -debugtype:cv" + LDFLAGS_OPTIMIZE="-release" + if test "$doWince" != "no" ; then + LDFLAGS_CONSOLE="-link ${lflags}" + LDFLAGS_WINDOW=${LDFLAGS_CONSOLE} + else + LDFLAGS_CONSOLE="-link -subsystem:console ${lflags}" + LDFLAGS_WINDOW="-link -subsystem:windows ${lflags}" + fi + fi + + SHLIB_SUFFIX=".dll" + SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.dll' + + TCL_LIB_VERSIONS_OK=nodots + ;; + AIX-*) + if test "${TCL_THREADS}" = "1" -a "$GCC" != "yes"; then : + + # AIX requires the _r compiler when gcc isn't being used + case "${CC}" in + *_r|*_r\ *) + # ok ... + ;; + *) + # Make sure only first arg gets _r + CC=`echo "$CC" | sed -e 's/^\([^ ]*\)/\1_r/'` + ;; + esac + { $as_echo "$as_me:${as_lineno-$LINENO}: result: Using $CC for compiling with threads" >&5 +$as_echo "Using $CC for compiling with threads" >&6; } + +fi + LIBS="$LIBS -lc" + SHLIB_CFLAGS="" + SHLIB_SUFFIX=".so" + + LD_LIBRARY_PATH_VAR="LIBPATH" + + # Check to enable 64-bit flags for compiler/linker + if test "$do64bit" = yes; then : + + if test "$GCC" = yes; then : + + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: 64bit mode not supported with GCC on $system" >&5 +$as_echo "$as_me: WARNING: 64bit mode not supported with GCC on $system" >&2;} + +else + + do64bit_ok=yes + CFLAGS="$CFLAGS -q64" + LDFLAGS_ARCH="-q64" + RANLIB="${RANLIB} -X64" + AR="${AR} -X64" + SHLIB_LD_FLAGS="-b64" + +fi + +fi + + if test "`uname -m`" = ia64; then : + + # AIX-5 uses ELF style dynamic libraries on IA-64, but not PPC + SHLIB_LD="/usr/ccs/bin/ld -G -z text" + if test "$GCC" = yes; then : + + CC_SEARCH_FLAGS='-Wl,-R,${LIB_RUNTIME_DIR}' + +else + + CC_SEARCH_FLAGS='-R${LIB_RUNTIME_DIR}' + +fi + LD_SEARCH_FLAGS='-R ${LIB_RUNTIME_DIR}' + +else + + if test "$GCC" = yes; then : + + SHLIB_LD='${CC} -shared -Wl,-bexpall' + +else + + SHLIB_LD="/bin/ld -bhalt:4 -bM:SRE -bexpall -H512 -T512 -bnoentry" + LDFLAGS="$LDFLAGS -brtl" + +fi + SHLIB_LD="${SHLIB_LD} ${SHLIB_LD_FLAGS}" + CC_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}' + LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} + +fi + ;; + BeOS*) + SHLIB_CFLAGS="-fPIC" + SHLIB_LD='${CC} -nostart' + SHLIB_SUFFIX=".so" + + #----------------------------------------------------------- + # Check for inet_ntoa in -lbind, for BeOS (which also needs + # -lsocket, even if the network functions are in -lnet which + # is always linked to, for compatibility. + #----------------------------------------------------------- + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for inet_ntoa in -lbind" >&5 +$as_echo_n "checking for inet_ntoa in -lbind... " >&6; } +if ${ac_cv_lib_bind_inet_ntoa+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lbind $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char inet_ntoa (); +int +main () +{ +return inet_ntoa (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_bind_inet_ntoa=yes +else + ac_cv_lib_bind_inet_ntoa=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_bind_inet_ntoa" >&5 +$as_echo "$ac_cv_lib_bind_inet_ntoa" >&6; } +if test "x$ac_cv_lib_bind_inet_ntoa" = xyes; then : + LIBS="$LIBS -lbind -lsocket" +fi + + ;; + BSD/OS-4.*) + SHLIB_CFLAGS="-export-dynamic -fPIC" + SHLIB_LD='${CC} -shared' + SHLIB_SUFFIX=".so" + LDFLAGS="$LDFLAGS -export-dynamic" + CC_SEARCH_FLAGS="" + LD_SEARCH_FLAGS="" + ;; + CYGWIN_*) + SHLIB_CFLAGS="" + SHLIB_LD='${CC} -shared' + SHLIB_LD_LIBS="${SHLIB_LD_LIBS} -Wl,--out-implib,\$@.a" + SHLIB_SUFFIX=".dll" + EXEEXT=".exe" + do64bit_ok=yes + CC_SEARCH_FLAGS="" + LD_SEARCH_FLAGS="" + ;; + Haiku*) + LDFLAGS="$LDFLAGS -Wl,--export-dynamic" + SHLIB_CFLAGS="-fPIC" + SHLIB_SUFFIX=".so" + SHLIB_LD='${CC} ${CFLAGS} ${LDFLAGS} -shared' + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for inet_ntoa in -lnetwork" >&5 +$as_echo_n "checking for inet_ntoa in -lnetwork... " >&6; } +if ${ac_cv_lib_network_inet_ntoa+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lnetwork $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char inet_ntoa (); +int +main () +{ +return inet_ntoa (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_network_inet_ntoa=yes +else + ac_cv_lib_network_inet_ntoa=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_network_inet_ntoa" >&5 +$as_echo "$ac_cv_lib_network_inet_ntoa" >&6; } +if test "x$ac_cv_lib_network_inet_ntoa" = xyes; then : + LIBS="$LIBS -lnetwork" +fi + + ;; + HP-UX-*.11.*) + # Use updated header definitions where possible + +$as_echo "#define _XOPEN_SOURCE_EXTENDED 1" >>confdefs.h + + # TEA specific: Needed by Tcl, but not most extensions + #AC_DEFINE(_XOPEN_SOURCE, 1, [Do we want to use the XOPEN network library?]) + #LIBS="$LIBS -lxnet" # Use the XOPEN network library + + if test "`uname -m`" = ia64; then : + + SHLIB_SUFFIX=".so" + # Use newer C++ library for C++ extensions + #if test "$GCC" != "yes" ; then + # CPPFLAGS="-AA" + #fi + +else + + SHLIB_SUFFIX=".sl" + +fi + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for shl_load in -ldld" >&5 +$as_echo_n "checking for shl_load in -ldld... " >&6; } +if ${ac_cv_lib_dld_shl_load+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-ldld $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char shl_load (); +int +main () +{ +return shl_load (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_dld_shl_load=yes +else + ac_cv_lib_dld_shl_load=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_dld_shl_load" >&5 +$as_echo "$ac_cv_lib_dld_shl_load" >&6; } +if test "x$ac_cv_lib_dld_shl_load" = xyes; then : + tcl_ok=yes +else + tcl_ok=no +fi + + if test "$tcl_ok" = yes; then : + + LDFLAGS="$LDFLAGS -Wl,-E" + CC_SEARCH_FLAGS='-Wl,+s,+b,${LIB_RUNTIME_DIR}:.' + LD_SEARCH_FLAGS='+s +b ${LIB_RUNTIME_DIR}:.' + LD_LIBRARY_PATH_VAR="SHLIB_PATH" + +fi + if test "$GCC" = yes; then : + + SHLIB_LD='${CC} -shared' + LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} + +else + + CFLAGS="$CFLAGS -z" + # Users may want PA-RISC 1.1/2.0 portable code - needs HP cc + #CFLAGS="$CFLAGS +DAportable" + SHLIB_CFLAGS="+z" + SHLIB_LD="ld -b" + +fi + + # Check to enable 64-bit flags for compiler/linker + if test "$do64bit" = "yes"; then : + + if test "$GCC" = yes; then : + + case `${CC} -dumpmachine` in + hppa64*) + # 64-bit gcc in use. Fix flags for GNU ld. + do64bit_ok=yes + SHLIB_LD='${CC} -shared' + if test $doRpath = yes; then : + + CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' +fi + LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} + ;; + *) + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: 64bit mode not supported with GCC on $system" >&5 +$as_echo "$as_me: WARNING: 64bit mode not supported with GCC on $system" >&2;} + ;; + esac + +else + + do64bit_ok=yes + CFLAGS="$CFLAGS +DD64" + LDFLAGS_ARCH="+DD64" + +fi + +fi ;; + IRIX-6.*) + SHLIB_CFLAGS="" + SHLIB_LD="ld -n32 -shared -rdata_shared" + SHLIB_SUFFIX=".so" + if test $doRpath = yes; then : + + CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' + LD_SEARCH_FLAGS='-rpath ${LIB_RUNTIME_DIR}' +fi + if test "$GCC" = yes; then : + + CFLAGS="$CFLAGS -mabi=n32" + LDFLAGS="$LDFLAGS -mabi=n32" + +else + + case $system in + IRIX-6.3) + # Use to build 6.2 compatible binaries on 6.3. + CFLAGS="$CFLAGS -n32 -D_OLD_TERMIOS" + ;; + *) + CFLAGS="$CFLAGS -n32" + ;; + esac + LDFLAGS="$LDFLAGS -n32" + +fi + ;; + IRIX64-6.*) + SHLIB_CFLAGS="" + SHLIB_LD="ld -n32 -shared -rdata_shared" + SHLIB_SUFFIX=".so" + if test $doRpath = yes; then : + + CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' + LD_SEARCH_FLAGS='-rpath ${LIB_RUNTIME_DIR}' +fi + + # Check to enable 64-bit flags for compiler/linker + + if test "$do64bit" = yes; then : + + if test "$GCC" = yes; then : + + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: 64bit mode not supported by gcc" >&5 +$as_echo "$as_me: WARNING: 64bit mode not supported by gcc" >&2;} + +else + + do64bit_ok=yes + SHLIB_LD="ld -64 -shared -rdata_shared" + CFLAGS="$CFLAGS -64" + LDFLAGS_ARCH="-64" + +fi + +fi + ;; + Linux*|GNU*|NetBSD-Debian) + SHLIB_CFLAGS="-fPIC" + SHLIB_SUFFIX=".so" + + # TEA specific: + CFLAGS_OPTIMIZE="-O2 -fomit-frame-pointer" + + # TEA specific: use LDFLAGS_DEFAULT instead of LDFLAGS + SHLIB_LD='${CC} ${CFLAGS} ${LDFLAGS_DEFAULT} -shared' + LDFLAGS="$LDFLAGS -Wl,--export-dynamic" + if test $doRpath = yes; then : + + CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' +fi + LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} + if test "`uname -m`" = "alpha"; then : + CFLAGS="$CFLAGS -mieee" +fi + if test $do64bit = yes; then : + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking if compiler accepts -m64 flag" >&5 +$as_echo_n "checking if compiler accepts -m64 flag... " >&6; } +if ${tcl_cv_cc_m64+:} false; then : + $as_echo_n "(cached) " >&6 +else + + hold_cflags=$CFLAGS + CFLAGS="$CFLAGS -m64" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + tcl_cv_cc_m64=yes +else + tcl_cv_cc_m64=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + CFLAGS=$hold_cflags +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_cc_m64" >&5 +$as_echo "$tcl_cv_cc_m64" >&6; } + if test $tcl_cv_cc_m64 = yes; then : + + CFLAGS="$CFLAGS -m64" + do64bit_ok=yes + +fi + +fi + + # The combo of gcc + glibc has a bug related to inlining of + # functions like strtod(). The -fno-builtin flag should address + # this problem but it does not work. The -fno-inline flag is kind + # of overkill but it works. Disable inlining only when one of the + # files in compat/*.c is being linked in. + + if test x"${USE_COMPAT}" != x; then : + CFLAGS="$CFLAGS -fno-inline" +fi + ;; + Lynx*) + SHLIB_CFLAGS="-fPIC" + SHLIB_SUFFIX=".so" + CFLAGS_OPTIMIZE=-02 + SHLIB_LD='${CC} -shared' + LD_FLAGS="-Wl,--export-dynamic" + if test $doRpath = yes; then : + + CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' + LD_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' +fi + ;; + OpenBSD-*) + arch=`arch -s` + case "$arch" in + alpha|sparc64) + SHLIB_CFLAGS="-fPIC" + ;; + *) + SHLIB_CFLAGS="-fpic" + ;; + esac + SHLIB_LD='${CC} ${SHLIB_CFLAGS} -shared' + SHLIB_SUFFIX=".so" + if test $doRpath = yes; then : + + CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' +fi + LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} + SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.so${SHLIB_VERSION}' + LDFLAGS="-Wl,-export-dynamic" + CFLAGS_OPTIMIZE="-O2" + if test "${TCL_THREADS}" = "1"; then : + + # On OpenBSD: Compile with -pthread + # Don't link with -lpthread + LIBS=`echo $LIBS | sed s/-lpthread//` + CFLAGS="$CFLAGS -pthread" + +fi + # OpenBSD doesn't do version numbers with dots. + UNSHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.a' + TCL_LIB_VERSIONS_OK=nodots + ;; + NetBSD-*) + # NetBSD has ELF and can use 'cc -shared' to build shared libs + SHLIB_CFLAGS="-fPIC" + SHLIB_LD='${CC} ${SHLIB_CFLAGS} -shared' + SHLIB_SUFFIX=".so" + LDFLAGS="$LDFLAGS -export-dynamic" + if test $doRpath = yes; then : + + CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' +fi + LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} + if test "${TCL_THREADS}" = "1"; then : + + # The -pthread needs to go in the CFLAGS, not LIBS + LIBS=`echo $LIBS | sed s/-pthread//` + CFLAGS="$CFLAGS -pthread" + LDFLAGS="$LDFLAGS -pthread" + +fi + ;; + DragonFly-*|FreeBSD-*) + # This configuration from FreeBSD Ports. + SHLIB_CFLAGS="-fPIC" + SHLIB_LD="${CC} -shared" + SHLIB_LD_LIBS="${SHLIB_LD_LIBS} -Wl,-soname,\$@" + SHLIB_SUFFIX=".so" + LDFLAGS="" + if test $doRpath = yes; then : + + CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' + LD_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' +fi + if test "${TCL_THREADS}" = "1"; then : + + # The -pthread needs to go in the LDFLAGS, not LIBS + LIBS=`echo $LIBS | sed s/-pthread//` + CFLAGS="$CFLAGS $PTHREAD_CFLAGS" + LDFLAGS="$LDFLAGS $PTHREAD_LIBS" +fi + case $system in + FreeBSD-3.*) + # Version numbers are dot-stripped by system policy. + TCL_TRIM_DOTS=`echo ${PACKAGE_VERSION} | tr -d .` + UNSHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.a' + SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}\$\{DBGX\}.so.1' + TCL_LIB_VERSIONS_OK=nodots + ;; + esac + ;; + Darwin-*) + CFLAGS_OPTIMIZE="-Os" + SHLIB_CFLAGS="-fno-common" + # To avoid discrepancies between what headers configure sees during + # preprocessing tests and compiling tests, move any -isysroot and + # -mmacosx-version-min flags from CFLAGS to CPPFLAGS: + CPPFLAGS="${CPPFLAGS} `echo " ${CFLAGS}" | \ + awk 'BEGIN {FS=" +-";ORS=" "}; {for (i=2;i<=NF;i++) \ + if ($i~/^(isysroot|mmacosx-version-min)/) print "-"$i}'`" + CFLAGS="`echo " ${CFLAGS}" | \ + awk 'BEGIN {FS=" +-";ORS=" "}; {for (i=2;i<=NF;i++) \ + if (!($i~/^(isysroot|mmacosx-version-min)/)) print "-"$i}'`" + if test $do64bit = yes; then : + + case `arch` in + ppc) + { $as_echo "$as_me:${as_lineno-$LINENO}: checking if compiler accepts -arch ppc64 flag" >&5 +$as_echo_n "checking if compiler accepts -arch ppc64 flag... " >&6; } +if ${tcl_cv_cc_arch_ppc64+:} false; then : + $as_echo_n "(cached) " >&6 +else + + hold_cflags=$CFLAGS + CFLAGS="$CFLAGS -arch ppc64 -mpowerpc64 -mcpu=G5" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + tcl_cv_cc_arch_ppc64=yes +else + tcl_cv_cc_arch_ppc64=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + CFLAGS=$hold_cflags +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_cc_arch_ppc64" >&5 +$as_echo "$tcl_cv_cc_arch_ppc64" >&6; } + if test $tcl_cv_cc_arch_ppc64 = yes; then : + + CFLAGS="$CFLAGS -arch ppc64 -mpowerpc64 -mcpu=G5" + do64bit_ok=yes + +fi;; + i386) + { $as_echo "$as_me:${as_lineno-$LINENO}: checking if compiler accepts -arch x86_64 flag" >&5 +$as_echo_n "checking if compiler accepts -arch x86_64 flag... " >&6; } +if ${tcl_cv_cc_arch_x86_64+:} false; then : + $as_echo_n "(cached) " >&6 +else + + hold_cflags=$CFLAGS + CFLAGS="$CFLAGS -arch x86_64" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + tcl_cv_cc_arch_x86_64=yes +else + tcl_cv_cc_arch_x86_64=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + CFLAGS=$hold_cflags +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_cc_arch_x86_64" >&5 +$as_echo "$tcl_cv_cc_arch_x86_64" >&6; } + if test $tcl_cv_cc_arch_x86_64 = yes; then : + + CFLAGS="$CFLAGS -arch x86_64" + do64bit_ok=yes + +fi;; + *) + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Don't know how enable 64-bit on architecture \`arch\`" >&5 +$as_echo "$as_me: WARNING: Don't know how enable 64-bit on architecture \`arch\`" >&2;};; + esac + +else + + # Check for combined 32-bit and 64-bit fat build + if echo "$CFLAGS " |grep -E -q -- '-arch (ppc64|x86_64) ' \ + && echo "$CFLAGS " |grep -E -q -- '-arch (ppc|i386) '; then : + + fat_32_64=yes +fi + +fi + # TEA specific: use LDFLAGS_DEFAULT instead of LDFLAGS + SHLIB_LD='${CC} -dynamiclib ${CFLAGS} ${LDFLAGS_DEFAULT}' + { $as_echo "$as_me:${as_lineno-$LINENO}: checking if ld accepts -single_module flag" >&5 +$as_echo_n "checking if ld accepts -single_module flag... " >&6; } +if ${tcl_cv_ld_single_module+:} false; then : + $as_echo_n "(cached) " >&6 +else + + hold_ldflags=$LDFLAGS + LDFLAGS="$LDFLAGS -dynamiclib -Wl,-single_module" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ +int i; + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + tcl_cv_ld_single_module=yes +else + tcl_cv_ld_single_module=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LDFLAGS=$hold_ldflags +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_ld_single_module" >&5 +$as_echo "$tcl_cv_ld_single_module" >&6; } + if test $tcl_cv_ld_single_module = yes; then : + + SHLIB_LD="${SHLIB_LD} -Wl,-single_module" + +fi + # TEA specific: link shlib with current and compatibility version flags + vers=`echo ${PACKAGE_VERSION} | sed -e 's/^\([0-9]\{1,5\}\)\(\(\.[0-9]\{1,3\}\)\{0,2\}\).*$/\1\2/p' -e d` + SHLIB_LD="${SHLIB_LD} -current_version ${vers:-0} -compatibility_version ${vers:-0}" + SHLIB_SUFFIX=".dylib" + # Don't use -prebind when building for Mac OS X 10.4 or later only: + if test "`echo "${MACOSX_DEPLOYMENT_TARGET}" | awk -F '10\\.' '{print int($2)}'`" -lt 4 -a \ + "`echo "${CPPFLAGS}" | awk -F '-mmacosx-version-min=10\\.' '{print int($2)}'`" -lt 4; then : + + LDFLAGS="$LDFLAGS -prebind" +fi + LDFLAGS="$LDFLAGS -headerpad_max_install_names" + { $as_echo "$as_me:${as_lineno-$LINENO}: checking if ld accepts -search_paths_first flag" >&5 +$as_echo_n "checking if ld accepts -search_paths_first flag... " >&6; } +if ${tcl_cv_ld_search_paths_first+:} false; then : + $as_echo_n "(cached) " >&6 +else + + hold_ldflags=$LDFLAGS + LDFLAGS="$LDFLAGS -Wl,-search_paths_first" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ +int i; + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + tcl_cv_ld_search_paths_first=yes +else + tcl_cv_ld_search_paths_first=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LDFLAGS=$hold_ldflags +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_ld_search_paths_first" >&5 +$as_echo "$tcl_cv_ld_search_paths_first" >&6; } + if test $tcl_cv_ld_search_paths_first = yes; then : + + LDFLAGS="$LDFLAGS -Wl,-search_paths_first" + +fi + if test "$tcl_cv_cc_visibility_hidden" != yes; then : + + +$as_echo "#define MODULE_SCOPE __private_extern__" >>confdefs.h + + tcl_cv_cc_visibility_hidden=yes + +fi + CC_SEARCH_FLAGS="" + LD_SEARCH_FLAGS="" + LD_LIBRARY_PATH_VAR="DYLD_LIBRARY_PATH" + # TEA specific: for combined 32 & 64 bit fat builds of Tk + # extensions, verify that 64-bit build is possible. + if test "$fat_32_64" = yes && test -n "${TK_BIN_DIR}"; then : + + if test "${TEA_WINDOWINGSYSTEM}" = x11; then : + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for 64-bit X11" >&5 +$as_echo_n "checking for 64-bit X11... " >&6; } +if ${tcl_cv_lib_x11_64+:} false; then : + $as_echo_n "(cached) " >&6 +else + + for v in CFLAGS CPPFLAGS LDFLAGS; do + eval 'hold_'$v'="$'$v'";'$v'="`echo "$'$v' "|sed -e "s/-arch ppc / /g" -e "s/-arch i386 / /g"`"' + done + CPPFLAGS="$CPPFLAGS -I/usr/X11R6/include" + LDFLAGS="$LDFLAGS -L/usr/X11R6/lib -lX11" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <X11/Xlib.h> +int +main () +{ +XrmInitialize(); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + tcl_cv_lib_x11_64=yes +else + tcl_cv_lib_x11_64=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + for v in CFLAGS CPPFLAGS LDFLAGS; do + eval $v'="$hold_'$v'"' + done +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_lib_x11_64" >&5 +$as_echo "$tcl_cv_lib_x11_64" >&6; } + +fi + if test "${TEA_WINDOWINGSYSTEM}" = aqua; then : + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for 64-bit Tk" >&5 +$as_echo_n "checking for 64-bit Tk... " >&6; } +if ${tcl_cv_lib_tk_64+:} false; then : + $as_echo_n "(cached) " >&6 +else + + for v in CFLAGS CPPFLAGS LDFLAGS; do + eval 'hold_'$v'="$'$v'";'$v'="`echo "$'$v' "|sed -e "s/-arch ppc / /g" -e "s/-arch i386 / /g"`"' + done + CPPFLAGS="$CPPFLAGS -DUSE_TCL_STUBS=1 -DUSE_TK_STUBS=1 ${TCL_INCLUDES} ${TK_INCLUDES}" + LDFLAGS="$LDFLAGS ${TCL_STUB_LIB_SPEC} ${TK_STUB_LIB_SPEC}" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <tk.h> +int +main () +{ +Tk_InitStubs(NULL, "", 0); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + tcl_cv_lib_tk_64=yes +else + tcl_cv_lib_tk_64=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + for v in CFLAGS CPPFLAGS LDFLAGS; do + eval $v'="$hold_'$v'"' + done +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_lib_tk_64" >&5 +$as_echo "$tcl_cv_lib_tk_64" >&6; } + +fi + # remove 64-bit arch flags from CFLAGS et al. if configuration + # does not support 64-bit. + if test "$tcl_cv_lib_tk_64" = no -o "$tcl_cv_lib_x11_64" = no; then : + + { $as_echo "$as_me:${as_lineno-$LINENO}: Removing 64-bit architectures from compiler & linker flags" >&5 +$as_echo "$as_me: Removing 64-bit architectures from compiler & linker flags" >&6;} + for v in CFLAGS CPPFLAGS LDFLAGS; do + eval $v'="`echo "$'$v' "|sed -e "s/-arch ppc64 / /g" -e "s/-arch x86_64 / /g"`"' + done +fi + +fi + ;; + OS/390-*) + CFLAGS_OPTIMIZE="" # Optimizer is buggy + +$as_echo "#define _OE_SOCKETS 1" >>confdefs.h + + ;; + OSF1-V*) + # Digital OSF/1 + SHLIB_CFLAGS="" + if test "$SHARED_BUILD" = 1; then : + + SHLIB_LD='ld -shared -expect_unresolved "*"' + +else + + SHLIB_LD='ld -non_shared -expect_unresolved "*"' + +fi + SHLIB_SUFFIX=".so" + if test $doRpath = yes; then : + + CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' + LD_SEARCH_FLAGS='-rpath ${LIB_RUNTIME_DIR}' +fi + if test "$GCC" = yes; then : + CFLAGS="$CFLAGS -mieee" +else + + CFLAGS="$CFLAGS -DHAVE_TZSET -std1 -ieee" +fi + # see pthread_intro(3) for pthread support on osf1, k.furukawa + if test "${TCL_THREADS}" = 1; then : + + CFLAGS="$CFLAGS -DHAVE_PTHREAD_ATTR_SETSTACKSIZE" + CFLAGS="$CFLAGS -DTCL_THREAD_STACK_MIN=PTHREAD_STACK_MIN*64" + LIBS=`echo $LIBS | sed s/-lpthreads//` + if test "$GCC" = yes; then : + + LIBS="$LIBS -lpthread -lmach -lexc" + +else + + CFLAGS="$CFLAGS -pthread" + LDFLAGS="$LDFLAGS -pthread" + +fi + +fi + ;; + QNX-6*) + # QNX RTP + # This may work for all QNX, but it was only reported for v6. + SHLIB_CFLAGS="-fPIC" + SHLIB_LD="ld -Bshareable -x" + SHLIB_LD_LIBS="" + SHLIB_SUFFIX=".so" + CC_SEARCH_FLAGS="" + LD_SEARCH_FLAGS="" + ;; + SCO_SV-3.2*) + if test "$GCC" = yes; then : + + SHLIB_CFLAGS="-fPIC -melf" + LDFLAGS="$LDFLAGS -melf -Wl,-Bexport" + +else + + SHLIB_CFLAGS="-Kpic -belf" + LDFLAGS="$LDFLAGS -belf -Wl,-Bexport" + +fi + SHLIB_LD="ld -G" + SHLIB_LD_LIBS="" + SHLIB_SUFFIX=".so" + CC_SEARCH_FLAGS="" + LD_SEARCH_FLAGS="" + ;; + SunOS-5.[0-6]) + # Careful to not let 5.10+ fall into this case + + # Note: If _REENTRANT isn't defined, then Solaris + # won't define thread-safe library routines. + + +$as_echo "#define _REENTRANT 1" >>confdefs.h + + +$as_echo "#define _POSIX_PTHREAD_SEMANTICS 1" >>confdefs.h + + + SHLIB_CFLAGS="-KPIC" + SHLIB_SUFFIX=".so" + if test "$GCC" = yes; then : + + SHLIB_LD='${CC} -shared' + CC_SEARCH_FLAGS='-Wl,-R,${LIB_RUNTIME_DIR}' + LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} + +else + + SHLIB_LD="/usr/ccs/bin/ld -G -z text" + CC_SEARCH_FLAGS='-R ${LIB_RUNTIME_DIR}' + LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} + +fi + ;; + SunOS-5*) + # Note: If _REENTRANT isn't defined, then Solaris + # won't define thread-safe library routines. + + +$as_echo "#define _REENTRANT 1" >>confdefs.h + + +$as_echo "#define _POSIX_PTHREAD_SEMANTICS 1" >>confdefs.h + + + SHLIB_CFLAGS="-KPIC" + + # Check to enable 64-bit flags for compiler/linker + if test "$do64bit" = yes; then : + + arch=`isainfo` + if test "$arch" = "sparcv9 sparc"; then : + + if test "$GCC" = yes; then : + + if test "`${CC} -dumpversion | awk -F. '{print $1}'`" -lt 3; then : + + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: 64bit mode not supported with GCC < 3.2 on $system" >&5 +$as_echo "$as_me: WARNING: 64bit mode not supported with GCC < 3.2 on $system" >&2;} + +else + + do64bit_ok=yes + CFLAGS="$CFLAGS -m64 -mcpu=v9" + LDFLAGS="$LDFLAGS -m64 -mcpu=v9" + SHLIB_CFLAGS="-fPIC" + +fi + +else + + do64bit_ok=yes + if test "$do64bitVIS" = yes; then : + + CFLAGS="$CFLAGS -xarch=v9a" + LDFLAGS_ARCH="-xarch=v9a" + +else + + CFLAGS="$CFLAGS -xarch=v9" + LDFLAGS_ARCH="-xarch=v9" + +fi + # Solaris 64 uses this as well + #LD_LIBRARY_PATH_VAR="LD_LIBRARY_PATH_64" + +fi + +else + if test "$arch" = "amd64 i386"; then : + + if test "$GCC" = yes; then : + + case $system in + SunOS-5.1[1-9]*|SunOS-5.[2-9][0-9]*) + do64bit_ok=yes + CFLAGS="$CFLAGS -m64" + LDFLAGS="$LDFLAGS -m64";; + *) + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: 64bit mode not supported with GCC on $system" >&5 +$as_echo "$as_me: WARNING: 64bit mode not supported with GCC on $system" >&2;};; + esac + +else + + do64bit_ok=yes + case $system in + SunOS-5.1[1-9]*|SunOS-5.[2-9][0-9]*) + CFLAGS="$CFLAGS -m64" + LDFLAGS="$LDFLAGS -m64";; + *) + CFLAGS="$CFLAGS -xarch=amd64" + LDFLAGS="$LDFLAGS -xarch=amd64";; + esac + +fi + +else + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: 64bit mode not supported for $arch" >&5 +$as_echo "$as_me: WARNING: 64bit mode not supported for $arch" >&2;} +fi +fi + +fi + + SHLIB_SUFFIX=".so" + if test "$GCC" = yes; then : + + SHLIB_LD='${CC} -shared' + CC_SEARCH_FLAGS='-Wl,-R,${LIB_RUNTIME_DIR}' + LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} + if test "$do64bit_ok" = yes; then : + + if test "$arch" = "sparcv9 sparc"; then : + + # We need to specify -static-libgcc or we need to + # add the path to the sparv9 libgcc. + # JH: static-libgcc is necessary for core Tcl, but may + # not be necessary for extensions. + SHLIB_LD="$SHLIB_LD -m64 -mcpu=v9 -static-libgcc" + # for finding sparcv9 libgcc, get the regular libgcc + # path, remove so name and append 'sparcv9' + #v9gcclibdir="`gcc -print-file-name=libgcc_s.so` | ..." + #CC_SEARCH_FLAGS="${CC_SEARCH_FLAGS},-R,$v9gcclibdir" + +else + if test "$arch" = "amd64 i386"; then : + + # JH: static-libgcc is necessary for core Tcl, but may + # not be necessary for extensions. + SHLIB_LD="$SHLIB_LD -m64 -static-libgcc" + +fi +fi + +fi + +else + + case $system in + SunOS-5.[1-9][0-9]*) + # TEA specific: use LDFLAGS_DEFAULT instead of LDFLAGS + SHLIB_LD='${CC} -G -z text ${LDFLAGS_DEFAULT}';; + *) + SHLIB_LD='/usr/ccs/bin/ld -G -z text';; + esac + CC_SEARCH_FLAGS='-Wl,-R,${LIB_RUNTIME_DIR}' + LD_SEARCH_FLAGS='-R ${LIB_RUNTIME_DIR}' + +fi + ;; + UNIX_SV* | UnixWare-5*) + SHLIB_CFLAGS="-KPIC" + SHLIB_LD='${CC} -G' + SHLIB_LD_LIBS="" + SHLIB_SUFFIX=".so" + # Some UNIX_SV* systems (unixware 1.1.2 for example) have linkers + # that don't grok the -Bexport option. Test that it does. + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for ld accepts -Bexport flag" >&5 +$as_echo_n "checking for ld accepts -Bexport flag... " >&6; } +if ${tcl_cv_ld_Bexport+:} false; then : + $as_echo_n "(cached) " >&6 +else + + hold_ldflags=$LDFLAGS + LDFLAGS="$LDFLAGS -Wl,-Bexport" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ +int i; + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + tcl_cv_ld_Bexport=yes +else + tcl_cv_ld_Bexport=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LDFLAGS=$hold_ldflags +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_ld_Bexport" >&5 +$as_echo "$tcl_cv_ld_Bexport" >&6; } + if test $tcl_cv_ld_Bexport = yes; then : + + LDFLAGS="$LDFLAGS -Wl,-Bexport" + +fi + CC_SEARCH_FLAGS="" + LD_SEARCH_FLAGS="" + ;; + esac + + if test "$do64bit" = yes -a "$do64bit_ok" = no; then : + + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: 64bit support being disabled -- don't know magic for this platform" >&5 +$as_echo "$as_me: WARNING: 64bit support being disabled -- don't know magic for this platform" >&2;} + +fi + + + + # Add in the arch flags late to ensure it wasn't removed. + # Not necessary in TEA, but this is aligned with core + LDFLAGS="$LDFLAGS $LDFLAGS_ARCH" + + # If we're running gcc, then change the C flags for compiling shared + # libraries to the right flags for gcc, instead of those for the + # standard manufacturer compiler. + + if test "$GCC" = yes; then : + + case $system in + AIX-*) ;; + BSD/OS*) ;; + CYGWIN_*|MINGW32_*|MINGW64_*) ;; + IRIX*) ;; + NetBSD-*|DragonFly-*|FreeBSD-*|OpenBSD-*) ;; + Darwin-*) ;; + SCO_SV-3.2*) ;; + windows) ;; + *) SHLIB_CFLAGS="-fPIC" ;; + esac +fi + + if test "$tcl_cv_cc_visibility_hidden" != yes; then : + + +$as_echo "#define MODULE_SCOPE extern" >>confdefs.h + + +fi + + if test "$SHARED_LIB_SUFFIX" = ""; then : + + # TEA specific: use PACKAGE_VERSION instead of VERSION + SHARED_LIB_SUFFIX='${PACKAGE_VERSION}${SHLIB_SUFFIX}' +fi + if test "$UNSHARED_LIB_SUFFIX" = ""; then : + + # TEA specific: use PACKAGE_VERSION instead of VERSION + UNSHARED_LIB_SUFFIX='${PACKAGE_VERSION}.a' +fi + + if test "${GCC}" = "yes" -a ${SHLIB_SUFFIX} = ".dll"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for SEH support in compiler" >&5 +$as_echo_n "checking for SEH support in compiler... " >&6; } +if ${tcl_cv_seh+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test "$cross_compiling" = yes; then : + tcl_cv_seh=no +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +#define WIN32_LEAN_AND_MEAN +#include <windows.h> +#undef WIN32_LEAN_AND_MEAN + + int main(int argc, char** argv) { + int a, b = 0; + __try { + a = 666 / b; + } + __except (EXCEPTION_EXECUTE_HANDLER) { + return 0; + } + return 1; + } + +_ACEOF +if ac_fn_c_try_run "$LINENO"; then : + tcl_cv_seh=yes +else + tcl_cv_seh=no +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_seh" >&5 +$as_echo "$tcl_cv_seh" >&6; } + if test "$tcl_cv_seh" = "no" ; then + +$as_echo "#define HAVE_NO_SEH 1" >>confdefs.h + + fi + + # + # Check to see if the excpt.h include file provided contains the + # definition for EXCEPTION_DISPOSITION; if not, which is the case + # with Cygwin's version as of 2002-04-10, define it to be int, + # sufficient for getting the current code to work. + # + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for EXCEPTION_DISPOSITION support in include files" >&5 +$as_echo_n "checking for EXCEPTION_DISPOSITION support in include files... " >&6; } +if ${tcl_cv_eh_disposition+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +# define WIN32_LEAN_AND_MEAN +# include <windows.h> +# undef WIN32_LEAN_AND_MEAN + +int +main () +{ + + EXCEPTION_DISPOSITION x; + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + tcl_cv_eh_disposition=yes +else + tcl_cv_eh_disposition=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_eh_disposition" >&5 +$as_echo "$tcl_cv_eh_disposition" >&6; } + if test "$tcl_cv_eh_disposition" = "no" ; then + +$as_echo "#define EXCEPTION_DISPOSITION int" >>confdefs.h + + fi + + # Check to see if winnt.h defines CHAR, SHORT, and LONG + # even if VOID has already been #defined. The win32api + # used by mingw and cygwin is known to do this. + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for winnt.h that ignores VOID define" >&5 +$as_echo_n "checking for winnt.h that ignores VOID define... " >&6; } +if ${tcl_cv_winnt_ignore_void+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +#define VOID void +#define WIN32_LEAN_AND_MEAN +#include <windows.h> +#undef WIN32_LEAN_AND_MEAN + +int +main () +{ + + CHAR c; + SHORT s; + LONG l; + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + tcl_cv_winnt_ignore_void=yes +else + tcl_cv_winnt_ignore_void=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_winnt_ignore_void" >&5 +$as_echo "$tcl_cv_winnt_ignore_void" >&6; } + if test "$tcl_cv_winnt_ignore_void" = "yes" ; then + +$as_echo "#define HAVE_WINNT_IGNORE_VOID 1" >>confdefs.h + + fi + fi + + # See if the compiler supports casting to a union type. + # This is used to stop gcc from printing a compiler + # warning when initializing a union member. + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for cast to union support" >&5 +$as_echo_n "checking for cast to union support... " >&6; } +if ${tcl_cv_cast_to_union+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + union foo { int i; double d; }; + union foo f = (union foo) (int) 0; + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + tcl_cv_cast_to_union=yes +else + tcl_cv_cast_to_union=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_cast_to_union" >&5 +$as_echo "$tcl_cv_cast_to_union" >&6; } + if test "$tcl_cv_cast_to_union" = "yes"; then + +$as_echo "#define HAVE_CAST_TO_UNION 1" >>confdefs.h + + fi + + + + + + + + + + + + + + # These must be called after we do the basic CFLAGS checks and + # verify any possible 64-bit or similar switches are necessary + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for required early compiler flags" >&5 +$as_echo_n "checking for required early compiler flags... " >&6; } + tcl_flags="" + + if ${tcl_cv_flag__isoc99_source+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <stdlib.h> +int +main () +{ +char *p = (char *)strtoll; char *q = (char *)strtoull; + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + tcl_cv_flag__isoc99_source=no +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#define _ISOC99_SOURCE 1 +#include <stdlib.h> +int +main () +{ +char *p = (char *)strtoll; char *q = (char *)strtoull; + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + tcl_cv_flag__isoc99_source=yes +else + tcl_cv_flag__isoc99_source=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi + + if test "x${tcl_cv_flag__isoc99_source}" = "xyes" ; then + +$as_echo "#define _ISOC99_SOURCE 1" >>confdefs.h + + tcl_flags="$tcl_flags _ISOC99_SOURCE" + fi + + + if ${tcl_cv_flag__largefile64_source+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <sys/stat.h> +int +main () +{ +struct stat64 buf; int i = stat64("/", &buf); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + tcl_cv_flag__largefile64_source=no +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#define _LARGEFILE64_SOURCE 1 +#include <sys/stat.h> +int +main () +{ +struct stat64 buf; int i = stat64("/", &buf); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + tcl_cv_flag__largefile64_source=yes +else + tcl_cv_flag__largefile64_source=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi + + if test "x${tcl_cv_flag__largefile64_source}" = "xyes" ; then + +$as_echo "#define _LARGEFILE64_SOURCE 1" >>confdefs.h + + tcl_flags="$tcl_flags _LARGEFILE64_SOURCE" + fi + + + if ${tcl_cv_flag__largefile_source64+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <sys/stat.h> +int +main () +{ +char *p = (char *)open64; + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + tcl_cv_flag__largefile_source64=no +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#define _LARGEFILE_SOURCE64 1 +#include <sys/stat.h> +int +main () +{ +char *p = (char *)open64; + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + tcl_cv_flag__largefile_source64=yes +else + tcl_cv_flag__largefile_source64=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi + + if test "x${tcl_cv_flag__largefile_source64}" = "xyes" ; then + +$as_echo "#define _LARGEFILE_SOURCE64 1" >>confdefs.h + + tcl_flags="$tcl_flags _LARGEFILE_SOURCE64" + fi + + if test "x${tcl_flags}" = "x" ; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: none" >&5 +$as_echo "none" >&6; } + else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: ${tcl_flags}" >&5 +$as_echo "${tcl_flags}" >&6; } + fi + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for 64-bit integer type" >&5 +$as_echo_n "checking for 64-bit integer type... " >&6; } + if ${tcl_cv_type_64bit+:} false; then : + $as_echo_n "(cached) " >&6 +else + + tcl_cv_type_64bit=none + # See if the compiler knows natively about __int64 + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ +__int64 value = (__int64) 0; + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + tcl_type_64bit=__int64 +else + tcl_type_64bit="long long" +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + # See if we should use long anyway Note that we substitute in the + # type that is our current guess for a 64-bit type inside this check + # program, so it should be modified only carefully... + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ +switch (0) { + case 1: case (sizeof(${tcl_type_64bit})==sizeof(long)): ; + } + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + tcl_cv_type_64bit=${tcl_type_64bit} +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi + + if test "${tcl_cv_type_64bit}" = none ; then + +$as_echo "#define TCL_WIDE_INT_IS_LONG 1" >>confdefs.h + + { $as_echo "$as_me:${as_lineno-$LINENO}: result: using long" >&5 +$as_echo "using long" >&6; } + elif test "${tcl_cv_type_64bit}" = "__int64" \ + -a "${TEA_PLATFORM}" = "windows" ; then + # TEA specific: We actually want to use the default tcl.h checks in + # this case to handle both TCL_WIDE_INT_TYPE and TCL_LL_MODIFIER* + { $as_echo "$as_me:${as_lineno-$LINENO}: result: using Tcl header defaults" >&5 +$as_echo "using Tcl header defaults" >&6; } + else + +cat >>confdefs.h <<_ACEOF +#define TCL_WIDE_INT_TYPE ${tcl_cv_type_64bit} +_ACEOF + + { $as_echo "$as_me:${as_lineno-$LINENO}: result: ${tcl_cv_type_64bit}" >&5 +$as_echo "${tcl_cv_type_64bit}" >&6; } + + # Now check for auxiliary declarations + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for struct dirent64" >&5 +$as_echo_n "checking for struct dirent64... " >&6; } +if ${tcl_cv_struct_dirent64+:} false; then : + $as_echo_n "(cached) " >&6 +else + + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <sys/types.h> +#include <dirent.h> +int +main () +{ +struct dirent64 p; + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + tcl_cv_struct_dirent64=yes +else + tcl_cv_struct_dirent64=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_struct_dirent64" >&5 +$as_echo "$tcl_cv_struct_dirent64" >&6; } + if test "x${tcl_cv_struct_dirent64}" = "xyes" ; then + +$as_echo "#define HAVE_STRUCT_DIRENT64 1" >>confdefs.h + + fi + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for struct stat64" >&5 +$as_echo_n "checking for struct stat64... " >&6; } +if ${tcl_cv_struct_stat64+:} false; then : + $as_echo_n "(cached) " >&6 +else + + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <sys/stat.h> +int +main () +{ +struct stat64 p; + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + tcl_cv_struct_stat64=yes +else + tcl_cv_struct_stat64=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_struct_stat64" >&5 +$as_echo "$tcl_cv_struct_stat64" >&6; } + if test "x${tcl_cv_struct_stat64}" = "xyes" ; then + +$as_echo "#define HAVE_STRUCT_STAT64 1" >>confdefs.h + + fi + + for ac_func in open64 lseek64 +do : + as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh` +ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var" +if eval test \"x\$"$as_ac_var"\" = x"yes"; then : + cat >>confdefs.h <<_ACEOF +#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1 +_ACEOF + +fi +done + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for off64_t" >&5 +$as_echo_n "checking for off64_t... " >&6; } + if ${tcl_cv_type_off64_t+:} false; then : + $as_echo_n "(cached) " >&6 +else + + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <sys/types.h> +int +main () +{ +off64_t offset; + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + tcl_cv_type_off64_t=yes +else + tcl_cv_type_off64_t=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi + + if test "x${tcl_cv_type_off64_t}" = "xyes" && \ + test "x${ac_cv_func_lseek64}" = "xyes" && \ + test "x${ac_cv_func_open64}" = "xyes" ; then + +$as_echo "#define HAVE_TYPE_OFF64_T 1" >>confdefs.h + + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +$as_echo "yes" >&6; } + else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } + fi + fi + + + +#-------------------------------------------------------------------- +# Set the default compiler switches based on the --enable-symbols option. +#-------------------------------------------------------------------- + + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for build with symbols" >&5 +$as_echo_n "checking for build with symbols... " >&6; } + # Check whether --enable-symbols was given. +if test "${enable_symbols+set}" = set; then : + enableval=$enable_symbols; tcl_ok=$enableval +else + tcl_ok=no +fi + + DBGX="" + if test "$tcl_ok" = "no"; then + CFLAGS_DEFAULT="${CFLAGS_OPTIMIZE} -DNDEBUG" + LDFLAGS_DEFAULT="${LDFLAGS_OPTIMIZE}" + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } + else + CFLAGS_DEFAULT="${CFLAGS_DEBUG}" + LDFLAGS_DEFAULT="${LDFLAGS_DEBUG}" + if test "$tcl_ok" = "yes"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes (standard debugging)" >&5 +$as_echo "yes (standard debugging)" >&6; } + fi + fi + # TEA specific: + if test "${TEA_PLATFORM}" != "windows" ; then + LDFLAGS_DEFAULT="${LDFLAGS}" + fi + + + + + if test "$tcl_ok" = "mem" -o "$tcl_ok" = "all"; then + +$as_echo "#define TCL_MEM_DEBUG 1" >>confdefs.h + + fi + + if test "$tcl_ok" != "yes" -a "$tcl_ok" != "no"; then + if test "$tcl_ok" = "all"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: enabled symbols mem debugging" >&5 +$as_echo "enabled symbols mem debugging" >&6; } + else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: enabled $tcl_ok debugging" >&5 +$as_echo "enabled $tcl_ok debugging" >&6; } + fi + fi + + +#-------------------------------------------------------------------- +# Everyone should be linking against the Tcl stub library. If you +# can't for some reason, remove this definition. If you aren't using +# stubs, you also need to modify the SHLIB_LD_LIBS setting below to +# link against the non-stubbed Tcl library. Add Tk too if necessary. +#-------------------------------------------------------------------- + + +$as_echo "#define USE_TCL_STUBS 1" >>confdefs.h + + +#-------------------------------------------------------------------- +# Enable compile-time support for TIP #143 and TIP #285. When using +# a pre-Tcl 8.5 or 8.6 core, respectively, the actual functionality +# will not be available at runtime. +#-------------------------------------------------------------------- + + +$as_echo "#define TCL_TIP143 1" >>confdefs.h + + +$as_echo "#define TCL_TIP285 1" >>confdefs.h + + +#-------------------------------------------------------------------- +# This macro generates a line to use when building a library. It +# depends on values set by the TEA_ENABLE_SHARED, TEA_ENABLE_SYMBOLS, +# and TEA_LOAD_TCLCONFIG macros above. +#-------------------------------------------------------------------- + + + if test "${TEA_PLATFORM}" = "windows" -a "$GCC" != "yes"; then + MAKE_STATIC_LIB="\${STLIB_LD} -out:\$@ \$(PKG_OBJECTS)" + MAKE_SHARED_LIB="\${SHLIB_LD} \${SHLIB_LD_LIBS} \${LDFLAGS_DEFAULT} -out:\$@ \$(PKG_OBJECTS)" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +#if defined(_MSC_VER) && _MSC_VER >= 1400 +print("manifest needed") +#endif + +_ACEOF +if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | + $EGREP "manifest needed" >/dev/null 2>&1; then : + + # Could do a CHECK_PROG for mt, but should always be with MSVC8+ + VC_MANIFEST_EMBED_DLL="if test -f \$@.manifest ; then mt.exe -nologo -manifest \$@.manifest -outputresource:\$@\;2 ; fi" + VC_MANIFEST_EMBED_EXE="if test -f \$@.manifest ; then mt.exe -nologo -manifest \$@.manifest -outputresource:\$@\;1 ; fi" + MAKE_SHARED_LIB="${MAKE_SHARED_LIB} ; ${VC_MANIFEST_EMBED_DLL}" + + CLEANFILES="$CLEANFILES *.manifest" + + +fi +rm -f conftest* + + MAKE_STUB_LIB="\${STLIB_LD} -nodefaultlib -out:\$@ \$(PKG_STUB_OBJECTS)" + else + MAKE_STATIC_LIB="\${STLIB_LD} \$@ \$(PKG_OBJECTS)" + MAKE_SHARED_LIB="\${SHLIB_LD} -o \$@ \$(PKG_OBJECTS) \${SHLIB_LD_LIBS}" + MAKE_STUB_LIB="\${STLIB_LD} \$@ \$(PKG_STUB_OBJECTS)" + fi + + if test "${SHARED_BUILD}" = "1" ; then + MAKE_LIB="${MAKE_SHARED_LIB} " + else + MAKE_LIB="${MAKE_STATIC_LIB} " + fi + + #-------------------------------------------------------------------- + # Shared libraries and static libraries have different names. + # Use the double eval to make sure any variables in the suffix is + # substituted. (@@@ Might not be necessary anymore) + #-------------------------------------------------------------------- + + if test "${TEA_PLATFORM}" = "windows" ; then + if test "${SHARED_BUILD}" = "1" ; then + # We force the unresolved linking of symbols that are really in + # the private libraries of Tcl and Tk. + if test x"${TK_BIN_DIR}" != x ; then + SHLIB_LD_LIBS="${SHLIB_LD_LIBS} \"`${CYGPATH} ${TK_BIN_DIR}/${TK_STUB_LIB_FILE}`\"" + fi + SHLIB_LD_LIBS="${SHLIB_LD_LIBS} \"`${CYGPATH} ${TCL_BIN_DIR}/${TCL_STUB_LIB_FILE}`\"" + if test "$GCC" = "yes"; then + SHLIB_LD_LIBS="${SHLIB_LD_LIBS} -static-libgcc" + fi + eval eval "PKG_LIB_FILE=${PACKAGE_LIB_PREFIX}${PACKAGE_NAME}${SHARED_LIB_SUFFIX}" + else + eval eval "PKG_LIB_FILE=${PACKAGE_LIB_PREFIX}${PACKAGE_NAME}${UNSHARED_LIB_SUFFIX}" + if test "$GCC" = "yes"; then + PKG_LIB_FILE=lib${PKG_LIB_FILE} + fi + fi + # Some packages build their own stubs libraries + eval eval "PKG_STUB_LIB_FILE=${PACKAGE_LIB_PREFIX}${PACKAGE_NAME}stub${UNSHARED_LIB_SUFFIX}" + if test "$GCC" = "yes"; then + PKG_STUB_LIB_FILE=lib${PKG_STUB_LIB_FILE} + fi + # These aren't needed on Windows (either MSVC or gcc) + RANLIB=: + RANLIB_STUB=: + else + RANLIB_STUB="${RANLIB}" + if test "${SHARED_BUILD}" = "1" ; then + SHLIB_LD_LIBS="${SHLIB_LD_LIBS} ${TCL_STUB_LIB_SPEC}" + if test x"${TK_BIN_DIR}" != x ; then + SHLIB_LD_LIBS="${SHLIB_LD_LIBS} ${TK_STUB_LIB_SPEC}" + fi + eval eval "PKG_LIB_FILE=lib${PACKAGE_LIB_PREFIX}${PACKAGE_NAME}${SHARED_LIB_SUFFIX}" + RANLIB=: + else + eval eval "PKG_LIB_FILE=lib${PACKAGE_LIB_PREFIX}${PACKAGE_NAME}${UNSHARED_LIB_SUFFIX}" + fi + # Some packages build their own stubs libraries + eval eval "PKG_STUB_LIB_FILE=lib${PACKAGE_LIB_PREFIX}${PACKAGE_NAME}stub${UNSHARED_LIB_SUFFIX}" + fi + + # These are escaped so that only CFLAGS is picked up at configure time. + # The other values will be substituted at make time. + CFLAGS="${CFLAGS} \${CFLAGS_DEFAULT} \${CFLAGS_WARNING}" + if test "${SHARED_BUILD}" = "1" ; then + CFLAGS="${CFLAGS} \${SHLIB_CFLAGS}" + fi + + + + + + + + + + +#-------------------------------------------------------------------- +# Determine the name of the tclsh and/or wish executables in the +# Tcl and Tk build directories or the location they were installed +# into. These paths are used to support running test cases only, +# the Makefile should not be making use of these paths to generate +# a pkgIndex.tcl file or anything else at extension build time. +#-------------------------------------------------------------------- + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for tclsh" >&5 +$as_echo_n "checking for tclsh... " >&6; } + if test -f "${TCL_BIN_DIR}/Makefile" ; then + # tclConfig.sh is in Tcl build directory + if test "${TEA_PLATFORM}" = "windows"; then + if test -f "${TCL_BIN_DIR}/tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}${TCL_DBGX}${EXEEXT}" ; then + TCLSH_PROG="${TCL_BIN_DIR}/tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}${TCL_DBGX}${EXEEXT}" + elif test -f "${TCL_BIN_DIR}/tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}${TCL_DBGX}s${EXEEXT}" ; then + TCLSH_PROG="${TCL_BIN_DIR}/tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}${TCL_DBGX}s${EXEEXT}" + elif test -f "${TCL_BIN_DIR}/tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}${TCL_DBGX}t${EXEEXT}" ; then + TCLSH_PROG="${TCL_BIN_DIR}/tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}${TCL_DBGX}t${EXEEXT}" + elif test -f "${TCL_BIN_DIR}/tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}${TCL_DBGX}st${EXEEXT}" ; then + TCLSH_PROG="${TCL_BIN_DIR}/tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}${TCL_DBGX}st${EXEEXT}" + fi + else + TCLSH_PROG="${TCL_BIN_DIR}/tclsh" + fi + else + # tclConfig.sh is in install location + if test "${TEA_PLATFORM}" = "windows"; then + TCLSH_PROG="tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}${TCL_DBGX}${EXEEXT}" + else + TCLSH_PROG="tclsh${TCL_MAJOR_VERSION}.${TCL_MINOR_VERSION}${TCL_DBGX}" + fi + list="`ls -d ${TCL_BIN_DIR}/../bin 2>/dev/null` \ + `ls -d ${TCL_BIN_DIR}/.. 2>/dev/null` \ + `ls -d ${TCL_PREFIX}/bin 2>/dev/null`" + for i in $list ; do + if test -f "$i/${TCLSH_PROG}" ; then + REAL_TCL_BIN_DIR="`cd "$i"; pwd`/" + break + fi + done + TCLSH_PROG="${REAL_TCL_BIN_DIR}${TCLSH_PROG}" + fi + { $as_echo "$as_me:${as_lineno-$LINENO}: result: ${TCLSH_PROG}" >&5 +$as_echo "${TCLSH_PROG}" >&6; } + + +#TEA_PROG_WISH + +#-------------------------------------------------------------------- +# Finally, substitute all of the various values into the Makefile. +# You may alternatively have a special pkgIndex.tcl.in or other files +# which require substituting th AC variables in. Include these here. +#-------------------------------------------------------------------- + +ac_config_files="$ac_config_files Makefile pkgIndex.tcl" + +cat >confcache <<\_ACEOF +# This file is a shell script that caches the results of configure +# tests run on this system so they can be shared between configure +# scripts and configure runs, see configure's option --config-cache. +# It is not useful on other systems. If it contains results you don't +# want to keep, you may remove or edit it. +# +# config.status only pays attention to the cache file if you give it +# the --recheck option to rerun configure. +# +# `ac_cv_env_foo' variables (set or unset) will be overridden when +# loading this file, other *unset* `ac_cv_foo' will be assigned the +# following values. + +_ACEOF + +# The following way of writing the cache mishandles newlines in values, +# but we know of no workaround that is simple, portable, and efficient. +# So, we kill variables containing newlines. +# Ultrix sh set writes to stderr and can't be redirected directly, +# and sets the high bit in the cache file unless we assign to the vars. +( + for ac_var in `(set) 2>&1 | sed -n 's/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'`; do + eval ac_val=\$$ac_var + case $ac_val in #( + *${as_nl}*) + case $ac_var in #( + *_cv_*) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5 +$as_echo "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;; + esac + case $ac_var in #( + _ | IFS | as_nl) ;; #( + BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #( + *) { eval $ac_var=; unset $ac_var;} ;; + esac ;; + esac + done + + (set) 2>&1 | + case $as_nl`(ac_space=' '; set) 2>&1` in #( + *${as_nl}ac_space=\ *) + # `set' does not quote correctly, so add quotes: double-quote + # substitution turns \\\\ into \\, and sed turns \\ into \. + sed -n \ + "s/'/'\\\\''/g; + s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\\2'/p" + ;; #( + *) + # `set' quotes correctly as required by POSIX, so do not add quotes. + sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p" + ;; + esac | + sort +) | + sed ' + /^ac_cv_env_/b end + t clear + :clear + s/^\([^=]*\)=\(.*[{}].*\)$/test "${\1+set}" = set || &/ + t end + s/^\([^=]*\)=\(.*\)$/\1=${\1=\2}/ + :end' >>confcache +if diff "$cache_file" confcache >/dev/null 2>&1; then :; else + if test -w "$cache_file"; then + if test "x$cache_file" != "x/dev/null"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: updating cache $cache_file" >&5 +$as_echo "$as_me: updating cache $cache_file" >&6;} + if test ! -f "$cache_file" || test -h "$cache_file"; then + cat confcache >"$cache_file" + else + case $cache_file in #( + */* | ?:*) + mv -f confcache "$cache_file"$$ && + mv -f "$cache_file"$$ "$cache_file" ;; #( + *) + mv -f confcache "$cache_file" ;; + esac + fi + fi + else + { $as_echo "$as_me:${as_lineno-$LINENO}: not updating unwritable cache $cache_file" >&5 +$as_echo "$as_me: not updating unwritable cache $cache_file" >&6;} + fi +fi +rm -f confcache + +test "x$prefix" = xNONE && prefix=$ac_default_prefix +# Let make expand exec_prefix. +test "x$exec_prefix" = xNONE && exec_prefix='${prefix}' + +# Transform confdefs.h into DEFS. +# Protect against shell expansion while executing Makefile rules. +# Protect against Makefile macro expansion. +# +# If the first sed substitution is executed (which looks for macros that +# take arguments), then branch to the quote section. Otherwise, +# look for a macro that doesn't take arguments. +ac_script=' +:mline +/\\$/{ + N + s,\\\n,, + b mline +} +t clear +:clear +s/^[ ]*#[ ]*define[ ][ ]*\([^ (][^ (]*([^)]*)\)[ ]*\(.*\)/-D\1=\2/g +t quote +s/^[ ]*#[ ]*define[ ][ ]*\([^ ][^ ]*\)[ ]*\(.*\)/-D\1=\2/g +t quote +b any +:quote +s/[ `~#$^&*(){}\\|;'\''"<>?]/\\&/g +s/\[/\\&/g +s/\]/\\&/g +s/\$/$$/g +H +:any +${ + g + s/^\n// + s/\n/ /g + p +} +' +DEFS=`sed -n "$ac_script" confdefs.h` + + +ac_libobjs= +ac_ltlibobjs= +U= +for ac_i in : $LIBOBJS; do test "x$ac_i" = x: && continue + # 1. Remove the extension, and $U if already installed. + ac_script='s/\$U\././;s/\.o$//;s/\.obj$//' + ac_i=`$as_echo "$ac_i" | sed "$ac_script"` + # 2. Prepend LIBOBJDIR. When used with automake>=1.10 LIBOBJDIR + # will be set to the directory where LIBOBJS objects are built. + as_fn_append ac_libobjs " \${LIBOBJDIR}$ac_i\$U.$ac_objext" + as_fn_append ac_ltlibobjs " \${LIBOBJDIR}$ac_i"'$U.lo' +done +LIBOBJS=$ac_libobjs + +LTLIBOBJS=$ac_ltlibobjs + + + +CFLAGS="${CFLAGS} ${CPPFLAGS}"; CPPFLAGS="" + +: "${CONFIG_STATUS=./config.status}" +ac_write_fail=0 +ac_clean_files_save=$ac_clean_files +ac_clean_files="$ac_clean_files $CONFIG_STATUS" +{ $as_echo "$as_me:${as_lineno-$LINENO}: creating $CONFIG_STATUS" >&5 +$as_echo "$as_me: creating $CONFIG_STATUS" >&6;} +as_write_fail=0 +cat >$CONFIG_STATUS <<_ASEOF || as_write_fail=1 +#! $SHELL +# Generated by $as_me. +# Run this file to recreate the current configuration. +# Compiler output produced by configure, useful for debugging +# configure, is in config.log if it exists. + +debug=false +ac_cs_recheck=false +ac_cs_silent=false + +SHELL=\${CONFIG_SHELL-$SHELL} +export SHELL +_ASEOF +cat >>$CONFIG_STATUS <<\_ASEOF || as_write_fail=1 +## -------------------- ## +## M4sh Initialization. ## +## -------------------- ## + +# Be more Bourne compatible +DUALCASE=1; export DUALCASE # for MKS sh +if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then : + emulate sh + NULLCMD=: + # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which + # is contrary to our usage. Disable this feature. + alias -g '${1+"$@"}'='"$@"' + setopt NO_GLOB_SUBST +else + case `(set -o) 2>/dev/null` in #( + *posix*) : + set -o posix ;; #( + *) : + ;; +esac +fi + + +as_nl=' +' +export as_nl +# Printing a long string crashes Solaris 7 /usr/bin/printf. +as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\' +as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo +as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo +# Prefer a ksh shell builtin over an external printf program on Solaris, +# but without wasting forks for bash or zsh. +if test -z "$BASH_VERSION$ZSH_VERSION" \ + && (test "X`print -r -- $as_echo`" = "X$as_echo") 2>/dev/null; then + as_echo='print -r --' + as_echo_n='print -rn --' +elif (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then + as_echo='printf %s\n' + as_echo_n='printf %s' +else + if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then + as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"' + as_echo_n='/usr/ucb/echo -n' + else + as_echo_body='eval expr "X$1" : "X\\(.*\\)"' + as_echo_n_body='eval + arg=$1; + case $arg in #( + *"$as_nl"*) + expr "X$arg" : "X\\(.*\\)$as_nl"; + arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;; + esac; + expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl" + ' + export as_echo_n_body + as_echo_n='sh -c $as_echo_n_body as_echo' + fi + export as_echo_body + as_echo='sh -c $as_echo_body as_echo' +fi + +# The user is always right. +if test "${PATH_SEPARATOR+set}" != set; then + PATH_SEPARATOR=: + (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && { + (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 || + PATH_SEPARATOR=';' + } +fi + + +# IFS +# We need space, tab and new line, in precisely that order. Quoting is +# there to prevent editors from complaining about space-tab. +# (If _AS_PATH_WALK were called with IFS unset, it would disable word +# splitting by setting IFS to empty value.) +IFS=" "" $as_nl" + +# Find who we are. Look in the path if we contain no directory separator. +as_myself= +case $0 in #(( + *[\\/]* ) as_myself=$0 ;; + *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break + done +IFS=$as_save_IFS + + ;; +esac +# We did not find ourselves, most probably we were run as `sh COMMAND' +# in which case we are not to be found in the path. +if test "x$as_myself" = x; then + as_myself=$0 +fi +if test ! -f "$as_myself"; then + $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2 + exit 1 +fi + +# Unset variables that we do not need and which cause bugs (e.g. in +# pre-3.0 UWIN ksh). But do not cause bugs in bash 2.01; the "|| exit 1" +# suppresses any "Segmentation fault" message there. '((' could +# trigger a bug in pdksh 5.2.14. +for as_var in BASH_ENV ENV MAIL MAILPATH +do eval test x\${$as_var+set} = xset \ + && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || : +done +PS1='$ ' +PS2='> ' +PS4='+ ' + +# NLS nuisances. +LC_ALL=C +export LC_ALL +LANGUAGE=C +export LANGUAGE + +# CDPATH. +(unset CDPATH) >/dev/null 2>&1 && unset CDPATH + + +# as_fn_error STATUS ERROR [LINENO LOG_FD] +# ---------------------------------------- +# Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are +# provided, also output the error to LOG_FD, referencing LINENO. Then exit the +# script with STATUS, using 1 if that was 0. +as_fn_error () +{ + as_status=$1; test $as_status -eq 0 && as_status=1 + if test "$4"; then + as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + $as_echo "$as_me:${as_lineno-$LINENO}: error: $2" >&$4 + fi + $as_echo "$as_me: error: $2" >&2 + as_fn_exit $as_status +} # as_fn_error + + +# as_fn_set_status STATUS +# ----------------------- +# Set $? to STATUS, without forking. +as_fn_set_status () +{ + return $1 +} # as_fn_set_status + +# as_fn_exit STATUS +# ----------------- +# Exit the shell with STATUS, even in a "trap 0" or "set -e" context. +as_fn_exit () +{ + set +e + as_fn_set_status $1 + exit $1 +} # as_fn_exit + +# as_fn_unset VAR +# --------------- +# Portably unset VAR. +as_fn_unset () +{ + { eval $1=; unset $1;} +} +as_unset=as_fn_unset +# as_fn_append VAR VALUE +# ---------------------- +# Append the text in VALUE to the end of the definition contained in VAR. Take +# advantage of any shell optimizations that allow amortized linear growth over +# repeated appends, instead of the typical quadratic growth present in naive +# implementations. +if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null; then : + eval 'as_fn_append () + { + eval $1+=\$2 + }' +else + as_fn_append () + { + eval $1=\$$1\$2 + } +fi # as_fn_append + +# as_fn_arith ARG... +# ------------------ +# Perform arithmetic evaluation on the ARGs, and store the result in the +# global $as_val. Take advantage of shells that can avoid forks. The arguments +# must be portable across $(()) and expr. +if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null; then : + eval 'as_fn_arith () + { + as_val=$(( $* )) + }' +else + as_fn_arith () + { + as_val=`expr "$@" || test $? -eq 1` + } +fi # as_fn_arith + + +if expr a : '\(a\)' >/dev/null 2>&1 && + test "X`expr 00001 : '.*\(...\)'`" = X001; then + as_expr=expr +else + as_expr=false +fi + +if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then + as_basename=basename +else + as_basename=false +fi + +if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then + as_dirname=dirname +else + as_dirname=false +fi + +as_me=`$as_basename -- "$0" || +$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ + X"$0" : 'X\(//\)$' \| \ + X"$0" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X/"$0" | + sed '/^.*\/\([^/][^/]*\)\/*$/{ + s//\1/ + q + } + /^X\/\(\/\/\)$/{ + s//\1/ + q + } + /^X\/\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + +# Avoid depending upon Character Ranges. +as_cr_letters='abcdefghijklmnopqrstuvwxyz' +as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' +as_cr_Letters=$as_cr_letters$as_cr_LETTERS +as_cr_digits='0123456789' +as_cr_alnum=$as_cr_Letters$as_cr_digits + +ECHO_C= ECHO_N= ECHO_T= +case `echo -n x` in #((((( +-n*) + case `echo 'xy\c'` in + *c*) ECHO_T=' ';; # ECHO_T is single tab character. + xy) ECHO_C='\c';; + *) echo `echo ksh88 bug on AIX 6.1` > /dev/null + ECHO_T=' ';; + esac;; +*) + ECHO_N='-n';; +esac + +rm -f conf$$ conf$$.exe conf$$.file +if test -d conf$$.dir; then + rm -f conf$$.dir/conf$$.file +else + rm -f conf$$.dir + mkdir conf$$.dir 2>/dev/null +fi +if (echo >conf$$.file) 2>/dev/null; then + if ln -s conf$$.file conf$$ 2>/dev/null; then + as_ln_s='ln -s' + # ... but there are two gotchas: + # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail. + # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable. + # In both cases, we have to default to `cp -pR'. + ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || + as_ln_s='cp -pR' + elif ln conf$$.file conf$$ 2>/dev/null; then + as_ln_s=ln + else + as_ln_s='cp -pR' + fi +else + as_ln_s='cp -pR' +fi +rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file +rmdir conf$$.dir 2>/dev/null + + +# as_fn_mkdir_p +# ------------- +# Create "$as_dir" as a directory, including parents if necessary. +as_fn_mkdir_p () +{ + + case $as_dir in #( + -*) as_dir=./$as_dir;; + esac + test -d "$as_dir" || eval $as_mkdir_p || { + as_dirs= + while :; do + case $as_dir in #( + *\'*) as_qdir=`$as_echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'( + *) as_qdir=$as_dir;; + esac + as_dirs="'$as_qdir' $as_dirs" + as_dir=`$as_dirname -- "$as_dir" || +$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$as_dir" : 'X\(//\)[^/]' \| \ + X"$as_dir" : 'X\(//\)$' \| \ + X"$as_dir" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X"$as_dir" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ + s//\1/ + q + } + /^X\(\/\/\)[^/].*/{ + s//\1/ + q + } + /^X\(\/\/\)$/{ + s//\1/ + q + } + /^X\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + test -d "$as_dir" && break + done + test -z "$as_dirs" || eval "mkdir $as_dirs" + } || test -d "$as_dir" || as_fn_error $? "cannot create directory $as_dir" + + +} # as_fn_mkdir_p +if mkdir -p . 2>/dev/null; then + as_mkdir_p='mkdir -p "$as_dir"' +else + test -d ./-p && rmdir ./-p + as_mkdir_p=false +fi + + +# as_fn_executable_p FILE +# ----------------------- +# Test if FILE is an executable regular file. +as_fn_executable_p () +{ + test -f "$1" && test -x "$1" +} # as_fn_executable_p +as_test_x='test -x' +as_executable_p=as_fn_executable_p + +# Sed expression to map a string onto a valid CPP name. +as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" + +# Sed expression to map a string onto a valid variable name. +as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" + + +exec 6>&1 +## ----------------------------------- ## +## Main body of $CONFIG_STATUS script. ## +## ----------------------------------- ## +_ASEOF +test $as_write_fail = 0 && chmod +x $CONFIG_STATUS || ac_write_fail=1 + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +# Save the log message, to keep $0 and so on meaningful, and to +# report actual input values of CONFIG_FILES etc. instead of their +# values after options handling. +ac_log=" +This file was extended by thread $as_me 2.8.4, which was +generated by GNU Autoconf 2.69. Invocation command line was + + CONFIG_FILES = $CONFIG_FILES + CONFIG_HEADERS = $CONFIG_HEADERS + CONFIG_LINKS = $CONFIG_LINKS + CONFIG_COMMANDS = $CONFIG_COMMANDS + $ $0 $@ + +on `(hostname || uname -n) 2>/dev/null | sed 1q` +" + +_ACEOF + +case $ac_config_files in *" +"*) set x $ac_config_files; shift; ac_config_files=$*;; +esac + + + +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +# Files that config.status was made for. +config_files="$ac_config_files" + +_ACEOF + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +ac_cs_usage="\ +\`$as_me' instantiates files and other configuration actions +from templates according to the current configuration. Unless the files +and actions are specified as TAGs, all are instantiated by default. + +Usage: $0 [OPTION]... [TAG]... + + -h, --help print this help, then exit + -V, --version print version number and configuration settings, then exit + --config print configuration, then exit + -q, --quiet, --silent + do not print progress messages + -d, --debug don't remove temporary files + --recheck update $as_me by reconfiguring in the same conditions + --file=FILE[:TEMPLATE] + instantiate the configuration file FILE + +Configuration files: +$config_files + +Report bugs to the package provider." + +_ACEOF +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`" +ac_cs_version="\\ +thread config.status 2.8.4 +configured by $0, generated by GNU Autoconf 2.69, + with options \\"\$ac_cs_config\\" + +Copyright (C) 2012 Free Software Foundation, Inc. +This config.status script is free software; the Free Software Foundation +gives unlimited permission to copy, distribute and modify it." + +ac_pwd='$ac_pwd' +srcdir='$srcdir' +test -n "\$AWK" || AWK=awk +_ACEOF + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +# The default lists apply if the user does not specify any file. +ac_need_defaults=: +while test $# != 0 +do + case $1 in + --*=?*) + ac_option=`expr "X$1" : 'X\([^=]*\)='` + ac_optarg=`expr "X$1" : 'X[^=]*=\(.*\)'` + ac_shift=: + ;; + --*=) + ac_option=`expr "X$1" : 'X\([^=]*\)='` + ac_optarg= + ac_shift=: + ;; + *) + ac_option=$1 + ac_optarg=$2 + ac_shift=shift + ;; + esac + + case $ac_option in + # Handling of the options. + -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r) + ac_cs_recheck=: ;; + --version | --versio | --versi | --vers | --ver | --ve | --v | -V ) + $as_echo "$ac_cs_version"; exit ;; + --config | --confi | --conf | --con | --co | --c ) + $as_echo "$ac_cs_config"; exit ;; + --debug | --debu | --deb | --de | --d | -d ) + debug=: ;; + --file | --fil | --fi | --f ) + $ac_shift + case $ac_optarg in + *\'*) ac_optarg=`$as_echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` ;; + '') as_fn_error $? "missing file argument" ;; + esac + as_fn_append CONFIG_FILES " '$ac_optarg'" + ac_need_defaults=false;; + --he | --h | --help | --hel | -h ) + $as_echo "$ac_cs_usage"; exit ;; + -q | -quiet | --quiet | --quie | --qui | --qu | --q \ + | -silent | --silent | --silen | --sile | --sil | --si | --s) + ac_cs_silent=: ;; + + # This is an error. + -*) as_fn_error $? "unrecognized option: \`$1' +Try \`$0 --help' for more information." ;; + + *) as_fn_append ac_config_targets " $1" + ac_need_defaults=false ;; + + esac + shift +done + +ac_configure_extra_args= + +if $ac_cs_silent; then + exec 6>/dev/null + ac_configure_extra_args="$ac_configure_extra_args --silent" +fi + +_ACEOF +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +if \$ac_cs_recheck; then + set X $SHELL '$0' $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion + shift + \$as_echo "running CONFIG_SHELL=$SHELL \$*" >&6 + CONFIG_SHELL='$SHELL' + export CONFIG_SHELL + exec "\$@" +fi + +_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +exec 5>>config.log +{ + echo + sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX +## Running $as_me. ## +_ASBOX + $as_echo "$ac_log" +} >&5 + +_ACEOF +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +_ACEOF + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 + +# Handling of arguments. +for ac_config_target in $ac_config_targets +do + case $ac_config_target in + "Makefile") CONFIG_FILES="$CONFIG_FILES Makefile" ;; + "pkgIndex.tcl") CONFIG_FILES="$CONFIG_FILES pkgIndex.tcl" ;; + + *) as_fn_error $? "invalid argument: \`$ac_config_target'" "$LINENO" 5;; + esac +done + + +# If the user did not use the arguments to specify the items to instantiate, +# then the envvar interface is used. Set only those that are not. +# We use the long form for the default assignment because of an extremely +# bizarre bug on SunOS 4.1.3. +if $ac_need_defaults; then + test "${CONFIG_FILES+set}" = set || CONFIG_FILES=$config_files +fi + +# Have a temporary directory for convenience. Make it in the build tree +# simply because there is no reason against having it here, and in addition, +# creating and moving files from /tmp can sometimes cause problems. +# Hook for its removal unless debugging. +# Note that there is a small window in which the directory will not be cleaned: +# after its creation but before its name has been assigned to `$tmp'. +$debug || +{ + tmp= ac_tmp= + trap 'exit_status=$? + : "${ac_tmp:=$tmp}" + { test ! -d "$ac_tmp" || rm -fr "$ac_tmp"; } && exit $exit_status +' 0 + trap 'as_fn_exit 1' 1 2 13 15 +} +# Create a (secure) tmp directory for tmp files. + +{ + tmp=`(umask 077 && mktemp -d "./confXXXXXX") 2>/dev/null` && + test -d "$tmp" +} || +{ + tmp=./conf$$-$RANDOM + (umask 077 && mkdir "$tmp") +} || as_fn_error $? "cannot create a temporary directory in ." "$LINENO" 5 +ac_tmp=$tmp + +# Set up the scripts for CONFIG_FILES section. +# No need to generate them if there are no CONFIG_FILES. +# This happens for instance with `./config.status config.h'. +if test -n "$CONFIG_FILES"; then + + +ac_cr=`echo X | tr X '\015'` +# On cygwin, bash can eat \r inside `` if the user requested igncr. +# But we know of no other shell where ac_cr would be empty at this +# point, so we can use a bashism as a fallback. +if test "x$ac_cr" = x; then + eval ac_cr=\$\'\\r\' +fi +ac_cs_awk_cr=`$AWK 'BEGIN { print "a\rb" }' </dev/null 2>/dev/null` +if test "$ac_cs_awk_cr" = "a${ac_cr}b"; then + ac_cs_awk_cr='\\r' +else + ac_cs_awk_cr=$ac_cr +fi + +echo 'BEGIN {' >"$ac_tmp/subs1.awk" && +_ACEOF + + +{ + echo "cat >conf$$subs.awk <<_ACEOF" && + echo "$ac_subst_vars" | sed 's/.*/&!$&$ac_delim/' && + echo "_ACEOF" +} >conf$$subs.sh || + as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5 +ac_delim_num=`echo "$ac_subst_vars" | grep -c '^'` +ac_delim='%!_!# ' +for ac_last_try in false false false false false :; do + . ./conf$$subs.sh || + as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5 + + ac_delim_n=`sed -n "s/.*$ac_delim\$/X/p" conf$$subs.awk | grep -c X` + if test $ac_delim_n = $ac_delim_num; then + break + elif $ac_last_try; then + as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5 + else + ac_delim="$ac_delim!$ac_delim _$ac_delim!! " + fi +done +rm -f conf$$subs.sh + +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +cat >>"\$ac_tmp/subs1.awk" <<\\_ACAWK && +_ACEOF +sed -n ' +h +s/^/S["/; s/!.*/"]=/ +p +g +s/^[^!]*!// +:repl +t repl +s/'"$ac_delim"'$// +t delim +:nl +h +s/\(.\{148\}\)..*/\1/ +t more1 +s/["\\]/\\&/g; s/^/"/; s/$/\\n"\\/ +p +n +b repl +:more1 +s/["\\]/\\&/g; s/^/"/; s/$/"\\/ +p +g +s/.\{148\}// +t nl +:delim +h +s/\(.\{148\}\)..*/\1/ +t more2 +s/["\\]/\\&/g; s/^/"/; s/$/"/ +p +b +:more2 +s/["\\]/\\&/g; s/^/"/; s/$/"\\/ +p +g +s/.\{148\}// +t delim +' <conf$$subs.awk | sed ' +/^[^""]/{ + N + s/\n// +} +' >>$CONFIG_STATUS || ac_write_fail=1 +rm -f conf$$subs.awk +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +_ACAWK +cat >>"\$ac_tmp/subs1.awk" <<_ACAWK && + for (key in S) S_is_set[key] = 1 + FS = "" + +} +{ + line = $ 0 + nfields = split(line, field, "@") + substed = 0 + len = length(field[1]) + for (i = 2; i < nfields; i++) { + key = field[i] + keylen = length(key) + if (S_is_set[key]) { + value = S[key] + line = substr(line, 1, len) "" value "" substr(line, len + keylen + 3) + len += length(value) + length(field[++i]) + substed = 1 + } else + len += 1 + keylen + } + + print line +} + +_ACAWK +_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +if sed "s/$ac_cr//" < /dev/null > /dev/null 2>&1; then + sed "s/$ac_cr\$//; s/$ac_cr/$ac_cs_awk_cr/g" +else + cat +fi < "$ac_tmp/subs1.awk" > "$ac_tmp/subs.awk" \ + || as_fn_error $? "could not setup config files machinery" "$LINENO" 5 +_ACEOF + +# VPATH may cause trouble with some makes, so we remove sole $(srcdir), +# ${srcdir} and @srcdir@ entries from VPATH if srcdir is ".", strip leading and +# trailing colons and then remove the whole line if VPATH becomes empty +# (actually we leave an empty line to preserve line numbers). +if test "x$srcdir" = x.; then + ac_vpsub='/^[ ]*VPATH[ ]*=[ ]*/{ +h +s/// +s/^/:/ +s/[ ]*$/:/ +s/:\$(srcdir):/:/g +s/:\${srcdir}:/:/g +s/:@srcdir@:/:/g +s/^:*// +s/:*$// +x +s/\(=[ ]*\).*/\1/ +G +s/\n// +s/^[^=]*=[ ]*$// +}' +fi + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +fi # test -n "$CONFIG_FILES" + + +eval set X " :F $CONFIG_FILES " +shift +for ac_tag +do + case $ac_tag in + :[FHLC]) ac_mode=$ac_tag; continue;; + esac + case $ac_mode$ac_tag in + :[FHL]*:*);; + :L* | :C*:*) as_fn_error $? "invalid tag \`$ac_tag'" "$LINENO" 5;; + :[FH]-) ac_tag=-:-;; + :[FH]*) ac_tag=$ac_tag:$ac_tag.in;; + esac + ac_save_IFS=$IFS + IFS=: + set x $ac_tag + IFS=$ac_save_IFS + shift + ac_file=$1 + shift + + case $ac_mode in + :L) ac_source=$1;; + :[FH]) + ac_file_inputs= + for ac_f + do + case $ac_f in + -) ac_f="$ac_tmp/stdin";; + *) # Look for the file first in the build tree, then in the source tree + # (if the path is not absolute). The absolute path cannot be DOS-style, + # because $ac_f cannot contain `:'. + test -f "$ac_f" || + case $ac_f in + [\\/$]*) false;; + *) test -f "$srcdir/$ac_f" && ac_f="$srcdir/$ac_f";; + esac || + as_fn_error 1 "cannot find input file: \`$ac_f'" "$LINENO" 5;; + esac + case $ac_f in *\'*) ac_f=`$as_echo "$ac_f" | sed "s/'/'\\\\\\\\''/g"`;; esac + as_fn_append ac_file_inputs " '$ac_f'" + done + + # Let's still pretend it is `configure' which instantiates (i.e., don't + # use $as_me), people would be surprised to read: + # /* config.h. Generated by config.status. */ + configure_input='Generated from '` + $as_echo "$*" | sed 's|^[^:]*/||;s|:[^:]*/|, |g' + `' by configure.' + if test x"$ac_file" != x-; then + configure_input="$ac_file. $configure_input" + { $as_echo "$as_me:${as_lineno-$LINENO}: creating $ac_file" >&5 +$as_echo "$as_me: creating $ac_file" >&6;} + fi + # Neutralize special characters interpreted by sed in replacement strings. + case $configure_input in #( + *\&* | *\|* | *\\* ) + ac_sed_conf_input=`$as_echo "$configure_input" | + sed 's/[\\\\&|]/\\\\&/g'`;; #( + *) ac_sed_conf_input=$configure_input;; + esac + + case $ac_tag in + *:-:* | *:-) cat >"$ac_tmp/stdin" \ + || as_fn_error $? "could not create $ac_file" "$LINENO" 5 ;; + esac + ;; + esac + + ac_dir=`$as_dirname -- "$ac_file" || +$as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$ac_file" : 'X\(//\)[^/]' \| \ + X"$ac_file" : 'X\(//\)$' \| \ + X"$ac_file" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X"$ac_file" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ + s//\1/ + q + } + /^X\(\/\/\)[^/].*/{ + s//\1/ + q + } + /^X\(\/\/\)$/{ + s//\1/ + q + } + /^X\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + as_dir="$ac_dir"; as_fn_mkdir_p + ac_builddir=. + +case "$ac_dir" in +.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;; +*) + ac_dir_suffix=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'` + # A ".." for each directory in $ac_dir_suffix. + ac_top_builddir_sub=`$as_echo "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'` + case $ac_top_builddir_sub in + "") ac_top_builddir_sub=. ac_top_build_prefix= ;; + *) ac_top_build_prefix=$ac_top_builddir_sub/ ;; + esac ;; +esac +ac_abs_top_builddir=$ac_pwd +ac_abs_builddir=$ac_pwd$ac_dir_suffix +# for backward compatibility: +ac_top_builddir=$ac_top_build_prefix + +case $srcdir in + .) # We are building in place. + ac_srcdir=. + ac_top_srcdir=$ac_top_builddir_sub + ac_abs_top_srcdir=$ac_pwd ;; + [\\/]* | ?:[\\/]* ) # Absolute name. + ac_srcdir=$srcdir$ac_dir_suffix; + ac_top_srcdir=$srcdir + ac_abs_top_srcdir=$srcdir ;; + *) # Relative name. + ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix + ac_top_srcdir=$ac_top_build_prefix$srcdir + ac_abs_top_srcdir=$ac_pwd/$srcdir ;; +esac +ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix + + + case $ac_mode in + :F) + # + # CONFIG_FILE + # + +_ACEOF + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +# If the template does not know about datarootdir, expand it. +# FIXME: This hack should be removed a few years after 2.60. +ac_datarootdir_hack=; ac_datarootdir_seen= +ac_sed_dataroot=' +/datarootdir/ { + p + q +} +/@datadir@/p +/@docdir@/p +/@infodir@/p +/@localedir@/p +/@mandir@/p' +case `eval "sed -n \"\$ac_sed_dataroot\" $ac_file_inputs"` in +*datarootdir*) ac_datarootdir_seen=yes;; +*@datadir@*|*@docdir@*|*@infodir@*|*@localedir@*|*@mandir@*) + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&5 +$as_echo "$as_me: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&2;} +_ACEOF +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 + ac_datarootdir_hack=' + s&@datadir@&$datadir&g + s&@docdir@&$docdir&g + s&@infodir@&$infodir&g + s&@localedir@&$localedir&g + s&@mandir@&$mandir&g + s&\\\${datarootdir}&$datarootdir&g' ;; +esac +_ACEOF + +# Neutralize VPATH when `$srcdir' = `.'. +# Shell code in configure.ac might set extrasub. +# FIXME: do we really want to maintain this feature? +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +ac_sed_extra="$ac_vpsub +$extrasub +_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +:t +/@[a-zA-Z_][a-zA-Z_0-9]*@/!b +s|@configure_input@|$ac_sed_conf_input|;t t +s&@top_builddir@&$ac_top_builddir_sub&;t t +s&@top_build_prefix@&$ac_top_build_prefix&;t t +s&@srcdir@&$ac_srcdir&;t t +s&@abs_srcdir@&$ac_abs_srcdir&;t t +s&@top_srcdir@&$ac_top_srcdir&;t t +s&@abs_top_srcdir@&$ac_abs_top_srcdir&;t t +s&@builddir@&$ac_builddir&;t t +s&@abs_builddir@&$ac_abs_builddir&;t t +s&@abs_top_builddir@&$ac_abs_top_builddir&;t t +$ac_datarootdir_hack +" +eval sed \"\$ac_sed_extra\" "$ac_file_inputs" | $AWK -f "$ac_tmp/subs.awk" \ + >$ac_tmp/out || as_fn_error $? "could not create $ac_file" "$LINENO" 5 + +test -z "$ac_datarootdir_hack$ac_datarootdir_seen" && + { ac_out=`sed -n '/\${datarootdir}/p' "$ac_tmp/out"`; test -n "$ac_out"; } && + { ac_out=`sed -n '/^[ ]*datarootdir[ ]*:*=/p' \ + "$ac_tmp/out"`; test -z "$ac_out"; } && + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file contains a reference to the variable \`datarootdir' +which seems to be undefined. Please make sure it is defined" >&5 +$as_echo "$as_me: WARNING: $ac_file contains a reference to the variable \`datarootdir' +which seems to be undefined. Please make sure it is defined" >&2;} + + rm -f "$ac_tmp/stdin" + case $ac_file in + -) cat "$ac_tmp/out" && rm -f "$ac_tmp/out";; + *) rm -f "$ac_file" && mv "$ac_tmp/out" "$ac_file";; + esac \ + || as_fn_error $? "could not create $ac_file" "$LINENO" 5 + ;; + + + + esac + +done # for ac_tag + + +as_fn_exit 0 +_ACEOF +ac_clean_files=$ac_clean_files_save + +test $ac_write_fail = 0 || + as_fn_error $? "write failure creating $CONFIG_STATUS" "$LINENO" 5 + + +# configure is writing to config.log, and then calls config.status. +# config.status does its own redirection, appending to config.log. +# Unfortunately, on DOS this fails, as config.log is still kept open +# by configure, so config.status won't be able to write to it; its +# output is simply discarded. So we exec the FD to /dev/null, +# effectively closing config.log, so it can be properly (re)opened and +# appended to by config.status. When coming back to configure, we +# need to make the FD available again. +if test "$no_create" != yes; then + ac_cs_success=: + ac_config_status_args= + test "$silent" = yes && + ac_config_status_args="$ac_config_status_args --quiet" + exec 5>/dev/null + $SHELL $CONFIG_STATUS $ac_config_status_args || ac_cs_success=false + exec 5>>config.log + # Use ||, not &&, to avoid exiting from the if with $? = 1, which + # would make configure fail if this is the last instruction. + $ac_cs_success || as_fn_exit 1 +fi +if test -n "$ac_unrecognized_opts" && test "$enable_option_checking" != no; then + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: unrecognized options: $ac_unrecognized_opts" >&5 +$as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2;} +fi + diff --git a/tcl8.6/pkgs/thread2.8.4/configure.ac b/tcl8.6/pkgs/thread2.8.4/configure.ac new file mode 100644 index 0000000..059a45c --- /dev/null +++ b/tcl8.6/pkgs/thread2.8.4/configure.ac @@ -0,0 +1,229 @@ +#!/bin/bash -norc +dnl This file is an input file used by the GNU "autoconf" program to +dnl generate the file "configure", which is run during Tcl installation +dnl to configure the system for the local environment. + +#----------------------------------------------------------------------- +# Sample configure.ac for Tcl Extensions. The only places you should +# need to modify this file are marked by the string __CHANGE__ +#----------------------------------------------------------------------- + +#----------------------------------------------------------------------- +# __CHANGE__ +# Set your package name and version numbers here. +# +# This initializes the environment with PACKAGE_NAME and PACKAGE_VERSION +# set as provided. These will also be added as -D defs in your Makefile +# so you can encode the package version directly into the source files. +#----------------------------------------------------------------------- + +AC_INIT([thread], [2.8.4]) + +#-------------------------------------------------------------------- +# Call TEA_INIT as the first TEA_ macro to set up initial vars. +# This will define a ${TEA_PLATFORM} variable == "unix" or "windows" +# as well as PKG_LIB_FILE and PKG_STUB_LIB_FILE. +#-------------------------------------------------------------------- + +TEA_INIT() + +AC_CONFIG_AUX_DIR(tclconfig) + +#-------------------------------------------------------------------- +# Load the tclConfig.sh file +#-------------------------------------------------------------------- + +TEA_PATH_TCLCONFIG +TEA_LOAD_TCLCONFIG + +if test "${TCL_MAJOR_VERSION}" -ne 8 ; then + AC_MSG_ERROR([${PACKAGE_NAME} ${PACKAGE_VERSION} requires Tcl 8.4+ +Found config for Tcl ${TCL_VERSION}]) +fi +if test "${TCL_MINOR_VERSION}" -lt 4 ; then + AC_MSG_ERROR([${PACKAGE_NAME} ${PACKAGE_VERSION} requires Tcl 8.4+ +Found config for Tcl ${TCL_VERSION}]) +fi + +#-------------------------------------------------------------------- +# Load the tkConfig.sh file if necessary (Tk extension) +#-------------------------------------------------------------------- + +#TEA_PATH_TKCONFIG +#TEA_LOAD_TKCONFIG + +#----------------------------------------------------------------------- +# Handle the --prefix=... option by defaulting to what Tcl gave. +# Must be called after TEA_LOAD_TCLCONFIG and before TEA_SETUP_COMPILER. +#----------------------------------------------------------------------- + +TEA_PREFIX + +#----------------------------------------------------------------------- +# Standard compiler checks. +# This sets up CC by using the CC env var, or looks for gcc otherwise. +# This also calls AC_PROG_CC and a few others to create the basic setup +# necessary to compile executables. +#----------------------------------------------------------------------- + +TEA_SETUP_COMPILER + +#-------------------------------------------------------------------- +# Check if building with optional Gdbm package. This will declare +# GDBM_CFLAGS and GDBM_LIBS variables. +#-------------------------------------------------------------------- + +TCLTHREAD_WITH_GDBM + +#-------------------------------------------------------------------- +# Check if building with optional lmdb package. This will declare +# LMDB_CFLAGS and LMDB_LIBS variables. +#-------------------------------------------------------------------- + +TCLTHREAD_WITH_LMDB + +#-------------------------------------------------------------------- +# Locate the NaviServer/AOLserver dir for compilation as NaviServer/AOLserver module. +# This will declare NS_INCLUDES, NS_LIBS and define NS_AOLSERVER. +#-------------------------------------------------------------------- + +NS_PATH_AOLSERVER + +#----------------------------------------------------------------------- +# __CHANGE__ +# Specify the C source files to compile in TEA_ADD_SOURCES, +# public headers that need to be installed in TEA_ADD_HEADERS, +# stub library C source files to compile in TEA_ADD_STUB_SOURCES, +# and runtime Tcl library files in TEA_ADD_TCL_SOURCES. +# This defines PKG(_STUB)_SOURCES, PKG(_STUB)_OBJECTS, PKG_HEADERS +# and PKG_TCL_SOURCES. +#----------------------------------------------------------------------- + +TEA_ADD_SOURCES([generic/threadNs.c \ + generic/threadCmd.c \ + generic/threadSvCmd.c \ + generic/threadSpCmd.c \ + generic/threadPoolCmd.c \ + generic/psGdbm.c \ + generic/psLmdb.c \ + generic/threadSvListCmd.c \ + generic/threadSvKeylistCmd.c \ + generic/tclXkeylist.c \ +]) + +TEA_ADD_HEADERS([generic/tclThread.h]) +TEA_ADD_INCLUDES([${NS_INCLUDES}]) +TEA_ADD_LIBS([${GDBM_LIBS} ${LMDB_LIBS} ${NS_LIBS}]) +TEA_ADD_CFLAGS([${GDBM_CFLAGS} ${LMDB_CFLAGS}]) +TEA_ADD_STUB_SOURCES([]) +TEA_ADD_TCL_SOURCES([lib/ttrace.tcl]) + +#-------------------------------------------------------------------- +# __CHANGE__ +# A few miscellaneous platform-specific items: +# +# Define a special symbol for Windows (BUILD_sample in this case) so +# that we create the export library with the dll. +# +# Windows creates a few extra files that need to be cleaned up. +# You can add more files to clean if your extension creates any extra +# files. +# +# TEA_ADD_* any platform specific compiler/build info here. +#-------------------------------------------------------------------- + +if test "${TEA_PLATFORM}" = "windows" ; then + TEA_ADD_SOURCES([win/threadWin.c]) + TEA_ADD_INCLUDES([-I\"$(${CYGPATH} ${srcdir}/win)\"]) +else + TEA_ADD_SOURCES([unix/threadUnix.c]) +fi + +#-------------------------------------------------------------------- +# __CHANGE__ +# Choose which headers you need. Extension authors should try very +# hard to only rely on the Tcl public header files. Internal headers +# contain private data structures and are subject to change without +# notice. +# This MUST be called after TEA_LOAD_TCLCONFIG / TEA_LOAD_TKCONFIG +#-------------------------------------------------------------------- + +TEA_PUBLIC_TCL_HEADERS +#TEA_PRIVATE_TCL_HEADERS + +#TEA_PUBLIC_TK_HEADERS +#TEA_PRIVATE_TK_HEADERS +#TEA_PATH_X + +#-------------------------------------------------------------------- +# Check whether --enable-threads or --disable-threads was given. +# This auto-enables if Tcl was compiled threaded. +#-------------------------------------------------------------------- + +TEA_ENABLE_THREADS + +#-------------------------------------------------------------------- +# The statement below defines a collection of symbols related to +# building as a shared library instead of a static library. +#-------------------------------------------------------------------- + +TEA_ENABLE_SHARED + +#-------------------------------------------------------------------- +# This macro figures out what flags to use with the compiler/linker +# when building shared/static debug/optimized objects. This information +# can be taken from the tclConfig.sh file, but this figures it all out. +#-------------------------------------------------------------------- + +TEA_CONFIG_CFLAGS + +#-------------------------------------------------------------------- +# Set the default compiler switches based on the --enable-symbols option. +#-------------------------------------------------------------------- + +TEA_ENABLE_SYMBOLS + +#-------------------------------------------------------------------- +# Everyone should be linking against the Tcl stub library. If you +# can't for some reason, remove this definition. If you aren't using +# stubs, you also need to modify the SHLIB_LD_LIBS setting below to +# link against the non-stubbed Tcl library. Add Tk too if necessary. +#-------------------------------------------------------------------- + +AC_DEFINE(USE_TCL_STUBS, 1, [Use Tcl stubs]) + +#-------------------------------------------------------------------- +# Enable compile-time support for TIP #143 and TIP #285. When using +# a pre-Tcl 8.5 or 8.6 core, respectively, the actual functionality +# will not be available at runtime. +#-------------------------------------------------------------------- + +AC_DEFINE(TCL_TIP143, 1, [Enable TIP #143 support]) +AC_DEFINE(TCL_TIP285, 1, [Enable TIP #285 support]) + +#-------------------------------------------------------------------- +# This macro generates a line to use when building a library. It +# depends on values set by the TEA_ENABLE_SHARED, TEA_ENABLE_SYMBOLS, +# and TEA_LOAD_TCLCONFIG macros above. +#-------------------------------------------------------------------- + +TEA_MAKE_LIB + +#-------------------------------------------------------------------- +# Determine the name of the tclsh and/or wish executables in the +# Tcl and Tk build directories or the location they were installed +# into. These paths are used to support running test cases only, +# the Makefile should not be making use of these paths to generate +# a pkgIndex.tcl file or anything else at extension build time. +#-------------------------------------------------------------------- + +TEA_PROG_TCLSH +#TEA_PROG_WISH + +#-------------------------------------------------------------------- +# Finally, substitute all of the various values into the Makefile. +# You may alternatively have a special pkgIndex.tcl.in or other files +# which require substituting th AC variables in. Include these here. +#-------------------------------------------------------------------- + +AC_OUTPUT([Makefile pkgIndex.tcl]) diff --git a/tcl8.6/pkgs/thread2.8.4/doc/format.tcl b/tcl8.6/pkgs/thread2.8.4/doc/format.tcl new file mode 100644 index 0000000..394c462 --- /dev/null +++ b/tcl8.6/pkgs/thread2.8.4/doc/format.tcl @@ -0,0 +1,35 @@ +#!/usr/local/bin/tclsh +set mydir [file dirname [info script]] +lappend auto_path /usr/local/lib +package req doctools +doctools::new dt +set wd [pwd] +cd $mydir +file rename html htm +set code [catch { + set f [open man.macros] + set m [read $f] + close $f + foreach file [glob -nocomplain *.man] { + set xx [file root $file] + set f [open $xx.man] + set t [read $f] + close $f + foreach {fmt ext dir} {nroff n man html html htm} { + dt configure -format $fmt + set o [dt format $t] + set f [open $dir/$xx.$ext w] + if {$fmt == "nroff"} { + set o [string map [list {.so man.macros} $m] $o] + } + puts $f $o + close $f + } + } +} err] +file rename htm html +cd $wd +if {$code} { + error $err +} +exit 0 diff --git a/tcl8.6/pkgs/thread2.8.4/doc/html/thread.html b/tcl8.6/pkgs/thread2.8.4/doc/html/thread.html new file mode 100644 index 0000000..6e89dfc --- /dev/null +++ b/tcl8.6/pkgs/thread2.8.4/doc/html/thread.html @@ -0,0 +1,604 @@ + +<html><head> +<title>thread - Tcl Threading</title> +<style type="text/css"><!-- + HTML { + background: #FFFFFF; + color: black; + } + BODY { + background: #FFFFFF; + color: black; + } + DIV.doctools { + margin-left: 10%; + margin-right: 10%; + } + DIV.doctools H1,DIV.doctools H2 { + margin-left: -5%; + } + H1, H2, H3, H4 { + margin-top: 1em; + font-family: sans-serif; + font-size: large; + color: #005A9C; + background: transparent; + text-align: left; + } + H1.doctools_title { + text-align: center; + } + UL,OL { + margin-right: 0em; + margin-top: 3pt; + margin-bottom: 3pt; + } + UL LI { + list-style: disc; + } + OL LI { + list-style: decimal; + } + DT { + padding-top: 1ex; + } + UL.doctools_toc,UL.doctools_toc UL, UL.doctools_toc UL UL { + font: normal 12pt/14pt sans-serif; + list-style: none; + } + LI.doctools_section, LI.doctools_subsection { + list-style: none; + margin-left: 0em; + text-indent: 0em; + padding: 0em; + } + PRE { + display: block; + font-family: monospace; + white-space: pre; + margin: 0%; + padding-top: 0.5ex; + padding-bottom: 0.5ex; + padding-left: 1ex; + padding-right: 1ex; + width: 100%; + } + PRE.doctools_example { + color: black; + background: #f5dcb3; + border: 1px solid black; + } + UL.doctools_requirements LI, UL.doctools_syntax LI { + list-style: none; + margin-left: 0em; + text-indent: 0em; + padding: 0em; + } + DIV.doctools_synopsis { + color: black; + background: #80ffff; + border: 1px solid black; + font-family: serif; + margin-top: 1em; + margin-bottom: 1em; + } + UL.doctools_syntax { + margin-top: 1em; + border-top: 1px solid black; + } + UL.doctools_requirements { + margin-bottom: 1em; + border-bottom: 1px solid black; + } +--></style> +</head> +<! -- Generated from file '' by tcllib/doctools with format 'html' + --> +<! -- thread.n + --> +<body><div class="doctools"> +<h1 class="doctools_title">thread(n) 2.8 "Tcl Threading"</h1> +<div id="name" class="doctools_section"><h2><a name="name">Name</a></h2> +<p>thread - Extension for script access to Tcl threading</p> +</div> +<div id="toc" class="doctools_section"><h2><a name="toc">Table Of Contents</a></h2> +<ul class="doctools_toc"> +<li class="doctools_section"><a href="#toc">Table Of Contents</a></li> +<li class="doctools_section"><a href="#synopsis">Synopsis</a></li> +<li class="doctools_section"><a href="#section1">Description</a></li> +<li class="doctools_section"><a href="#section2">COMMANDS</a></li> +<li class="doctools_section"><a href="#section3">DISCUSSION</a></li> +<li class="doctools_section"><a href="#see-also">See Also</a></li> +<li class="doctools_section"><a href="#keywords">Keywords</a></li> +</ul> +</div> +<div id="synopsis" class="doctools_section"><h2><a name="synopsis">Synopsis</a></h2> +<div class="doctools_synopsis"> +<ul class="doctools_requirements"> +<li>package require <b class="pkgname">Tcl 8.4</b></li> +<li>package require <b class="pkgname">Thread <span class="opt">?2.8?</span></b></li> +</ul> +<ul class="doctools_syntax"> +<li><a href="#1"><b class="cmd">thread::create</b> <span class="opt">?-joinable?</span> <span class="opt">?-preserved?</span> <span class="opt">?script?</span></a></li> +<li><a href="#2"><b class="cmd">thread::preserve</b> <span class="opt">?id?</span></a></li> +<li><a href="#3"><b class="cmd">thread::release</b> <span class="opt">?-wait?</span> <span class="opt">?id?</span></a></li> +<li><a href="#4"><b class="cmd">thread::id</b></a></li> +<li><a href="#5"><b class="cmd">thread::errorproc</b> <span class="opt">?procname?</span></a></li> +<li><a href="#6"><b class="cmd">thread::cancel</b> <span class="opt">?-unwind?</span> <i class="arg">id</i> <span class="opt">?result?</span></a></li> +<li><a href="#7"><b class="cmd">thread::unwind</b></a></li> +<li><a href="#8"><b class="cmd">thread::exit</b> <span class="opt">?status?</span></a></li> +<li><a href="#9"><b class="cmd">thread::names</b></a></li> +<li><a href="#10"><b class="cmd">thread::exists</b> <i class="arg">id</i></a></li> +<li><a href="#11"><b class="cmd">thread::send</b> <span class="opt">?-async?</span> <span class="opt">?-head?</span> <i class="arg">id</i> <i class="arg">script</i> <span class="opt">?varname?</span></a></li> +<li><a href="#12"><b class="cmd">thread::broadcast</b> <i class="arg">script</i></a></li> +<li><a href="#13"><b class="cmd">thread::wait</b></a></li> +<li><a href="#14"><b class="cmd">thread::eval</b> <span class="opt">?-lock mutex?</span> <i class="arg">arg</i> <span class="opt">?arg ...?</span></a></li> +<li><a href="#15"><b class="cmd">thread::join</b> <i class="arg">id</i></a></li> +<li><a href="#16"><b class="cmd">thread::configure</b> <i class="arg">id</i> <span class="opt">?option?</span> <span class="opt">?value?</span> <span class="opt">?...?</span></a></li> +<li><a href="#17"><b class="cmd">thread::transfer</b> <i class="arg">id</i> <i class="arg">channel</i></a></li> +<li><a href="#18"><b class="cmd">thread::detach</b> <i class="arg">channel</i></a></li> +<li><a href="#19"><b class="cmd">thread::attach</b> <i class="arg">channel</i></a></li> +<li><a href="#20"><b class="cmd">thread::mutex</b></a></li> +<li><a href="#21"><b class="cmd">thread::mutex</b> <b class="method">create</b> <span class="opt">?-recursive?</span></a></li> +<li><a href="#22"><b class="cmd">thread::mutex</b> <b class="method">destroy</b> <i class="arg">mutex</i></a></li> +<li><a href="#23"><b class="cmd">thread::mutex</b> <b class="method">lock</b> <i class="arg">mutex</i></a></li> +<li><a href="#24"><b class="cmd">thread::mutex</b> <b class="method">unlock</b> <i class="arg">mutex</i></a></li> +<li><a href="#25"><b class="cmd">thread::rwmutex</b></a></li> +<li><a href="#26"><b class="cmd">thread::rwmutex</b> <b class="method">create</b></a></li> +<li><a href="#27"><b class="cmd">thread::rwmutex</b> <b class="method">destroy</b> <i class="arg">mutex</i></a></li> +<li><a href="#28"><b class="cmd">thread::rwmutex</b> <b class="method">rlock</b> <i class="arg">mutex</i></a></li> +<li><a href="#29"><b class="cmd">thread::rwmutex</b> <b class="method">wlock</b> <i class="arg">mutex</i></a></li> +<li><a href="#30"><b class="cmd">thread::rwmutex</b> <b class="method">unlock</b> <i class="arg">mutex</i></a></li> +<li><a href="#31"><b class="cmd">thread::cond</b></a></li> +<li><a href="#32"><b class="cmd">thread::cond</b> <b class="method">create</b></a></li> +<li><a href="#33"><b class="cmd">thread::cond</b> <b class="method">destroy</b> <i class="arg">cond</i></a></li> +<li><a href="#34"><b class="cmd">thread::cond</b> <b class="method">notify</b> <i class="arg">cond</i></a></li> +<li><a href="#35"><b class="cmd">thread::cond</b> <b class="method">wait</b> <i class="arg">cond</i> <i class="arg">mutex</i> <span class="opt">?ms?</span></a></li> +</ul> +</div> +</div> +<div id="section1" class="doctools_section"><h2><a name="section1">Description</a></h2> +<p>The <b class="package">thread</b> extension creates threads that contain Tcl +interpreters, and it lets you send scripts to those threads for +evaluation. +Additionaly, it provides script-level access to basic thread +synchronization primitives, like mutexes and condition variables.</p> +</div> +<div id="section2" class="doctools_section"><h2><a name="section2">COMMANDS</a></h2> +<p>This section describes commands for creating and destroying threads +and sending scripts to threads for evaluation.</p> +<dl class="doctools_definitions"> +<dt><a name="1"><b class="cmd">thread::create</b> <span class="opt">?-joinable?</span> <span class="opt">?-preserved?</span> <span class="opt">?script?</span></a></dt> +<dd><p>This command creates a thread that contains a Tcl interpreter. +The Tcl interpreter either evaluates the optional <b class="option">script</b>, if +specified, or it waits in the event loop for scripts that arrive via +the <b class="cmd">thread::send</b> command. The result, if any, of the +optional <b class="option">script</b> is never returned to the caller. +The result of <b class="cmd">thread::create</b> is the ID of the thread. This is +the opaque handle which identifies the newly created thread for +all other package commands. The handle of the thread goes out of scope +automatically when thread is marked for exit +(see the <b class="cmd">thread::release</b> command below).</p> +<p>If the optional <b class="option">script</b> argument contains the <b class="cmd">thread::wait</b> +command the thread will enter into the event loop. If such command is not +found in the <b class="option">script</b> the thread will run the <b class="option">script</b> to +the end and exit. In that case, the handle may be safely ignored since it +refers to a thread which does not exists any more at the time when the +command returns.</p> +<p>Using flag <b class="option">-joinable</b> it is possible to create a joinable +thread, i.e. one upon whose exit can be waited upon by using +<b class="cmd">thread::join</b> command. +Note that failure to join a thread created with <b class="option">-joinable</b> flag +results in resource and memory leaks.</p> +<p>Threads created by the <b class="cmd">thread::create</b> cannot be destroyed +forcefully. Consequently, there is no corresponding thread destroy +command. A thread may only be released using the <b class="cmd">thread::release</b> +and if its internal reference count drops to zero, the thread is +marked for exit. This kicks the thread out of the event loop +servicing and the thread continues to execute commands passed in +the <b class="option">script</b> argument, following the <b class="cmd">thread::wait</b> +command. If this was the last command in the script, as usualy the +case, the thread will exit.</p> +<p>It is possible to create a situation in which it may be impossible +to terminate the thread, for example by putting some endless loop +after the <b class="cmd">thread::wait</b> or entering the event loop again by +doing an vwait-type of command. In such cases, the thread may never +exit. This is considered to be a bad practice and should be avoided +if possible. This is best illustrated by the example below:</p> +<pre class="doctools_example"> + # You should never do ... + set tid [thread::create { + package require Http + thread::wait + vwait forever ; # <-- this! + }] +</pre> +<p>The thread created in the above example will never be able to exit. +After it has been released with the last matching <b class="cmd">thread::release</b> +call, the thread will jump out of the <b class="cmd">thread::wait</b> and continue +to execute commands following. It will enter <b class="cmd">vwait</b> command and +wait endlessly for events. There is no way one can terminate such thread, +so you wouldn't want to do this!</p> +<p>Each newly created has its internal reference counter set to 0 (zero), +i.e. it is unreserved. This counter gets incremented by a call to +<b class="cmd">thread::preserve</b> and decremented by a call to <b class="cmd">thread::release</b> +command. These two commands implement simple but effective thread +reservation system and offer predictable and controllable thread +termination capabilities. It is however possible to create initialy +preserved threads by using flag <b class="option">-preserved</b> of the +<b class="cmd">thread::create</b> command. Threads created with this flag have the +initial value of the reference counter of 1 (one), and are thus +initially marked reserved.</p></dd> +<dt><a name="2"><b class="cmd">thread::preserve</b> <span class="opt">?id?</span></a></dt> +<dd><p>This command increments the thread reference counter. Each call +to this command increments the reference counter by one (1). +Command returns the value of the reference counter after the increment. +If called with the optional thread <b class="option">id</b>, the command preserves +the given thread. Otherwise the current thread is preserved.</p> +<p>With reference counting, one can implement controlled access to a +shared Tcl thread. By incrementing the reference counter, the +caller signalizes that he/she wishes to use the thread for a longer +period of time. By decrementing the counter, caller signalizes that +he/she has finished using the thread.</p></dd> +<dt><a name="3"><b class="cmd">thread::release</b> <span class="opt">?-wait?</span> <span class="opt">?id?</span></a></dt> +<dd><p>This command decrements the thread reference counter. Each call to +this command decrements the reference counter by one (1). +If called with the optional thread <b class="option">id</b>, the command releases +the given thread. Otherwise, the current thread is released. +Command returns the value of the reference counter after the decrement. +When the reference counter reaches zero (0), the target thread is +marked for termination. You should not reference the thread after the +<b class="cmd">thread::release</b> command returns zero or negative integer. +The handle of the thread goes out of scope and should not be used any +more. Any following reference to the same thread handle will result +in Tcl error.</p> +<p>Optional flag <b class="option">-wait</b> instructs the caller thread to wait for +the target thread to exit, if the effect of the command would result +in termination of the target thread, i.e. if the return result would +be zero (0). Without the flag, the caller thread does not wait for +the target thread to exit. Care must be taken when using the +<b class="option">-wait</b>, since this may block the caller thread indefinitely. +This option has been implemented for some special uses of the extension +and is deprecated for regular use. Regular users should create joinable +threads by using the <b class="option">-joinable</b> option of the <b class="cmd">thread::create</b> +command and the <b class="cmd">thread::join</b> to wait for thread to exit.</p></dd> +<dt><a name="4"><b class="cmd">thread::id</b></a></dt> +<dd><p>This command returns the ID of the current thread.</p></dd> +<dt><a name="5"><b class="cmd">thread::errorproc</b> <span class="opt">?procname?</span></a></dt> +<dd><p>This command sets a handler for errors that occur in scripts sent +asynchronously, using the <b class="option">-async</b> flag of the +<b class="cmd">thread::send</b> command, to other threads. If no handler +is specified, the current handler is returned. The empty string +resets the handler to default (unspecified) value. +An uncaught error in a thread causes an error message to be sent +to the standard error channel. This default reporting scheme can +be changed by registering a procedure which is called to report +the error. The <i class="arg">procname</i> is called in the interpreter that +invoked the <b class="cmd">thread::errorproc</b> command. The <i class="arg">procname</i> +is called like this:</p> +<pre class="doctools_example"> + myerrorproc thread_id errorInfo +</pre> +</dd> +<dt><a name="6"><b class="cmd">thread::cancel</b> <span class="opt">?-unwind?</span> <i class="arg">id</i> <span class="opt">?result?</span></a></dt> +<dd><p>This command requires Tcl version 8.6 or higher.</p> +<p>Cancels the script being evaluated in the thread given by the <i class="arg">id</i> +parameter. Without the <b class="option">-unwind</b> switch the evaluation stack for +the interpreter is unwound until an enclosing catch command is found or +there are no further invocations of the interpreter left on the call +stack. With the <b class="option">-unwind</b> switch the evaluation stack for the +interpreter is unwound without regard to any intervening catch command +until there are no further invocations of the interpreter left on the +call stack. If <i class="arg">result</i> is present, it will be used as the error +message string; otherwise, a default error message string will be used.</p></dd> +<dt><a name="7"><b class="cmd">thread::unwind</b></a></dt> +<dd><p>Use of this command is deprecated in favour of more advanced thread +reservation system implemented with <b class="cmd">thread::preserve</b> and +<b class="cmd">thread::release</b> commands. Support for <b class="cmd">thread::unwind</b> +command will dissapear in some future major release of the extension.</p> +<p>This command stops a prior <b class="cmd">thread::wait</b> command. Execution of +the script passed to newly created thread will continue from the +<b class="cmd">thread::wait</b> command. If <b class="cmd">thread::wait</b> was the last command +in the script, the thread will exit. The command returns empty result +but may trigger Tcl error with the message "target thread died" in some +situations.</p></dd> +<dt><a name="8"><b class="cmd">thread::exit</b> <span class="opt">?status?</span></a></dt> +<dd><p>Use of this command is deprecated in favour of more advanced thread +reservation system implemented with <b class="cmd">thread::preserve</b> and +<b class="cmd">thread::release</b> commands. Support for <b class="cmd">thread::exit</b> +command will dissapear in some future major release of the extension.</p> +<p>This command forces a thread stuck in the <b class="cmd">thread::wait</b> command to +unconditionaly exit. The thread's exit status defaults to 666 and can be +specified using the optional <i class="arg">status</i> argument. The execution of +<b class="cmd">thread::exit</b> command is guaranteed to leave the program memory in the +unconsistent state, produce memory leaks and otherwise affect other subsytem(s) +of the Tcl application in an unpredictable manner. The command returns empty +result but may trigger Tcl error with the message "target thread died" in some +situations.</p></dd> +<dt><a name="9"><b class="cmd">thread::names</b></a></dt> +<dd><p>This command returns a list of thread IDs. These are only for +threads that have been created via <b class="cmd">thread::create</b> command. +If your application creates other threads at the C level, they +are not reported by this command.</p></dd> +<dt><a name="10"><b class="cmd">thread::exists</b> <i class="arg">id</i></a></dt> +<dd><p>Returns true (1) if thread given by the <i class="arg">id</i> parameter exists, +false (0) otherwise. This applies only for threads that have +been created via <b class="cmd">thread::create</b> command.</p></dd> +<dt><a name="11"><b class="cmd">thread::send</b> <span class="opt">?-async?</span> <span class="opt">?-head?</span> <i class="arg">id</i> <i class="arg">script</i> <span class="opt">?varname?</span></a></dt> +<dd><p>This command passes a <i class="arg">script</i> to another thread and, optionally, +waits for the result. If the <b class="option">-async</b> flag is specified, the +command does not wait for the result and it returns empty string. +The target thread must enter it's event loop in order to receive +scripts sent via this command. This is done by default for threads +created without a startup script. Threads can enter the event loop +explicitly by calling <b class="cmd">thread::wait</b> or any other relevant Tcl/Tk +command, like <b class="cmd">update</b>, <b class="cmd">vwait</b>, etc.</p> +<p>Optional <b class="option">varname</b> specifies name of the variable to store +the result of the <i class="arg">script</i>. Without the <b class="option">-async</b> flag, +the command returns the evaluation code, similarily to the standard +Tcl <b class="cmd">catch</b> command. If, however, the <b class="option">-async</b> flag is +specified, the command returns immediately and caller can later +<b class="cmd">vwait</b> on <span class="opt">?varname?</span> to get the result of the passed <i class="arg">script</i></p> +<pre class="doctools_example"> + set t1 [thread::create] + set t2 [thread::create] + thread::send -async $t1 "set a 1" result + thread::send -async $t2 "set b 2" result + for {set i 0} {$i < 2} {incr i} { + vwait result + } +</pre> +<p>In the above example, two threads were fed work and both of them were +instructed to signalize the same variable "result" in the calling thread. +The caller entered the event loop twice to get both results. Note, +however, that the order of the received results may vary, depending on +the current system load, type of work done, etc, etc.</p> +<p>Many threads can simultaneously send scripts to the target thread for +execution. All of them are entered into the event queue of the target +thread and executed on the FIFO basis, intermingled with optional other +events pending in the event queue of the target thread. +Using the optional <span class="opt">?-head?</span> switch, scripts posted to the thread's +event queue can be placed on the head, instead on the tail of the queue, +thus being executed in the LIFO fashion.</p></dd> +<dt><a name="12"><b class="cmd">thread::broadcast</b> <i class="arg">script</i></a></dt> +<dd><p>This command passes a <i class="arg">script</i> to all threads created by the +package for execution. It does not wait for response from any of +the threads.</p></dd> +<dt><a name="13"><b class="cmd">thread::wait</b></a></dt> +<dd><p>This enters the event loop so a thread can receive messages from +the <b class="cmd">thread::send</b> command. This command should only be used +within the script passed to the <b class="cmd">thread::create</b>. It should +be the very last command in the script. If this is not the case, +the exiting thread will continue executing the script lines past +the <b class="cmd">thread::wait</b> which is usually not what you want and/or +expect.</p> +<pre class="doctools_example"> + set t1 [thread::create { + # + # Do some initialization work here + # + thread::wait ; # Enter the event loop + }] +</pre> +</dd> +<dt><a name="14"><b class="cmd">thread::eval</b> <span class="opt">?-lock mutex?</span> <i class="arg">arg</i> <span class="opt">?arg ...?</span></a></dt> +<dd><p>This command concatenates passed arguments and evaluates the +resulting script under the mutex protection. If no mutex is +specified by using the <span class="opt">?-lock mutex?</span> optional argument, +the internal static mutex is used.</p></dd> +<dt><a name="15"><b class="cmd">thread::join</b> <i class="arg">id</i></a></dt> +<dd><p>This command waits for the thread with ID <i class="arg">id</i> to exit and +then returns it's exit code. Errors will be returned for threads +which are not joinable or already waited upon by another thread. +Upon the join the handle of the thread has gone out of scope and +should not be used any more.</p></dd> +<dt><a name="16"><b class="cmd">thread::configure</b> <i class="arg">id</i> <span class="opt">?option?</span> <span class="opt">?value?</span> <span class="opt">?...?</span></a></dt> +<dd><p>This command configures various low-level aspects of the thread with +ID <i class="arg">id</i> in the similar way as the standard Tcl command +<b class="cmd">fconfigure</b> configures some Tcl channel options. Options currently +supported are: <b class="option">-eventmark</b> and <b class="option">-unwindonerror</b>.</p> +<p>The <b class="option">-eventmark</b> option, when set, limits the number of +asynchronously posted scripts to the thread event loop. +The <b class="cmd">thread::send -async</b> command will block until the number +of pending scripts in the event loop does not drop below the value +configured with <b class="option">-eventmark</b>. Default value for the +<b class="option">-eventmark</b> is 0 (zero) which effectively disables the checking, +i.e. allows for unlimited number of posted scripts.</p> +<p>The <b class="option">-unwindonerror</b> option, when set, causes the +target thread to unwind if the result of the script processing +resulted in error. Default value for the <b class="option">-unwindonerror</b> +is 0 (false), i.e. thread continues to process scripts after one +of the posted scripts fails.</p></dd> +<dt><a name="17"><b class="cmd">thread::transfer</b> <i class="arg">id</i> <i class="arg">channel</i></a></dt> +<dd><p>This moves the specified <i class="arg">channel</i> from the current thread +and interpreter to the main interpreter of the thread with the +given <i class="arg">id</i>. After the move the current interpreter has no +access to the channel any more, but the main interpreter of the +target thread will be able to use it from now on. +The command waits until the other thread has incorporated the +channel. Because of this it is possible to deadlock the +participating threads by commanding the other through a +synchronous <b class="cmd">thread::send</b> to transfer a channel to us. +This easily extends into longer loops of threads waiting for +each other. Other restrictions: the channel in question must +not be shared among multiple interpreters running in the +sending thread. This automatically excludes the special channels +for standard input, output and error.</p> +<p>Due to the internal Tcl core implementation and the restriction on +transferring shared channels, one has to take extra measures when +transferring socket channels created by accepting the connection +out of the <b class="cmd">socket</b> commands callback procedures:</p> +<pre class="doctools_example"> + socket -server _Accept 2200 + proc _Accept {s ipaddr port} { + after idle [list Accept $s $ipaddr $port] + } + proc Accept {s ipaddr port} { + set tid [thread::create] + thread::transfer $tid $s + } +</pre> +</dd> +<dt><a name="18"><b class="cmd">thread::detach</b> <i class="arg">channel</i></a></dt> +<dd><p>This detaches the specified <i class="arg">channel</i> from the current thread and +interpreter. After that, the current interpreter has no access to the +channel any more. The channel is in the parked state until some other +(or the same) thread attaches the channel again with <b class="cmd">thread::attach</b>. +Restrictions: same as for transferring shared channels with the +<b class="cmd">thread::transfer</b> command.</p></dd> +<dt><a name="19"><b class="cmd">thread::attach</b> <i class="arg">channel</i></a></dt> +<dd><p>This attaches the previously detached <i class="arg">channel</i> in the +current thread/interpreter. For already existing channels, +the command does nothing, i.e. it is not an error to attach the +same channel more than once. The first operation will actualy +perform the operation, while all subsequent operation will just +do nothing. Command throws error if the <i class="arg">channel</i> cannot be +found in the list of detached channels and/or in the current +interpreter.</p></dd> +<dt><a name="20"><b class="cmd">thread::mutex</b></a></dt> +<dd><p>Mutexes are most common thread synchronization primitives. +They are used to synchronize access from two or more threads to one or +more shared resources. This command provides script-level access to +exclusive and/or recursive mutexes. Exclusive mutexes can be locked +only once by one thread, while recursive mutexes can be locked many +times by the same thread. For recursive mutexes, number of lock and +unlock operations must match, otherwise, the mutex will never be +released, which would lead to various deadlock situations.</p> +<p>Care has to be taken when using mutexes in an multithreading program. +Improper use of mutexes may lead to various deadlock situations, +especially when using exclusive mutexes.</p> +<p>The <b class="cmd">thread::mutex</b> command supports following subcommands and options:</p> +<dl class="doctools_definitions"> +<dt><a name="21"><b class="cmd">thread::mutex</b> <b class="method">create</b> <span class="opt">?-recursive?</span></a></dt> +<dd><p>Creates the mutex and returns it's opaque handle. This handle +should be used for any future reference to the newly created mutex. +If no optional <span class="opt">?-recursive?</span> argument was specified, the command +creates the exclusive mutex. With the <span class="opt">?-recursive?</span> argument, +the command creates a recursive mutex.</p></dd> +<dt><a name="22"><b class="cmd">thread::mutex</b> <b class="method">destroy</b> <i class="arg">mutex</i></a></dt> +<dd><p>Destroys the <i class="arg">mutex</i>. Mutex should be in unlocked state before +the destroy attempt. If the mutex is locked, the command will throw +Tcl error.</p></dd> +<dt><a name="23"><b class="cmd">thread::mutex</b> <b class="method">lock</b> <i class="arg">mutex</i></a></dt> +<dd><p>Locks the <i class="arg">mutex</i>. Locking the exclusive mutex may throw Tcl +error if on attempt to lock the same mutex twice from the same +thread. If your program logic forces you to lock the same mutex +twice or more from the same thread (this may happen in recursive +procedure invocations) you should consider using the recursive mutexes.</p></dd> +<dt><a name="24"><b class="cmd">thread::mutex</b> <b class="method">unlock</b> <i class="arg">mutex</i></a></dt> +<dd><p>Unlocks the <i class="arg">mutex</i> so some other thread may lock it again. +Attempt to unlock the already unlocked mutex will throw Tcl error.</p></dd> +</dl></dd> +<dt><a name="25"><b class="cmd">thread::rwmutex</b></a></dt> +<dd><p>This command creates many-readers/single-writer mutexes. Reader/writer +mutexes allow you to serialize access to a shared resource more optimally. +In situations where a shared resource gets mostly read and seldom modified, +you might gain some performace by using reader/writer mutexes instead of +exclusive or recursive mutexes.</p> +<p>For reading the resource, thread should obtain a read lock on the resource. +Read lock is non-exclusive, meaning that more than one thread can +obtain a read lock to the same resource, without waiting on other readers. +For changing the resource, however, a thread must obtain a exclusive +write lock. This lock effectively blocks all threads from gaining the +read-lock while the resource is been modified by the writer thread. +Only after the write lock has been released, the resource may be read-locked +again.</p> +<p>The <b class="cmd">thread::rwmutex</b> command supports following subcommands and options:</p> +<dl class="doctools_definitions"> +<dt><a name="26"><b class="cmd">thread::rwmutex</b> <b class="method">create</b></a></dt> +<dd><p>Creates the reader/writer mutex and returns it's opaque handle. +This handle should be used for any future reference to the newly +created mutex.</p></dd> +<dt><a name="27"><b class="cmd">thread::rwmutex</b> <b class="method">destroy</b> <i class="arg">mutex</i></a></dt> +<dd><p>Destroys the reader/writer <i class="arg">mutex</i>. If the mutex is already locked, +attempt to destroy it will throw Tcl error.</p></dd> +<dt><a name="28"><b class="cmd">thread::rwmutex</b> <b class="method">rlock</b> <i class="arg">mutex</i></a></dt> +<dd><p>Locks the <i class="arg">mutex</i> for reading. More than one thread may read-lock +the same <i class="arg">mutex</i> at the same time.</p></dd> +<dt><a name="29"><b class="cmd">thread::rwmutex</b> <b class="method">wlock</b> <i class="arg">mutex</i></a></dt> +<dd><p>Locks the <i class="arg">mutex</i> for writing. Only one thread may write-lock +the same <i class="arg">mutex</i> at the same time. Attempt to write-lock same +<i class="arg">mutex</i> twice from the same thread will throw Tcl error.</p></dd> +<dt><a name="30"><b class="cmd">thread::rwmutex</b> <b class="method">unlock</b> <i class="arg">mutex</i></a></dt> +<dd><p>Unlocks the <i class="arg">mutex</i> so some other thread may lock it again. +Attempt to unlock already unlocked <i class="arg">mutex</i> will throw Tcl error.</p></dd> +</dl></dd> +<dt><a name="31"><b class="cmd">thread::cond</b></a></dt> +<dd><p>This command provides script-level access to condition variables. +A condition variable creates a safe environment for the program +to test some condition, sleep on it when false and be awakened +when it might have become true. A condition variable is always +used in the conjuction with an exclusive mutex. If you attempt +to use other type of mutex in conjuction with the condition +variable, a Tcl error will be thrown.</p> +<p>The command supports following subcommands and options:</p> +<dl class="doctools_definitions"> +<dt><a name="32"><b class="cmd">thread::cond</b> <b class="method">create</b></a></dt> +<dd><p>Creates the condition variable and returns it's opaque handle. +This handle should be used for any future reference to newly +created condition variable.</p></dd> +<dt><a name="33"><b class="cmd">thread::cond</b> <b class="method">destroy</b> <i class="arg">cond</i></a></dt> +<dd><p>Destroys condition variable <i class="arg">cond</i>. Extreme care has to be taken +that nobody is using (i.e. waiting on) the condition variable, +otherwise unexpected errors may happen.</p></dd> +<dt><a name="34"><b class="cmd">thread::cond</b> <b class="method">notify</b> <i class="arg">cond</i></a></dt> +<dd><p>Wakes up all threads waiting on the condition variable <i class="arg">cond</i>.</p></dd> +<dt><a name="35"><b class="cmd">thread::cond</b> <b class="method">wait</b> <i class="arg">cond</i> <i class="arg">mutex</i> <span class="opt">?ms?</span></a></dt> +<dd><p>This command is used to suspend program execution until the condition +variable <i class="arg">cond</i> has been signalled or the optional timer has expired. +The exclusive <i class="arg">mutex</i> must be locked by the calling thread on entrance +to this command. If the mutex is not locked, Tcl error is thrown. +While waiting on the <i class="arg">cond</i>, the command releases <i class="arg">mutex</i>. +Before returning to the calling thread, the command re-acquires the +<i class="arg">mutex</i> again. Unlocking the <i class="arg">mutex</i> and waiting on the +condition variable <i class="arg">cond</i> is done atomically.</p> +<p>The <b class="option">ms</b> command option, if given, must be an integer specifying +time interval in milliseconds the command waits to be signalled. +Otherwise the command waits on condition notify forever.</p> +<p>In multithreading programs, there are many situations where a thread has +to wait for some event to happen until it is allowed to proceed. +This is usually accomplished by repeatedly testing a condition under the +mutex protection and waiting on the condition variable until the condition +evaluates to true:</p> +<pre class="doctools_example"> + set mutex [thread::mutex create] + set cond [thread::cond create] + thread::mutex lock $mutex + while {<some_condition_is_true>} { + thread::cond wait $cond $mutex + } + # Do some work under mutex protection + thread::mutex unlock $mutex +</pre> +<p>Repeated testing of the condition is needed since the condition variable +may get signalled without the condition being actually changed (spurious +thread wake-ups, for example).</p></dd> +</dl></dd> +</dl> +</div> +<div id="section3" class="doctools_section"><h2><a name="section3">DISCUSSION</a></h2> +<p>The fundamental threading model in Tcl is that there can be one or +more Tcl interpreters per thread, but each Tcl interpreter should +only be used by a single thread which created it. +A "shared memory" abstraction is awkward to provide in Tcl because +Tcl makes assumptions about variable and data ownership. Therefore +this extension supports a simple form of threading where the main +thread can manage several background, or "worker" threads. +For example, an event-driven server can pass requests to worker +threads, and then await responses from worker threads or new client +requests. Everything goes through the common Tcl event loop, so +message passing between threads works naturally with event-driven I/O, +<b class="cmd">vwait</b> on variables, and so forth. For the transfer of bulk +information it is possible to move channels between the threads.</p> +<p>For advanced multithreading scripts, script-level access to two +basic synchronization primitives, mutex and condition variables, +is also supported.</p> +</div> +<div id="see-also" class="doctools_section"><h2><a name="see-also">See Also</a></h2> +<p><a href="http://www.tcl.tk/doc/howto/thread_model.html">http://www.tcl.tk/doc/howto/thread_model.html</a>, tpool, tsv, ttrace</p> +</div> +<div id="keywords" class="doctools_section"><h2><a name="keywords">Keywords</a></h2> +<p>events, message passing, mutex, synchronization, thread</p> +</div> +</div></body></html> + diff --git a/tcl8.6/pkgs/thread2.8.4/doc/html/tpool.html b/tcl8.6/pkgs/thread2.8.4/doc/html/tpool.html new file mode 100644 index 0000000..468d7ce --- /dev/null +++ b/tcl8.6/pkgs/thread2.8.4/doc/html/tpool.html @@ -0,0 +1,316 @@ + +<html><head> +<title>tpool - Tcl Threading</title> +<style type="text/css"><!-- + HTML { + background: #FFFFFF; + color: black; + } + BODY { + background: #FFFFFF; + color: black; + } + DIV.doctools { + margin-left: 10%; + margin-right: 10%; + } + DIV.doctools H1,DIV.doctools H2 { + margin-left: -5%; + } + H1, H2, H3, H4 { + margin-top: 1em; + font-family: sans-serif; + font-size: large; + color: #005A9C; + background: transparent; + text-align: left; + } + H1.doctools_title { + text-align: center; + } + UL,OL { + margin-right: 0em; + margin-top: 3pt; + margin-bottom: 3pt; + } + UL LI { + list-style: disc; + } + OL LI { + list-style: decimal; + } + DT { + padding-top: 1ex; + } + UL.doctools_toc,UL.doctools_toc UL, UL.doctools_toc UL UL { + font: normal 12pt/14pt sans-serif; + list-style: none; + } + LI.doctools_section, LI.doctools_subsection { + list-style: none; + margin-left: 0em; + text-indent: 0em; + padding: 0em; + } + PRE { + display: block; + font-family: monospace; + white-space: pre; + margin: 0%; + padding-top: 0.5ex; + padding-bottom: 0.5ex; + padding-left: 1ex; + padding-right: 1ex; + width: 100%; + } + PRE.doctools_example { + color: black; + background: #f5dcb3; + border: 1px solid black; + } + UL.doctools_requirements LI, UL.doctools_syntax LI { + list-style: none; + margin-left: 0em; + text-indent: 0em; + padding: 0em; + } + DIV.doctools_synopsis { + color: black; + background: #80ffff; + border: 1px solid black; + font-family: serif; + margin-top: 1em; + margin-bottom: 1em; + } + UL.doctools_syntax { + margin-top: 1em; + border-top: 1px solid black; + } + UL.doctools_requirements { + margin-bottom: 1em; + border-bottom: 1px solid black; + } +--></style> +</head> +<! -- Generated from file '' by tcllib/doctools with format 'html' + --> +<! -- tpool.n + --> +<body><div class="doctools"> +<h1 class="doctools_title">tpool(n) 2.8 "Tcl Threading"</h1> +<div id="name" class="doctools_section"><h2><a name="name">Name</a></h2> +<p>tpool - Part of the Tcl threading extension implementing pools of worker threads.</p> +</div> +<div id="toc" class="doctools_section"><h2><a name="toc">Table Of Contents</a></h2> +<ul class="doctools_toc"> +<li class="doctools_section"><a href="#toc">Table Of Contents</a></li> +<li class="doctools_section"><a href="#synopsis">Synopsis</a></li> +<li class="doctools_section"><a href="#section1">Description</a></li> +<li class="doctools_section"><a href="#section2">COMMANDS</a></li> +<li class="doctools_section"><a href="#section3">DISCUSSION</a></li> +<li class="doctools_section"><a href="#see-also">See Also</a></li> +<li class="doctools_section"><a href="#keywords">Keywords</a></li> +</ul> +</div> +<div id="synopsis" class="doctools_section"><h2><a name="synopsis">Synopsis</a></h2> +<div class="doctools_synopsis"> +<ul class="doctools_requirements"> +<li>package require <b class="pkgname">Tcl 8.4</b></li> +<li>package require <b class="pkgname">Thread <span class="opt">?2.8?</span></b></li> +</ul> +<ul class="doctools_syntax"> +<li><a href="#1"><b class="cmd">tpool::create</b> <span class="opt">?options?</span></a></li> +<li><a href="#2"><b class="cmd">tpool::names</b></a></li> +<li><a href="#3"><b class="cmd">tpool::post</b> <span class="opt">?-detached?</span> <span class="opt">?-nowait?</span> <i class="arg">tpool</i> <i class="arg">script</i></a></li> +<li><a href="#4"><b class="cmd">tpool::wait</b> <i class="arg">tpool</i> <i class="arg">joblist</i> <span class="opt">?varname?</span></a></li> +<li><a href="#5"><b class="cmd">tpool::cancel</b> <i class="arg">tpool</i> <i class="arg">joblist</i> <span class="opt">?varname?</span></a></li> +<li><a href="#6"><b class="cmd">tpool::get</b> <i class="arg">tpool</i> <i class="arg">job</i></a></li> +<li><a href="#7"><b class="cmd">tpool::preserve</b> <i class="arg">tpool</i></a></li> +<li><a href="#8"><b class="cmd">tpool::release</b> <i class="arg">tpool</i></a></li> +<li><a href="#9"><b class="cmd">tpool::suspend</b> <i class="arg">tpool</i></a></li> +<li><a href="#10"><b class="cmd">tpool::resume</b> <i class="arg">tpool</i></a></li> +</ul> +</div> +</div> +<div id="section1" class="doctools_section"><h2><a name="section1">Description</a></h2> +<p>This package creates and manages pools of worker threads. It allows you +to post jobs to worker threads and wait for their completion. The +threadpool implementation is Tcl event-loop aware. That means that any +time a caller is forced to wait for an event (job being completed or +a worker thread becoming idle or initialized), the implementation will +enter the event loop and allow for servicing of other pending file or +timer (or any other supported) events.</p> +</div> +<div id="section2" class="doctools_section"><h2><a name="section2">COMMANDS</a></h2> +<dl class="doctools_definitions"> +<dt><a name="1"><b class="cmd">tpool::create</b> <span class="opt">?options?</span></a></dt> +<dd><p>This command creates new threadpool. It accepts several options as +key-value pairs. Options are used to tune some threadpool parameters. +The command returns the ID of the newly created threadpool.</p> +<p>Following options are supported:</p> +<dl class="doctools_options"> +<dt><b class="option">-minworkers</b> <i class="arg">number</i></dt> +<dd><p>Minimum number of worker threads needed for this threadpool instance. +During threadpool creation, the implementation will create somany +worker threads upfront and will keep at least number of them alive +during the lifetime of the threadpool instance. +Default value of this parameter is 0 (zero). which means that a newly +threadpool will have no worker threads initialy. All worker threads +will be started on demand by callers running <b class="cmd">tpool::post</b> command +and posting jobs to the job queue.</p></dd> +<dt><b class="option">-maxworkers</b> <i class="arg">number</i></dt> +<dd><p>Maximum number of worker threads allowed for this threadpool instance. +If a new job is pending and there are no idle worker threads available, +the implementation will try to create new worker thread. If the number +of available worker threads is lower than the given number, +new worker thread will start. The caller will automatically enter the +event loop and wait until the worker thread has initialized. If. however, +the number of available worker threads is equal to the given number, +the caller will enter the event loop and wait for the first worker thread +to get idle, thus ready to run the job. +Default value of this parameter is 4 (four), which means that the +threadpool instance will allow maximum of 4 worker threads running jobs +or being idle waiting for new jobs to get posted to the job queue.</p></dd> +<dt><b class="option">-idletime</b> <i class="arg">seconds</i></dt> +<dd><p>Time in seconds an idle worker thread waits for the job to get posted +to the job queue. If no job arrives during this interval and the time +expires, the worker thread will check the number of currently available +worker threads and if the number is higher than the number set by the +<b class="option">minthreads</b> option, it will exit. +If an <b class="option">exitscript</b> has been defined, the exiting worker thread +will first run the script and then exit. Errors from the exit script, +if any, are ignored.</p> +<p>The idle worker thread is not servicing the event loop. If you, however, +put the worker thread into the event loop, by evaluating the +<b class="cmd">vwait</b> or other related Tcl commands, the worker thread +will not be in the idle state, hence the idle timer will not be +taken into account. +Default value for this option is unspecified.</p></dd> +<dt><b class="option">-initcmd</b> <i class="arg">script</i></dt> +<dd><p>Sets a Tcl script used to initialize new worker thread. This is usually +used to load packages and commands in the worker, set default variables, +create namespaces, and such. If the passed script runs into a Tcl error, +the worker will not be created and the initiating command (either the +<b class="cmd">tpool::create</b> or <b class="cmd">tpool::post</b>) will throw error. +Default value for this option is unspecified, hence, the Tcl interpreter of +the worker thread will contain just the initial set of Tcl commands.</p></dd> +<dt><b class="option">-exitcmd</b> <i class="arg">script</i></dt> +<dd><p>Sets a Tcl script run when the idle worker thread exits. This is normaly +used to cleanup the state of the worker thread, release reserved resources, +cleanup memory and such. +Default value for this option is unspecified, thus no Tcl script will run +on the worker thread exit.</p></dd> +</dl></dd> +<dt><a name="2"><b class="cmd">tpool::names</b></a></dt> +<dd><p>This command returns a list of IDs of threadpools created with the +<b class="cmd">tpool::create</b> command. If no threadpools were found, the +command will return empty list.</p></dd> +<dt><a name="3"><b class="cmd">tpool::post</b> <span class="opt">?-detached?</span> <span class="opt">?-nowait?</span> <i class="arg">tpool</i> <i class="arg">script</i></a></dt> +<dd><p>This command sends a <i class="arg">script</i> to the target <i class="arg">tpool</i> threadpool +for execution. The script will be executed in the first available idle +worker thread. If there are no idle worker threads available, the command +will create new one, enter the event loop and service events until the +newly created thread is initialized. If the current number of worker +threads is equal to the maximum number of worker threads, as defined +during the threadpool creation, the command will enter the event loop and +service events while waiting for one of the worker threads to become idle. +If the optional <span class="opt">?-nowait?</span> argument is given, the command will not wait +for one idle worker. It will just place the job in the pool's job queue +and return immediately.</p> +<p>The command returns the ID of the posted job. This ID is used for subsequent +<b class="cmd">tpool::wait</b>, <b class="cmd">tpool::get</b> and <b class="cmd">tpool::cancel</b> commands to wait +for and retrieve result of the posted script, or cancel the posted job +respectively. If the optional <span class="opt">?-detached?</span> argument is specified, the +command will post a detached job. A detached job can not be cancelled or +waited upon and is not identified by the job ID.</p> +<p>If the threadpool <i class="arg">tpool</i> is not found in the list of active +thread pools, the command will throw error. The error will also be triggered +if the newly created worker thread fails to initialize.</p></dd> +<dt><a name="4"><b class="cmd">tpool::wait</b> <i class="arg">tpool</i> <i class="arg">joblist</i> <span class="opt">?varname?</span></a></dt> +<dd><p>This command waits for one or many jobs, whose job IDs are given in the +<i class="arg">joblist</i> to get processed by the worker thread(s). If none of the +specified jobs are ready, the command will enter the event loop, service +events and wait for the first job to get ready.</p> +<p>The command returns the list of completed job IDs. If the optional variable +<span class="opt">?varname?</span> is given, it will be set to the list of jobs in the +<i class="arg">joblist</i> which are still pending. If the threadpool <i class="arg">tpool</i> +is not found in the list of active thread pools, the command will throw error.</p></dd> +<dt><a name="5"><b class="cmd">tpool::cancel</b> <i class="arg">tpool</i> <i class="arg">joblist</i> <span class="opt">?varname?</span></a></dt> +<dd><p>This command cancels the previously posted jobs given by the <i class="arg">joblist</i> +to the pool <i class="arg">tpool</i>. Job cancellation succeeds only for job still +waiting to be processed. If the job is already being executed by one of +the worker threads, the job will not be cancelled. +The command returns the list of cancelled job IDs. If the optional variable +<span class="opt">?varname?</span> is given, it will be set to the list of jobs in the +<i class="arg">joblist</i> which were not cancelled. If the threadpool <i class="arg">tpool</i> +is not found in the list of active thread pools, the command will throw error.</p></dd> +<dt><a name="6"><b class="cmd">tpool::get</b> <i class="arg">tpool</i> <i class="arg">job</i></a></dt> +<dd><p>This command retrieves the result of the previously posted <i class="arg">job</i>. +Only results of jobs waited upon with the <b class="cmd">tpool::wait</b> command +can be retrieved. If the execution of the script resulted in error, +the command will throw the error and update the <b class="variable">errorInfo</b> and +<b class="variable">errorCode</b> variables correspondingly. If the pool <i class="arg">tpool</i> +is not found in the list of threadpools, the command will throw error. +If the job <i class="arg">job</i> is not ready for retrieval, because it is currently +being executed by the worker thread, the command will throw error.</p></dd> +<dt><a name="7"><b class="cmd">tpool::preserve</b> <i class="arg">tpool</i></a></dt> +<dd><p>Each call to this command increments the reference counter of the +threadpool <i class="arg">tpool</i> by one (1). Command returns the value of the +reference counter after the increment. +By incrementing the reference counter, the caller signalizes that +he/she wishes to use the resource for a longer period of time.</p></dd> +<dt><a name="8"><b class="cmd">tpool::release</b> <i class="arg">tpool</i></a></dt> +<dd><p>Each call to this command decrements the reference counter of the +threadpool <i class="arg">tpool</i> by one (1).Command returns the value of the +reference counter after the decrement. +When the reference counter reaches zero (0), the threadpool <i class="arg">tpool</i> +is marked for termination. You should not reference the threadpool +after the <b class="cmd">tpool::release</b> command returns zero. The <i class="arg">tpool</i> +handle goes out of scope and should not be used any more. Any following +reference to the same threadpool handle will result in Tcl error.</p></dd> +<dt><a name="9"><b class="cmd">tpool::suspend</b> <i class="arg">tpool</i></a></dt> +<dd><p>Suspends processing work on this queue. All pool workers are paused +but additional work can be added to the pool. Note that adding the +additional work will not increase the number of workers dynamically +as the pool processing is suspended. Number of workers is maintained +to the count that was found prior suspending worker activity. +If you need to assure certain number of worker threads, use the +<b class="option">minworkers</b> option of the <b class="cmd">tpool::create</b> command.</p></dd> +<dt><a name="10"><b class="cmd">tpool::resume</b> <i class="arg">tpool</i></a></dt> +<dd><p>Resume processing work on this queue. All paused (suspended) +workers are free to get work from the pool. Note that resuming pool +operation will just let already created workers to proceed. +It will not create additional worker threads to handle the work +posted to the pool's work queue.</p></dd> +</dl> +</div> +<div id="section3" class="doctools_section"><h2><a name="section3">DISCUSSION</a></h2> +<p>Threadpool is one of the most common threading paradigm when it comes +to server applications handling a large number of relatively small tasks. +A very simplistic model for building a server application would be to +create a new thread each time a request arrives and service the request +in the new thread. One of the disadvantages of this approach is that +the overhead of creating a new thread for each request is significant; +a server that created a new thread for each request would spend more time +and consume more system resources in creating and destroying threads than +in processing actual user requests. In addition to the overhead of +creating and destroying threads, active threads consume system resources. +Creating too many threads can cause the system to run out of memory or +trash due to excessive memory consumption.</p> +<p>A thread pool offers a solution to both the problem of thread life-cycle +overhead and the problem of resource trashing. By reusing threads for +multiple tasks, the thread-creation overhead is spread over many tasks. +As a bonus, because the thread already exists when a request arrives, +the delay introduced by thread creation is eliminated. Thus, the request +can be serviced immediately. Furthermore, by properly tuning the number +of threads in the thread pool, resource thrashing may also be eliminated +by forcing any request to wait until a thread is available to process it.</p> +</div> +<div id="see-also" class="doctools_section"><h2><a name="see-also">See Also</a></h2> +<p>thread, tsv, ttrace</p> +</div> +<div id="keywords" class="doctools_section"><h2><a name="keywords">Keywords</a></h2> +<p>thread, threadpool</p> +</div> +</div></body></html> + diff --git a/tcl8.6/pkgs/thread2.8.4/doc/html/tsv.html b/tcl8.6/pkgs/thread2.8.4/doc/html/tsv.html new file mode 100644 index 0000000..6461f5e --- /dev/null +++ b/tcl8.6/pkgs/thread2.8.4/doc/html/tsv.html @@ -0,0 +1,409 @@ + +<html><head> +<title>tsv - Tcl Threading</title> +<style type="text/css"><!-- + HTML { + background: #FFFFFF; + color: black; + } + BODY { + background: #FFFFFF; + color: black; + } + DIV.doctools { + margin-left: 10%; + margin-right: 10%; + } + DIV.doctools H1,DIV.doctools H2 { + margin-left: -5%; + } + H1, H2, H3, H4 { + margin-top: 1em; + font-family: sans-serif; + font-size: large; + color: #005A9C; + background: transparent; + text-align: left; + } + H1.doctools_title { + text-align: center; + } + UL,OL { + margin-right: 0em; + margin-top: 3pt; + margin-bottom: 3pt; + } + UL LI { + list-style: disc; + } + OL LI { + list-style: decimal; + } + DT { + padding-top: 1ex; + } + UL.doctools_toc,UL.doctools_toc UL, UL.doctools_toc UL UL { + font: normal 12pt/14pt sans-serif; + list-style: none; + } + LI.doctools_section, LI.doctools_subsection { + list-style: none; + margin-left: 0em; + text-indent: 0em; + padding: 0em; + } + PRE { + display: block; + font-family: monospace; + white-space: pre; + margin: 0%; + padding-top: 0.5ex; + padding-bottom: 0.5ex; + padding-left: 1ex; + padding-right: 1ex; + width: 100%; + } + PRE.doctools_example { + color: black; + background: #f5dcb3; + border: 1px solid black; + } + UL.doctools_requirements LI, UL.doctools_syntax LI { + list-style: none; + margin-left: 0em; + text-indent: 0em; + padding: 0em; + } + DIV.doctools_synopsis { + color: black; + background: #80ffff; + border: 1px solid black; + font-family: serif; + margin-top: 1em; + margin-bottom: 1em; + } + UL.doctools_syntax { + margin-top: 1em; + border-top: 1px solid black; + } + UL.doctools_requirements { + margin-bottom: 1em; + border-bottom: 1px solid black; + } +--></style> +</head> +<! -- Generated from file '' by tcllib/doctools with format 'html' + --> +<! -- tsv.n + --> +<body><div class="doctools"> +<h1 class="doctools_title">tsv(n) 2.8 "Tcl Threading"</h1> +<div id="name" class="doctools_section"><h2><a name="name">Name</a></h2> +<p>tsv - Part of the Tcl threading extension allowing script level manipulation of data shared between threads.</p> +</div> +<div id="toc" class="doctools_section"><h2><a name="toc">Table Of Contents</a></h2> +<ul class="doctools_toc"> +<li class="doctools_section"><a href="#toc">Table Of Contents</a></li> +<li class="doctools_section"><a href="#synopsis">Synopsis</a></li> +<li class="doctools_section"><a href="#section1">Description</a></li> +<li class="doctools_section"><a href="#section2">ELEMENT COMMANDS</a></li> +<li class="doctools_section"><a href="#section3">LIST COMMANDS</a></li> +<li class="doctools_section"><a href="#section4">ARRAY COMMANDS</a></li> +<li class="doctools_section"><a href="#section5">KEYED LIST COMMANDS</a></li> +<li class="doctools_section"><a href="#section6">DISCUSSION</a></li> +<li class="doctools_section"><a href="#section7">CREDITS</a></li> +<li class="doctools_section"><a href="#see-also">See Also</a></li> +<li class="doctools_section"><a href="#keywords">Keywords</a></li> +</ul> +</div> +<div id="synopsis" class="doctools_section"><h2><a name="synopsis">Synopsis</a></h2> +<div class="doctools_synopsis"> +<ul class="doctools_requirements"> +<li>package require <b class="pkgname">Tcl 8.4</b></li> +<li>package require <b class="pkgname">Thread <span class="opt">?2.8?</span></b></li> +</ul> +<ul class="doctools_syntax"> +<li><a href="#1"><b class="cmd">tsv::names</b> <span class="opt">?pattern?</span></a></li> +<li><a href="#2"><b class="cmd">tsv::object</b> <i class="arg">varname</i> <i class="arg">element</i></a></li> +<li><a href="#3"><b class="cmd">tsv::set</b> <i class="arg">varname</i> <i class="arg">element</i> <span class="opt">?value?</span></a></li> +<li><a href="#4"><b class="cmd">tsv::get</b> <i class="arg">varname</i> <i class="arg">element</i> <span class="opt">?namedvar?</span></a></li> +<li><a href="#5"><b class="cmd">tsv::unset</b> <i class="arg">varname</i> <span class="opt">?element?</span></a></li> +<li><a href="#6"><b class="cmd">tsv::exists</b> <i class="arg">varname</i> <i class="arg">element</i></a></li> +<li><a href="#7"><b class="cmd">tsv::pop</b> <i class="arg">varname</i> <i class="arg">element</i></a></li> +<li><a href="#8"><b class="cmd">tsv::move</b> <i class="arg">varname</i> <i class="arg">oldname</i> <i class="arg">newname</i></a></li> +<li><a href="#9"><b class="cmd">tsv::incr</b> <i class="arg">varname</i> <i class="arg">element</i> <span class="opt">?count?</span></a></li> +<li><a href="#10"><b class="cmd">tsv::append</b> <i class="arg">varname</i> <i class="arg">element</i> <i class="arg">value</i> <span class="opt">?value ...?</span></a></li> +<li><a href="#11"><b class="cmd">tsv::lock</b> <i class="arg">varname</i> <i class="arg">arg</i> <span class="opt">?arg ...?</span></a></li> +<li><a href="#12"><b class="cmd">tsv::handlers</b></a></li> +<li><a href="#13"><b class="cmd">tsv::lappend</b> <i class="arg">varname</i> <i class="arg">element</i> <i class="arg">value</i> <span class="opt">?value ...?</span></a></li> +<li><a href="#14"><b class="cmd">tsv::linsert</b> <i class="arg">varname</i> <i class="arg">element</i> <i class="arg">index</i> <i class="arg">value</i> <span class="opt">?value ...?</span></a></li> +<li><a href="#15"><b class="cmd">tsv::lreplace</b> <i class="arg">varname</i> <i class="arg">element</i> <i class="arg">first</i> <i class="arg">last</i> <span class="opt">?value ...?</span></a></li> +<li><a href="#16"><b class="cmd">tsv::llength</b> <i class="arg">varname</i> <i class="arg">element</i></a></li> +<li><a href="#17"><b class="cmd">tsv::lindex</b> <i class="arg">varname</i> <i class="arg">element</i> <span class="opt">?index?</span></a></li> +<li><a href="#18"><b class="cmd">tsv::lrange</b> <i class="arg">varname</i> <i class="arg">element</i> <i class="arg">from</i> <i class="arg">to</i></a></li> +<li><a href="#19"><b class="cmd">tsv::lsearch</b> <i class="arg">varname</i> <i class="arg">element</i> <span class="opt">?options?</span> <i class="arg">pattern</i></a></li> +<li><a href="#20"><b class="cmd">tsv::lset</b> <i class="arg">varname</i> <i class="arg">element</i> <i class="arg">index</i> <span class="opt">?index ...?</span> <i class="arg">value</i></a></li> +<li><a href="#21"><b class="cmd">tsv::lpop</b> <i class="arg">varname</i> <i class="arg">element</i> <span class="opt">?index?</span></a></li> +<li><a href="#22"><b class="cmd">tsv::lpush</b> <i class="arg">varname</i> <i class="arg">element</i> <span class="opt">?index?</span></a></li> +<li><a href="#23"><b class="cmd">tsv::array set</b> <i class="arg">varname</i> <i class="arg">list</i></a></li> +<li><a href="#24"><b class="cmd">tsv::array get</b> <i class="arg">varname</i> <span class="opt">?pattern?</span></a></li> +<li><a href="#25"><b class="cmd">tsv::array names</b> <i class="arg">varname</i> <span class="opt">?pattern?</span></a></li> +<li><a href="#26"><b class="cmd">tsv::array size</b> <i class="arg">varname</i></a></li> +<li><a href="#27"><b class="cmd">tsv::array reset</b> <i class="arg">varname</i> <i class="arg">list</i></a></li> +<li><a href="#28"><b class="cmd">tsv::array bind</b> <i class="arg">varname</i> <i class="arg">handle</i></a></li> +<li><a href="#29"><b class="cmd">tsv::array unbind</b> <i class="arg">varname</i></a></li> +<li><a href="#30"><b class="cmd">tsv::array isbound</b> <i class="arg">varname</i></a></li> +<li><a href="#31"><b class="cmd">tsv::keyldel</b> <i class="arg">varname</i> <i class="arg">keylist</i> <i class="arg">key</i></a></li> +<li><a href="#32"><b class="cmd">tsv::keylget</b> <i class="arg">varname</i> <i class="arg">keylist</i> <i class="arg">key</i> <span class="opt">?retvar?</span></a></li> +<li><a href="#33"><b class="cmd">tsv::keylkeys</b> <i class="arg">varname</i> <i class="arg">keylist</i> <span class="opt">?key?</span></a></li> +<li><a href="#34"><b class="cmd">tsv::keylset</b> <i class="arg">varname</i> <i class="arg">keylist</i> <i class="arg">key</i> <i class="arg">value</i> <span class="opt">?key value..?</span></a></li> +</ul> +</div> +</div> +<div id="section1" class="doctools_section"><h2><a name="section1">Description</a></h2> +<p>This section describes commands implementing thread shared variables. +A thread shared variable is very similar to a Tcl array but in +contrast to a Tcl array it is created in shared memory and can +be accessed from many threads at the same time. Important feature of +thread shared variable is that each access to the variable is internaly +protected by a mutex so script programmer does not have to take care +about locking the variable himself.</p> +<p>Thread shared variables are not bound to any thread explicitly. That +means that when a thread which created any of thread shared variables +exits, the variable and associated memory is not unset/reclaimed. +User has to explicitly unset the variable to reclaim the memory +consumed by the variable.</p> +</div> +<div id="section2" class="doctools_section"><h2><a name="section2">ELEMENT COMMANDS</a></h2> +<dl class="doctools_definitions"> +<dt><a name="1"><b class="cmd">tsv::names</b> <span class="opt">?pattern?</span></a></dt> +<dd><p>Returns names of shared variables matching optional <span class="opt">?pattern?</span> +or all known variables if pattern is ommited.</p></dd> +<dt><a name="2"><b class="cmd">tsv::object</b> <i class="arg">varname</i> <i class="arg">element</i></a></dt> +<dd><p>Creates object accessor command for the <i class="arg">element</i> in the +shared variable <i class="arg">varname</i>. Using this command, one can apply most +of the other shared variable commands as method functions of +the element object command. The object command is automatically +deleted when the element which this command is pointing to is unset.</p> +<pre class="doctools_example"> + % tsv::set foo bar "A shared string" + % set string [tsv::object foo bar] + % $string append " appended" + => A shared string appended +</pre> +</dd> +<dt><a name="3"><b class="cmd">tsv::set</b> <i class="arg">varname</i> <i class="arg">element</i> <span class="opt">?value?</span></a></dt> +<dd><p>Sets the value of the <i class="arg">element</i> in the shared variable <i class="arg">varname</i> +to <i class="arg">value</i> and returns the value to caller. The <i class="arg">value</i> +may be ommited, in which case the command will return the current +value of the element. If the element cannot be found, error is triggered.</p></dd> +<dt><a name="4"><b class="cmd">tsv::get</b> <i class="arg">varname</i> <i class="arg">element</i> <span class="opt">?namedvar?</span></a></dt> +<dd><p>Retrieves the value of the <i class="arg">element</i> from the shared variable <i class="arg">varname</i>. +If the optional argument <i class="arg">namedvar</i> is given, the value is +stored in the named variable. Return value of the command depends +of the existence of the optional argument <i class="arg">namedvar</i>. +If the argument is ommited and the requested element cannot be found +in the shared array, the command triggers error. If, however, the +optional argument is given on the command line, the command returns +true (1) if the element is found or false (0) if the element is not found.</p></dd> +<dt><a name="5"><b class="cmd">tsv::unset</b> <i class="arg">varname</i> <span class="opt">?element?</span></a></dt> +<dd><p>Unsets the <i class="arg">element</i> from the shared variable <i class="arg">varname</i>. +If the optional element is not given, it deletes the variable.</p></dd> +<dt><a name="6"><b class="cmd">tsv::exists</b> <i class="arg">varname</i> <i class="arg">element</i></a></dt> +<dd><p>Checks wether the <i class="arg">element</i> exists in the shared variable <i class="arg">varname</i> +and returns true (1) if it does or false (0) if it doesn't.</p></dd> +<dt><a name="7"><b class="cmd">tsv::pop</b> <i class="arg">varname</i> <i class="arg">element</i></a></dt> +<dd><p>Returns value of the <i class="arg">element</i> in the shared variable <i class="arg">varname</i> +and unsets the element, all in one atomic operation.</p></dd> +<dt><a name="8"><b class="cmd">tsv::move</b> <i class="arg">varname</i> <i class="arg">oldname</i> <i class="arg">newname</i></a></dt> +<dd><p>Renames the element <i class="arg">oldname</i> to the <i class="arg">newname</i> in the +shared variable <i class="arg">varname</i>. This effectively performs an get/unset/set +sequence of operations but all in one atomic step.</p></dd> +<dt><a name="9"><b class="cmd">tsv::incr</b> <i class="arg">varname</i> <i class="arg">element</i> <span class="opt">?count?</span></a></dt> +<dd><p>Similar to standard Tcl <b class="cmd">incr</b> command but increments the value +of the <i class="arg">element</i> in shared variaboe <i class="arg">varname</i> instead of +the Tcl variable.</p></dd> +<dt><a name="10"><b class="cmd">tsv::append</b> <i class="arg">varname</i> <i class="arg">element</i> <i class="arg">value</i> <span class="opt">?value ...?</span></a></dt> +<dd><p>Similar to standard Tcl <b class="cmd">append</b> command but appends one or more +values to the <i class="arg">element</i> in shared variable <i class="arg">varname</i> instead of the +Tcl variable.</p></dd> +<dt><a name="11"><b class="cmd">tsv::lock</b> <i class="arg">varname</i> <i class="arg">arg</i> <span class="opt">?arg ...?</span></a></dt> +<dd><p>This command concatenates passed arguments and evaluates the +resulting script under the internal mutex protection. During the +script evaluation, the entire shared variable is locked. For shared +variable commands within the script, internal locking is disabled +so no deadlock can occur. It is also allowed to unset the shared +variable from within the script. The shared variable is automatically +created if it did not exists at the time of the first lock operation.</p> +<pre class="doctools_example"> + % tsv::lock foo { + tsv::lappend foo bar 1 + tsv::lappend foo bar 2 + puts stderr [tsv::set foo bar] + tsv::unset foo + } +</pre> +</dd> +<dt><a name="12"><b class="cmd">tsv::handlers</b></a></dt> +<dd><p>Returns the names of all persistent storage handlers enabled at compile time. +See <span class="sectref"><a href="#section4">ARRAY COMMANDS</a></span> for details.</p></dd> +</dl> +</div> +<div id="section3" class="doctools_section"><h2><a name="section3">LIST COMMANDS</a></h2> +<p>Those command are similar to the equivalently named Tcl command. The difference +is that they operate on elements of shared arrays.</p> +<dl class="doctools_definitions"> +<dt><a name="13"><b class="cmd">tsv::lappend</b> <i class="arg">varname</i> <i class="arg">element</i> <i class="arg">value</i> <span class="opt">?value ...?</span></a></dt> +<dd><p>Similar to standard Tcl <b class="cmd">lappend</b> command but appends one +or more values to the <i class="arg">element</i> in shared variable <i class="arg">varname</i> +instead of the Tcl variable.</p></dd> +<dt><a name="14"><b class="cmd">tsv::linsert</b> <i class="arg">varname</i> <i class="arg">element</i> <i class="arg">index</i> <i class="arg">value</i> <span class="opt">?value ...?</span></a></dt> +<dd><p>Similar to standard Tcl <b class="cmd">linsert</b> command but inserts one +or more values at the <i class="arg">index</i> list position in the +<i class="arg">element</i> in the shared variable <i class="arg">varname</i> instead of the Tcl variable.</p></dd> +<dt><a name="15"><b class="cmd">tsv::lreplace</b> <i class="arg">varname</i> <i class="arg">element</i> <i class="arg">first</i> <i class="arg">last</i> <span class="opt">?value ...?</span></a></dt> +<dd><p>Similar to standard Tcl <b class="cmd">lreplace</b> command but replaces one +or more values between the <i class="arg">first</i> and <i class="arg">last</i> position +in the <i class="arg">element</i> of the shared variable <i class="arg">varname</i> instead of +the Tcl variable.</p></dd> +<dt><a name="16"><b class="cmd">tsv::llength</b> <i class="arg">varname</i> <i class="arg">element</i></a></dt> +<dd><p>Similar to standard Tcl <b class="cmd">llength</b> command but returns length +of the <i class="arg">element</i> in the shared variable <i class="arg">varname</i> instead of the Tcl +variable.</p></dd> +<dt><a name="17"><b class="cmd">tsv::lindex</b> <i class="arg">varname</i> <i class="arg">element</i> <span class="opt">?index?</span></a></dt> +<dd><p>Similar to standard Tcl <b class="cmd">lindex</b> command but returns the value +at the <i class="arg">index</i> list position of the <i class="arg">element</i> from +the shared variable <i class="arg">varname</i> instead of the Tcl variable.</p></dd> +<dt><a name="18"><b class="cmd">tsv::lrange</b> <i class="arg">varname</i> <i class="arg">element</i> <i class="arg">from</i> <i class="arg">to</i></a></dt> +<dd><p>Similar to standard Tcl <b class="cmd">lrange</b> command but returns values +between <i class="arg">from</i> and <i class="arg">to</i> list positions from the +<i class="arg">element</i> in the shared variable <i class="arg">varname</i> instead of the Tcl variable.</p></dd> +<dt><a name="19"><b class="cmd">tsv::lsearch</b> <i class="arg">varname</i> <i class="arg">element</i> <span class="opt">?options?</span> <i class="arg">pattern</i></a></dt> +<dd><p>Similar to standard Tcl <b class="cmd">lsearch</b> command but searches the <i class="arg">element</i> +in the shared variable <i class="arg">varname</i> instead of the Tcl variable.</p></dd> +<dt><a name="20"><b class="cmd">tsv::lset</b> <i class="arg">varname</i> <i class="arg">element</i> <i class="arg">index</i> <span class="opt">?index ...?</span> <i class="arg">value</i></a></dt> +<dd><p>Similar to standard Tcl <b class="cmd">lset</b> command but sets the <i class="arg">element</i> +in the shared variable <i class="arg">varname</i> instead of the Tcl variable.</p></dd> +<dt><a name="21"><b class="cmd">tsv::lpop</b> <i class="arg">varname</i> <i class="arg">element</i> <span class="opt">?index?</span></a></dt> +<dd><p>Similar to the standard Tcl <b class="cmd">lindex</b> command but in addition to +returning, it also splices the value out of the <i class="arg">element</i> +from the shared variable <i class="arg">varname</i> in one atomic operation. +In contrast to the Tcl <b class="cmd">lindex</b> command, this command returns +no value to the caller.</p></dd> +<dt><a name="22"><b class="cmd">tsv::lpush</b> <i class="arg">varname</i> <i class="arg">element</i> <span class="opt">?index?</span></a></dt> +<dd><p>This command performes the opposite of the <b class="cmd">tsv::lpop</b> command. +As its counterpart, it returns no value to the caller.</p></dd> +</dl> +</div> +<div id="section4" class="doctools_section"><h2><a name="section4">ARRAY COMMANDS</a></h2> +<p>This command supports most of the options of the standard Tcl +<b class="cmd">array</b> command. In addition to those, it allows binding +a shared variable to some persisten storage databases. Currently the persistent +options supported are the famous GNU Gdbm and LMDB. These options have to be +selected during the package compilation time. +The implementation provides hooks for defining other persistency layers, if +needed.</p> +<dl class="doctools_definitions"> +<dt><a name="23"><b class="cmd">tsv::array set</b> <i class="arg">varname</i> <i class="arg">list</i></a></dt> +<dd><p>Does the same as standard Tcl <b class="cmd">array set</b>.</p></dd> +<dt><a name="24"><b class="cmd">tsv::array get</b> <i class="arg">varname</i> <span class="opt">?pattern?</span></a></dt> +<dd><p>Does the same as standard Tcl <b class="cmd">array get</b>.</p></dd> +<dt><a name="25"><b class="cmd">tsv::array names</b> <i class="arg">varname</i> <span class="opt">?pattern?</span></a></dt> +<dd><p>Does the same as standard Tcl <b class="cmd">array names</b>.</p></dd> +<dt><a name="26"><b class="cmd">tsv::array size</b> <i class="arg">varname</i></a></dt> +<dd><p>Does the same as standard Tcl <b class="cmd">array size</b>.</p></dd> +<dt><a name="27"><b class="cmd">tsv::array reset</b> <i class="arg">varname</i> <i class="arg">list</i></a></dt> +<dd><p>Does the same as standard Tcl <b class="cmd">array set</b> but it clears +the <i class="arg">varname</i> and sets new values from the list atomically.</p></dd> +<dt><a name="28"><b class="cmd">tsv::array bind</b> <i class="arg">varname</i> <i class="arg">handle</i></a></dt> +<dd><p>Binds the <i class="arg">varname</i> to the persistent storage <i class="arg">handle</i>. +The format of the <i class="arg">handle</i> is <handler>:<address>, where <handler> is +"gdbm" for GNU Gdbm and "lmdb" for LMDB and <address> is the path to the +database file.</p></dd> +<dt><a name="29"><b class="cmd">tsv::array unbind</b> <i class="arg">varname</i></a></dt> +<dd><p>Unbinds the shared <i class="arg">array</i> from its bound persistent storage.</p></dd> +<dt><a name="30"><b class="cmd">tsv::array isbound</b> <i class="arg">varname</i></a></dt> +<dd><p>Returns true (1) if the shared <i class="arg">varname</i> is bound to some +persistent storage or zero (0) if not.</p></dd> +</dl> +</div> +<div id="section5" class="doctools_section"><h2><a name="section5">KEYED LIST COMMANDS</a></h2> +<p>Keyed list commands are borrowed from the TclX package. Keyed lists provide +a structured data type built upon standard Tcl lists. This is a functionality +similar to structs in the C programming language.</p> +<p>A keyed list is a list in which each element contains a key and value +pair. These element pairs are stored as lists themselves, where the key +is the first element of the list, and the value is the second. The +key-value pairs are referred to as fields. This is an example of a +keyed list:</p> +<pre class="doctools_example"> + {{NAME {Frank Zappa}} {JOB {musician and composer}}} +</pre> +<p>Fields may contain subfields; `.' is the separator character. Subfields +are actually fields where the value is another keyed list. Thus the +following list has the top level fields ID and NAME, and subfields +NAME.FIRST and NAME.LAST:</p> +<pre class="doctools_example"> + {ID 106} {NAME {{FIRST Frank} {LAST Zappa}}} +</pre> +<p>There is no limit to the recursive depth of subfields, +allowing one to build complex data structures. Keyed lists are constructed +and accessed via a number of commands. All keyed list management +commands take the name of the variable containing the keyed list as an +argument (i.e. passed by reference), rather than passing the list directly.</p> +<dl class="doctools_definitions"> +<dt><a name="31"><b class="cmd">tsv::keyldel</b> <i class="arg">varname</i> <i class="arg">keylist</i> <i class="arg">key</i></a></dt> +<dd><p>Delete the field specified by <i class="arg">key</i> from the keyed list <i class="arg">keylist</i> +in the shared variable <i class="arg">varname</i>. +This removes both the key and the value from the keyed list.</p></dd> +<dt><a name="32"><b class="cmd">tsv::keylget</b> <i class="arg">varname</i> <i class="arg">keylist</i> <i class="arg">key</i> <span class="opt">?retvar?</span></a></dt> +<dd><p>Return the value associated with <i class="arg">key</i> from the keyed list <i class="arg">keylist</i> +in the shared variable <i class="arg">varname</i>. +If the optional <i class="arg">retvar</i> is not specified, then the value will be +returned as the result of the command. In this case, if key is not found +in the list, an error will result.</p> +<p>If <i class="arg">retvar</i> is specified and <i class="arg">key</i> is in the list, then the value +is returned in the variable <i class="arg">retvar</i> and the command returns 1 if the +key was present within the list. If <i class="arg">key</i> isn't in the list, the +command will return 0, and <i class="arg">retvar</i> will be left unchanged. If {} is +specified for <i class="arg">retvar</i>, the value is not returned, allowing the Tcl +programmer to determine if a <i class="arg">key</i> is present in a keyed list without +setting a variable as a side-effect.</p></dd> +<dt><a name="33"><b class="cmd">tsv::keylkeys</b> <i class="arg">varname</i> <i class="arg">keylist</i> <span class="opt">?key?</span></a></dt> +<dd><p>Return the a list of the keys in the keyed list <i class="arg">keylist</i> in the +shared variable <i class="arg">varname</i>. If <i class="arg">key</i> is specified, then it is +the name of a key field who's subfield keys are to be retrieved.</p></dd> +<dt><a name="34"><b class="cmd">tsv::keylset</b> <i class="arg">varname</i> <i class="arg">keylist</i> <i class="arg">key</i> <i class="arg">value</i> <span class="opt">?key value..?</span></a></dt> +<dd><p>Set the value associated with <i class="arg">key</i>, in the keyed list <i class="arg">keylist</i> +to <i class="arg">value</i>. If the <i class="arg">keylist</i> does not exists, it is created. +If <i class="arg">key</i> is not currently in the list, it will be added. If it already +exists, <i class="arg">value</i> replaces the existing value. Multiple keywords and +values may be specified, if desired.</p></dd> +</dl> +</div> +<div id="section6" class="doctools_section"><h2><a name="section6">DISCUSSION</a></h2> +<p>The current implementation of thread shared variables allows for easy and +convenient access to data shared between different threads. +Internally, the data is stored in Tcl objects and all package commands +operate on internal data representation, thus minimizing shimmering and +improving performance. Special care has been taken to assure that all +object data is properly locked and deep-copied when moving objects between +threads.</p> +<p>Due to the internal design of the Tcl core, there is no provision of full +integration of shared variables within the Tcl syntax, unfortunately. All +access to shared data must be performed with the supplied package commands. +Also, variable traces are not supported. But even so, benefits of easy, +simple and safe shared data manipulation outweights imposed limitations.</p> +</div> +<div id="section7" class="doctools_section"><h2><a name="section7">CREDITS</a></h2> +<p>Thread shared variables are inspired by the nsv interface found in +AOLserver, a highly scalable Web server from America Online.</p> +</div> +<div id="see-also" class="doctools_section"><h2><a name="see-also">See Also</a></h2> +<p>thread, tpool, ttrace</p> +</div> +<div id="keywords" class="doctools_section"><h2><a name="keywords">Keywords</a></h2> +<p>locking, synchronization, thread shared data, threads</p> +</div> +</div></body></html> + diff --git a/tcl8.6/pkgs/thread2.8.4/doc/html/ttrace.html b/tcl8.6/pkgs/thread2.8.4/doc/html/ttrace.html new file mode 100644 index 0000000..c4271b8 --- /dev/null +++ b/tcl8.6/pkgs/thread2.8.4/doc/html/ttrace.html @@ -0,0 +1,312 @@ + +<html><head> +<title>ttrace - Tcl Threading</title> +<style type="text/css"><!-- + HTML { + background: #FFFFFF; + color: black; + } + BODY { + background: #FFFFFF; + color: black; + } + DIV.doctools { + margin-left: 10%; + margin-right: 10%; + } + DIV.doctools H1,DIV.doctools H2 { + margin-left: -5%; + } + H1, H2, H3, H4 { + margin-top: 1em; + font-family: sans-serif; + font-size: large; + color: #005A9C; + background: transparent; + text-align: left; + } + H1.doctools_title { + text-align: center; + } + UL,OL { + margin-right: 0em; + margin-top: 3pt; + margin-bottom: 3pt; + } + UL LI { + list-style: disc; + } + OL LI { + list-style: decimal; + } + DT { + padding-top: 1ex; + } + UL.doctools_toc,UL.doctools_toc UL, UL.doctools_toc UL UL { + font: normal 12pt/14pt sans-serif; + list-style: none; + } + LI.doctools_section, LI.doctools_subsection { + list-style: none; + margin-left: 0em; + text-indent: 0em; + padding: 0em; + } + PRE { + display: block; + font-family: monospace; + white-space: pre; + margin: 0%; + padding-top: 0.5ex; + padding-bottom: 0.5ex; + padding-left: 1ex; + padding-right: 1ex; + width: 100%; + } + PRE.doctools_example { + color: black; + background: #f5dcb3; + border: 1px solid black; + } + UL.doctools_requirements LI, UL.doctools_syntax LI { + list-style: none; + margin-left: 0em; + text-indent: 0em; + padding: 0em; + } + DIV.doctools_synopsis { + color: black; + background: #80ffff; + border: 1px solid black; + font-family: serif; + margin-top: 1em; + margin-bottom: 1em; + } + UL.doctools_syntax { + margin-top: 1em; + border-top: 1px solid black; + } + UL.doctools_requirements { + margin-bottom: 1em; + border-bottom: 1px solid black; + } +--></style> +</head> +<! -- Generated from file '' by tcllib/doctools with format 'html' + --> +<! -- ttrace.n + --> +<body><div class="doctools"> +<h1 class="doctools_title">ttrace(n) 2.8 "Tcl Threading"</h1> +<div id="name" class="doctools_section"><h2><a name="name">Name</a></h2> +<p>ttrace - Trace-based interpreter initialization</p> +</div> +<div id="toc" class="doctools_section"><h2><a name="toc">Table Of Contents</a></h2> +<ul class="doctools_toc"> +<li class="doctools_section"><a href="#toc">Table Of Contents</a></li> +<li class="doctools_section"><a href="#synopsis">Synopsis</a></li> +<li class="doctools_section"><a href="#section1">Description</a></li> +<li class="doctools_section"><a href="#section2">USER COMMANDS</a></li> +<li class="doctools_section"><a href="#section3">CALLBACK COMMANDS</a></li> +<li class="doctools_section"><a href="#section4">DISCUSSION</a></li> +<li class="doctools_section"><a href="#see-also">See Also</a></li> +<li class="doctools_section"><a href="#keywords">Keywords</a></li> +</ul> +</div> +<div id="synopsis" class="doctools_section"><h2><a name="synopsis">Synopsis</a></h2> +<div class="doctools_synopsis"> +<ul class="doctools_requirements"> +<li>package require <b class="pkgname">Tcl 8.4</b></li> +<li>package require <b class="pkgname">Thread <span class="opt">?2.8?</span></b></li> +</ul> +<ul class="doctools_syntax"> +<li><a href="#1"><b class="cmd">ttrace::eval</b> <i class="arg">arg</i> <span class="opt">?arg ...?</span></a></li> +<li><a href="#2"><b class="cmd">ttrace::enable</b></a></li> +<li><a href="#3"><b class="cmd">ttrace::disable</b></a></li> +<li><a href="#4"><b class="cmd">ttrace::cleanup</b></a></li> +<li><a href="#5"><b class="cmd">ttrace::update</b> <span class="opt">?epoch?</span></a></li> +<li><a href="#6"><b class="cmd">ttrace::getscript</b></a></li> +<li><a href="#7"><b class="cmd">ttrace::atenable</b> <i class="arg">cmd</i> <i class="arg">arglist</i> <i class="arg">body</i></a></li> +<li><a href="#8"><b class="cmd">ttrace::atdisable</b> <i class="arg">cmd</i> <i class="arg">arglist</i> <i class="arg">body</i></a></li> +<li><a href="#9"><b class="cmd">ttrace::addtrace</b> <i class="arg">cmd</i> <i class="arg">arglist</i> <i class="arg">body</i></a></li> +<li><a href="#10"><b class="cmd">ttrace::addscript</b> <i class="arg">name</i> <i class="arg">body</i></a></li> +<li><a href="#11"><b class="cmd">ttrace::addresolver</b> <i class="arg">cmd</i> <i class="arg">arglist</i> <i class="arg">body</i></a></li> +<li><a href="#12"><b class="cmd">ttrace::addcleanup</b> <i class="arg">body</i></a></li> +<li><a href="#13"><b class="cmd">ttrace::addentry</b> <i class="arg">cmd</i> <i class="arg">var</i> <i class="arg">val</i></a></li> +<li><a href="#14"><b class="cmd">ttrace::getentry</b> <i class="arg">cmd</i> <i class="arg">var</i></a></li> +<li><a href="#15"><b class="cmd">ttrace::getentries</b> <i class="arg">cmd</i> <span class="opt">?pattern?</span></a></li> +<li><a href="#16"><b class="cmd">ttrace::delentry</b> <i class="arg">cmd</i></a></li> +<li><a href="#17"><b class="cmd">ttrace::preload</b> <i class="arg">cmd</i></a></li> +</ul> +</div> +</div> +<div id="section1" class="doctools_section"><h2><a name="section1">Description</a></h2> +<p>This package creates a framework for on-demand replication of the +interpreter state accross threads in an multithreading application. +It relies on the mechanics of Tcl command tracing and the Tcl +<b class="cmd">unknown</b> command and mechanism.</p> +<p>The package requires Tcl threading extension but can be alternatively +used stand-alone within the AOLserver, a scalable webserver from +America Online.</p> +<p>In a nutshell, a short sample illustrating the usage of the ttrace +with the Tcl threading extension:</p> +<pre class="doctools_example"> + % package require Ttrace + 2.8.2 + % set t1 [thread::create {package require Ttrace; thread::wait}] + tid0x1802800 + % ttrace::eval {proc test args {return test-[thread::id]}} + % thread::send $t1 test + test-tid0x1802800 + % set t2 [thread::create {package require Ttrace; thread::wait}] + tid0x1804000 + % thread::send $t2 test + test-tid0x1804000 +</pre> +<p>As seen from above, the <b class="cmd">ttrace::eval</b> and <b class="cmd">ttrace::update</b> +commands are used to create a thread-wide definition of a simple +Tcl procedure and replicate that definition to all, already existing +or later created, threads.</p> +</div> +<div id="section2" class="doctools_section"><h2><a name="section2">USER COMMANDS</a></h2> +<p>This section describes user-level commands. Those commands can be +used by script writers to control the execution of the tracing +framework.</p> +<dl class="doctools_definitions"> +<dt><a name="1"><b class="cmd">ttrace::eval</b> <i class="arg">arg</i> <span class="opt">?arg ...?</span></a></dt> +<dd><p>This command concatenates given arguments and evaluates the resulting +Tcl command with trace framework enabled. If the command execution +was ok, it takes necessary steps to automatically propagate the +trace epoch change to all threads in the application. +For AOLserver, only newly created threads actually receive the +epoch change. For the Tcl threading extension, all threads created by +the extension are automatically updated. If the command execution +resulted in Tcl error, no state propagation takes place.</p> +<p>This is the most important user-level command of the package as +it wraps most of the commands described below. This greatly +simplifies things, because user need to learn just this (one) +command in order to effectively use the package. Other commands, +as desribed below, are included mostly for the sake of completeness.</p></dd> +<dt><a name="2"><b class="cmd">ttrace::enable</b></a></dt> +<dd><p>Activates all registered callbacks in the framework +and starts a new trace epoch. The trace epoch encapsulates all +changes done to the interpreter during the time traces are activated.</p></dd> +<dt><a name="3"><b class="cmd">ttrace::disable</b></a></dt> +<dd><p>Deactivates all registered callbacks in the framework +and closes the current trace epoch.</p></dd> +<dt><a name="4"><b class="cmd">ttrace::cleanup</b></a></dt> +<dd><p>Used to clean-up all on-demand loaded resources in the interpreter. +It effectively brings Tcl interpreter to its pristine state.</p></dd> +<dt><a name="5"><b class="cmd">ttrace::update</b> <span class="opt">?epoch?</span></a></dt> +<dd><p>Used to refresh the state of the interpreter to match the optional +trace <span class="opt">?epoch?</span>. If the optional <span class="opt">?epoch?</span> is not given, it takes +the most recent trace epoch.</p></dd> +<dt><a name="6"><b class="cmd">ttrace::getscript</b></a></dt> +<dd><p>Returns a synthetized Tcl script which may be sourced in any interpreter. +This script sets the stage for the Tcl <b class="cmd">unknown</b> command so it can +load traced resources from the in-memory database. Normally, this command +is automatically invoked by other higher-level commands like +<b class="cmd">ttrace::eval</b> and <b class="cmd">ttrace::update</b>.</p></dd> +</dl> +</div> +<div id="section3" class="doctools_section"><h2><a name="section3">CALLBACK COMMANDS</a></h2> +<p>A word upfront: the package already includes callbacks for tracing +following Tcl commands: <b class="cmd">proc</b>, <b class="cmd">namespace</b>, <b class="cmd">variable</b>, +<b class="cmd">load</b>, and <b class="cmd">rename</b>. Additionaly, a set of callbacks for +tracing resources (object, clasess) for the XOTcl v1.3.8+, an +OO-extension to Tcl, is also provided. +This gives a solid base for solving most of the real-life needs and +serves as an example for people wanting to customize the package +to cover their specific needs.</p> +<p>Below, you can find commands for registering callbacks in the +framework and for writing callback scripts. These callbacks are +invoked by the framework in order to gather interpreter state +changes, build in-memory database, perform custom-cleanups and +various other tasks.</p> +<dl class="doctools_definitions"> +<dt><a name="7"><b class="cmd">ttrace::atenable</b> <i class="arg">cmd</i> <i class="arg">arglist</i> <i class="arg">body</i></a></dt> +<dd><p>Registers Tcl callback to be activated at <b class="cmd">ttrace::enable</b>. +Registered callbacks are activated on FIFO basis. The callback +definition includes the name of the callback, <i class="arg">cmd</i>, a list +of callback arguments, <i class="arg">arglist</i> and the <i class="arg">body</i> of the +callback. Effectively, this actually resembles the call interface +of the standard Tcl <b class="cmd">proc</b> command.</p></dd> +<dt><a name="8"><b class="cmd">ttrace::atdisable</b> <i class="arg">cmd</i> <i class="arg">arglist</i> <i class="arg">body</i></a></dt> +<dd><p>Registers Tcl callback to be activated at <b class="cmd">ttrace::disable</b>. +Registered callbacks are activated on FIFO basis. The callback +definition includes the name of the callback, <i class="arg">cmd</i>, a list +of callback arguments, <i class="arg">arglist</i> and the <i class="arg">body</i> of the +callback. Effectively, this actually resembles the call interface +of the standard Tcl <b class="cmd">proc</b> command.</p></dd> +<dt><a name="9"><b class="cmd">ttrace::addtrace</b> <i class="arg">cmd</i> <i class="arg">arglist</i> <i class="arg">body</i></a></dt> +<dd><p>Registers Tcl callback to be activated for tracing the Tcl +<b class="cmd">cmd</b> command. The callback definition includes the name of +the Tcl command to trace, <i class="arg">cmd</i>, a list of callback arguments, +<i class="arg">arglist</i> and the <i class="arg">body</i> of the callback. Effectively, +this actually resembles the call interface of the standard Tcl +<b class="cmd">proc</b> command.</p></dd> +<dt><a name="10"><b class="cmd">ttrace::addscript</b> <i class="arg">name</i> <i class="arg">body</i></a></dt> +<dd><p>Registers Tcl callback to be activated for building a Tcl +script to be passed to other interpreters. This script is +used to set the stage for the Tcl <b class="cmd">unknown</b> command. +Registered callbacks are activated on FIFO basis. +The callback definition includes the name of the callback, +<i class="arg">name</i> and the <i class="arg">body</i> of the callback.</p></dd> +<dt><a name="11"><b class="cmd">ttrace::addresolver</b> <i class="arg">cmd</i> <i class="arg">arglist</i> <i class="arg">body</i></a></dt> +<dd><p>Registers Tcl callback to be activated by the overloaded Tcl +<b class="cmd">unknown</b> command. +Registered callbacks are activated on FIFO basis. +This callback is used to resolve the resource and load the +resource in the current interpreter.</p></dd> +<dt><a name="12"><b class="cmd">ttrace::addcleanup</b> <i class="arg">body</i></a></dt> +<dd><p>Registers Tcl callback to be activated by the <b class="cmd">trace::cleanup</b>. +Registered callbacks are activated on FIFO basis.</p></dd> +<dt><a name="13"><b class="cmd">ttrace::addentry</b> <i class="arg">cmd</i> <i class="arg">var</i> <i class="arg">val</i></a></dt> +<dd><p>Adds one entry to the named in-memory database.</p></dd> +<dt><a name="14"><b class="cmd">ttrace::getentry</b> <i class="arg">cmd</i> <i class="arg">var</i></a></dt> +<dd><p>Returns the value of the entry from the named in-memory database.</p></dd> +<dt><a name="15"><b class="cmd">ttrace::getentries</b> <i class="arg">cmd</i> <span class="opt">?pattern?</span></a></dt> +<dd><p>Returns names of all entries from the named in-memory database.</p></dd> +<dt><a name="16"><b class="cmd">ttrace::delentry</b> <i class="arg">cmd</i></a></dt> +<dd><p>Deletes an entry from the named in-memory database.</p></dd> +<dt><a name="17"><b class="cmd">ttrace::preload</b> <i class="arg">cmd</i></a></dt> +<dd><p>Registers the Tcl command to be loaded in the interpreter. +Commands registered this way will always be the part of +the interpreter and not be on-demand loaded by the Tcl +<b class="cmd">unknown</b> command.</p></dd> +</dl> +</div> +<div id="section4" class="doctools_section"><h2><a name="section4">DISCUSSION</a></h2> +<p>Common introspective state-replication approaches use a custom Tcl +script to introspect the running interpreter and synthesize another +Tcl script to replicate this state in some other interpreter. +This package, on the contrary, uses Tcl command traces. Command +traces are registered on selected Tcl commands, like <b class="cmd">proc</b>, +<b class="cmd">namespace</b>, <b class="cmd">load</b> and other standard (and/or user-defined) +Tcl commands. When activated, those traces build an in-memory +database of created resources. This database is used as a resource +repository for the (overloaded) Tcl <b class="cmd">unknown</b> command which +creates the requested resource in the interpreter on demand. +This way, users can update just one interpreter (master) in one +thread and replicate that interpreter state (or part of it) to other +threads/interpreters in the process.</p> +<p>Immediate benefit of such approach is the much smaller memory footprint +of the application and much faster thread creation. By not actually +loading all necessary procedures (and other resources) in every thread +at the thread initialization time, but by deffering this to the time the +resource is actually referenced, significant improvements in both +memory consumption and thread initialization time can be achieved. Some +tests have shown that memory footprint of an multithreading Tcl application +went down more than three times and thread startup time was reduced for +about 50 times. Note that your mileage may vary. +Other benefits include much finer control about what (and when) gets +replicated from the master to other Tcl thread/interpreters.</p> +</div> +<div id="see-also" class="doctools_section"><h2><a name="see-also">See Also</a></h2> +<p>thread, tpool, tsv</p> +</div> +<div id="keywords" class="doctools_section"><h2><a name="keywords">Keywords</a></h2> +<p>command tracing, introspection</p> +</div> +</div></body></html> + diff --git a/tcl8.6/pkgs/thread2.8.4/doc/man.macros b/tcl8.6/pkgs/thread2.8.4/doc/man.macros new file mode 100644 index 0000000..8626abf --- /dev/null +++ b/tcl8.6/pkgs/thread2.8.4/doc/man.macros @@ -0,0 +1,236 @@ +'\" The definitions below are for supplemental macros used in Tcl/Tk +'\" manual entries. +'\" +'\" .AP type name in/out ?indent? +'\" Start paragraph describing an argument to a library procedure. +'\" type is type of argument (int, etc.), in/out is either "in", "out", +'\" or "in/out" to describe whether procedure reads or modifies arg, +'\" and indent is equivalent to second arg of .IP (shouldn't ever be +'\" needed; use .AS below instead) +'\" +'\" .AS ?type? ?name? +'\" Give maximum sizes of arguments for setting tab stops. Type and +'\" name are examples of largest possible arguments that will be passed +'\" to .AP later. If args are omitted, default tab stops are used. +'\" +'\" .BS +'\" Start box enclosure. From here until next .BE, everything will be +'\" enclosed in one large box. +'\" +'\" .BE +'\" End of box enclosure. +'\" +'\" .CS +'\" Begin code excerpt. +'\" +'\" .CE +'\" End code excerpt. +'\" +'\" .VS ?version? ?br? +'\" Begin vertical sidebar, for use in marking newly-changed parts +'\" of man pages. The first argument is ignored and used for recording +'\" the version when the .VS was added, so that the sidebars can be +'\" found and removed when they reach a certain age. If another argument +'\" is present, then a line break is forced before starting the sidebar. +'\" +'\" .VE +'\" End of vertical sidebar. +'\" +'\" .DS +'\" Begin an indented unfilled display. +'\" +'\" .DE +'\" End of indented unfilled display. +'\" +'\" .SO +'\" Start of list of standard options for a Tk widget. The +'\" options follow on successive lines, in four columns separated +'\" by tabs. +'\" +'\" .SE +'\" End of list of standard options for a Tk widget. +'\" +'\" .OP cmdName dbName dbClass +'\" Start of description of a specific option. cmdName gives the +'\" option's name as specified in the class command, dbName gives +'\" the option's name in the option database, and dbClass gives +'\" the option's class in the option database. +'\" +'\" .UL arg1 arg2 +'\" Print arg1 underlined, then print arg2 normally. +'\" +'\" # Set up traps and other miscellaneous stuff for Tcl/Tk man pages. +.if t .wh -1.3i ^B +.nr ^l \n(.l +.ad b +'\" # Start an argument description +.de AP +.ie !"\\$4"" .TP \\$4 +.el \{\ +. ie !"\\$2"" .TP \\n()Cu +. el .TP 15 +.\} +.ta \\n()Au \\n()Bu +.ie !"\\$3"" \{\ +\&\\$1 \\fI\\$2\\fP (\\$3) +.\".b +.\} +.el \{\ +.br +.ie !"\\$2"" \{\ +\&\\$1 \\fI\\$2\\fP +.\} +.el \{\ +\&\\fI\\$1\\fP +.\} +.\} +.. +'\" # define tabbing values for .AP +.de AS +.nr )A 10n +.if !"\\$1"" .nr )A \\w'\\$1'u+3n +.nr )B \\n()Au+15n +.\" +.if !"\\$2"" .nr )B \\w'\\$2'u+\\n()Au+3n +.nr )C \\n()Bu+\\w'(in/out)'u+2n +.. +.AS Tcl_Interp Tcl_CreateInterp in/out +'\" # BS - start boxed text +'\" # ^y = starting y location +'\" # ^b = 1 +.de BS +.br +.mk ^y +.nr ^b 1u +.if n .nf +.if n .ti 0 +.if n \l'\\n(.lu\(ul' +.if n .fi +.. +'\" # BE - end boxed text (draw box now) +.de BE +.nf +.ti 0 +.mk ^t +.ie n \l'\\n(^lu\(ul' +.el \{\ +.\" Draw four-sided box normally, but don't draw top of +.\" box if the box started on an earlier page. +.ie !\\n(^b-1 \{\ +\h'-1.5n'\L'|\\n(^yu-1v'\l'\\n(^lu+3n\(ul'\L'\\n(^tu+1v-\\n(^yu'\l'|0u-1.5n\(ul' +.\} +.el \}\ +\h'-1.5n'\L'|\\n(^yu-1v'\h'\\n(^lu+3n'\L'\\n(^tu+1v-\\n(^yu'\l'|0u-1.5n\(ul' +.\} +.\} +.fi +.br +.nr ^b 0 +.. +'\" # VS - start vertical sidebar +'\" # ^Y = starting y location +'\" # ^v = 1 (for troff; for nroff this doesn't matter) +.de VS +.if !"\\$2"" .br +.mk ^Y +.ie n 'mc \s12\(br\s0 +.el .nr ^v 1u +.. +'\" # VE - end of vertical sidebar +.de VE +.ie n 'mc +.el \{\ +.ev 2 +.nf +.ti 0 +.mk ^t +\h'|\\n(^lu+3n'\L'|\\n(^Yu-1v\(bv'\v'\\n(^tu+1v-\\n(^Yu'\h'-|\\n(^lu+3n' +.sp -1 +.fi +.ev +.\} +.nr ^v 0 +.. +'\" # Special macro to handle page bottom: finish off current +'\" # box/sidebar if in box/sidebar mode, then invoked standard +'\" # page bottom macro. +.de ^B +.ev 2 +'ti 0 +'nf +.mk ^t +.if \\n(^b \{\ +.\" Draw three-sided box if this is the box's first page, +.\" draw two sides but no top otherwise. +.ie !\\n(^b-1 \h'-1.5n'\L'|\\n(^yu-1v'\l'\\n(^lu+3n\(ul'\L'\\n(^tu+1v-\\n(^yu'\h'|0u'\c +.el \h'-1.5n'\L'|\\n(^yu-1v'\h'\\n(^lu+3n'\L'\\n(^tu+1v-\\n(^yu'\h'|0u'\c +.\} +.if \\n(^v \{\ +.nr ^x \\n(^tu+1v-\\n(^Yu +\kx\h'-\\nxu'\h'|\\n(^lu+3n'\ky\L'-\\n(^xu'\v'\\n(^xu'\h'|0u'\c +.\} +.bp +'fi +.ev +.if \\n(^b \{\ +.mk ^y +.nr ^b 2 +.\} +.if \\n(^v \{\ +.mk ^Y +.\} +.. +'\" # DS - begin display +.de DS +.RS +.nf +.sp +.. +'\" # DE - end display +.de DE +.fi +.RE +.sp +.. +'\" # SO - start of list of standard options +.de SO +.SH "STANDARD OPTIONS" +.LP +.nf +.ta 5.5c 11c +.ft B +.. +'\" # SE - end of list of standard options +.de SE +.fi +.ft R +.LP +See the \\fBoptions\\fR manual entry for details on the standard options. +.. +'\" # OP - start of full description for a single option +.de OP +.LP +.nf +.ta 4c +Command-Line Name: \\fB\\$1\\fR +Database Name: \\fB\\$2\\fR +Database Class: \\fB\\$3\\fR +.fi +.IP +.. +'\" # CS - begin code excerpt +.de CS +.RS +.nf +.ta .25i .5i .75i 1i +.if t .ft C +.. +'\" # CE - end code excerpt +.de CE +.fi +.if t .ft R +.RE +.. +.de UL +\\$1\l'|0\(ul'\\$2 +.. diff --git a/tcl8.6/pkgs/thread2.8.4/doc/man/thread.n b/tcl8.6/pkgs/thread2.8.4/doc/man/thread.n new file mode 100644 index 0000000..4b5f1cc --- /dev/null +++ b/tcl8.6/pkgs/thread2.8.4/doc/man/thread.n @@ -0,0 +1,866 @@ +'\" +'\" Generated from file '' by tcllib/doctools with format 'nroff' +'\" +.TH "thread" n 2\&.8 "Tcl Threading" +.\" The -*- nroff -*- definitions below are for supplemental macros used +.\" in Tcl/Tk manual entries. +.\" +.\" .AP type name in/out ?indent? +.\" Start paragraph describing an argument to a library procedure. +.\" type is type of argument (int, etc.), in/out is either "in", "out", +.\" or "in/out" to describe whether procedure reads or modifies arg, +.\" and indent is equivalent to second arg of .IP (shouldn't ever be +.\" needed; use .AS below instead) +.\" +.\" .AS ?type? ?name? +.\" Give maximum sizes of arguments for setting tab stops. Type and +.\" name are examples of largest possible arguments that will be passed +.\" to .AP later. If args are omitted, default tab stops are used. +.\" +.\" .BS +.\" Start box enclosure. From here until next .BE, everything will be +.\" enclosed in one large box. +.\" +.\" .BE +.\" End of box enclosure. +.\" +.\" .CS +.\" Begin code excerpt. +.\" +.\" .CE +.\" End code excerpt. +.\" +.\" .VS ?version? ?br? +.\" Begin vertical sidebar, for use in marking newly-changed parts +.\" of man pages. The first argument is ignored and used for recording +.\" the version when the .VS was added, so that the sidebars can be +.\" found and removed when they reach a certain age. If another argument +.\" is present, then a line break is forced before starting the sidebar. +.\" +.\" .VE +.\" End of vertical sidebar. +.\" +.\" .DS +.\" Begin an indented unfilled display. +.\" +.\" .DE +.\" End of indented unfilled display. +.\" +.\" .SO ?manpage? +.\" Start of list of standard options for a Tk widget. The manpage +.\" argument defines where to look up the standard options; if +.\" omitted, defaults to "options". The options follow on successive +.\" lines, in three columns separated by tabs. +.\" +.\" .SE +.\" End of list of standard options for a Tk widget. +.\" +.\" .OP cmdName dbName dbClass +.\" Start of description of a specific option. cmdName gives the +.\" option's name as specified in the class command, dbName gives +.\" the option's name in the option database, and dbClass gives +.\" the option's class in the option database. +.\" +.\" .UL arg1 arg2 +.\" Print arg1 underlined, then print arg2 normally. +.\" +.\" .QW arg1 ?arg2? +.\" Print arg1 in quotes, then arg2 normally (for trailing punctuation). +.\" +.\" .PQ arg1 ?arg2? +.\" Print an open parenthesis, arg1 in quotes, then arg2 normally +.\" (for trailing punctuation) and then a closing parenthesis. +.\" +.\" # Set up traps and other miscellaneous stuff for Tcl/Tk man pages. +.if t .wh -1.3i ^B +.nr ^l \n(.l +.ad b +.\" # Start an argument description +.de AP +.ie !"\\$4"" .TP \\$4 +.el \{\ +. ie !"\\$2"" .TP \\n()Cu +. el .TP 15 +.\} +.ta \\n()Au \\n()Bu +.ie !"\\$3"" \{\ +\&\\$1 \\fI\\$2\\fP (\\$3) +.\".b +.\} +.el \{\ +.br +.ie !"\\$2"" \{\ +\&\\$1 \\fI\\$2\\fP +.\} +.el \{\ +\&\\fI\\$1\\fP +.\} +.\} +.. +.\" # define tabbing values for .AP +.de AS +.nr )A 10n +.if !"\\$1"" .nr )A \\w'\\$1'u+3n +.nr )B \\n()Au+15n +.\" +.if !"\\$2"" .nr )B \\w'\\$2'u+\\n()Au+3n +.nr )C \\n()Bu+\\w'(in/out)'u+2n +.. +.AS Tcl_Interp Tcl_CreateInterp in/out +.\" # BS - start boxed text +.\" # ^y = starting y location +.\" # ^b = 1 +.de BS +.br +.mk ^y +.nr ^b 1u +.if n .nf +.if n .ti 0 +.if n \l'\\n(.lu\(ul' +.if n .fi +.. +.\" # BE - end boxed text (draw box now) +.de BE +.nf +.ti 0 +.mk ^t +.ie n \l'\\n(^lu\(ul' +.el \{\ +.\" Draw four-sided box normally, but don't draw top of +.\" box if the box started on an earlier page. +.ie !\\n(^b-1 \{\ +\h'-1.5n'\L'|\\n(^yu-1v'\l'\\n(^lu+3n\(ul'\L'\\n(^tu+1v-\\n(^yu'\l'|0u-1.5n\(ul' +.\} +.el \}\ +\h'-1.5n'\L'|\\n(^yu-1v'\h'\\n(^lu+3n'\L'\\n(^tu+1v-\\n(^yu'\l'|0u-1.5n\(ul' +.\} +.\} +.fi +.br +.nr ^b 0 +.. +.\" # VS - start vertical sidebar +.\" # ^Y = starting y location +.\" # ^v = 1 (for troff; for nroff this doesn't matter) +.de VS +.if !"\\$2"" .br +.mk ^Y +.ie n 'mc \s12\(br\s0 +.el .nr ^v 1u +.. +.\" # VE - end of vertical sidebar +.de VE +.ie n 'mc +.el \{\ +.ev 2 +.nf +.ti 0 +.mk ^t +\h'|\\n(^lu+3n'\L'|\\n(^Yu-1v\(bv'\v'\\n(^tu+1v-\\n(^Yu'\h'-|\\n(^lu+3n' +.sp -1 +.fi +.ev +.\} +.nr ^v 0 +.. +.\" # Special macro to handle page bottom: finish off current +.\" # box/sidebar if in box/sidebar mode, then invoked standard +.\" # page bottom macro. +.de ^B +.ev 2 +'ti 0 +'nf +.mk ^t +.if \\n(^b \{\ +.\" Draw three-sided box if this is the box's first page, +.\" draw two sides but no top otherwise. +.ie !\\n(^b-1 \h'-1.5n'\L'|\\n(^yu-1v'\l'\\n(^lu+3n\(ul'\L'\\n(^tu+1v-\\n(^yu'\h'|0u'\c +.el \h'-1.5n'\L'|\\n(^yu-1v'\h'\\n(^lu+3n'\L'\\n(^tu+1v-\\n(^yu'\h'|0u'\c +.\} +.if \\n(^v \{\ +.nr ^x \\n(^tu+1v-\\n(^Yu +\kx\h'-\\nxu'\h'|\\n(^lu+3n'\ky\L'-\\n(^xu'\v'\\n(^xu'\h'|0u'\c +.\} +.bp +'fi +.ev +.if \\n(^b \{\ +.mk ^y +.nr ^b 2 +.\} +.if \\n(^v \{\ +.mk ^Y +.\} +.. +.\" # DS - begin display +.de DS +.RS +.nf +.sp +.. +.\" # DE - end display +.de DE +.fi +.RE +.sp +.. +.\" # SO - start of list of standard options +.de SO +'ie '\\$1'' .ds So \\fBoptions\\fR +'el .ds So \\fB\\$1\\fR +.SH "STANDARD OPTIONS" +.LP +.nf +.ta 5.5c 11c +.ft B +.. +.\" # SE - end of list of standard options +.de SE +.fi +.ft R +.LP +See the \\*(So manual entry for details on the standard options. +.. +.\" # OP - start of full description for a single option +.de OP +.LP +.nf +.ta 4c +Command-Line Name: \\fB\\$1\\fR +Database Name: \\fB\\$2\\fR +Database Class: \\fB\\$3\\fR +.fi +.IP +.. +.\" # CS - begin code excerpt +.de CS +.RS +.nf +.ta .25i .5i .75i 1i +.. +.\" # CE - end code excerpt +.de CE +.fi +.RE +.. +.\" # UL - underline word +.de UL +\\$1\l'|0\(ul'\\$2 +.. +.\" # QW - apply quotation marks to word +.de QW +.ie '\\*(lq'"' ``\\$1''\\$2 +.\"" fix emacs highlighting +.el \\*(lq\\$1\\*(rq\\$2 +.. +.\" # PQ - apply parens and quotation marks to word +.de PQ +.ie '\\*(lq'"' (``\\$1''\\$2)\\$3 +.\"" fix emacs highlighting +.el (\\*(lq\\$1\\*(rq\\$2)\\$3 +.. +.\" # QR - quoted range +.de QR +.ie '\\*(lq'"' ``\\$1''\\-``\\$2''\\$3 +.\"" fix emacs highlighting +.el \\*(lq\\$1\\*(rq\\-\\*(lq\\$2\\*(rq\\$3 +.. +.\" # MT - "empty" string +.de MT +.QW "" +.. +.BS +.SH NAME +thread \- Extension for script access to Tcl threading +.SH SYNOPSIS +package require \fBTcl 8\&.4\fR +.sp +package require \fBThread ?2\&.8?\fR +.sp +\fBthread::create\fR ?-joinable? ?-preserved? ?script? +.sp +\fBthread::preserve\fR ?id? +.sp +\fBthread::release\fR ?-wait? ?id? +.sp +\fBthread::id\fR +.sp +\fBthread::errorproc\fR ?procname? +.sp +\fBthread::cancel\fR ?-unwind? \fIid\fR ?result? +.sp +\fBthread::unwind\fR +.sp +\fBthread::exit\fR ?status? +.sp +\fBthread::names\fR +.sp +\fBthread::exists\fR \fIid\fR +.sp +\fBthread::send\fR ?-async? ?-head? \fIid\fR \fIscript\fR ?varname? +.sp +\fBthread::broadcast\fR \fIscript\fR +.sp +\fBthread::wait\fR +.sp +\fBthread::eval\fR ?-lock mutex? \fIarg\fR ?arg \&.\&.\&.? +.sp +\fBthread::join\fR \fIid\fR +.sp +\fBthread::configure\fR \fIid\fR ?option? ?value? ?\&.\&.\&.? +.sp +\fBthread::transfer\fR \fIid\fR \fIchannel\fR +.sp +\fBthread::detach\fR \fIchannel\fR +.sp +\fBthread::attach\fR \fIchannel\fR +.sp +\fBthread::mutex\fR +.sp +\fBthread::mutex\fR \fBcreate\fR ?-recursive? +.sp +\fBthread::mutex\fR \fBdestroy\fR \fImutex\fR +.sp +\fBthread::mutex\fR \fBlock\fR \fImutex\fR +.sp +\fBthread::mutex\fR \fBunlock\fR \fImutex\fR +.sp +\fBthread::rwmutex\fR +.sp +\fBthread::rwmutex\fR \fBcreate\fR +.sp +\fBthread::rwmutex\fR \fBdestroy\fR \fImutex\fR +.sp +\fBthread::rwmutex\fR \fBrlock\fR \fImutex\fR +.sp +\fBthread::rwmutex\fR \fBwlock\fR \fImutex\fR +.sp +\fBthread::rwmutex\fR \fBunlock\fR \fImutex\fR +.sp +\fBthread::cond\fR +.sp +\fBthread::cond\fR \fBcreate\fR +.sp +\fBthread::cond\fR \fBdestroy\fR \fIcond\fR +.sp +\fBthread::cond\fR \fBnotify\fR \fIcond\fR +.sp +\fBthread::cond\fR \fBwait\fR \fIcond\fR \fImutex\fR ?ms? +.sp +.BE +.SH DESCRIPTION +The \fBthread\fR extension creates threads that contain Tcl +interpreters, and it lets you send scripts to those threads for +evaluation\&. +Additionaly, it provides script-level access to basic thread +synchronization primitives, like mutexes and condition variables\&. +.SH COMMANDS +This section describes commands for creating and destroying threads +and sending scripts to threads for evaluation\&. +.TP +\fBthread::create\fR ?-joinable? ?-preserved? ?script? +This command creates a thread that contains a Tcl interpreter\&. +The Tcl interpreter either evaluates the optional \fBscript\fR, if +specified, or it waits in the event loop for scripts that arrive via +the \fBthread::send\fR command\&. The result, if any, of the +optional \fBscript\fR is never returned to the caller\&. +The result of \fBthread::create\fR is the ID of the thread\&. This is +the opaque handle which identifies the newly created thread for +all other package commands\&. The handle of the thread goes out of scope +automatically when thread is marked for exit +(see the \fBthread::release\fR command below)\&. +.sp +If the optional \fBscript\fR argument contains the \fBthread::wait\fR +command the thread will enter into the event loop\&. If such command is not +found in the \fBscript\fR the thread will run the \fBscript\fR to +the end and exit\&. In that case, the handle may be safely ignored since it +refers to a thread which does not exists any more at the time when the +command returns\&. +.sp +Using flag \fB-joinable\fR it is possible to create a joinable +thread, i\&.e\&. one upon whose exit can be waited upon by using +\fBthread::join\fR command\&. +Note that failure to join a thread created with \fB-joinable\fR flag +results in resource and memory leaks\&. +.sp +Threads created by the \fBthread::create\fR cannot be destroyed +forcefully\&. Consequently, there is no corresponding thread destroy +command\&. A thread may only be released using the \fBthread::release\fR +and if its internal reference count drops to zero, the thread is +marked for exit\&. This kicks the thread out of the event loop +servicing and the thread continues to execute commands passed in +the \fBscript\fR argument, following the \fBthread::wait\fR +command\&. If this was the last command in the script, as usualy the +case, the thread will exit\&. +.sp +It is possible to create a situation in which it may be impossible +to terminate the thread, for example by putting some endless loop +after the \fBthread::wait\fR or entering the event loop again by +doing an vwait-type of command\&. In such cases, the thread may never +exit\&. This is considered to be a bad practice and should be avoided +if possible\&. This is best illustrated by the example below: +.CS + + + # You should never do \&.\&.\&. + set tid [thread::create { + package require Http + thread::wait + vwait forever ; # <-- this! + }] + +.CE +.IP +The thread created in the above example will never be able to exit\&. +After it has been released with the last matching \fBthread::release\fR +call, the thread will jump out of the \fBthread::wait\fR and continue +to execute commands following\&. It will enter \fBvwait\fR command and +wait endlessly for events\&. There is no way one can terminate such thread, +so you wouldn't want to do this! +.sp +Each newly created has its internal reference counter set to 0 (zero), +i\&.e\&. it is unreserved\&. This counter gets incremented by a call to +\fBthread::preserve\fR and decremented by a call to \fBthread::release\fR +command\&. These two commands implement simple but effective thread +reservation system and offer predictable and controllable thread +termination capabilities\&. It is however possible to create initialy +preserved threads by using flag \fB-preserved\fR of the +\fBthread::create\fR command\&. Threads created with this flag have the +initial value of the reference counter of 1 (one), and are thus +initially marked reserved\&. +.TP +\fBthread::preserve\fR ?id? +This command increments the thread reference counter\&. Each call +to this command increments the reference counter by one (1)\&. +Command returns the value of the reference counter after the increment\&. +If called with the optional thread \fBid\fR, the command preserves +the given thread\&. Otherwise the current thread is preserved\&. +.sp +With reference counting, one can implement controlled access to a +shared Tcl thread\&. By incrementing the reference counter, the +caller signalizes that he/she wishes to use the thread for a longer +period of time\&. By decrementing the counter, caller signalizes that +he/she has finished using the thread\&. +.TP +\fBthread::release\fR ?-wait? ?id? +This command decrements the thread reference counter\&. Each call to +this command decrements the reference counter by one (1)\&. +If called with the optional thread \fBid\fR, the command releases +the given thread\&. Otherwise, the current thread is released\&. +Command returns the value of the reference counter after the decrement\&. +When the reference counter reaches zero (0), the target thread is +marked for termination\&. You should not reference the thread after the +\fBthread::release\fR command returns zero or negative integer\&. +The handle of the thread goes out of scope and should not be used any +more\&. Any following reference to the same thread handle will result +in Tcl error\&. +.sp +Optional flag \fB-wait\fR instructs the caller thread to wait for +the target thread to exit, if the effect of the command would result +in termination of the target thread, i\&.e\&. if the return result would +be zero (0)\&. Without the flag, the caller thread does not wait for +the target thread to exit\&. Care must be taken when using the +\fB-wait\fR, since this may block the caller thread indefinitely\&. +This option has been implemented for some special uses of the extension +and is deprecated for regular use\&. Regular users should create joinable +threads by using the \fB-joinable\fR option of the \fBthread::create\fR +command and the \fBthread::join\fR to wait for thread to exit\&. +.TP +\fBthread::id\fR +This command returns the ID of the current thread\&. +.TP +\fBthread::errorproc\fR ?procname? +This command sets a handler for errors that occur in scripts sent +asynchronously, using the \fB-async\fR flag of the +\fBthread::send\fR command, to other threads\&. If no handler +is specified, the current handler is returned\&. The empty string +resets the handler to default (unspecified) value\&. +An uncaught error in a thread causes an error message to be sent +to the standard error channel\&. This default reporting scheme can +be changed by registering a procedure which is called to report +the error\&. The \fIprocname\fR is called in the interpreter that +invoked the \fBthread::errorproc\fR command\&. The \fIprocname\fR +is called like this: +.CS + + + myerrorproc thread_id errorInfo + +.CE +.TP +\fBthread::cancel\fR ?-unwind? \fIid\fR ?result? +This command requires Tcl version 8\&.6 or higher\&. +.sp +Cancels the script being evaluated in the thread given by the \fIid\fR +parameter\&. Without the \fB-unwind\fR switch the evaluation stack for +the interpreter is unwound until an enclosing catch command is found or +there are no further invocations of the interpreter left on the call +stack\&. With the \fB-unwind\fR switch the evaluation stack for the +interpreter is unwound without regard to any intervening catch command +until there are no further invocations of the interpreter left on the +call stack\&. If \fIresult\fR is present, it will be used as the error +message string; otherwise, a default error message string will be used\&. +.TP +\fBthread::unwind\fR +Use of this command is deprecated in favour of more advanced thread +reservation system implemented with \fBthread::preserve\fR and +\fBthread::release\fR commands\&. Support for \fBthread::unwind\fR +command will dissapear in some future major release of the extension\&. +.sp +This command stops a prior \fBthread::wait\fR command\&. Execution of +the script passed to newly created thread will continue from the +\fBthread::wait\fR command\&. If \fBthread::wait\fR was the last command +in the script, the thread will exit\&. The command returns empty result +but may trigger Tcl error with the message "target thread died" in some +situations\&. +.TP +\fBthread::exit\fR ?status? +Use of this command is deprecated in favour of more advanced thread +reservation system implemented with \fBthread::preserve\fR and +\fBthread::release\fR commands\&. Support for \fBthread::exit\fR +command will dissapear in some future major release of the extension\&. +.sp +This command forces a thread stuck in the \fBthread::wait\fR command to +unconditionaly exit\&. The thread's exit status defaults to 666 and can be +specified using the optional \fIstatus\fR argument\&. The execution of +\fBthread::exit\fR command is guaranteed to leave the program memory in the +unconsistent state, produce memory leaks and otherwise affect other subsytem(s) +of the Tcl application in an unpredictable manner\&. The command returns empty +result but may trigger Tcl error with the message "target thread died" in some +situations\&. +.TP +\fBthread::names\fR +This command returns a list of thread IDs\&. These are only for +threads that have been created via \fBthread::create\fR command\&. +If your application creates other threads at the C level, they +are not reported by this command\&. +.TP +\fBthread::exists\fR \fIid\fR +Returns true (1) if thread given by the \fIid\fR parameter exists, +false (0) otherwise\&. This applies only for threads that have +been created via \fBthread::create\fR command\&. +.TP +\fBthread::send\fR ?-async? ?-head? \fIid\fR \fIscript\fR ?varname? +This command passes a \fIscript\fR to another thread and, optionally, +waits for the result\&. If the \fB-async\fR flag is specified, the +command does not wait for the result and it returns empty string\&. +The target thread must enter it's event loop in order to receive +scripts sent via this command\&. This is done by default for threads +created without a startup script\&. Threads can enter the event loop +explicitly by calling \fBthread::wait\fR or any other relevant Tcl/Tk +command, like \fBupdate\fR, \fBvwait\fR, etc\&. +.sp +Optional \fBvarname\fR specifies name of the variable to store +the result of the \fIscript\fR\&. Without the \fB-async\fR flag, +the command returns the evaluation code, similarily to the standard +Tcl \fBcatch\fR command\&. If, however, the \fB-async\fR flag is +specified, the command returns immediately and caller can later +\fBvwait\fR on ?varname? to get the result of the passed \fIscript\fR +.CS + + + set t1 [thread::create] + set t2 [thread::create] + thread::send -async $t1 "set a 1" result + thread::send -async $t2 "set b 2" result + for {set i 0} {$i < 2} {incr i} { + vwait result + } + +.CE +.IP +In the above example, two threads were fed work and both of them were +instructed to signalize the same variable "result" in the calling thread\&. +The caller entered the event loop twice to get both results\&. Note, +however, that the order of the received results may vary, depending on +the current system load, type of work done, etc, etc\&. +.sp +Many threads can simultaneously send scripts to the target thread for +execution\&. All of them are entered into the event queue of the target +thread and executed on the FIFO basis, intermingled with optional other +events pending in the event queue of the target thread\&. +Using the optional ?-head? switch, scripts posted to the thread's +event queue can be placed on the head, instead on the tail of the queue, +thus being executed in the LIFO fashion\&. +.TP +\fBthread::broadcast\fR \fIscript\fR +This command passes a \fIscript\fR to all threads created by the +package for execution\&. It does not wait for response from any of +the threads\&. +.TP +\fBthread::wait\fR +This enters the event loop so a thread can receive messages from +the \fBthread::send\fR command\&. This command should only be used +within the script passed to the \fBthread::create\fR\&. It should +be the very last command in the script\&. If this is not the case, +the exiting thread will continue executing the script lines past +the \fBthread::wait\fR which is usually not what you want and/or +expect\&. +.CS + + + set t1 [thread::create { + # + # Do some initialization work here + # + thread::wait ; # Enter the event loop + }] + +.CE +.TP +\fBthread::eval\fR ?-lock mutex? \fIarg\fR ?arg \&.\&.\&.? +This command concatenates passed arguments and evaluates the +resulting script under the mutex protection\&. If no mutex is +specified by using the ?-lock mutex? optional argument, +the internal static mutex is used\&. +.TP +\fBthread::join\fR \fIid\fR +This command waits for the thread with ID \fIid\fR to exit and +then returns it's exit code\&. Errors will be returned for threads +which are not joinable or already waited upon by another thread\&. +Upon the join the handle of the thread has gone out of scope and +should not be used any more\&. +.TP +\fBthread::configure\fR \fIid\fR ?option? ?value? ?\&.\&.\&.? +This command configures various low-level aspects of the thread with +ID \fIid\fR in the similar way as the standard Tcl command +\fBfconfigure\fR configures some Tcl channel options\&. Options currently +supported are: \fB-eventmark\fR and \fB-unwindonerror\fR\&. +.sp +The \fB-eventmark\fR option, when set, limits the number of +asynchronously posted scripts to the thread event loop\&. +The \fBthread::send -async\fR command will block until the number +of pending scripts in the event loop does not drop below the value +configured with \fB-eventmark\fR\&. Default value for the +\fB-eventmark\fR is 0 (zero) which effectively disables the checking, +i\&.e\&. allows for unlimited number of posted scripts\&. +.sp +The \fB-unwindonerror\fR option, when set, causes the +target thread to unwind if the result of the script processing +resulted in error\&. Default value for the \fB-unwindonerror\fR +is 0 (false), i\&.e\&. thread continues to process scripts after one +of the posted scripts fails\&. +.TP +\fBthread::transfer\fR \fIid\fR \fIchannel\fR +This moves the specified \fIchannel\fR from the current thread +and interpreter to the main interpreter of the thread with the +given \fIid\fR\&. After the move the current interpreter has no +access to the channel any more, but the main interpreter of the +target thread will be able to use it from now on\&. +The command waits until the other thread has incorporated the +channel\&. Because of this it is possible to deadlock the +participating threads by commanding the other through a +synchronous \fBthread::send\fR to transfer a channel to us\&. +This easily extends into longer loops of threads waiting for +each other\&. Other restrictions: the channel in question must +not be shared among multiple interpreters running in the +sending thread\&. This automatically excludes the special channels +for standard input, output and error\&. +.sp +Due to the internal Tcl core implementation and the restriction on +transferring shared channels, one has to take extra measures when +transferring socket channels created by accepting the connection +out of the \fBsocket\fR commands callback procedures: +.CS + + + socket -server _Accept 2200 + proc _Accept {s ipaddr port} { + after idle [list Accept $s $ipaddr $port] + } + proc Accept {s ipaddr port} { + set tid [thread::create] + thread::transfer $tid $s + } + +.CE +.TP +\fBthread::detach\fR \fIchannel\fR +This detaches the specified \fIchannel\fR from the current thread and +interpreter\&. After that, the current interpreter has no access to the +channel any more\&. The channel is in the parked state until some other +(or the same) thread attaches the channel again with \fBthread::attach\fR\&. +Restrictions: same as for transferring shared channels with the +\fBthread::transfer\fR command\&. +.TP +\fBthread::attach\fR \fIchannel\fR +This attaches the previously detached \fIchannel\fR in the +current thread/interpreter\&. For already existing channels, +the command does nothing, i\&.e\&. it is not an error to attach the +same channel more than once\&. The first operation will actualy +perform the operation, while all subsequent operation will just +do nothing\&. Command throws error if the \fIchannel\fR cannot be +found in the list of detached channels and/or in the current +interpreter\&. +.TP +\fBthread::mutex\fR +Mutexes are most common thread synchronization primitives\&. +They are used to synchronize access from two or more threads to one or +more shared resources\&. This command provides script-level access to +exclusive and/or recursive mutexes\&. Exclusive mutexes can be locked +only once by one thread, while recursive mutexes can be locked many +times by the same thread\&. For recursive mutexes, number of lock and +unlock operations must match, otherwise, the mutex will never be +released, which would lead to various deadlock situations\&. +.sp +Care has to be taken when using mutexes in an multithreading program\&. +Improper use of mutexes may lead to various deadlock situations, +especially when using exclusive mutexes\&. +.sp +The \fBthread::mutex\fR command supports following subcommands and options: +.RS +.TP +\fBthread::mutex\fR \fBcreate\fR ?-recursive? +Creates the mutex and returns it's opaque handle\&. This handle +should be used for any future reference to the newly created mutex\&. +If no optional ?-recursive? argument was specified, the command +creates the exclusive mutex\&. With the ?-recursive? argument, +the command creates a recursive mutex\&. +.TP +\fBthread::mutex\fR \fBdestroy\fR \fImutex\fR +Destroys the \fImutex\fR\&. Mutex should be in unlocked state before +the destroy attempt\&. If the mutex is locked, the command will throw +Tcl error\&. +.TP +\fBthread::mutex\fR \fBlock\fR \fImutex\fR +Locks the \fImutex\fR\&. Locking the exclusive mutex may throw Tcl +error if on attempt to lock the same mutex twice from the same +thread\&. If your program logic forces you to lock the same mutex +twice or more from the same thread (this may happen in recursive +procedure invocations) you should consider using the recursive mutexes\&. +.TP +\fBthread::mutex\fR \fBunlock\fR \fImutex\fR +Unlocks the \fImutex\fR so some other thread may lock it again\&. +Attempt to unlock the already unlocked mutex will throw Tcl error\&. +.RE +.sp +.TP +\fBthread::rwmutex\fR +This command creates many-readers/single-writer mutexes\&. Reader/writer +mutexes allow you to serialize access to a shared resource more optimally\&. +In situations where a shared resource gets mostly read and seldom modified, +you might gain some performace by using reader/writer mutexes instead of +exclusive or recursive mutexes\&. +.sp +For reading the resource, thread should obtain a read lock on the resource\&. +Read lock is non-exclusive, meaning that more than one thread can +obtain a read lock to the same resource, without waiting on other readers\&. +For changing the resource, however, a thread must obtain a exclusive +write lock\&. This lock effectively blocks all threads from gaining the +read-lock while the resource is been modified by the writer thread\&. +Only after the write lock has been released, the resource may be read-locked +again\&. +.sp +The \fBthread::rwmutex\fR command supports following subcommands and options: +.RS +.TP +\fBthread::rwmutex\fR \fBcreate\fR +Creates the reader/writer mutex and returns it's opaque handle\&. +This handle should be used for any future reference to the newly +created mutex\&. +.TP +\fBthread::rwmutex\fR \fBdestroy\fR \fImutex\fR +Destroys the reader/writer \fImutex\fR\&. If the mutex is already locked, +attempt to destroy it will throw Tcl error\&. +.TP +\fBthread::rwmutex\fR \fBrlock\fR \fImutex\fR +Locks the \fImutex\fR for reading\&. More than one thread may read-lock +the same \fImutex\fR at the same time\&. +.TP +\fBthread::rwmutex\fR \fBwlock\fR \fImutex\fR +Locks the \fImutex\fR for writing\&. Only one thread may write-lock +the same \fImutex\fR at the same time\&. Attempt to write-lock same +\fImutex\fR twice from the same thread will throw Tcl error\&. +.TP +\fBthread::rwmutex\fR \fBunlock\fR \fImutex\fR +Unlocks the \fImutex\fR so some other thread may lock it again\&. +Attempt to unlock already unlocked \fImutex\fR will throw Tcl error\&. +.RE +.sp +.TP +\fBthread::cond\fR +This command provides script-level access to condition variables\&. +A condition variable creates a safe environment for the program +to test some condition, sleep on it when false and be awakened +when it might have become true\&. A condition variable is always +used in the conjuction with an exclusive mutex\&. If you attempt +to use other type of mutex in conjuction with the condition +variable, a Tcl error will be thrown\&. +.sp +The command supports following subcommands and options: +.RS +.TP +\fBthread::cond\fR \fBcreate\fR +Creates the condition variable and returns it's opaque handle\&. +This handle should be used for any future reference to newly +created condition variable\&. +.TP +\fBthread::cond\fR \fBdestroy\fR \fIcond\fR +Destroys condition variable \fIcond\fR\&. Extreme care has to be taken +that nobody is using (i\&.e\&. waiting on) the condition variable, +otherwise unexpected errors may happen\&. +.TP +\fBthread::cond\fR \fBnotify\fR \fIcond\fR +Wakes up all threads waiting on the condition variable \fIcond\fR\&. +.TP +\fBthread::cond\fR \fBwait\fR \fIcond\fR \fImutex\fR ?ms? +This command is used to suspend program execution until the condition +variable \fIcond\fR has been signalled or the optional timer has expired\&. +The exclusive \fImutex\fR must be locked by the calling thread on entrance +to this command\&. If the mutex is not locked, Tcl error is thrown\&. +While waiting on the \fIcond\fR, the command releases \fImutex\fR\&. +Before returning to the calling thread, the command re-acquires the +\fImutex\fR again\&. Unlocking the \fImutex\fR and waiting on the +condition variable \fIcond\fR is done atomically\&. +.sp +The \fBms\fR command option, if given, must be an integer specifying +time interval in milliseconds the command waits to be signalled\&. +Otherwise the command waits on condition notify forever\&. +.sp +In multithreading programs, there are many situations where a thread has +to wait for some event to happen until it is allowed to proceed\&. +This is usually accomplished by repeatedly testing a condition under the +mutex protection and waiting on the condition variable until the condition +evaluates to true: +.CS + + + set mutex [thread::mutex create] + set cond [thread::cond create] + + thread::mutex lock $mutex + while {<some_condition_is_true>} { + thread::cond wait $cond $mutex + } + # Do some work under mutex protection + thread::mutex unlock $mutex + +.CE +.IP +Repeated testing of the condition is needed since the condition variable +may get signalled without the condition being actually changed (spurious +thread wake-ups, for example)\&. +.RE +.PP +.SH DISCUSSION +The fundamental threading model in Tcl is that there can be one or +more Tcl interpreters per thread, but each Tcl interpreter should +only be used by a single thread which created it\&. +A "shared memory" abstraction is awkward to provide in Tcl because +Tcl makes assumptions about variable and data ownership\&. Therefore +this extension supports a simple form of threading where the main +thread can manage several background, or "worker" threads\&. +For example, an event-driven server can pass requests to worker +threads, and then await responses from worker threads or new client +requests\&. Everything goes through the common Tcl event loop, so +message passing between threads works naturally with event-driven I/O, +\fBvwait\fR on variables, and so forth\&. For the transfer of bulk +information it is possible to move channels between the threads\&. +.PP +For advanced multithreading scripts, script-level access to two +basic synchronization primitives, mutex and condition variables, +is also supported\&. +.SH "SEE ALSO" +\fIhttp://www\&.tcl\&.tk/doc/howto/thread_model\&.html\fR, tpool, tsv, ttrace +.SH KEYWORDS +events, message passing, mutex, synchronization, thread diff --git a/tcl8.6/pkgs/thread2.8.4/doc/man/tpool.n b/tcl8.6/pkgs/thread2.8.4/doc/man/tpool.n new file mode 100644 index 0000000..a915bcb --- /dev/null +++ b/tcl8.6/pkgs/thread2.8.4/doc/man/tpool.n @@ -0,0 +1,496 @@ +'\" +'\" Generated from file '' by tcllib/doctools with format 'nroff' +'\" +.TH "tpool" n 2\&.8 "Tcl Threading" +.\" The -*- nroff -*- definitions below are for supplemental macros used +.\" in Tcl/Tk manual entries. +.\" +.\" .AP type name in/out ?indent? +.\" Start paragraph describing an argument to a library procedure. +.\" type is type of argument (int, etc.), in/out is either "in", "out", +.\" or "in/out" to describe whether procedure reads or modifies arg, +.\" and indent is equivalent to second arg of .IP (shouldn't ever be +.\" needed; use .AS below instead) +.\" +.\" .AS ?type? ?name? +.\" Give maximum sizes of arguments for setting tab stops. Type and +.\" name are examples of largest possible arguments that will be passed +.\" to .AP later. If args are omitted, default tab stops are used. +.\" +.\" .BS +.\" Start box enclosure. From here until next .BE, everything will be +.\" enclosed in one large box. +.\" +.\" .BE +.\" End of box enclosure. +.\" +.\" .CS +.\" Begin code excerpt. +.\" +.\" .CE +.\" End code excerpt. +.\" +.\" .VS ?version? ?br? +.\" Begin vertical sidebar, for use in marking newly-changed parts +.\" of man pages. The first argument is ignored and used for recording +.\" the version when the .VS was added, so that the sidebars can be +.\" found and removed when they reach a certain age. If another argument +.\" is present, then a line break is forced before starting the sidebar. +.\" +.\" .VE +.\" End of vertical sidebar. +.\" +.\" .DS +.\" Begin an indented unfilled display. +.\" +.\" .DE +.\" End of indented unfilled display. +.\" +.\" .SO ?manpage? +.\" Start of list of standard options for a Tk widget. The manpage +.\" argument defines where to look up the standard options; if +.\" omitted, defaults to "options". The options follow on successive +.\" lines, in three columns separated by tabs. +.\" +.\" .SE +.\" End of list of standard options for a Tk widget. +.\" +.\" .OP cmdName dbName dbClass +.\" Start of description of a specific option. cmdName gives the +.\" option's name as specified in the class command, dbName gives +.\" the option's name in the option database, and dbClass gives +.\" the option's class in the option database. +.\" +.\" .UL arg1 arg2 +.\" Print arg1 underlined, then print arg2 normally. +.\" +.\" .QW arg1 ?arg2? +.\" Print arg1 in quotes, then arg2 normally (for trailing punctuation). +.\" +.\" .PQ arg1 ?arg2? +.\" Print an open parenthesis, arg1 in quotes, then arg2 normally +.\" (for trailing punctuation) and then a closing parenthesis. +.\" +.\" # Set up traps and other miscellaneous stuff for Tcl/Tk man pages. +.if t .wh -1.3i ^B +.nr ^l \n(.l +.ad b +.\" # Start an argument description +.de AP +.ie !"\\$4"" .TP \\$4 +.el \{\ +. ie !"\\$2"" .TP \\n()Cu +. el .TP 15 +.\} +.ta \\n()Au \\n()Bu +.ie !"\\$3"" \{\ +\&\\$1 \\fI\\$2\\fP (\\$3) +.\".b +.\} +.el \{\ +.br +.ie !"\\$2"" \{\ +\&\\$1 \\fI\\$2\\fP +.\} +.el \{\ +\&\\fI\\$1\\fP +.\} +.\} +.. +.\" # define tabbing values for .AP +.de AS +.nr )A 10n +.if !"\\$1"" .nr )A \\w'\\$1'u+3n +.nr )B \\n()Au+15n +.\" +.if !"\\$2"" .nr )B \\w'\\$2'u+\\n()Au+3n +.nr )C \\n()Bu+\\w'(in/out)'u+2n +.. +.AS Tcl_Interp Tcl_CreateInterp in/out +.\" # BS - start boxed text +.\" # ^y = starting y location +.\" # ^b = 1 +.de BS +.br +.mk ^y +.nr ^b 1u +.if n .nf +.if n .ti 0 +.if n \l'\\n(.lu\(ul' +.if n .fi +.. +.\" # BE - end boxed text (draw box now) +.de BE +.nf +.ti 0 +.mk ^t +.ie n \l'\\n(^lu\(ul' +.el \{\ +.\" Draw four-sided box normally, but don't draw top of +.\" box if the box started on an earlier page. +.ie !\\n(^b-1 \{\ +\h'-1.5n'\L'|\\n(^yu-1v'\l'\\n(^lu+3n\(ul'\L'\\n(^tu+1v-\\n(^yu'\l'|0u-1.5n\(ul' +.\} +.el \}\ +\h'-1.5n'\L'|\\n(^yu-1v'\h'\\n(^lu+3n'\L'\\n(^tu+1v-\\n(^yu'\l'|0u-1.5n\(ul' +.\} +.\} +.fi +.br +.nr ^b 0 +.. +.\" # VS - start vertical sidebar +.\" # ^Y = starting y location +.\" # ^v = 1 (for troff; for nroff this doesn't matter) +.de VS +.if !"\\$2"" .br +.mk ^Y +.ie n 'mc \s12\(br\s0 +.el .nr ^v 1u +.. +.\" # VE - end of vertical sidebar +.de VE +.ie n 'mc +.el \{\ +.ev 2 +.nf +.ti 0 +.mk ^t +\h'|\\n(^lu+3n'\L'|\\n(^Yu-1v\(bv'\v'\\n(^tu+1v-\\n(^Yu'\h'-|\\n(^lu+3n' +.sp -1 +.fi +.ev +.\} +.nr ^v 0 +.. +.\" # Special macro to handle page bottom: finish off current +.\" # box/sidebar if in box/sidebar mode, then invoked standard +.\" # page bottom macro. +.de ^B +.ev 2 +'ti 0 +'nf +.mk ^t +.if \\n(^b \{\ +.\" Draw three-sided box if this is the box's first page, +.\" draw two sides but no top otherwise. +.ie !\\n(^b-1 \h'-1.5n'\L'|\\n(^yu-1v'\l'\\n(^lu+3n\(ul'\L'\\n(^tu+1v-\\n(^yu'\h'|0u'\c +.el \h'-1.5n'\L'|\\n(^yu-1v'\h'\\n(^lu+3n'\L'\\n(^tu+1v-\\n(^yu'\h'|0u'\c +.\} +.if \\n(^v \{\ +.nr ^x \\n(^tu+1v-\\n(^Yu +\kx\h'-\\nxu'\h'|\\n(^lu+3n'\ky\L'-\\n(^xu'\v'\\n(^xu'\h'|0u'\c +.\} +.bp +'fi +.ev +.if \\n(^b \{\ +.mk ^y +.nr ^b 2 +.\} +.if \\n(^v \{\ +.mk ^Y +.\} +.. +.\" # DS - begin display +.de DS +.RS +.nf +.sp +.. +.\" # DE - end display +.de DE +.fi +.RE +.sp +.. +.\" # SO - start of list of standard options +.de SO +'ie '\\$1'' .ds So \\fBoptions\\fR +'el .ds So \\fB\\$1\\fR +.SH "STANDARD OPTIONS" +.LP +.nf +.ta 5.5c 11c +.ft B +.. +.\" # SE - end of list of standard options +.de SE +.fi +.ft R +.LP +See the \\*(So manual entry for details on the standard options. +.. +.\" # OP - start of full description for a single option +.de OP +.LP +.nf +.ta 4c +Command-Line Name: \\fB\\$1\\fR +Database Name: \\fB\\$2\\fR +Database Class: \\fB\\$3\\fR +.fi +.IP +.. +.\" # CS - begin code excerpt +.de CS +.RS +.nf +.ta .25i .5i .75i 1i +.. +.\" # CE - end code excerpt +.de CE +.fi +.RE +.. +.\" # UL - underline word +.de UL +\\$1\l'|0\(ul'\\$2 +.. +.\" # QW - apply quotation marks to word +.de QW +.ie '\\*(lq'"' ``\\$1''\\$2 +.\"" fix emacs highlighting +.el \\*(lq\\$1\\*(rq\\$2 +.. +.\" # PQ - apply parens and quotation marks to word +.de PQ +.ie '\\*(lq'"' (``\\$1''\\$2)\\$3 +.\"" fix emacs highlighting +.el (\\*(lq\\$1\\*(rq\\$2)\\$3 +.. +.\" # QR - quoted range +.de QR +.ie '\\*(lq'"' ``\\$1''\\-``\\$2''\\$3 +.\"" fix emacs highlighting +.el \\*(lq\\$1\\*(rq\\-\\*(lq\\$2\\*(rq\\$3 +.. +.\" # MT - "empty" string +.de MT +.QW "" +.. +.BS +.SH NAME +tpool \- Part of the Tcl threading extension implementing pools of worker threads\&. +.SH SYNOPSIS +package require \fBTcl 8\&.4\fR +.sp +package require \fBThread ?2\&.8?\fR +.sp +\fBtpool::create\fR ?options? +.sp +\fBtpool::names\fR +.sp +\fBtpool::post\fR ?-detached? ?-nowait? \fItpool\fR \fIscript\fR +.sp +\fBtpool::wait\fR \fItpool\fR \fIjoblist\fR ?varname? +.sp +\fBtpool::cancel\fR \fItpool\fR \fIjoblist\fR ?varname? +.sp +\fBtpool::get\fR \fItpool\fR \fIjob\fR +.sp +\fBtpool::preserve\fR \fItpool\fR +.sp +\fBtpool::release\fR \fItpool\fR +.sp +\fBtpool::suspend\fR \fItpool\fR +.sp +\fBtpool::resume\fR \fItpool\fR +.sp +.BE +.SH DESCRIPTION +This package creates and manages pools of worker threads\&. It allows you +to post jobs to worker threads and wait for their completion\&. The +threadpool implementation is Tcl event-loop aware\&. That means that any +time a caller is forced to wait for an event (job being completed or +a worker thread becoming idle or initialized), the implementation will +enter the event loop and allow for servicing of other pending file or +timer (or any other supported) events\&. +.SH COMMANDS +.TP +\fBtpool::create\fR ?options? +This command creates new threadpool\&. It accepts several options as +key-value pairs\&. Options are used to tune some threadpool parameters\&. +The command returns the ID of the newly created threadpool\&. +.sp +Following options are supported: +.RS +.TP +\fB-minworkers\fR \fInumber\fR +Minimum number of worker threads needed for this threadpool instance\&. +During threadpool creation, the implementation will create somany +worker threads upfront and will keep at least number of them alive +during the lifetime of the threadpool instance\&. +Default value of this parameter is 0 (zero)\&. which means that a newly +threadpool will have no worker threads initialy\&. All worker threads +will be started on demand by callers running \fBtpool::post\fR command +and posting jobs to the job queue\&. +.TP +\fB-maxworkers\fR \fInumber\fR +Maximum number of worker threads allowed for this threadpool instance\&. +If a new job is pending and there are no idle worker threads available, +the implementation will try to create new worker thread\&. If the number +of available worker threads is lower than the given number, +new worker thread will start\&. The caller will automatically enter the +event loop and wait until the worker thread has initialized\&. If\&. however, +the number of available worker threads is equal to the given number, +the caller will enter the event loop and wait for the first worker thread +to get idle, thus ready to run the job\&. +Default value of this parameter is 4 (four), which means that the +threadpool instance will allow maximum of 4 worker threads running jobs +or being idle waiting for new jobs to get posted to the job queue\&. +.TP +\fB-idletime\fR \fIseconds\fR +Time in seconds an idle worker thread waits for the job to get posted +to the job queue\&. If no job arrives during this interval and the time +expires, the worker thread will check the number of currently available +worker threads and if the number is higher than the number set by the +\fBminthreads\fR option, it will exit\&. +If an \fBexitscript\fR has been defined, the exiting worker thread +will first run the script and then exit\&. Errors from the exit script, +if any, are ignored\&. +.sp +The idle worker thread is not servicing the event loop\&. If you, however, +put the worker thread into the event loop, by evaluating the +\fBvwait\fR or other related Tcl commands, the worker thread +will not be in the idle state, hence the idle timer will not be +taken into account\&. +Default value for this option is unspecified\&. +.TP +\fB-initcmd\fR \fIscript\fR +Sets a Tcl script used to initialize new worker thread\&. This is usually +used to load packages and commands in the worker, set default variables, +create namespaces, and such\&. If the passed script runs into a Tcl error, +the worker will not be created and the initiating command (either the +\fBtpool::create\fR or \fBtpool::post\fR) will throw error\&. +Default value for this option is unspecified, hence, the Tcl interpreter of +the worker thread will contain just the initial set of Tcl commands\&. +.TP +\fB-exitcmd\fR \fIscript\fR +Sets a Tcl script run when the idle worker thread exits\&. This is normaly +used to cleanup the state of the worker thread, release reserved resources, +cleanup memory and such\&. +Default value for this option is unspecified, thus no Tcl script will run +on the worker thread exit\&. +.RE +.sp +.TP +\fBtpool::names\fR +This command returns a list of IDs of threadpools created with the +\fBtpool::create\fR command\&. If no threadpools were found, the +command will return empty list\&. +.TP +\fBtpool::post\fR ?-detached? ?-nowait? \fItpool\fR \fIscript\fR +This command sends a \fIscript\fR to the target \fItpool\fR threadpool +for execution\&. The script will be executed in the first available idle +worker thread\&. If there are no idle worker threads available, the command +will create new one, enter the event loop and service events until the +newly created thread is initialized\&. If the current number of worker +threads is equal to the maximum number of worker threads, as defined +during the threadpool creation, the command will enter the event loop and +service events while waiting for one of the worker threads to become idle\&. +If the optional ?-nowait? argument is given, the command will not wait +for one idle worker\&. It will just place the job in the pool's job queue +and return immediately\&. +.sp +The command returns the ID of the posted job\&. This ID is used for subsequent +\fBtpool::wait\fR, \fBtpool::get\fR and \fBtpool::cancel\fR commands to wait +for and retrieve result of the posted script, or cancel the posted job +respectively\&. If the optional ?-detached? argument is specified, the +command will post a detached job\&. A detached job can not be cancelled or +waited upon and is not identified by the job ID\&. +.sp +If the threadpool \fItpool\fR is not found in the list of active +thread pools, the command will throw error\&. The error will also be triggered +if the newly created worker thread fails to initialize\&. +.TP +\fBtpool::wait\fR \fItpool\fR \fIjoblist\fR ?varname? +This command waits for one or many jobs, whose job IDs are given in the +\fIjoblist\fR to get processed by the worker thread(s)\&. If none of the +specified jobs are ready, the command will enter the event loop, service +events and wait for the first job to get ready\&. +.sp +The command returns the list of completed job IDs\&. If the optional variable +?varname? is given, it will be set to the list of jobs in the +\fIjoblist\fR which are still pending\&. If the threadpool \fItpool\fR +is not found in the list of active thread pools, the command will throw error\&. +.TP +\fBtpool::cancel\fR \fItpool\fR \fIjoblist\fR ?varname? +This command cancels the previously posted jobs given by the \fIjoblist\fR +to the pool \fItpool\fR\&. Job cancellation succeeds only for job still +waiting to be processed\&. If the job is already being executed by one of +the worker threads, the job will not be cancelled\&. +The command returns the list of cancelled job IDs\&. If the optional variable +?varname? is given, it will be set to the list of jobs in the +\fIjoblist\fR which were not cancelled\&. If the threadpool \fItpool\fR +is not found in the list of active thread pools, the command will throw error\&. +.TP +\fBtpool::get\fR \fItpool\fR \fIjob\fR +This command retrieves the result of the previously posted \fIjob\fR\&. +Only results of jobs waited upon with the \fBtpool::wait\fR command +can be retrieved\&. If the execution of the script resulted in error, +the command will throw the error and update the \fBerrorInfo\fR and +\fBerrorCode\fR variables correspondingly\&. If the pool \fItpool\fR +is not found in the list of threadpools, the command will throw error\&. +If the job \fIjob\fR is not ready for retrieval, because it is currently +being executed by the worker thread, the command will throw error\&. +.TP +\fBtpool::preserve\fR \fItpool\fR +Each call to this command increments the reference counter of the +threadpool \fItpool\fR by one (1)\&. Command returns the value of the +reference counter after the increment\&. +By incrementing the reference counter, the caller signalizes that +he/she wishes to use the resource for a longer period of time\&. +.TP +\fBtpool::release\fR \fItpool\fR +Each call to this command decrements the reference counter of the +threadpool \fItpool\fR by one (1)\&.Command returns the value of the +reference counter after the decrement\&. +When the reference counter reaches zero (0), the threadpool \fItpool\fR +is marked for termination\&. You should not reference the threadpool +after the \fBtpool::release\fR command returns zero\&. The \fItpool\fR +handle goes out of scope and should not be used any more\&. Any following +reference to the same threadpool handle will result in Tcl error\&. +.TP +\fBtpool::suspend\fR \fItpool\fR +Suspends processing work on this queue\&. All pool workers are paused +but additional work can be added to the pool\&. Note that adding the +additional work will not increase the number of workers dynamically +as the pool processing is suspended\&. Number of workers is maintained +to the count that was found prior suspending worker activity\&. +If you need to assure certain number of worker threads, use the +\fBminworkers\fR option of the \fBtpool::create\fR command\&. +.TP +\fBtpool::resume\fR \fItpool\fR +Resume processing work on this queue\&. All paused (suspended) +workers are free to get work from the pool\&. Note that resuming pool +operation will just let already created workers to proceed\&. +It will not create additional worker threads to handle the work +posted to the pool's work queue\&. +.PP +.SH DISCUSSION +Threadpool is one of the most common threading paradigm when it comes +to server applications handling a large number of relatively small tasks\&. +A very simplistic model for building a server application would be to +create a new thread each time a request arrives and service the request +in the new thread\&. One of the disadvantages of this approach is that +the overhead of creating a new thread for each request is significant; +a server that created a new thread for each request would spend more time +and consume more system resources in creating and destroying threads than +in processing actual user requests\&. In addition to the overhead of +creating and destroying threads, active threads consume system resources\&. +Creating too many threads can cause the system to run out of memory or +trash due to excessive memory consumption\&. +.PP +A thread pool offers a solution to both the problem of thread life-cycle +overhead and the problem of resource trashing\&. By reusing threads for +multiple tasks, the thread-creation overhead is spread over many tasks\&. +As a bonus, because the thread already exists when a request arrives, +the delay introduced by thread creation is eliminated\&. Thus, the request +can be serviced immediately\&. Furthermore, by properly tuning the number +of threads in the thread pool, resource thrashing may also be eliminated +by forcing any request to wait until a thread is available to process it\&. +.SH "SEE ALSO" +thread, tsv, ttrace +.SH KEYWORDS +thread, threadpool diff --git a/tcl8.6/pkgs/thread2.8.4/doc/man/tsv.n b/tcl8.6/pkgs/thread2.8.4/doc/man/tsv.n new file mode 100644 index 0000000..386e904 --- /dev/null +++ b/tcl8.6/pkgs/thread2.8.4/doc/man/tsv.n @@ -0,0 +1,628 @@ +'\" +'\" Generated from file '' by tcllib/doctools with format 'nroff' +'\" +.TH "tsv" n 2\&.8 "Tcl Threading" +.\" The -*- nroff -*- definitions below are for supplemental macros used +.\" in Tcl/Tk manual entries. +.\" +.\" .AP type name in/out ?indent? +.\" Start paragraph describing an argument to a library procedure. +.\" type is type of argument (int, etc.), in/out is either "in", "out", +.\" or "in/out" to describe whether procedure reads or modifies arg, +.\" and indent is equivalent to second arg of .IP (shouldn't ever be +.\" needed; use .AS below instead) +.\" +.\" .AS ?type? ?name? +.\" Give maximum sizes of arguments for setting tab stops. Type and +.\" name are examples of largest possible arguments that will be passed +.\" to .AP later. If args are omitted, default tab stops are used. +.\" +.\" .BS +.\" Start box enclosure. From here until next .BE, everything will be +.\" enclosed in one large box. +.\" +.\" .BE +.\" End of box enclosure. +.\" +.\" .CS +.\" Begin code excerpt. +.\" +.\" .CE +.\" End code excerpt. +.\" +.\" .VS ?version? ?br? +.\" Begin vertical sidebar, for use in marking newly-changed parts +.\" of man pages. The first argument is ignored and used for recording +.\" the version when the .VS was added, so that the sidebars can be +.\" found and removed when they reach a certain age. If another argument +.\" is present, then a line break is forced before starting the sidebar. +.\" +.\" .VE +.\" End of vertical sidebar. +.\" +.\" .DS +.\" Begin an indented unfilled display. +.\" +.\" .DE +.\" End of indented unfilled display. +.\" +.\" .SO ?manpage? +.\" Start of list of standard options for a Tk widget. The manpage +.\" argument defines where to look up the standard options; if +.\" omitted, defaults to "options". The options follow on successive +.\" lines, in three columns separated by tabs. +.\" +.\" .SE +.\" End of list of standard options for a Tk widget. +.\" +.\" .OP cmdName dbName dbClass +.\" Start of description of a specific option. cmdName gives the +.\" option's name as specified in the class command, dbName gives +.\" the option's name in the option database, and dbClass gives +.\" the option's class in the option database. +.\" +.\" .UL arg1 arg2 +.\" Print arg1 underlined, then print arg2 normally. +.\" +.\" .QW arg1 ?arg2? +.\" Print arg1 in quotes, then arg2 normally (for trailing punctuation). +.\" +.\" .PQ arg1 ?arg2? +.\" Print an open parenthesis, arg1 in quotes, then arg2 normally +.\" (for trailing punctuation) and then a closing parenthesis. +.\" +.\" # Set up traps and other miscellaneous stuff for Tcl/Tk man pages. +.if t .wh -1.3i ^B +.nr ^l \n(.l +.ad b +.\" # Start an argument description +.de AP +.ie !"\\$4"" .TP \\$4 +.el \{\ +. ie !"\\$2"" .TP \\n()Cu +. el .TP 15 +.\} +.ta \\n()Au \\n()Bu +.ie !"\\$3"" \{\ +\&\\$1 \\fI\\$2\\fP (\\$3) +.\".b +.\} +.el \{\ +.br +.ie !"\\$2"" \{\ +\&\\$1 \\fI\\$2\\fP +.\} +.el \{\ +\&\\fI\\$1\\fP +.\} +.\} +.. +.\" # define tabbing values for .AP +.de AS +.nr )A 10n +.if !"\\$1"" .nr )A \\w'\\$1'u+3n +.nr )B \\n()Au+15n +.\" +.if !"\\$2"" .nr )B \\w'\\$2'u+\\n()Au+3n +.nr )C \\n()Bu+\\w'(in/out)'u+2n +.. +.AS Tcl_Interp Tcl_CreateInterp in/out +.\" # BS - start boxed text +.\" # ^y = starting y location +.\" # ^b = 1 +.de BS +.br +.mk ^y +.nr ^b 1u +.if n .nf +.if n .ti 0 +.if n \l'\\n(.lu\(ul' +.if n .fi +.. +.\" # BE - end boxed text (draw box now) +.de BE +.nf +.ti 0 +.mk ^t +.ie n \l'\\n(^lu\(ul' +.el \{\ +.\" Draw four-sided box normally, but don't draw top of +.\" box if the box started on an earlier page. +.ie !\\n(^b-1 \{\ +\h'-1.5n'\L'|\\n(^yu-1v'\l'\\n(^lu+3n\(ul'\L'\\n(^tu+1v-\\n(^yu'\l'|0u-1.5n\(ul' +.\} +.el \}\ +\h'-1.5n'\L'|\\n(^yu-1v'\h'\\n(^lu+3n'\L'\\n(^tu+1v-\\n(^yu'\l'|0u-1.5n\(ul' +.\} +.\} +.fi +.br +.nr ^b 0 +.. +.\" # VS - start vertical sidebar +.\" # ^Y = starting y location +.\" # ^v = 1 (for troff; for nroff this doesn't matter) +.de VS +.if !"\\$2"" .br +.mk ^Y +.ie n 'mc \s12\(br\s0 +.el .nr ^v 1u +.. +.\" # VE - end of vertical sidebar +.de VE +.ie n 'mc +.el \{\ +.ev 2 +.nf +.ti 0 +.mk ^t +\h'|\\n(^lu+3n'\L'|\\n(^Yu-1v\(bv'\v'\\n(^tu+1v-\\n(^Yu'\h'-|\\n(^lu+3n' +.sp -1 +.fi +.ev +.\} +.nr ^v 0 +.. +.\" # Special macro to handle page bottom: finish off current +.\" # box/sidebar if in box/sidebar mode, then invoked standard +.\" # page bottom macro. +.de ^B +.ev 2 +'ti 0 +'nf +.mk ^t +.if \\n(^b \{\ +.\" Draw three-sided box if this is the box's first page, +.\" draw two sides but no top otherwise. +.ie !\\n(^b-1 \h'-1.5n'\L'|\\n(^yu-1v'\l'\\n(^lu+3n\(ul'\L'\\n(^tu+1v-\\n(^yu'\h'|0u'\c +.el \h'-1.5n'\L'|\\n(^yu-1v'\h'\\n(^lu+3n'\L'\\n(^tu+1v-\\n(^yu'\h'|0u'\c +.\} +.if \\n(^v \{\ +.nr ^x \\n(^tu+1v-\\n(^Yu +\kx\h'-\\nxu'\h'|\\n(^lu+3n'\ky\L'-\\n(^xu'\v'\\n(^xu'\h'|0u'\c +.\} +.bp +'fi +.ev +.if \\n(^b \{\ +.mk ^y +.nr ^b 2 +.\} +.if \\n(^v \{\ +.mk ^Y +.\} +.. +.\" # DS - begin display +.de DS +.RS +.nf +.sp +.. +.\" # DE - end display +.de DE +.fi +.RE +.sp +.. +.\" # SO - start of list of standard options +.de SO +'ie '\\$1'' .ds So \\fBoptions\\fR +'el .ds So \\fB\\$1\\fR +.SH "STANDARD OPTIONS" +.LP +.nf +.ta 5.5c 11c +.ft B +.. +.\" # SE - end of list of standard options +.de SE +.fi +.ft R +.LP +See the \\*(So manual entry for details on the standard options. +.. +.\" # OP - start of full description for a single option +.de OP +.LP +.nf +.ta 4c +Command-Line Name: \\fB\\$1\\fR +Database Name: \\fB\\$2\\fR +Database Class: \\fB\\$3\\fR +.fi +.IP +.. +.\" # CS - begin code excerpt +.de CS +.RS +.nf +.ta .25i .5i .75i 1i +.. +.\" # CE - end code excerpt +.de CE +.fi +.RE +.. +.\" # UL - underline word +.de UL +\\$1\l'|0\(ul'\\$2 +.. +.\" # QW - apply quotation marks to word +.de QW +.ie '\\*(lq'"' ``\\$1''\\$2 +.\"" fix emacs highlighting +.el \\*(lq\\$1\\*(rq\\$2 +.. +.\" # PQ - apply parens and quotation marks to word +.de PQ +.ie '\\*(lq'"' (``\\$1''\\$2)\\$3 +.\"" fix emacs highlighting +.el (\\*(lq\\$1\\*(rq\\$2)\\$3 +.. +.\" # QR - quoted range +.de QR +.ie '\\*(lq'"' ``\\$1''\\-``\\$2''\\$3 +.\"" fix emacs highlighting +.el \\*(lq\\$1\\*(rq\\-\\*(lq\\$2\\*(rq\\$3 +.. +.\" # MT - "empty" string +.de MT +.QW "" +.. +.BS +.SH NAME +tsv \- Part of the Tcl threading extension allowing script level manipulation of data shared between threads\&. +.SH SYNOPSIS +package require \fBTcl 8\&.4\fR +.sp +package require \fBThread ?2\&.8?\fR +.sp +\fBtsv::names\fR ?pattern? +.sp +\fBtsv::object\fR \fIvarname\fR \fIelement\fR +.sp +\fBtsv::set\fR \fIvarname\fR \fIelement\fR ?value? +.sp +\fBtsv::get\fR \fIvarname\fR \fIelement\fR ?namedvar? +.sp +\fBtsv::unset\fR \fIvarname\fR ?element? +.sp +\fBtsv::exists\fR \fIvarname\fR \fIelement\fR +.sp +\fBtsv::pop\fR \fIvarname\fR \fIelement\fR +.sp +\fBtsv::move\fR \fIvarname\fR \fIoldname\fR \fInewname\fR +.sp +\fBtsv::incr\fR \fIvarname\fR \fIelement\fR ?count? +.sp +\fBtsv::append\fR \fIvarname\fR \fIelement\fR \fIvalue\fR ?value \&.\&.\&.? +.sp +\fBtsv::lock\fR \fIvarname\fR \fIarg\fR ?arg \&.\&.\&.? +.sp +\fBtsv::handlers\fR +.sp +\fBtsv::lappend\fR \fIvarname\fR \fIelement\fR \fIvalue\fR ?value \&.\&.\&.? +.sp +\fBtsv::linsert\fR \fIvarname\fR \fIelement\fR \fIindex\fR \fIvalue\fR ?value \&.\&.\&.? +.sp +\fBtsv::lreplace\fR \fIvarname\fR \fIelement\fR \fIfirst\fR \fIlast\fR ?value \&.\&.\&.? +.sp +\fBtsv::llength\fR \fIvarname\fR \fIelement\fR +.sp +\fBtsv::lindex\fR \fIvarname\fR \fIelement\fR ?index? +.sp +\fBtsv::lrange\fR \fIvarname\fR \fIelement\fR \fIfrom\fR \fIto\fR +.sp +\fBtsv::lsearch\fR \fIvarname\fR \fIelement\fR ?options? \fIpattern\fR +.sp +\fBtsv::lset\fR \fIvarname\fR \fIelement\fR \fIindex\fR ?index \&.\&.\&.? \fIvalue\fR +.sp +\fBtsv::lpop\fR \fIvarname\fR \fIelement\fR ?index? +.sp +\fBtsv::lpush\fR \fIvarname\fR \fIelement\fR ?index? +.sp +\fBtsv::array set\fR \fIvarname\fR \fIlist\fR +.sp +\fBtsv::array get\fR \fIvarname\fR ?pattern? +.sp +\fBtsv::array names\fR \fIvarname\fR ?pattern? +.sp +\fBtsv::array size\fR \fIvarname\fR +.sp +\fBtsv::array reset\fR \fIvarname\fR \fIlist\fR +.sp +\fBtsv::array bind\fR \fIvarname\fR \fIhandle\fR +.sp +\fBtsv::array unbind\fR \fIvarname\fR +.sp +\fBtsv::array isbound\fR \fIvarname\fR +.sp +\fBtsv::keyldel\fR \fIvarname\fR \fIkeylist\fR \fIkey\fR +.sp +\fBtsv::keylget\fR \fIvarname\fR \fIkeylist\fR \fIkey\fR ?retvar? +.sp +\fBtsv::keylkeys\fR \fIvarname\fR \fIkeylist\fR ?key? +.sp +\fBtsv::keylset\fR \fIvarname\fR \fIkeylist\fR \fIkey\fR \fIvalue\fR ?key value\&.\&.? +.sp +.BE +.SH DESCRIPTION +This section describes commands implementing thread shared variables\&. +A thread shared variable is very similar to a Tcl array but in +contrast to a Tcl array it is created in shared memory and can +be accessed from many threads at the same time\&. Important feature of +thread shared variable is that each access to the variable is internaly +protected by a mutex so script programmer does not have to take care +about locking the variable himself\&. +.PP +Thread shared variables are not bound to any thread explicitly\&. That +means that when a thread which created any of thread shared variables +exits, the variable and associated memory is not unset/reclaimed\&. +User has to explicitly unset the variable to reclaim the memory +consumed by the variable\&. +.SH "ELEMENT COMMANDS" +.TP +\fBtsv::names\fR ?pattern? +Returns names of shared variables matching optional ?pattern? +or all known variables if pattern is ommited\&. +.TP +\fBtsv::object\fR \fIvarname\fR \fIelement\fR +Creates object accessor command for the \fIelement\fR in the +shared variable \fIvarname\fR\&. Using this command, one can apply most +of the other shared variable commands as method functions of +the element object command\&. The object command is automatically +deleted when the element which this command is pointing to is unset\&. +.CS + + + % tsv::set foo bar "A shared string" + % set string [tsv::object foo bar] + % $string append " appended" + => A shared string appended + +.CE +.TP +\fBtsv::set\fR \fIvarname\fR \fIelement\fR ?value? +Sets the value of the \fIelement\fR in the shared variable \fIvarname\fR +to \fIvalue\fR and returns the value to caller\&. The \fIvalue\fR +may be ommited, in which case the command will return the current +value of the element\&. If the element cannot be found, error is triggered\&. +.TP +\fBtsv::get\fR \fIvarname\fR \fIelement\fR ?namedvar? +Retrieves the value of the \fIelement\fR from the shared variable \fIvarname\fR\&. +If the optional argument \fInamedvar\fR is given, the value is +stored in the named variable\&. Return value of the command depends +of the existence of the optional argument \fInamedvar\fR\&. +If the argument is ommited and the requested element cannot be found +in the shared array, the command triggers error\&. If, however, the +optional argument is given on the command line, the command returns +true (1) if the element is found or false (0) if the element is not found\&. +.TP +\fBtsv::unset\fR \fIvarname\fR ?element? +Unsets the \fIelement\fR from the shared variable \fIvarname\fR\&. +If the optional element is not given, it deletes the variable\&. +.TP +\fBtsv::exists\fR \fIvarname\fR \fIelement\fR +Checks wether the \fIelement\fR exists in the shared variable \fIvarname\fR +and returns true (1) if it does or false (0) if it doesn't\&. +.TP +\fBtsv::pop\fR \fIvarname\fR \fIelement\fR +Returns value of the \fIelement\fR in the shared variable \fIvarname\fR +and unsets the element, all in one atomic operation\&. +.TP +\fBtsv::move\fR \fIvarname\fR \fIoldname\fR \fInewname\fR +Renames the element \fIoldname\fR to the \fInewname\fR in the +shared variable \fIvarname\fR\&. This effectively performs an get/unset/set +sequence of operations but all in one atomic step\&. +.TP +\fBtsv::incr\fR \fIvarname\fR \fIelement\fR ?count? +Similar to standard Tcl \fBincr\fR command but increments the value +of the \fIelement\fR in shared variaboe \fIvarname\fR instead of +the Tcl variable\&. +.TP +\fBtsv::append\fR \fIvarname\fR \fIelement\fR \fIvalue\fR ?value \&.\&.\&.? +Similar to standard Tcl \fBappend\fR command but appends one or more +values to the \fIelement\fR in shared variable \fIvarname\fR instead of the +Tcl variable\&. +.TP +\fBtsv::lock\fR \fIvarname\fR \fIarg\fR ?arg \&.\&.\&.? +This command concatenates passed arguments and evaluates the +resulting script under the internal mutex protection\&. During the +script evaluation, the entire shared variable is locked\&. For shared +variable commands within the script, internal locking is disabled +so no deadlock can occur\&. It is also allowed to unset the shared +variable from within the script\&. The shared variable is automatically +created if it did not exists at the time of the first lock operation\&. +.CS + + + % tsv::lock foo { + tsv::lappend foo bar 1 + tsv::lappend foo bar 2 + puts stderr [tsv::set foo bar] + tsv::unset foo + } + +.CE +.TP +\fBtsv::handlers\fR +Returns the names of all persistent storage handlers enabled at compile time\&. +See \fBARRAY COMMANDS\fR for details\&. +.PP +.SH "LIST COMMANDS" +Those command are similar to the equivalently named Tcl command\&. The difference +is that they operate on elements of shared arrays\&. +.TP +\fBtsv::lappend\fR \fIvarname\fR \fIelement\fR \fIvalue\fR ?value \&.\&.\&.? +Similar to standard Tcl \fBlappend\fR command but appends one +or more values to the \fIelement\fR in shared variable \fIvarname\fR +instead of the Tcl variable\&. +.TP +\fBtsv::linsert\fR \fIvarname\fR \fIelement\fR \fIindex\fR \fIvalue\fR ?value \&.\&.\&.? +Similar to standard Tcl \fBlinsert\fR command but inserts one +or more values at the \fIindex\fR list position in the +\fIelement\fR in the shared variable \fIvarname\fR instead of the Tcl variable\&. +.TP +\fBtsv::lreplace\fR \fIvarname\fR \fIelement\fR \fIfirst\fR \fIlast\fR ?value \&.\&.\&.? +Similar to standard Tcl \fBlreplace\fR command but replaces one +or more values between the \fIfirst\fR and \fIlast\fR position +in the \fIelement\fR of the shared variable \fIvarname\fR instead of +the Tcl variable\&. +.TP +\fBtsv::llength\fR \fIvarname\fR \fIelement\fR +Similar to standard Tcl \fBllength\fR command but returns length +of the \fIelement\fR in the shared variable \fIvarname\fR instead of the Tcl +variable\&. +.TP +\fBtsv::lindex\fR \fIvarname\fR \fIelement\fR ?index? +Similar to standard Tcl \fBlindex\fR command but returns the value +at the \fIindex\fR list position of the \fIelement\fR from +the shared variable \fIvarname\fR instead of the Tcl variable\&. +.TP +\fBtsv::lrange\fR \fIvarname\fR \fIelement\fR \fIfrom\fR \fIto\fR +Similar to standard Tcl \fBlrange\fR command but returns values +between \fIfrom\fR and \fIto\fR list positions from the +\fIelement\fR in the shared variable \fIvarname\fR instead of the Tcl variable\&. +.TP +\fBtsv::lsearch\fR \fIvarname\fR \fIelement\fR ?options? \fIpattern\fR +Similar to standard Tcl \fBlsearch\fR command but searches the \fIelement\fR +in the shared variable \fIvarname\fR instead of the Tcl variable\&. +.TP +\fBtsv::lset\fR \fIvarname\fR \fIelement\fR \fIindex\fR ?index \&.\&.\&.? \fIvalue\fR +Similar to standard Tcl \fBlset\fR command but sets the \fIelement\fR +in the shared variable \fIvarname\fR instead of the Tcl variable\&. +.TP +\fBtsv::lpop\fR \fIvarname\fR \fIelement\fR ?index? +Similar to the standard Tcl \fBlindex\fR command but in addition to +returning, it also splices the value out of the \fIelement\fR +from the shared variable \fIvarname\fR in one atomic operation\&. +In contrast to the Tcl \fBlindex\fR command, this command returns +no value to the caller\&. +.TP +\fBtsv::lpush\fR \fIvarname\fR \fIelement\fR ?index? +This command performes the opposite of the \fBtsv::lpop\fR command\&. +As its counterpart, it returns no value to the caller\&. +.PP +.SH "ARRAY COMMANDS" +This command supports most of the options of the standard Tcl +\fBarray\fR command\&. In addition to those, it allows binding +a shared variable to some persisten storage databases\&. Currently the persistent +options supported are the famous GNU Gdbm and LMDB\&. These options have to be +selected during the package compilation time\&. +The implementation provides hooks for defining other persistency layers, if +needed\&. +.TP +\fBtsv::array set\fR \fIvarname\fR \fIlist\fR +Does the same as standard Tcl \fBarray set\fR\&. +.TP +\fBtsv::array get\fR \fIvarname\fR ?pattern? +Does the same as standard Tcl \fBarray get\fR\&. +.TP +\fBtsv::array names\fR \fIvarname\fR ?pattern? +Does the same as standard Tcl \fBarray names\fR\&. +.TP +\fBtsv::array size\fR \fIvarname\fR +Does the same as standard Tcl \fBarray size\fR\&. +.TP +\fBtsv::array reset\fR \fIvarname\fR \fIlist\fR +Does the same as standard Tcl \fBarray set\fR but it clears +the \fIvarname\fR and sets new values from the list atomically\&. +.TP +\fBtsv::array bind\fR \fIvarname\fR \fIhandle\fR +Binds the \fIvarname\fR to the persistent storage \fIhandle\fR\&. +The format of the \fIhandle\fR is <handler>:<address>, where <handler> is +"gdbm" for GNU Gdbm and "lmdb" for LMDB and <address> is the path to the +database file\&. +.TP +\fBtsv::array unbind\fR \fIvarname\fR +Unbinds the shared \fIarray\fR from its bound persistent storage\&. +.TP +\fBtsv::array isbound\fR \fIvarname\fR +Returns true (1) if the shared \fIvarname\fR is bound to some +persistent storage or zero (0) if not\&. +.PP +.SH "KEYED LIST COMMANDS" +Keyed list commands are borrowed from the TclX package\&. Keyed lists provide +a structured data type built upon standard Tcl lists\&. This is a functionality +similar to structs in the C programming language\&. +.PP +A keyed list is a list in which each element contains a key and value +pair\&. These element pairs are stored as lists themselves, where the key +is the first element of the list, and the value is the second\&. The +key-value pairs are referred to as fields\&. This is an example of a +keyed list: +.CS + + + {{NAME {Frank Zappa}} {JOB {musician and composer}}} + +.CE +Fields may contain subfields; `\&.' is the separator character\&. Subfields +are actually fields where the value is another keyed list\&. Thus the +following list has the top level fields ID and NAME, and subfields +NAME\&.FIRST and NAME\&.LAST: +.CS + + + {ID 106} {NAME {{FIRST Frank} {LAST Zappa}}} + +.CE +There is no limit to the recursive depth of subfields, +allowing one to build complex data structures\&. Keyed lists are constructed +and accessed via a number of commands\&. All keyed list management +commands take the name of the variable containing the keyed list as an +argument (i\&.e\&. passed by reference), rather than passing the list directly\&. +.TP +\fBtsv::keyldel\fR \fIvarname\fR \fIkeylist\fR \fIkey\fR +Delete the field specified by \fIkey\fR from the keyed list \fIkeylist\fR +in the shared variable \fIvarname\fR\&. +This removes both the key and the value from the keyed list\&. +.TP +\fBtsv::keylget\fR \fIvarname\fR \fIkeylist\fR \fIkey\fR ?retvar? +Return the value associated with \fIkey\fR from the keyed list \fIkeylist\fR +in the shared variable \fIvarname\fR\&. +If the optional \fIretvar\fR is not specified, then the value will be +returned as the result of the command\&. In this case, if key is not found +in the list, an error will result\&. +.sp +If \fIretvar\fR is specified and \fIkey\fR is in the list, then the value +is returned in the variable \fIretvar\fR and the command returns 1 if the +key was present within the list\&. If \fIkey\fR isn't in the list, the +command will return 0, and \fIretvar\fR will be left unchanged\&. If {} is +specified for \fIretvar\fR, the value is not returned, allowing the Tcl +programmer to determine if a \fIkey\fR is present in a keyed list without +setting a variable as a side-effect\&. +.TP +\fBtsv::keylkeys\fR \fIvarname\fR \fIkeylist\fR ?key? +Return the a list of the keys in the keyed list \fIkeylist\fR in the +shared variable \fIvarname\fR\&. If \fIkey\fR is specified, then it is +the name of a key field who's subfield keys are to be retrieved\&. +.TP +\fBtsv::keylset\fR \fIvarname\fR \fIkeylist\fR \fIkey\fR \fIvalue\fR ?key value\&.\&.? +Set the value associated with \fIkey\fR, in the keyed list \fIkeylist\fR +to \fIvalue\fR\&. If the \fIkeylist\fR does not exists, it is created\&. +If \fIkey\fR is not currently in the list, it will be added\&. If it already +exists, \fIvalue\fR replaces the existing value\&. Multiple keywords and +values may be specified, if desired\&. +.PP +.SH DISCUSSION +The current implementation of thread shared variables allows for easy and +convenient access to data shared between different threads\&. +Internally, the data is stored in Tcl objects and all package commands +operate on internal data representation, thus minimizing shimmering and +improving performance\&. Special care has been taken to assure that all +object data is properly locked and deep-copied when moving objects between +threads\&. +.PP +Due to the internal design of the Tcl core, there is no provision of full +integration of shared variables within the Tcl syntax, unfortunately\&. All +access to shared data must be performed with the supplied package commands\&. +Also, variable traces are not supported\&. But even so, benefits of easy, +simple and safe shared data manipulation outweights imposed limitations\&. +.SH CREDITS +Thread shared variables are inspired by the nsv interface found in +AOLserver, a highly scalable Web server from America Online\&. +.SH "SEE ALSO" +thread, tpool, ttrace +.SH KEYWORDS +locking, synchronization, thread shared data, threads diff --git a/tcl8.6/pkgs/thread2.8.4/doc/man/ttrace.n b/tcl8.6/pkgs/thread2.8.4/doc/man/ttrace.n new file mode 100644 index 0000000..e326acd --- /dev/null +++ b/tcl8.6/pkgs/thread2.8.4/doc/man/ttrace.n @@ -0,0 +1,506 @@ +'\" +'\" Generated from file '' by tcllib/doctools with format 'nroff' +'\" +.TH "ttrace" n 2\&.8 "Tcl Threading" +.\" The -*- nroff -*- definitions below are for supplemental macros used +.\" in Tcl/Tk manual entries. +.\" +.\" .AP type name in/out ?indent? +.\" Start paragraph describing an argument to a library procedure. +.\" type is type of argument (int, etc.), in/out is either "in", "out", +.\" or "in/out" to describe whether procedure reads or modifies arg, +.\" and indent is equivalent to second arg of .IP (shouldn't ever be +.\" needed; use .AS below instead) +.\" +.\" .AS ?type? ?name? +.\" Give maximum sizes of arguments for setting tab stops. Type and +.\" name are examples of largest possible arguments that will be passed +.\" to .AP later. If args are omitted, default tab stops are used. +.\" +.\" .BS +.\" Start box enclosure. From here until next .BE, everything will be +.\" enclosed in one large box. +.\" +.\" .BE +.\" End of box enclosure. +.\" +.\" .CS +.\" Begin code excerpt. +.\" +.\" .CE +.\" End code excerpt. +.\" +.\" .VS ?version? ?br? +.\" Begin vertical sidebar, for use in marking newly-changed parts +.\" of man pages. The first argument is ignored and used for recording +.\" the version when the .VS was added, so that the sidebars can be +.\" found and removed when they reach a certain age. If another argument +.\" is present, then a line break is forced before starting the sidebar. +.\" +.\" .VE +.\" End of vertical sidebar. +.\" +.\" .DS +.\" Begin an indented unfilled display. +.\" +.\" .DE +.\" End of indented unfilled display. +.\" +.\" .SO ?manpage? +.\" Start of list of standard options for a Tk widget. The manpage +.\" argument defines where to look up the standard options; if +.\" omitted, defaults to "options". The options follow on successive +.\" lines, in three columns separated by tabs. +.\" +.\" .SE +.\" End of list of standard options for a Tk widget. +.\" +.\" .OP cmdName dbName dbClass +.\" Start of description of a specific option. cmdName gives the +.\" option's name as specified in the class command, dbName gives +.\" the option's name in the option database, and dbClass gives +.\" the option's class in the option database. +.\" +.\" .UL arg1 arg2 +.\" Print arg1 underlined, then print arg2 normally. +.\" +.\" .QW arg1 ?arg2? +.\" Print arg1 in quotes, then arg2 normally (for trailing punctuation). +.\" +.\" .PQ arg1 ?arg2? +.\" Print an open parenthesis, arg1 in quotes, then arg2 normally +.\" (for trailing punctuation) and then a closing parenthesis. +.\" +.\" # Set up traps and other miscellaneous stuff for Tcl/Tk man pages. +.if t .wh -1.3i ^B +.nr ^l \n(.l +.ad b +.\" # Start an argument description +.de AP +.ie !"\\$4"" .TP \\$4 +.el \{\ +. ie !"\\$2"" .TP \\n()Cu +. el .TP 15 +.\} +.ta \\n()Au \\n()Bu +.ie !"\\$3"" \{\ +\&\\$1 \\fI\\$2\\fP (\\$3) +.\".b +.\} +.el \{\ +.br +.ie !"\\$2"" \{\ +\&\\$1 \\fI\\$2\\fP +.\} +.el \{\ +\&\\fI\\$1\\fP +.\} +.\} +.. +.\" # define tabbing values for .AP +.de AS +.nr )A 10n +.if !"\\$1"" .nr )A \\w'\\$1'u+3n +.nr )B \\n()Au+15n +.\" +.if !"\\$2"" .nr )B \\w'\\$2'u+\\n()Au+3n +.nr )C \\n()Bu+\\w'(in/out)'u+2n +.. +.AS Tcl_Interp Tcl_CreateInterp in/out +.\" # BS - start boxed text +.\" # ^y = starting y location +.\" # ^b = 1 +.de BS +.br +.mk ^y +.nr ^b 1u +.if n .nf +.if n .ti 0 +.if n \l'\\n(.lu\(ul' +.if n .fi +.. +.\" # BE - end boxed text (draw box now) +.de BE +.nf +.ti 0 +.mk ^t +.ie n \l'\\n(^lu\(ul' +.el \{\ +.\" Draw four-sided box normally, but don't draw top of +.\" box if the box started on an earlier page. +.ie !\\n(^b-1 \{\ +\h'-1.5n'\L'|\\n(^yu-1v'\l'\\n(^lu+3n\(ul'\L'\\n(^tu+1v-\\n(^yu'\l'|0u-1.5n\(ul' +.\} +.el \}\ +\h'-1.5n'\L'|\\n(^yu-1v'\h'\\n(^lu+3n'\L'\\n(^tu+1v-\\n(^yu'\l'|0u-1.5n\(ul' +.\} +.\} +.fi +.br +.nr ^b 0 +.. +.\" # VS - start vertical sidebar +.\" # ^Y = starting y location +.\" # ^v = 1 (for troff; for nroff this doesn't matter) +.de VS +.if !"\\$2"" .br +.mk ^Y +.ie n 'mc \s12\(br\s0 +.el .nr ^v 1u +.. +.\" # VE - end of vertical sidebar +.de VE +.ie n 'mc +.el \{\ +.ev 2 +.nf +.ti 0 +.mk ^t +\h'|\\n(^lu+3n'\L'|\\n(^Yu-1v\(bv'\v'\\n(^tu+1v-\\n(^Yu'\h'-|\\n(^lu+3n' +.sp -1 +.fi +.ev +.\} +.nr ^v 0 +.. +.\" # Special macro to handle page bottom: finish off current +.\" # box/sidebar if in box/sidebar mode, then invoked standard +.\" # page bottom macro. +.de ^B +.ev 2 +'ti 0 +'nf +.mk ^t +.if \\n(^b \{\ +.\" Draw three-sided box if this is the box's first page, +.\" draw two sides but no top otherwise. +.ie !\\n(^b-1 \h'-1.5n'\L'|\\n(^yu-1v'\l'\\n(^lu+3n\(ul'\L'\\n(^tu+1v-\\n(^yu'\h'|0u'\c +.el \h'-1.5n'\L'|\\n(^yu-1v'\h'\\n(^lu+3n'\L'\\n(^tu+1v-\\n(^yu'\h'|0u'\c +.\} +.if \\n(^v \{\ +.nr ^x \\n(^tu+1v-\\n(^Yu +\kx\h'-\\nxu'\h'|\\n(^lu+3n'\ky\L'-\\n(^xu'\v'\\n(^xu'\h'|0u'\c +.\} +.bp +'fi +.ev +.if \\n(^b \{\ +.mk ^y +.nr ^b 2 +.\} +.if \\n(^v \{\ +.mk ^Y +.\} +.. +.\" # DS - begin display +.de DS +.RS +.nf +.sp +.. +.\" # DE - end display +.de DE +.fi +.RE +.sp +.. +.\" # SO - start of list of standard options +.de SO +'ie '\\$1'' .ds So \\fBoptions\\fR +'el .ds So \\fB\\$1\\fR +.SH "STANDARD OPTIONS" +.LP +.nf +.ta 5.5c 11c +.ft B +.. +.\" # SE - end of list of standard options +.de SE +.fi +.ft R +.LP +See the \\*(So manual entry for details on the standard options. +.. +.\" # OP - start of full description for a single option +.de OP +.LP +.nf +.ta 4c +Command-Line Name: \\fB\\$1\\fR +Database Name: \\fB\\$2\\fR +Database Class: \\fB\\$3\\fR +.fi +.IP +.. +.\" # CS - begin code excerpt +.de CS +.RS +.nf +.ta .25i .5i .75i 1i +.. +.\" # CE - end code excerpt +.de CE +.fi +.RE +.. +.\" # UL - underline word +.de UL +\\$1\l'|0\(ul'\\$2 +.. +.\" # QW - apply quotation marks to word +.de QW +.ie '\\*(lq'"' ``\\$1''\\$2 +.\"" fix emacs highlighting +.el \\*(lq\\$1\\*(rq\\$2 +.. +.\" # PQ - apply parens and quotation marks to word +.de PQ +.ie '\\*(lq'"' (``\\$1''\\$2)\\$3 +.\"" fix emacs highlighting +.el (\\*(lq\\$1\\*(rq\\$2)\\$3 +.. +.\" # QR - quoted range +.de QR +.ie '\\*(lq'"' ``\\$1''\\-``\\$2''\\$3 +.\"" fix emacs highlighting +.el \\*(lq\\$1\\*(rq\\-\\*(lq\\$2\\*(rq\\$3 +.. +.\" # MT - "empty" string +.de MT +.QW "" +.. +.BS +.SH NAME +ttrace \- Trace-based interpreter initialization +.SH SYNOPSIS +package require \fBTcl 8\&.4\fR +.sp +package require \fBThread ?2\&.8?\fR +.sp +\fBttrace::eval\fR \fIarg\fR ?arg \&.\&.\&.? +.sp +\fBttrace::enable\fR +.sp +\fBttrace::disable\fR +.sp +\fBttrace::cleanup\fR +.sp +\fBttrace::update\fR ?epoch? +.sp +\fBttrace::getscript\fR +.sp +\fBttrace::atenable\fR \fIcmd\fR \fIarglist\fR \fIbody\fR +.sp +\fBttrace::atdisable\fR \fIcmd\fR \fIarglist\fR \fIbody\fR +.sp +\fBttrace::addtrace\fR \fIcmd\fR \fIarglist\fR \fIbody\fR +.sp +\fBttrace::addscript\fR \fIname\fR \fIbody\fR +.sp +\fBttrace::addresolver\fR \fIcmd\fR \fIarglist\fR \fIbody\fR +.sp +\fBttrace::addcleanup\fR \fIbody\fR +.sp +\fBttrace::addentry\fR \fIcmd\fR \fIvar\fR \fIval\fR +.sp +\fBttrace::getentry\fR \fIcmd\fR \fIvar\fR +.sp +\fBttrace::getentries\fR \fIcmd\fR ?pattern? +.sp +\fBttrace::delentry\fR \fIcmd\fR +.sp +\fBttrace::preload\fR \fIcmd\fR +.sp +.BE +.SH DESCRIPTION +This package creates a framework for on-demand replication of the +interpreter state accross threads in an multithreading application\&. +It relies on the mechanics of Tcl command tracing and the Tcl +\fBunknown\fR command and mechanism\&. +.PP +The package requires Tcl threading extension but can be alternatively +used stand-alone within the AOLserver, a scalable webserver from +America Online\&. +.PP +In a nutshell, a short sample illustrating the usage of the ttrace +with the Tcl threading extension: +.CS + + + + % package require Ttrace + 2\&.8\&.0 + + % set t1 [thread::create {package require Ttrace; thread::wait}] + tid0x1802800 + + % ttrace::eval {proc test args {return test-[thread::id]}} + % thread::send $t1 test + test-tid0x1802800 + + % set t2 [thread::create {package require Ttrace; thread::wait}] + tid0x1804000 + + % thread::send $t2 test + test-tid0x1804000 + + +.CE +.PP +As seen from above, the \fBttrace::eval\fR and \fBttrace::update\fR +commands are used to create a thread-wide definition of a simple +Tcl procedure and replicate that definition to all, already existing +or later created, threads\&. +.SH "USER COMMANDS" +This section describes user-level commands\&. Those commands can be +used by script writers to control the execution of the tracing +framework\&. +.TP +\fBttrace::eval\fR \fIarg\fR ?arg \&.\&.\&.? +This command concatenates given arguments and evaluates the resulting +Tcl command with trace framework enabled\&. If the command execution +was ok, it takes necessary steps to automatically propagate the +trace epoch change to all threads in the application\&. +For AOLserver, only newly created threads actually receive the +epoch change\&. For the Tcl threading extension, all threads created by +the extension are automatically updated\&. If the command execution +resulted in Tcl error, no state propagation takes place\&. +.sp +This is the most important user-level command of the package as +it wraps most of the commands described below\&. This greatly +simplifies things, because user need to learn just this (one) +command in order to effectively use the package\&. Other commands, +as desribed below, are included mostly for the sake of completeness\&. +.TP +\fBttrace::enable\fR +Activates all registered callbacks in the framework +and starts a new trace epoch\&. The trace epoch encapsulates all +changes done to the interpreter during the time traces are activated\&. +.TP +\fBttrace::disable\fR +Deactivates all registered callbacks in the framework +and closes the current trace epoch\&. +.TP +\fBttrace::cleanup\fR +Used to clean-up all on-demand loaded resources in the interpreter\&. +It effectively brings Tcl interpreter to its pristine state\&. +.TP +\fBttrace::update\fR ?epoch? +Used to refresh the state of the interpreter to match the optional +trace ?epoch?\&. If the optional ?epoch? is not given, it takes +the most recent trace epoch\&. +.TP +\fBttrace::getscript\fR +Returns a synthetized Tcl script which may be sourced in any interpreter\&. +This script sets the stage for the Tcl \fBunknown\fR command so it can +load traced resources from the in-memory database\&. Normally, this command +is automatically invoked by other higher-level commands like +\fBttrace::eval\fR and \fBttrace::update\fR\&. +.PP +.SH "CALLBACK COMMANDS" +A word upfront: the package already includes callbacks for tracing +following Tcl commands: \fBproc\fR, \fBnamespace\fR, \fBvariable\fR, +\fBload\fR, and \fBrename\fR\&. Additionaly, a set of callbacks for +tracing resources (object, clasess) for the XOTcl v1\&.3\&.8+, an +OO-extension to Tcl, is also provided\&. +This gives a solid base for solving most of the real-life needs and +serves as an example for people wanting to customize the package +to cover their specific needs\&. +.PP +Below, you can find commands for registering callbacks in the +framework and for writing callback scripts\&. These callbacks are +invoked by the framework in order to gather interpreter state +changes, build in-memory database, perform custom-cleanups and +various other tasks\&. +.TP +\fBttrace::atenable\fR \fIcmd\fR \fIarglist\fR \fIbody\fR +Registers Tcl callback to be activated at \fBttrace::enable\fR\&. +Registered callbacks are activated on FIFO basis\&. The callback +definition includes the name of the callback, \fIcmd\fR, a list +of callback arguments, \fIarglist\fR and the \fIbody\fR of the +callback\&. Effectively, this actually resembles the call interface +of the standard Tcl \fBproc\fR command\&. +.TP +\fBttrace::atdisable\fR \fIcmd\fR \fIarglist\fR \fIbody\fR +Registers Tcl callback to be activated at \fBttrace::disable\fR\&. +Registered callbacks are activated on FIFO basis\&. The callback +definition includes the name of the callback, \fIcmd\fR, a list +of callback arguments, \fIarglist\fR and the \fIbody\fR of the +callback\&. Effectively, this actually resembles the call interface +of the standard Tcl \fBproc\fR command\&. +.TP +\fBttrace::addtrace\fR \fIcmd\fR \fIarglist\fR \fIbody\fR +Registers Tcl callback to be activated for tracing the Tcl +\fBcmd\fR command\&. The callback definition includes the name of +the Tcl command to trace, \fIcmd\fR, a list of callback arguments, +\fIarglist\fR and the \fIbody\fR of the callback\&. Effectively, +this actually resembles the call interface of the standard Tcl +\fBproc\fR command\&. +.TP +\fBttrace::addscript\fR \fIname\fR \fIbody\fR +Registers Tcl callback to be activated for building a Tcl +script to be passed to other interpreters\&. This script is +used to set the stage for the Tcl \fBunknown\fR command\&. +Registered callbacks are activated on FIFO basis\&. +The callback definition includes the name of the callback, +\fIname\fR and the \fIbody\fR of the callback\&. +.TP +\fBttrace::addresolver\fR \fIcmd\fR \fIarglist\fR \fIbody\fR +Registers Tcl callback to be activated by the overloaded Tcl +\fBunknown\fR command\&. +Registered callbacks are activated on FIFO basis\&. +This callback is used to resolve the resource and load the +resource in the current interpreter\&. +.TP +\fBttrace::addcleanup\fR \fIbody\fR +Registers Tcl callback to be activated by the \fBtrace::cleanup\fR\&. +Registered callbacks are activated on FIFO basis\&. +.TP +\fBttrace::addentry\fR \fIcmd\fR \fIvar\fR \fIval\fR +Adds one entry to the named in-memory database\&. +.TP +\fBttrace::getentry\fR \fIcmd\fR \fIvar\fR +Returns the value of the entry from the named in-memory database\&. +.TP +\fBttrace::getentries\fR \fIcmd\fR ?pattern? +Returns names of all entries from the named in-memory database\&. +.TP +\fBttrace::delentry\fR \fIcmd\fR +Deletes an entry from the named in-memory database\&. +.TP +\fBttrace::preload\fR \fIcmd\fR +Registers the Tcl command to be loaded in the interpreter\&. +Commands registered this way will always be the part of +the interpreter and not be on-demand loaded by the Tcl +\fBunknown\fR command\&. +.PP +.SH DISCUSSION +Common introspective state-replication approaches use a custom Tcl +script to introspect the running interpreter and synthesize another +Tcl script to replicate this state in some other interpreter\&. +This package, on the contrary, uses Tcl command traces\&. Command +traces are registered on selected Tcl commands, like \fBproc\fR, +\fBnamespace\fR, \fBload\fR and other standard (and/or user-defined) +Tcl commands\&. When activated, those traces build an in-memory +database of created resources\&. This database is used as a resource +repository for the (overloaded) Tcl \fBunknown\fR command which +creates the requested resource in the interpreter on demand\&. +This way, users can update just one interpreter (master) in one +thread and replicate that interpreter state (or part of it) to other +threads/interpreters in the process\&. +.PP +Immediate benefit of such approach is the much smaller memory footprint +of the application and much faster thread creation\&. By not actually +loading all necessary procedures (and other resources) in every thread +at the thread initialization time, but by deffering this to the time the +resource is actually referenced, significant improvements in both +memory consumption and thread initialization time can be achieved\&. Some +tests have shown that memory footprint of an multithreading Tcl application +went down more than three times and thread startup time was reduced for +about 50 times\&. Note that your mileage may vary\&. +Other benefits include much finer control about what (and when) gets +replicated from the master to other Tcl thread/interpreters\&. +.SH "SEE ALSO" +thread, tpool, tsv +.SH KEYWORDS +command tracing, introspection diff --git a/tcl8.6/pkgs/thread2.8.4/doc/thread.man b/tcl8.6/pkgs/thread2.8.4/doc/thread.man new file mode 100644 index 0000000..2dfadfb --- /dev/null +++ b/tcl8.6/pkgs/thread2.8.4/doc/thread.man @@ -0,0 +1,611 @@ +[comment {-*- tcl -*- doctools manpage}] +[manpage_begin thread n 2.8] +[moddesc {Tcl Threading}] +[titledesc {Extension for script access to Tcl threading}] +[require Tcl 8.4] +[require Thread [opt 2.8]] + +[description] +The [package thread] extension creates threads that contain Tcl +interpreters, and it lets you send scripts to those threads for +evaluation. + +Additionally, it provides script-level access to basic thread +synchronization primitives, like mutexes and condition variables. + +[section COMMANDS] +This section describes commands for creating and destroying threads +and sending scripts to threads for evaluation. + + + +[list_begin definitions] + +[call [cmd thread::create] [opt -joinable] [opt -preserved] [opt script]] + +This command creates a thread that contains a Tcl interpreter. +The Tcl interpreter either evaluates the optional [option script], if +specified, or it waits in the event loop for scripts that arrive via +the [cmd thread::send] command. The result, if any, of the +optional [option script] is never returned to the caller. +The result of [cmd thread::create] is the ID of the thread. This is +the opaque handle which identifies the newly created thread for +all other package commands. The handle of the thread goes out of scope +automatically when thread is marked for exit +(see the [cmd thread::release] command below). + +[para] + +If the optional [option script] argument contains the [cmd thread::wait] +command the thread will enter into the event loop. If such command is not +found in the [option script] the thread will run the [option script] to +the end and exit. In that case, the handle may be safely ignored since it +refers to a thread which does not exists any more at the time when the +command returns. + +[para] + +Using flag [option -joinable] it is possible to create a joinable +thread, i.e. one upon whose exit can be waited upon by using +[cmd thread::join] command. +Note that failure to join a thread created with [option -joinable] flag +results in resource and memory leaks. + + +[para] + +Threads created by the [cmd thread::create] cannot be destroyed +forcefully. Consequently, there is no corresponding thread destroy +command. A thread may only be released using the [cmd thread::release] +and if its internal reference count drops to zero, the thread is +marked for exit. This kicks the thread out of the event loop +servicing and the thread continues to execute commands passed in +the [option script] argument, following the [cmd thread::wait] +command. If this was the last command in the script, as usually the +case, the thread will exit. + +[para] + +It is possible to create a situation in which it may be impossible +to terminate the thread, for example by putting some endless loop +after the [cmd thread::wait] or entering the event loop again by +doing an vwait-type of command. In such cases, the thread may never +exit. This is considered to be a bad practice and should be avoided +if possible. This is best illustrated by the example below: + +[example { + # You should never do ... + set tid [thread::create { + package require Http + thread::wait + vwait forever ; # <-- this! + }] +}] + +The thread created in the above example will never be able to exit. +After it has been released with the last matching [cmd thread::release] +call, the thread will jump out of the [cmd thread::wait] and continue +to execute commands following. It will enter [cmd vwait] command and +wait endlessly for events. There is no way one can terminate such thread, +so you wouldn't want to do this! + +[para] + +Each newly created has its internal reference counter set to 0 (zero), +i.e. it is unreserved. This counter gets incremented by a call to +[cmd thread::preserve] and decremented by a call to [cmd thread::release] +command. These two commands implement simple but effective thread +reservation system and offer predictable and controllable thread +termination capabilities. It is however possible to create initially +preserved threads by using flag [option -preserved] of the +[cmd thread::create] command. Threads created with this flag have the +initial value of the reference counter of 1 (one), and are thus +initially marked reserved. + + +[call [cmd thread::preserve] [opt id]] + +This command increments the thread reference counter. Each call +to this command increments the reference counter by one (1). +Command returns the value of the reference counter after the increment. +If called with the optional thread [option id], the command preserves +the given thread. Otherwise the current thread is preserved. + +[para] + +With reference counting, one can implement controlled access to a +shared Tcl thread. By incrementing the reference counter, the +caller signalizes that he/she wishes to use the thread for a longer +period of time. By decrementing the counter, caller signalizes that +he/she has finished using the thread. + +[call [cmd thread::release] [opt -wait] [opt id]] + +This command decrements the thread reference counter. Each call to +this command decrements the reference counter by one (1). +If called with the optional thread [option id], the command releases +the given thread. Otherwise, the current thread is released. +Command returns the value of the reference counter after the decrement. +When the reference counter reaches zero (0), the target thread is +marked for termination. You should not reference the thread after the +[cmd thread::release] command returns zero or negative integer. +The handle of the thread goes out of scope and should not be used any +more. Any following reference to the same thread handle will result +in Tcl error. + +[para] + +Optional flag [option -wait] instructs the caller thread to wait for +the target thread to exit, if the effect of the command would result +in termination of the target thread, i.e. if the return result would +be zero (0). Without the flag, the caller thread does not wait for +the target thread to exit. Care must be taken when using the +[option -wait], since this may block the caller thread indefinitely. +This option has been implemented for some special uses of the extension +and is deprecated for regular use. Regular users should create joinable +threads by using the [option -joinable] option of the [cmd thread::create] +command and the [cmd thread::join] to wait for thread to exit. + +[call [cmd thread::id]] + +This command returns the ID of the current thread. + +[call [cmd thread::errorproc] [opt procname]] + +This command sets a handler for errors that occur in scripts sent +asynchronously, using the [option -async] flag of the +[cmd thread::send] command, to other threads. If no handler +is specified, the current handler is returned. The empty string +resets the handler to default (unspecified) value. +An uncaught error in a thread causes an error message to be sent +to the standard error channel. This default reporting scheme can +be changed by registering a procedure which is called to report +the error. The [arg procname] is called in the interpreter that +invoked the [cmd thread::errorproc] command. The [arg procname] +is called like this: + +[example { + myerrorproc thread_id errorInfo +}] + +[call [cmd thread::cancel] [opt -unwind] [arg id] [opt result]] + +This command requires Tcl version 8.6 or higher. + +[para] + +Cancels the script being evaluated in the thread given by the [arg id] +parameter. Without the [option -unwind] switch the evaluation stack for +the interpreter is unwound until an enclosing catch command is found or +there are no further invocations of the interpreter left on the call +stack. With the [option -unwind] switch the evaluation stack for the +interpreter is unwound without regard to any intervening catch command +until there are no further invocations of the interpreter left on the +call stack. If [arg result] is present, it will be used as the error +message string; otherwise, a default error message string will be used. + +[call [cmd thread::unwind]] + +Use of this command is deprecated in favour of more advanced thread +reservation system implemented with [cmd thread::preserve] and +[cmd thread::release] commands. Support for [cmd thread::unwind] +command will disappear in some future major release of the extension. +[para] +This command stops a prior [cmd thread::wait] command. Execution of +the script passed to newly created thread will continue from the +[cmd thread::wait] command. If [cmd thread::wait] was the last command +in the script, the thread will exit. The command returns empty result +but may trigger Tcl error with the message "target thread died" in some +situations. + + +[call [cmd thread::exit] [opt status]] + +Use of this command is deprecated in favour of more advanced thread +reservation system implemented with [cmd thread::preserve] and +[cmd thread::release] commands. Support for [cmd thread::exit] +command will disappear in some future major release of the extension. +[para] +This command forces a thread stuck in the [cmd thread::wait] command to +unconditionally exit. The thread's exit status defaults to 666 and can be +specified using the optional [arg status] argument. The execution of +[cmd thread::exit] command is guaranteed to leave the program memory in the +inconsistent state, produce memory leaks and otherwise affect other subsystem(s) +of the Tcl application in an unpredictable manner. The command returns empty +result but may trigger Tcl error with the message "target thread died" in some +situations. + +[call [cmd thread::names]] + +This command returns a list of thread IDs. These are only for +threads that have been created via [cmd thread::create] command. +If your application creates other threads at the C level, they +are not reported by this command. + + +[call [cmd thread::exists] [arg id]] + +Returns true (1) if thread given by the [arg id] parameter exists, +false (0) otherwise. This applies only for threads that have +been created via [cmd thread::create] command. + + +[call [cmd thread::send] [opt -async] [opt -head] [arg id] [arg script] [opt varname]] + +This command passes a [arg script] to another thread and, optionally, +waits for the result. If the [option -async] flag is specified, the +command does not wait for the result and it returns empty string. +The target thread must enter it's event loop in order to receive +scripts sent via this command. This is done by default for threads +created without a startup script. Threads can enter the event loop +explicitly by calling [cmd thread::wait] or any other relevant Tcl/Tk +command, like [cmd update], [cmd vwait], etc. + +[para] + +Optional [option varname] specifies name of the variable to store +the result of the [arg script]. Without the [option -async] flag, +the command returns the evaluation code, similarly to the standard +Tcl [cmd catch] command. If, however, the [option -async] flag is +specified, the command returns immediately and caller can later +[cmd vwait] on [opt varname] to get the result of the passed [arg script] + +[example { + set t1 [thread::create] + set t2 [thread::create] + thread::send -async $t1 "set a 1" result + thread::send -async $t2 "set b 2" result + for {set i 0} {$i < 2} {incr i} { + vwait result + } +}] + +In the above example, two threads were fed work and both of them were +instructed to signalize the same variable "result" in the calling thread. +The caller entered the event loop twice to get both results. Note, +however, that the order of the received results may vary, depending on +the current system load, type of work done, etc, etc. + +[para] + +Many threads can simultaneously send scripts to the target thread for +execution. All of them are entered into the event queue of the target +thread and executed on the FIFO basis, intermingled with optional other +events pending in the event queue of the target thread. +Using the optional [opt -head] switch, scripts posted to the thread's +event queue can be placed on the head, instead on the tail of the queue, +thus being executed in the LIFO fashion. + + +[call [cmd thread::broadcast] [arg script]] + +This command passes a [arg script] to all threads created by the +package for execution. It does not wait for response from any of +the threads. + +[call [cmd thread::wait]] + +This enters the event loop so a thread can receive messages from +the [cmd thread::send] command. This command should only be used +within the script passed to the [cmd thread::create]. It should +be the very last command in the script. If this is not the case, +the exiting thread will continue executing the script lines past +the [cmd thread::wait] which is usually not what you want and/or +expect. + +[example { + set t1 [thread::create { + # + # Do some initialization work here + # + thread::wait ; # Enter the event loop + }] +}] + +[call [cmd thread::eval] [opt {-lock mutex}] [arg arg] [opt {arg ...}]] + +This command concatenates passed arguments and evaluates the +resulting script under the mutex protection. If no mutex is +specified by using the [opt {-lock mutex}] optional argument, +the internal static mutex is used. + + +[call [cmd thread::join] [arg id]] + +This command waits for the thread with ID [arg id] to exit and +then returns it's exit code. Errors will be returned for threads +which are not joinable or already waited upon by another thread. +Upon the join the handle of the thread has gone out of scope and +should not be used any more. + + +[call [cmd thread::configure] [arg id] [opt option] [opt value] [opt ...]] + +This command configures various low-level aspects of the thread with +ID [arg id] in the similar way as the standard Tcl command +[cmd fconfigure] configures some Tcl channel options. Options currently +supported are: [option -eventmark] and [option -unwindonerror]. + +[para] + +The [option -eventmark] option, when set, limits the number of +asynchronously posted scripts to the thread event loop. +The [cmd {thread::send -async}] command will block until the number +of pending scripts in the event loop does not drop below the value +configured with [option -eventmark]. Default value for the +[option -eventmark] is 0 (zero) which effectively disables the checking, +i.e. allows for unlimited number of posted scripts. + +[para] + +The [option -unwindonerror] option, when set, causes the +target thread to unwind if the result of the script processing +resulted in error. Default value for the [option -unwindonerror] +is 0 (false), i.e. thread continues to process scripts after one +of the posted scripts fails. + + +[call [cmd thread::transfer] [arg id] [arg channel]] + +This moves the specified [arg channel] from the current thread +and interpreter to the main interpreter of the thread with the +given [arg id]. After the move the current interpreter has no +access to the channel any more, but the main interpreter of the +target thread will be able to use it from now on. +The command waits until the other thread has incorporated the +channel. Because of this it is possible to deadlock the +participating threads by commanding the other through a +synchronous [cmd thread::send] to transfer a channel to us. +This easily extends into longer loops of threads waiting for +each other. Other restrictions: the channel in question must +not be shared among multiple interpreters running in the +sending thread. This automatically excludes the special channels +for standard input, output and error. + +[para] + +Due to the internal Tcl core implementation and the restriction on +transferring shared channels, one has to take extra measures when +transferring socket channels created by accepting the connection +out of the [cmd socket] commands callback procedures: + +[example { + socket -server _Accept 2200 + proc _Accept {s ipaddr port} { + after idle [list Accept $s $ipaddr $port] + } + proc Accept {s ipaddr port} { + set tid [thread::create] + thread::transfer $tid $s + } +}] + +[call [cmd thread::detach] [arg channel]] + +This detaches the specified [arg channel] from the current thread and +interpreter. After that, the current interpreter has no access to the +channel any more. The channel is in the parked state until some other +(or the same) thread attaches the channel again with [cmd thread::attach]. +Restrictions: same as for transferring shared channels with the +[cmd thread::transfer] command. + +[call [cmd thread::attach] [arg channel]] + +This attaches the previously detached [arg channel] in the +current thread/interpreter. For already existing channels, +the command does nothing, i.e. it is not an error to attach the +same channel more than once. The first operation will actually +perform the operation, while all subsequent operation will just +do nothing. Command throws error if the [arg channel] cannot be +found in the list of detached channels and/or in the current +interpreter. + +[call [cmd thread::mutex]] + +Mutexes are most common thread synchronization primitives. +They are used to synchronize access from two or more threads to one or +more shared resources. This command provides script-level access to +exclusive and/or recursive mutexes. Exclusive mutexes can be locked +only once by one thread, while recursive mutexes can be locked many +times by the same thread. For recursive mutexes, number of lock and +unlock operations must match, otherwise, the mutex will never be +released, which would lead to various deadlock situations. +[para] +Care has to be taken when using mutexes in an multithreading program. +Improper use of mutexes may lead to various deadlock situations, +especially when using exclusive mutexes. + +[para] + +The [cmd thread::mutex] command supports following subcommands and options: + +[list_begin definitions] + +[call [cmd thread::mutex] [method create] [opt -recursive]] + +Creates the mutex and returns it's opaque handle. This handle +should be used for any future reference to the newly created mutex. +If no optional [opt -recursive] argument was specified, the command +creates the exclusive mutex. With the [opt -recursive] argument, +the command creates a recursive mutex. + +[call [cmd thread::mutex] [method destroy] [arg mutex]] + +Destroys the [arg mutex]. Mutex should be in unlocked state before +the destroy attempt. If the mutex is locked, the command will throw +Tcl error. + +[call [cmd thread::mutex] [method lock] [arg mutex]] + +Locks the [arg mutex]. Locking the exclusive mutex may throw Tcl +error if on attempt to lock the same mutex twice from the same +thread. If your program logic forces you to lock the same mutex +twice or more from the same thread (this may happen in recursive +procedure invocations) you should consider using the recursive mutexes. + +[call [cmd thread::mutex] [method unlock] [arg mutex]] + +Unlocks the [arg mutex] so some other thread may lock it again. +Attempt to unlock the already unlocked mutex will throw Tcl error. + +[list_end] + +[para] + +[call [cmd thread::rwmutex]] + +This command creates many-readers/single-writer mutexes. Reader/writer +mutexes allow you to serialize access to a shared resource more optimally. +In situations where a shared resource gets mostly read and seldom modified, +you might gain some performance by using reader/writer mutexes instead of +exclusive or recursive mutexes. +[para] +For reading the resource, thread should obtain a read lock on the resource. +Read lock is non-exclusive, meaning that more than one thread can +obtain a read lock to the same resource, without waiting on other readers. +For changing the resource, however, a thread must obtain a exclusive +write lock. This lock effectively blocks all threads from gaining the +read-lock while the resource is been modified by the writer thread. +Only after the write lock has been released, the resource may be read-locked +again. + +[para] + +The [cmd thread::rwmutex] command supports following subcommands and options: + +[list_begin definitions] + +[call [cmd thread::rwmutex] [method create]] + +Creates the reader/writer mutex and returns it's opaque handle. +This handle should be used for any future reference to the newly +created mutex. + +[call [cmd thread::rwmutex] [method destroy] [arg mutex]] + +Destroys the reader/writer [arg mutex]. If the mutex is already locked, +attempt to destroy it will throw Tcl error. + +[call [cmd thread::rwmutex] [method rlock] [arg mutex]] + +Locks the [arg mutex] for reading. More than one thread may read-lock +the same [arg mutex] at the same time. + +[call [cmd thread::rwmutex] [method wlock] [arg mutex]] + +Locks the [arg mutex] for writing. Only one thread may write-lock +the same [arg mutex] at the same time. Attempt to write-lock same +[arg mutex] twice from the same thread will throw Tcl error. + +[call [cmd thread::rwmutex] [method unlock] [arg mutex]] + +Unlocks the [arg mutex] so some other thread may lock it again. +Attempt to unlock already unlocked [arg mutex] will throw Tcl error. + +[list_end] + +[para] + +[call [cmd thread::cond]] + +This command provides script-level access to condition variables. +A condition variable creates a safe environment for the program +to test some condition, sleep on it when false and be awakened +when it might have become true. A condition variable is always +used in the conjunction with an exclusive mutex. If you attempt +to use other type of mutex in conjunction with the condition +variable, a Tcl error will be thrown. + +[para] + +The command supports following subcommands and options: + +[list_begin definitions] + +[call [cmd thread::cond] [method create]] + +Creates the condition variable and returns it's opaque handle. +This handle should be used for any future reference to newly +created condition variable. + +[call [cmd thread::cond] [method destroy] [arg cond]] + +Destroys condition variable [arg cond]. Extreme care has to be taken +that nobody is using (i.e. waiting on) the condition variable, +otherwise unexpected errors may happen. + +[call [cmd thread::cond] [method notify] [arg cond]] + +Wakes up all threads waiting on the condition variable [arg cond]. + +[call [cmd thread::cond] [method wait] [arg cond] [arg mutex] [opt ms]] + +This command is used to suspend program execution until the condition +variable [arg cond] has been signalled or the optional timer has expired. +The exclusive [arg mutex] must be locked by the calling thread on entrance +to this command. If the mutex is not locked, Tcl error is thrown. +While waiting on the [arg cond], the command releases [arg mutex]. +Before returning to the calling thread, the command re-acquires the +[arg mutex] again. Unlocking the [arg mutex] and waiting on the +condition variable [arg cond] is done atomically. + +[para] + +The [option ms] command option, if given, must be an integer specifying +time interval in milliseconds the command waits to be signalled. +Otherwise the command waits on condition notify forever. + +[para] + +In multithreading programs, there are many situations where a thread has +to wait for some event to happen until it is allowed to proceed. +This is usually accomplished by repeatedly testing a condition under the +mutex protection and waiting on the condition variable until the condition +evaluates to true: + +[example { + set mutex [thread::mutex create] + set cond [thread::cond create] + + thread::mutex lock $mutex + while {<some_condition_is_true>} { + thread::cond wait $cond $mutex + } + # Do some work under mutex protection + thread::mutex unlock $mutex +}] + +Repeated testing of the condition is needed since the condition variable +may get signalled without the condition being actually changed (spurious +thread wake-ups, for example). + +[list_end] + +[list_end] + +[section DISCUSSION] +The fundamental threading model in Tcl is that there can be one or +more Tcl interpreters per thread, but each Tcl interpreter should +only be used by a single thread which created it. +A "shared memory" abstraction is awkward to provide in Tcl because +Tcl makes assumptions about variable and data ownership. Therefore +this extension supports a simple form of threading where the main +thread can manage several background, or "worker" threads. +For example, an event-driven server can pass requests to worker +threads, and then await responses from worker threads or new client +requests. Everything goes through the common Tcl event loop, so +message passing between threads works naturally with event-driven I/O, +[cmd vwait] on variables, and so forth. For the transfer of bulk +information it is possible to move channels between the threads. + +[para] + +For advanced multithreading scripts, script-level access to two +basic synchronization primitives, mutex and condition variables, +is also supported. + +[see_also tsv tpool ttrace [uri http://www.tcl.tk/doc/howto/thread_model.html]] + +[keywords thread events {message passing} synchronization mutex] + +[manpage_end] diff --git a/tcl8.6/pkgs/thread2.8.4/doc/tpool.man b/tcl8.6/pkgs/thread2.8.4/doc/tpool.man new file mode 100644 index 0000000..81122e2 --- /dev/null +++ b/tcl8.6/pkgs/thread2.8.4/doc/tpool.man @@ -0,0 +1,225 @@ +[comment {-*- tcl -*- doctools manpage}] +[manpage_begin tpool n 2.8] +[moddesc {Tcl Threading}] +[titledesc {Part of the Tcl threading extension implementing pools of worker threads.}] +[require Tcl 8.4] +[require Thread [opt 2.8]] + +[description] +This package creates and manages pools of worker threads. It allows you +to post jobs to worker threads and wait for their completion. The +threadpool implementation is Tcl event-loop aware. That means that any +time a caller is forced to wait for an event (job being completed or +a worker thread becoming idle or initialized), the implementation will +enter the event loop and allow for servicing of other pending file or +timer (or any other supported) events. + +[section COMMANDS] + +[list_begin definitions] + +[call [cmd tpool::create] [opt options]] + +This command creates new threadpool. It accepts several options as +key-value pairs. Options are used to tune some threadpool parameters. +The command returns the ID of the newly created threadpool. +[para] +Following options are supported: + +[list_begin options] + +[opt_def -minworkers [arg number]] +Minimum number of worker threads needed for this threadpool instance. +During threadpool creation, the implementation will create somany +worker threads upfront and will keep at least number of them alive +during the lifetime of the threadpool instance. +Default value of this parameter is 0 (zero). which means that a newly +threadpool will have no worker threads initially. All worker threads +will be started on demand by callers running [cmd tpool::post] command +and posting jobs to the job queue. + +[opt_def -maxworkers [arg number]] +Maximum number of worker threads allowed for this threadpool instance. +If a new job is pending and there are no idle worker threads available, +the implementation will try to create new worker thread. If the number +of available worker threads is lower than the given number, +new worker thread will start. The caller will automatically enter the +event loop and wait until the worker thread has initialized. If. however, +the number of available worker threads is equal to the given number, +the caller will enter the event loop and wait for the first worker thread +to get idle, thus ready to run the job. +Default value of this parameter is 4 (four), which means that the +threadpool instance will allow maximum of 4 worker threads running jobs +or being idle waiting for new jobs to get posted to the job queue. + +[opt_def -idletime [arg seconds]] +Time in seconds an idle worker thread waits for the job to get posted +to the job queue. If no job arrives during this interval and the time +expires, the worker thread will check the number of currently available +worker threads and if the number is higher than the number set by the +[option minthreads] option, it will exit. +If an [option exitscript] has been defined, the exiting worker thread +will first run the script and then exit. Errors from the exit script, +if any, are ignored. +[para] +The idle worker thread is not servicing the event loop. If you, however, +put the worker thread into the event loop, by evaluating the +[cmd vwait] or other related Tcl commands, the worker thread +will not be in the idle state, hence the idle timer will not be +taken into account. +Default value for this option is unspecified. + +[opt_def -initcmd [arg script]] +Sets a Tcl script used to initialize new worker thread. This is usually +used to load packages and commands in the worker, set default variables, +create namespaces, and such. If the passed script runs into a Tcl error, +the worker will not be created and the initiating command (either the +[cmd tpool::create] or [cmd tpool::post]) will throw error. +Default value for this option is unspecified, hence, the Tcl interpreter of +the worker thread will contain just the initial set of Tcl commands. + +[opt_def -exitcmd [arg script]] +Sets a Tcl script run when the idle worker thread exits. This is normally +used to cleanup the state of the worker thread, release reserved resources, +cleanup memory and such. +Default value for this option is unspecified, thus no Tcl script will run +on the worker thread exit. + +[list_end] + +[para] + +[call [cmd tpool::names]] + +This command returns a list of IDs of threadpools created with the +[cmd tpool::create] command. If no threadpools were found, the +command will return empty list. + +[call [cmd tpool::post] [opt -detached] [opt -nowait] [arg tpool] [arg script]] + +This command sends a [arg script] to the target [arg tpool] threadpool +for execution. The script will be executed in the first available idle +worker thread. If there are no idle worker threads available, the command +will create new one, enter the event loop and service events until the +newly created thread is initialized. If the current number of worker +threads is equal to the maximum number of worker threads, as defined +during the threadpool creation, the command will enter the event loop and +service events while waiting for one of the worker threads to become idle. +If the optional [opt -nowait] argument is given, the command will not wait +for one idle worker. It will just place the job in the pool's job queue +and return immediately. +[para] +The command returns the ID of the posted job. This ID is used for subsequent +[cmd tpool::wait], [cmd tpool::get] and [cmd tpool::cancel] commands to wait +for and retrieve result of the posted script, or cancel the posted job +respectively. If the optional [opt -detached] argument is specified, the +command will post a detached job. A detached job can not be cancelled or +waited upon and is not identified by the job ID. +[para] +If the threadpool [arg tpool] is not found in the list of active +thread pools, the command will throw error. The error will also be triggered +if the newly created worker thread fails to initialize. + +[call [cmd tpool::wait] [arg tpool] [arg joblist] [opt varname]] + +This command waits for one or many jobs, whose job IDs are given in the +[arg joblist] to get processed by the worker thread(s). If none of the +specified jobs are ready, the command will enter the event loop, service +events and wait for the first job to get ready. +[para] +The command returns the list of completed job IDs. If the optional variable +[opt varname] is given, it will be set to the list of jobs in the +[arg joblist] which are still pending. If the threadpool [arg tpool] +is not found in the list of active thread pools, the command will throw error. + +[call [cmd tpool::cancel] [arg tpool] [arg joblist] [opt varname]] + +This command cancels the previously posted jobs given by the [arg joblist] +to the pool [arg tpool]. Job cancellation succeeds only for job still +waiting to be processed. If the job is already being executed by one of +the worker threads, the job will not be cancelled. +The command returns the list of cancelled job IDs. If the optional variable +[opt varname] is given, it will be set to the list of jobs in the +[arg joblist] which were not cancelled. If the threadpool [arg tpool] +is not found in the list of active thread pools, the command will throw error. + +[call [cmd tpool::get] [arg tpool] [arg job]] + +This command retrieves the result of the previously posted [arg job]. +Only results of jobs waited upon with the [cmd tpool::wait] command +can be retrieved. If the execution of the script resulted in error, +the command will throw the error and update the [var errorInfo] and +[var errorCode] variables correspondingly. If the pool [arg tpool] +is not found in the list of threadpools, the command will throw error. +If the job [arg job] is not ready for retrieval, because it is currently +being executed by the worker thread, the command will throw error. + +[call [cmd tpool::preserve] [arg tpool]] + +Each call to this command increments the reference counter of the +threadpool [arg tpool] by one (1). Command returns the value of the +reference counter after the increment. +By incrementing the reference counter, the caller signalizes that +he/she wishes to use the resource for a longer period of time. + +[call [cmd tpool::release] [arg tpool]] + +Each call to this command decrements the reference counter of the +threadpool [arg tpool] by one (1).Command returns the value of the +reference counter after the decrement. +When the reference counter reaches zero (0), the threadpool [arg tpool] +is marked for termination. You should not reference the threadpool +after the [cmd tpool::release] command returns zero. The [arg tpool] +handle goes out of scope and should not be used any more. Any following +reference to the same threadpool handle will result in Tcl error. + +[call [cmd tpool::suspend] [arg tpool]] + +Suspends processing work on this queue. All pool workers are paused +but additional work can be added to the pool. Note that adding the +additional work will not increase the number of workers dynamically +as the pool processing is suspended. Number of workers is maintained +to the count that was found prior suspending worker activity. +If you need to assure certain number of worker threads, use the +[option minworkers] option of the [cmd tpool::create] command. + +[call [cmd tpool::resume] [arg tpool]] + +Resume processing work on this queue. All paused (suspended) +workers are free to get work from the pool. Note that resuming pool +operation will just let already created workers to proceed. +It will not create additional worker threads to handle the work +posted to the pool's work queue. + +[list_end] + + +[section DISCUSSION] + +Threadpool is one of the most common threading paradigm when it comes +to server applications handling a large number of relatively small tasks. +A very simplistic model for building a server application would be to +create a new thread each time a request arrives and service the request +in the new thread. One of the disadvantages of this approach is that +the overhead of creating a new thread for each request is significant; +a server that created a new thread for each request would spend more time +and consume more system resources in creating and destroying threads than +in processing actual user requests. In addition to the overhead of +creating and destroying threads, active threads consume system resources. +Creating too many threads can cause the system to run out of memory or +trash due to excessive memory consumption. +[para] +A thread pool offers a solution to both the problem of thread life-cycle +overhead and the problem of resource trashing. By reusing threads for +multiple tasks, the thread-creation overhead is spread over many tasks. +As a bonus, because the thread already exists when a request arrives, +the delay introduced by thread creation is eliminated. Thus, the request +can be serviced immediately. Furthermore, by properly tuning the number +of threads in the thread pool, resource thrashing may also be eliminated +by forcing any request to wait until a thread is available to process it. + +[see_also tsv ttrace thread] + +[keywords thread threadpool] + +[manpage_end] diff --git a/tcl8.6/pkgs/thread2.8.4/doc/tsv.man b/tcl8.6/pkgs/thread2.8.4/doc/tsv.man new file mode 100644 index 0000000..f35cda1 --- /dev/null +++ b/tcl8.6/pkgs/thread2.8.4/doc/tsv.man @@ -0,0 +1,336 @@ +[comment {-*- tcl -*- doctools manpage}] +[manpage_begin tsv n 2.8] +[moddesc {Tcl Threading}] +[titledesc {Part of the Tcl threading extension allowing script level manipulation of data shared between threads.}] +[require Tcl 8.4] +[require Thread [opt 2.8]] + +[description] +This section describes commands implementing thread shared variables. +A thread shared variable is very similar to a Tcl array but in +contrast to a Tcl array it is created in shared memory and can +be accessed from many threads at the same time. Important feature of +thread shared variable is that each access to the variable is internally +protected by a mutex so script programmer does not have to take care +about locking the variable himself. +[para] +Thread shared variables are not bound to any thread explicitly. That +means that when a thread which created any of thread shared variables +exits, the variable and associated memory is not unset/reclaimed. +User has to explicitly unset the variable to reclaim the memory +consumed by the variable. + +[section {ELEMENT COMMANDS}] + +[list_begin definitions] + +[call [cmd tsv::names] [opt pattern]] + +Returns names of shared variables matching optional [opt pattern] +or all known variables if pattern is omitted. + +[call [cmd tsv::object] [arg varname] [arg element]] + +Creates object accessor command for the [arg element] in the +shared variable [arg varname]. Using this command, one can apply most +of the other shared variable commands as method functions of +the element object command. The object command is automatically +deleted when the element which this command is pointing to is unset. + +[example { + % tsv::set foo bar "A shared string" + % set string [tsv::object foo bar] + % $string append " appended" + => A shared string appended +}] + +[call [cmd tsv::set] [arg varname] [arg element] [opt value]] + +Sets the value of the [arg element] in the shared variable [arg varname] +to [arg value] and returns the value to caller. The [arg value] +may be omitted, in which case the command will return the current +value of the element. If the element cannot be found, error is triggered. + +[call [cmd tsv::get] [arg varname] [arg element] [opt namedvar]] + +Retrieves the value of the [arg element] from the shared variable [arg varname]. +If the optional argument [arg namedvar] is given, the value is +stored in the named variable. Return value of the command depends +of the existence of the optional argument [arg namedvar]. +If the argument is omitted and the requested element cannot be found +in the shared array, the command triggers error. If, however, the +optional argument is given on the command line, the command returns +true (1) if the element is found or false (0) if the element is not found. + +[call [cmd tsv::unset] [arg varname] [opt element]] + +Unsets the [arg element] from the shared variable [arg varname]. +If the optional element is not given, it deletes the variable. + +[call [cmd tsv::exists] [arg varname] [arg element]] + +Checks whether the [arg element] exists in the shared variable [arg varname] +and returns true (1) if it does or false (0) if it doesn't. + +[call [cmd tsv::pop] [arg varname] [arg element]] + +Returns value of the [arg element] in the shared variable [arg varname] +and unsets the element, all in one atomic operation. + +[call [cmd tsv::move] [arg varname] [arg oldname] [arg newname]] + +Renames the element [arg oldname] to the [arg newname] in the +shared variable [arg varname]. This effectively performs an get/unset/set +sequence of operations but all in one atomic step. + +[call [cmd tsv::incr] [arg varname] [arg element] [opt count]] + +Similar to standard Tcl [cmd incr] command but increments the value +of the [arg element] in shared variable [arg varname] instead of +the Tcl variable. + +[call [cmd tsv::append] [arg varname] [arg element] [arg value] [opt {value ...}]] + +Similar to standard Tcl [cmd append] command but appends one or more +values to the [arg element] in shared variable [arg varname] instead of the +Tcl variable. + +[call [cmd tsv::lock] [arg varname] [arg arg] [opt {arg ...}]] + +This command concatenates passed arguments and evaluates the +resulting script under the internal mutex protection. During the +script evaluation, the entire shared variable is locked. For shared +variable commands within the script, internal locking is disabled +so no deadlock can occur. It is also allowed to unset the shared +variable from within the script. The shared variable is automatically +created if it did not exists at the time of the first lock operation. + +[example { + % tsv::lock foo { + tsv::lappend foo bar 1 + tsv::lappend foo bar 2 + puts stderr [tsv::set foo bar] + tsv::unset foo + } +}] + +[call [cmd tsv::handlers]] + +Returns the names of all persistent storage handlers enabled at compile time. +See [sectref {ARRAY COMMANDS}] for details. + +[list_end] + +[section {LIST COMMANDS}] + +Those command are similar to the equivalently named Tcl command. The difference +is that they operate on elements of shared arrays. + +[list_begin definitions] + +[call [cmd tsv::lappend] [arg varname] [arg element] [arg value] [opt {value ...}]] + +Similar to standard Tcl [cmd lappend] command but appends one +or more values to the [arg element] in shared variable [arg varname] +instead of the Tcl variable. + +[call [cmd tsv::linsert] [arg varname] [arg element] [arg index] [arg value] [opt {value ...}]] + +Similar to standard Tcl [cmd linsert] command but inserts one +or more values at the [arg index] list position in the +[arg element] in the shared variable [arg varname] instead of the Tcl variable. + +[call [cmd tsv::lreplace] [arg varname] [arg element] [arg first] [arg last] [opt {value ...}]] + +Similar to standard Tcl [cmd lreplace] command but replaces one +or more values between the [arg first] and [arg last] position +in the [arg element] of the shared variable [arg varname] instead of +the Tcl variable. + +[call [cmd tsv::llength] [arg varname] [arg element]] + +Similar to standard Tcl [cmd llength] command but returns length +of the [arg element] in the shared variable [arg varname] instead of the Tcl +variable. + +[call [cmd tsv::lindex] [arg varname] [arg element] [opt index]] + +Similar to standard Tcl [cmd lindex] command but returns the value +at the [arg index] list position of the [arg element] from +the shared variable [arg varname] instead of the Tcl variable. + +[call [cmd tsv::lrange] [arg varname] [arg element] [arg from] [arg to]] + +Similar to standard Tcl [cmd lrange] command but returns values +between [arg from] and [arg to] list positions from the +[arg element] in the shared variable [arg varname] instead of the Tcl variable. + +[call [cmd tsv::lsearch] [arg varname] [arg element] [opt options] [arg pattern]] + +Similar to standard Tcl [cmd lsearch] command but searches the [arg element] +in the shared variable [arg varname] instead of the Tcl variable. + +[call [cmd tsv::lset] [arg varname] [arg element] [arg index] [opt {index ...}] [arg value]] + +Similar to standard Tcl [cmd lset] command but sets the [arg element] +in the shared variable [arg varname] instead of the Tcl variable. + +[call [cmd tsv::lpop] [arg varname] [arg element] [opt index]] + +Similar to the standard Tcl [cmd lindex] command but in addition to +returning, it also splices the value out of the [arg element] +from the shared variable [arg varname] in one atomic operation. +In contrast to the Tcl [cmd lindex] command, this command returns +no value to the caller. + +[call [cmd tsv::lpush] [arg varname] [arg element] [opt index]] + +This command performs the opposite of the [cmd tsv::lpop] command. +As its counterpart, it returns no value to the caller. + +[list_end] + +[section {ARRAY COMMANDS}] + +This command supports most of the options of the standard Tcl +[cmd array] command. In addition to those, it allows binding +a shared variable to some persistent storage databases. Currently the persistent +options supported are the famous GNU Gdbm and LMDB. These options have to be +selected during the package compilation time. +The implementation provides hooks for defining other persistency layers, if +needed. + +[list_begin definitions] + +[call [cmd {tsv::array set}] [arg varname] [arg list]] + +Does the same as standard Tcl [cmd {array set}]. + +[call [cmd {tsv::array get}] [arg varname] [opt pattern]] + +Does the same as standard Tcl [cmd {array get}]. + +[call [cmd {tsv::array names}] [arg varname] [opt pattern]] + +Does the same as standard Tcl [cmd {array names}]. + +[call [cmd {tsv::array size}] [arg varname]] + +Does the same as standard Tcl [cmd {array size}]. + +[call [cmd {tsv::array reset}] [arg varname] [arg list]] + +Does the same as standard Tcl [cmd {array set}] but it clears +the [arg varname] and sets new values from the list atomically. + +[call [cmd {tsv::array bind}] [arg varname] [arg handle]] +Binds the [arg varname] to the persistent storage [arg handle]. +The format of the [arg handle] is <handler>:<address>, where <handler> is +"gdbm" for GNU Gdbm and "lmdb" for LMDB and <address> is the path to the +database file. + +[call [cmd {tsv::array unbind}] [arg varname]] +Unbinds the shared [arg array] from its bound persistent storage. + +[call [cmd {tsv::array isbound}] [arg varname]] +Returns true (1) if the shared [arg varname] is bound to some +persistent storage or zero (0) if not. + + +[list_end] + +[section {KEYED LIST COMMANDS}] + +Keyed list commands are borrowed from the TclX package. Keyed lists provide +a structured data type built upon standard Tcl lists. This is a functionality +similar to structs in the C programming language. +[para] +A keyed list is a list in which each element contains a key and value +pair. These element pairs are stored as lists themselves, where the key +is the first element of the list, and the value is the second. The +key-value pairs are referred to as fields. This is an example of a +keyed list: + +[example { + {{NAME {Frank Zappa}} {JOB {musician and composer}}} +}] + +Fields may contain subfields; `.' is the separator character. Subfields +are actually fields where the value is another keyed list. Thus the +following list has the top level fields ID and NAME, and subfields +NAME.FIRST and NAME.LAST: + +[example { + {ID 106} {NAME {{FIRST Frank} {LAST Zappa}}} +}] + +There is no limit to the recursive depth of subfields, +allowing one to build complex data structures. Keyed lists are constructed +and accessed via a number of commands. All keyed list management +commands take the name of the variable containing the keyed list as an +argument (i.e. passed by reference), rather than passing the list directly. + +[list_begin definitions] + +[call [cmd tsv::keyldel] [arg varname] [arg keylist] [arg key]] + +Delete the field specified by [arg key] from the keyed list [arg keylist] +in the shared variable [arg varname]. +This removes both the key and the value from the keyed list. + +[call [cmd tsv::keylget] [arg varname] [arg keylist] [arg key] [opt retvar]] + +Return the value associated with [arg key] from the keyed list [arg keylist] +in the shared variable [arg varname]. +If the optional [arg retvar] is not specified, then the value will be +returned as the result of the command. In this case, if key is not found +in the list, an error will result. +[para] +If [arg retvar] is specified and [arg key] is in the list, then the value +is returned in the variable [arg retvar] and the command returns 1 if the +key was present within the list. If [arg key] isn't in the list, the +command will return 0, and [arg retvar] will be left unchanged. If {} is +specified for [arg retvar], the value is not returned, allowing the Tcl +programmer to determine if a [arg key] is present in a keyed list without +setting a variable as a side-effect. + +[call [cmd tsv::keylkeys] [arg varname] [arg keylist] [opt key]] +Return the a list of the keys in the keyed list [arg keylist] in the +shared variable [arg varname]. If [arg key] is specified, then it is +the name of a key field whose subfield keys are to be retrieved. + + +[call [cmd tsv::keylset] [arg varname] [arg keylist] [arg key] [arg value] [opt {key value..}]] +Set the value associated with [arg key], in the keyed list [arg keylist] +to [arg value]. If the [arg keylist] does not exists, it is created. +If [arg key] is not currently in the list, it will be added. If it already +exists, [arg value] replaces the existing value. Multiple keywords and +values may be specified, if desired. + +[list_end] + + +[section DISCUSSION] +The current implementation of thread shared variables allows for easy and +convenient access to data shared between different threads. +Internally, the data is stored in Tcl objects and all package commands +operate on internal data representation, thus minimizing shimmering and +improving performance. Special care has been taken to assure that all +object data is properly locked and deep-copied when moving objects between +threads. +[para] +Due to the internal design of the Tcl core, there is no provision of full +integration of shared variables within the Tcl syntax, unfortunately. All +access to shared data must be performed with the supplied package commands. +Also, variable traces are not supported. But even so, benefits of easy, +simple and safe shared data manipulation outweighs imposed limitations. + +[section CREDITS] +Thread shared variables are inspired by the nsv interface found in +AOLserver, a highly scalable Web server from America Online. + +[see_also tpool ttrace thread] + +[keywords threads synchronization locking {thread shared data}] + +[manpage_end] diff --git a/tcl8.6/pkgs/thread2.8.4/doc/ttrace.man b/tcl8.6/pkgs/thread2.8.4/doc/ttrace.man new file mode 100644 index 0000000..244b16a --- /dev/null +++ b/tcl8.6/pkgs/thread2.8.4/doc/ttrace.man @@ -0,0 +1,230 @@ +[comment {-*- tcl -*- doctools manpage}] +[manpage_begin ttrace n 2.8] +[moddesc {Tcl Threading}] +[titledesc {Trace-based interpreter initialization}] +[require Tcl 8.4] +[require Thread [opt 2.8]] + +[description] +This package creates a framework for on-demand replication of the +interpreter state across threads in an multithreading application. +It relies on the mechanics of Tcl command tracing and the Tcl +[cmd unknown] command and mechanism. +[para] +The package requires Tcl threading extension but can be alternatively +used stand-alone within the AOLserver, a scalable webserver from +America Online. +[para] +In a nutshell, a short sample illustrating the usage of the ttrace +with the Tcl threading extension: + +[example { + + % package require Ttrace + 2.8.2 + + % set t1 [thread::create {package require Ttrace; thread::wait}] + tid0x1802800 + + % ttrace::eval {proc test args {return test-[thread::id]}} + % thread::send $t1 test + test-tid0x1802800 + + % set t2 [thread::create {package require Ttrace; thread::wait}] + tid0x1804000 + + % thread::send $t2 test + test-tid0x1804000 + +}] +[para] +As seen from above, the [cmd ttrace::eval] and [cmd ttrace::update] +commands are used to create a thread-wide definition of a simple +Tcl procedure and replicate that definition to all, already existing +or later created, threads. + +[section {USER COMMANDS}] +This section describes user-level commands. Those commands can be +used by script writers to control the execution of the tracing +framework. + +[list_begin definitions] + +[call [cmd ttrace::eval] [arg arg] [opt {arg ...}]] + +This command concatenates given arguments and evaluates the resulting +Tcl command with trace framework enabled. If the command execution +was ok, it takes necessary steps to automatically propagate the +trace epoch change to all threads in the application. +For AOLserver, only newly created threads actually receive the +epoch change. For the Tcl threading extension, all threads created by +the extension are automatically updated. If the command execution +resulted in Tcl error, no state propagation takes place. +[para] +This is the most important user-level command of the package as +it wraps most of the commands described below. This greatly +simplifies things, because user need to learn just this (one) +command in order to effectively use the package. Other commands, +as described below, are included mostly for the sake of completeness. + +[call [cmd ttrace::enable]] + +Activates all registered callbacks in the framework +and starts a new trace epoch. The trace epoch encapsulates all +changes done to the interpreter during the time traces are activated. + +[call [cmd ttrace::disable]] + +Deactivates all registered callbacks in the framework +and closes the current trace epoch. + +[call [cmd ttrace::cleanup]] + +Used to clean-up all on-demand loaded resources in the interpreter. +It effectively brings Tcl interpreter to its pristine state. + +[call [cmd ttrace::update] [opt epoch]] + +Used to refresh the state of the interpreter to match the optional +trace [opt epoch]. If the optional [opt epoch] is not given, it takes +the most recent trace epoch. + +[call [cmd ttrace::getscript]] + +Returns a synthesized Tcl script which may be sourced in any interpreter. +This script sets the stage for the Tcl [cmd unknown] command so it can +load traced resources from the in-memory database. Normally, this command +is automatically invoked by other higher-level commands like +[cmd ttrace::eval] and [cmd ttrace::update]. + +[list_end] + +[section {CALLBACK COMMANDS}] +A word upfront: the package already includes callbacks for tracing +following Tcl commands: [cmd proc], [cmd namespace], [cmd variable], +[cmd load], and [cmd rename]. Additionally, a set of callbacks for +tracing resources (object, classes) for the XOTcl v1.3.8+, an +OO-extension to Tcl, is also provided. +This gives a solid base for solving most of the real-life needs and +serves as an example for people wanting to customize the package +to cover their specific needs. +[para] +Below, you can find commands for registering callbacks in the +framework and for writing callback scripts. These callbacks are +invoked by the framework in order to gather interpreter state +changes, build in-memory database, perform custom-cleanups and +various other tasks. + + +[list_begin definitions] + +[call [cmd ttrace::atenable] [arg cmd] [arg arglist] [arg body]] + +Registers Tcl callback to be activated at [cmd ttrace::enable]. +Registered callbacks are activated on FIFO basis. The callback +definition includes the name of the callback, [arg cmd], a list +of callback arguments, [arg arglist] and the [arg body] of the +callback. Effectively, this actually resembles the call interface +of the standard Tcl [cmd proc] command. + + +[call [cmd ttrace::atdisable] [arg cmd] [arg arglist] [arg body]] + +Registers Tcl callback to be activated at [cmd ttrace::disable]. +Registered callbacks are activated on FIFO basis. The callback +definition includes the name of the callback, [arg cmd], a list +of callback arguments, [arg arglist] and the [arg body] of the +callback. Effectively, this actually resembles the call interface +of the standard Tcl [cmd proc] command. + + +[call [cmd ttrace::addtrace] [arg cmd] [arg arglist] [arg body]] + +Registers Tcl callback to be activated for tracing the Tcl +[cmd cmd] command. The callback definition includes the name of +the Tcl command to trace, [arg cmd], a list of callback arguments, +[arg arglist] and the [arg body] of the callback. Effectively, +this actually resembles the call interface of the standard Tcl +[cmd proc] command. + + +[call [cmd ttrace::addscript] [arg name] [arg body]] + +Registers Tcl callback to be activated for building a Tcl +script to be passed to other interpreters. This script is +used to set the stage for the Tcl [cmd unknown] command. +Registered callbacks are activated on FIFO basis. +The callback definition includes the name of the callback, +[arg name] and the [arg body] of the callback. + +[call [cmd ttrace::addresolver] [arg cmd] [arg arglist] [arg body]] + +Registers Tcl callback to be activated by the overloaded Tcl +[cmd unknown] command. +Registered callbacks are activated on FIFO basis. +This callback is used to resolve the resource and load the +resource in the current interpreter. + +[call [cmd ttrace::addcleanup] [arg body]] + +Registers Tcl callback to be activated by the [cmd trace::cleanup]. +Registered callbacks are activated on FIFO basis. + +[call [cmd ttrace::addentry] [arg cmd] [arg var] [arg val]] + +Adds one entry to the named in-memory database. + +[call [cmd ttrace::getentry] [arg cmd] [arg var]] + +Returns the value of the entry from the named in-memory database. + +[call [cmd ttrace::getentries] [arg cmd] [opt pattern]] + +Returns names of all entries from the named in-memory database. + +[call [cmd ttrace::delentry] [arg cmd]] + +Deletes an entry from the named in-memory database. + +[call [cmd ttrace::preload] [arg cmd]] + +Registers the Tcl command to be loaded in the interpreter. +Commands registered this way will always be the part of +the interpreter and not be on-demand loaded by the Tcl +[cmd unknown] command. + +[list_end] + +[section DISCUSSION] +Common introspective state-replication approaches use a custom Tcl +script to introspect the running interpreter and synthesize another +Tcl script to replicate this state in some other interpreter. +This package, on the contrary, uses Tcl command traces. Command +traces are registered on selected Tcl commands, like [cmd proc], +[cmd namespace], [cmd load] and other standard (and/or user-defined) +Tcl commands. When activated, those traces build an in-memory +database of created resources. This database is used as a resource +repository for the (overloaded) Tcl [cmd unknown] command which +creates the requested resource in the interpreter on demand. +This way, users can update just one interpreter (master) in one +thread and replicate that interpreter state (or part of it) to other +threads/interpreters in the process. +[para] +Immediate benefit of such approach is the much smaller memory footprint +of the application and much faster thread creation. By not actually +loading all necessary procedures (and other resources) in every thread +at the thread initialization time, but by deferring this to the time the +resource is actually referenced, significant improvements in both +memory consumption and thread initialization time can be achieved. Some +tests have shown that memory footprint of an multithreading Tcl application +went down more than three times and thread startup time was reduced for +about 50 times. Note that your mileage may vary. + +Other benefits include much finer control about what (and when) gets +replicated from the master to other Tcl thread/interpreters. + +[see_also tsv tpool thread] + +[keywords {command tracing} introspection] + +[manpage_end] diff --git a/tcl8.6/pkgs/thread2.8.4/generic/psGdbm.c b/tcl8.6/pkgs/thread2.8.4/generic/psGdbm.c new file mode 100644 index 0000000..fcaad37 --- /dev/null +++ b/tcl8.6/pkgs/thread2.8.4/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 (ClientData)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: */ diff --git a/tcl8.6/pkgs/thread2.8.4/generic/psGdbm.h b/tcl8.6/pkgs/thread2.8.4/generic/psGdbm.h new file mode 100644 index 0000000..4d68dd6 --- /dev/null +++ b/tcl8.6/pkgs/thread2.8.4/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: */ + diff --git a/tcl8.6/pkgs/thread2.8.4/generic/psLmdb.c b/tcl8.6/pkgs/thread2.8.4/generic/psLmdb.c new file mode 100644 index 0000000..90900e6 --- /dev/null +++ b/tcl8.6/pkgs/thread2.8.4/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 (ClientData)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: */ diff --git a/tcl8.6/pkgs/thread2.8.4/generic/psLmdb.h b/tcl8.6/pkgs/thread2.8.4/generic/psLmdb.h new file mode 100644 index 0000000..1881c30 --- /dev/null +++ b/tcl8.6/pkgs/thread2.8.4/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: */ + diff --git a/tcl8.6/pkgs/thread2.8.4/generic/tclThread.h b/tcl8.6/pkgs/thread2.8.4/generic/tclThread.h new file mode 100644 index 0000000..fad4a71 --- /dev/null +++ b/tcl8.6/pkgs/thread2.8.4/generic/tclThread.h @@ -0,0 +1,31 @@ +/* + * -------------------------------------------------------------------------- + * 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. + */ + +DLLEXPORT int Thread_Init(Tcl_Interp *interp); + +#endif /* _TCL_THREAD_H_ */ diff --git a/tcl8.6/pkgs/thread2.8.4/generic/tclThreadInt.h b/tcl8.6/pkgs/thread2.8.4/generic/tclThreadInt.h new file mode 100644 index 0000000..60c6880 --- /dev/null +++ b/tcl8.6/pkgs/thread2.8.4/generic/tclThreadInt.h @@ -0,0 +1,177 @@ +/* + * -------------------------------------------------------------------------- + * 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 */ + +/* + * 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),(ClientData)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_BackgroundError +# define Tcl_BackgroundError(interp) ((threadTclVersion>85)? \ + ((void (*)(Tcl_Interp *, int))((&(tclStubsPtr->tcl_PkgProvideEx))[609]))(interp, TCL_ERROR): \ + ((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)) +#endif + +#endif /* _TCL_THREAD_INT_H_ */ diff --git a/tcl8.6/pkgs/thread2.8.4/generic/tclXkeylist.c b/tcl8.6/pkgs/thread2.8.4/generic/tclXkeylist.c new file mode 100644 index 0000000..8a557f7 --- /dev/null +++ b/tcl8.6/pkgs/thread2.8.4/generic/tclXkeylist.c @@ -0,0 +1,1481 @@ +/* + * tclXkeylist.c -- + * + * 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. + * + *----------------------------------------------------------------------------- + * + * This file was synthetized from the TclX distribution and made + * self-containing in order to encapsulate the keyed list datatype + * for the inclusion in the Tcl threading extension. I have made + * some minor changes to it in order to get internal object handling + * thread-safe and allow for this datatype to be used from within + * the thread shared variables implementation. + * + * For any questions, contant Zoran Vasiljevic (zoran@archiware.com) + *----------------------------------------------------------------------------- + */ + +#include "tclThreadInt.h" +#include "threadSvCmd.h" +#include "tclXkeylist.h" +#include <stdarg.h> + +#ifdef STATIC_BUILD +#if TCL_MAJOR_VERSION >= 9 +/* + * Static build, Tcl >= 9, compile-time decision to disable T_ROT calls. + */ +#undef Tcl_RegisterObjType +#define Tcl_RegisterObjType(typePtr) (typePtr)->setFromAnyProc = NULL +#else +/* + * Static build, Tcl <= 9 --> T_ROT is directly linked, no stubs + * Nothing needs to be done + */ +#endif +#else /* !STATIC_BUILD */ +/* + * Dynamic build. Assume building with stubs (xx) and make a run-time + * decision regarding T_ROT. + * (Ad xx): Should be checked. Without stubs we have to go like static. + */ +#undef Tcl_RegisterObjType +#define Tcl_RegisterObjType(typePtr) if (threadTclVersion<90) { \ + ((void (*)(const Tcl_ObjType *))((&(tclStubsPtr->tcl_PkgProvideEx))[211]))(typePtr); \ +} else { \ + (typePtr)->setFromAnyProc = NULL; \ +} +#endif /* eof STATIC_BUILD */ + +/*---------------------------------------------------------------------------*/ +/*---------------------------------------------------------------------------*/ +/* Stuff copied verbatim from the rest of TclX to avoid dependencies */ +/*---------------------------------------------------------------------------*/ +/*---------------------------------------------------------------------------*/ + +/* + * Assert macro for use in TclX. Some GCCs libraries are missing a function + * used by their macro, so we define out own. + */ + +#ifdef TCLX_DEBUG +# define TclX_Assert(expr) ((expr) ? (void)0 : \ + panic("TclX assertion failure: %s:%d \"%s\"\n",\ + __FILE__, __LINE__, "expr")) +#else +# define TclX_Assert(expr) +#endif + +/* + * Macro that behaves like strdup, only uses ckalloc. Also macro that does the + * same with a string that might contain zero bytes, + */ + +#define ckstrdup(sourceStr) \ + (strcpy (ckalloc (strlen (sourceStr) + 1), sourceStr)) + +#define ckbinstrdup(sourceStr, length) \ + ((char *) memcpy (ckalloc (length + 1), sourceStr, length + 1)) + +/* + * Used to return argument messages by most commands. + */ +static const char *tclXWrongArgs = "wrong # args: "; + +static const Tcl_ObjType *listType; + +/*----------------------------------------------------------------------------- + * TclX_IsNullObj -- + * + * Check if an object is {}, either in list or zero-lemngth string form, with + * out forcing a conversion. + * + * Parameters: + * o objPtr - Object to check. + * Returns: + * 1 if NULL, 0 if not. + *----------------------------------------------------------------------------- + */ +static int +TclX_IsNullObj (objPtr) + Tcl_Obj *objPtr; +{ + if (objPtr->typePtr == NULL) { + return (objPtr->length == 0); + } else if (objPtr->typePtr == listType) { + int length; + Tcl_ListObjLength(NULL, objPtr, &length); + return (length == 0); + } + (void)Tcl_GetString(objPtr); + return (objPtr->length == 0); +} + +/*----------------------------------------------------------------------------- + * TclX_AppendObjResult -- + * + * Append a variable number of strings onto the object result already + * present for an interpreter. If the object is shared, the current contents + * are discarded. + * + * Parameters: + * o interp - Interpreter to set the result in. + * o args - Strings to append, terminated by a NULL. + *----------------------------------------------------------------------------- + */ +static void +TclX_AppendObjResult(Tcl_Interp *interp, ...) +{ + Tcl_Obj *resultPtr; + va_list argList; + char *string; + + va_start(argList, interp); + resultPtr = Tcl_GetObjResult (interp); + + if (Tcl_IsShared(resultPtr)) { + resultPtr = Tcl_NewStringObj((char *)NULL, 0); + Tcl_SetObjResult(interp, resultPtr); + } + + while (1) { + string = va_arg(argList, char *); + if (string == NULL) { + break; + } + Tcl_AppendToObj (resultPtr, string, -1); + } + va_end(argList); +} + +/*----------------------------------------------------------------------------- + * TclX_WrongArgs -- + * + * Easily create "wrong # args" error messages. + * + * Parameters: + * o commandNameObj - Object containing name of command (objv[0]) + * o string - Text message to append. + * Returns: + * TCL_ERROR + *----------------------------------------------------------------------------- + */ +static int +TclX_WrongArgs (interp, commandNameObj, string) + Tcl_Interp *interp; + Tcl_Obj *commandNameObj; + char *string; +{ + const char *commandName = Tcl_GetString(commandNameObj); + Tcl_Obj *resultPtr = Tcl_GetObjResult(interp); + + Tcl_ResetResult(interp); + Tcl_AppendStringsToObj (resultPtr, + tclXWrongArgs, + commandName, + (char *)NULL); + + if (*string != '\0') { + Tcl_AppendStringsToObj (resultPtr, " ", string, (char *)NULL); + } + return TCL_ERROR; +} + +/*---------------------------------------------------------------------------*/ +/*---------------------------------------------------------------------------*/ +/* Here is where the original file begins */ +/*---------------------------------------------------------------------------*/ +/*---------------------------------------------------------------------------*/ + +/* + * Keyed lists are stored as arrays recursively defined objects. The data + * portion of a keyed list entry is a Tcl_Obj which may be a keyed list object + * or any other Tcl object. Since determine the structure of a keyed list is + * lazy (you don't know if an element is data or another keyed list) until it + * is accessed, the object can be transformed into a keyed list from a Tcl + * string or list. + */ + +/* + * An entry in a keyed list array. (FIX: Should key be object?) + */ +typedef struct { + char *key; + Tcl_Obj *valuePtr; +} keylEntry_t; + +/* + * Internal representation of a keyed list object. + */ +typedef struct { + int arraySize; /* Current slots available in the array. */ + int numEntries; /* Number of actual entries in the array. */ + keylEntry_t *entries; /* Array of keyed list entries. */ +} keylIntObj_t; + +/* + * Amount to increment array size by when it needs to grow. + */ +#define KEYEDLIST_ARRAY_INCR_SIZE 16 + +/* + * Macro to duplicate a child entry of a keyed list if it is share by more + * than the parent. + */ +#define DupSharedKeyListChild(keylIntPtr, idx) \ + if (Tcl_IsShared (keylIntPtr->entries [idx].valuePtr)) { \ + keylIntPtr->entries [idx].valuePtr = \ + Tcl_DuplicateObj (keylIntPtr->entries [idx].valuePtr); \ + Tcl_IncrRefCount (keylIntPtr->entries [idx].valuePtr); \ + } + +/* + * Macros to validate an keyed list object or internal representation + */ +#ifdef TCLX_DEBUG +# define KEYL_OBJ_ASSERT(keylAPtr) {\ + TclX_Assert (keylAPtr->typePtr == &keyedListType); \ + ValidateKeyedList (keylAIntPtr); \ + } +# define KEYL_REP_ASSERT(keylAIntPtr) \ + ValidateKeyedList (keylAIntPtr) +#else +# define KEYL_REP_ASSERT(keylAIntPtr) +#endif + + +/* + * Prototypes of internal functions. + */ +#ifdef TCLX_DEBUG +static void +ValidateKeyedList(keylIntObj_t *keylIntPtr); +#endif + +static int +ValidateKey(Tcl_Interp *interp, + const char *key, + size_t keyLen, + int isPath); + +static keylIntObj_t * +AllocKeyedListIntRep(void); + +static void +FreeKeyedListData(keylIntObj_t *keylIntPtr); + +static void +EnsureKeyedListSpace(keylIntObj_t *keylIntPtr, + int newNumEntries); + +static void +DeleteKeyedListEntry(keylIntObj_t *keylIntPtr, + int entryIdx); + +static int +FindKeyedListEntry(keylIntObj_t *keylIntPtr, + const char *key, + int *keyLenPtr, + const char **nextSubKeyPtr); + +static int +ObjToKeyedListEntry(Tcl_Interp *interp, + Tcl_Obj *objPtr, + keylEntry_t *entryPtr); + +static void +DupKeyedListInternalRep(Tcl_Obj *srcPtr, + Tcl_Obj *copyPtr); + +static void +FreeKeyedListInternalRep(Tcl_Obj *keylPtr); + +static int +SetKeyedListFromAny(Tcl_Interp *interp, + Tcl_Obj *objPtr); + +static void +UpdateStringOfKeyedList(Tcl_Obj *keylPtr); + +static int +Tcl_KeylgetObjCmd(ClientData clientData, + Tcl_Interp *interp, + int objc, + Tcl_Obj *const objv[]); + +static int +Tcl_KeylsetObjCmd(ClientData clientData, + Tcl_Interp *interp, + int objc, + Tcl_Obj *const objv[]); + +static int +Tcl_KeyldelObjCmd(ClientData clientData, + Tcl_Interp *interp, + int objc, + Tcl_Obj *const objv[]); + +static int +Tcl_KeylkeysObjCmd(ClientData clientData, + Tcl_Interp *interp, + int objc, + Tcl_Obj *const objv[]); + +/* + * Type definition. + */ +Tcl_ObjType keyedListType = { + "keyedList", /* name */ + FreeKeyedListInternalRep, /* freeIntRepProc */ + DupKeyedListInternalRep, /* dupIntRepProc */ + UpdateStringOfKeyedList, /* updateStringProc */ + SetKeyedListFromAny /* setFromAnyProc */ +}; + + +/*----------------------------------------------------------------------------- + * ValidateKeyedList -- + * Validate a keyed list (only when TCLX_DEBUG is enabled). + * Parameters: + * o keylIntPtr - Keyed list internal representation. + *----------------------------------------------------------------------------- + */ +#ifdef TCLX_DEBUG +static void +ValidateKeyedList (keylIntPtr) + keylIntObj_t *keylIntPtr; +{ + int idx; + + TclX_Assert (keylIntPtr->arraySize >= keylIntPtr->numEntries); + TclX_Assert (keylIntPtr->arraySize >= 0); + TclX_Assert (keylIntPtr->numEntries >= 0); + TclX_Assert ((keylIntPtr->arraySize > 0) ? + (keylIntPtr->entries != NULL) : 1); + TclX_Assert ((keylIntPtr->numEntries > 0) ? + (keylIntPtr->entries != NULL) : 1); + + for (idx = 0; idx < keylIntPtr->numEntries; idx++) { + keylEntry_t *entryPtr = &(keylIntPtr->entries [idx]); + TclX_Assert (entryPtr->key != NULL); + TclX_Assert (entryPtr->valuePtr->refCount >= 1); + if (entryPtr->valuePtr->typePtr == &keyedListType) { + ValidateKeyedList (entryPtr->valuePtr->internalRep.twoPtrValue.ptr1); + } + } +} +#endif + +/*----------------------------------------------------------------------------- + * ValidateKey -- + * Check that a key or keypath string is a valid value. + * + * Parameters: + * o interp - Used to return error messages. + * o key - Key string to check. + * o keyLen - Length of the string, used to check for binary data. + * o isPath - 1 if this is a key path, 0 if its a simple key and + * thus "." is illegal. + * Returns: + * TCL_OK or TCL_ERROR. + *----------------------------------------------------------------------------- + */ +static int +ValidateKey(interp, key, keyLen, isPath) + Tcl_Interp *interp; + const char *key; + size_t keyLen; + int isPath; +{ + const char *keyp; + + if (strlen(key) != keyLen) { + Tcl_ResetResult(interp); + Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), + "keyed list key may not be a ", + "binary string", (char *) NULL); + return TCL_ERROR; + } + if (key[0] == '\0') { + Tcl_ResetResult(interp); + Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), + "keyed list key may not be an ", + "empty string", (char *) NULL); + return TCL_ERROR; + } + for (keyp = key; *keyp != '\0'; keyp++) { + if ((!isPath) && (*keyp == '.')) { + Tcl_ResetResult(interp); + Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), + "keyed list key may not contain a \".\"; ", + "it is used as a separator in key paths", + (char *) NULL); + return TCL_ERROR; + } + } + return TCL_OK; +} + + +/*----------------------------------------------------------------------------- + * AllocKeyedListIntRep -- + * Allocate an and initialize the keyed list internal representation. + * + * Returns: + * A pointer to the keyed list internal structure. + *----------------------------------------------------------------------------- + */ +static keylIntObj_t * +AllocKeyedListIntRep () +{ + keylIntObj_t *keylIntPtr; + + keylIntPtr = (keylIntObj_t *) ckalloc (sizeof (keylIntObj_t)); + + keylIntPtr->arraySize = 0; + keylIntPtr->numEntries = 0; + keylIntPtr->entries = NULL; + + return keylIntPtr; +} + +/*----------------------------------------------------------------------------- + * FreeKeyedListData -- + * Free the internal representation of a keyed list. + * + * Parameters: + * o keylIntPtr - Keyed list internal structure to free. + *----------------------------------------------------------------------------- + */ +static void +FreeKeyedListData (keylIntPtr) + keylIntObj_t *keylIntPtr; +{ + int idx; + + for (idx = 0; idx < keylIntPtr->numEntries ; idx++) { + ckfree (keylIntPtr->entries [idx].key); + Tcl_DecrRefCount (keylIntPtr->entries [idx].valuePtr); + } + if (keylIntPtr->entries != NULL) + ckfree ((char *) keylIntPtr->entries); + ckfree ((char *) keylIntPtr); +} + +/*----------------------------------------------------------------------------- + * EnsureKeyedListSpace -- + * Ensure there is enough room in a keyed list array for a certain number + * of entries, expanding if necessary. + * + * Parameters: + * o keylIntPtr - Keyed list internal representation. + * o newNumEntries - The number of entries that are going to be added to + * the keyed list. + *----------------------------------------------------------------------------- + */ +static void +EnsureKeyedListSpace (keylIntPtr, newNumEntries) + keylIntObj_t *keylIntPtr; + int newNumEntries; +{ + KEYL_REP_ASSERT (keylIntPtr); + + if ((keylIntPtr->arraySize - keylIntPtr->numEntries) < newNumEntries) { + int newSize = keylIntPtr->arraySize + newNumEntries + + KEYEDLIST_ARRAY_INCR_SIZE; + if (keylIntPtr->entries == NULL) { + keylIntPtr->entries = (keylEntry_t *) + ckalloc (newSize * sizeof (keylEntry_t)); + } else { + keylIntPtr->entries = (keylEntry_t *) + ckrealloc ((void *) keylIntPtr->entries, + newSize * sizeof (keylEntry_t)); + } + keylIntPtr->arraySize = newSize; + } + + KEYL_REP_ASSERT (keylIntPtr); +} + +/*----------------------------------------------------------------------------- + * DeleteKeyedListEntry -- + * Delete an entry from a keyed list. + * + * Parameters: + * o keylIntPtr - Keyed list internal representation. + * o entryIdx - Index of entry to delete. + *----------------------------------------------------------------------------- + */ +static void +DeleteKeyedListEntry (keylIntPtr, entryIdx) + keylIntObj_t *keylIntPtr; + int entryIdx; +{ + int idx; + + ckfree (keylIntPtr->entries [entryIdx].key); + Tcl_DecrRefCount (keylIntPtr->entries [entryIdx].valuePtr); + + for (idx = entryIdx; idx < keylIntPtr->numEntries - 1; idx++) + keylIntPtr->entries [idx] = keylIntPtr->entries [idx + 1]; + keylIntPtr->numEntries--; + + KEYL_REP_ASSERT (keylIntPtr); +} + +/*----------------------------------------------------------------------------- + * FindKeyedListEntry -- + * Find an entry in keyed list. + * + * Parameters: + * o keylIntPtr - Keyed list internal representation. + * o key - Name of key to search for. + * o keyLenPtr - In not NULL, the length of the key for this + * level is returned here. This excludes subkeys and the `.' delimiters. + * o nextSubKeyPtr - If not NULL, the start of the name of the next + * sub-key within key is returned. + * Returns: + * Index of the entry or -1 if not found. + *----------------------------------------------------------------------------- + */ +static int +FindKeyedListEntry (keylIntPtr, key, keyLenPtr, nextSubKeyPtr) + keylIntObj_t *keylIntPtr; + const char *key; + int *keyLenPtr; + const char **nextSubKeyPtr; +{ + char *keySeparPtr; + int keyLen, findIdx; + + keySeparPtr = strchr (key, '.'); + if (keySeparPtr != NULL) { + keyLen = keySeparPtr - key; + } else { + keyLen = strlen (key); + } + + for (findIdx = 0; findIdx < keylIntPtr->numEntries; findIdx++) { + if ((strncmp (keylIntPtr->entries [findIdx].key, key, keyLen) == 0) && + (keylIntPtr->entries [findIdx].key [keyLen] == '\0')) + break; + } + + if (nextSubKeyPtr != NULL) { + if (keySeparPtr == NULL) { + *nextSubKeyPtr = NULL; + } else { + *nextSubKeyPtr = keySeparPtr + 1; + } + } + if (keyLenPtr != NULL) { + *keyLenPtr = keyLen; + } + + if (findIdx >= keylIntPtr->numEntries) { + return -1; + } + + return findIdx; +} + +/*----------------------------------------------------------------------------- + * ObjToKeyedListEntry -- + * Convert an object to a keyed list entry. (Keyword/value pair). + * + * Parameters: + * o interp - Used to return error messages, if not NULL. + * o objPtr - Object to convert. Each entry must be a two element list, + * with the first element being the key and the second being the + * value. + * o entryPtr - The keyed list entry to initialize from the object. + * Returns: + * TCL_OK or TCL_ERROR. + *----------------------------------------------------------------------------- + */ +static int +ObjToKeyedListEntry (interp, objPtr, entryPtr) + Tcl_Interp *interp; + Tcl_Obj *objPtr; + keylEntry_t *entryPtr; +{ + int objc; + Tcl_Obj **objv; + const char *key; + + if (Tcl_ListObjGetElements(interp, objPtr, &objc, &objv) != TCL_OK) { + Tcl_ResetResult (interp); + Tcl_AppendStringsToObj(Tcl_GetObjResult (interp), + "keyed list entry not a valid list, ", + "found \"", + Tcl_GetString(objPtr), + "\"", (char *) NULL); + return TCL_ERROR; + } + + if (objc != 2) { + Tcl_AppendStringsToObj(Tcl_GetObjResult (interp), + "keyed list entry must be a two ", + "element list, found \"", + Tcl_GetString(objPtr), + "\"", (char *) NULL); + return TCL_ERROR; + } + + key = Tcl_GetString(objv[0]); + if (ValidateKey(interp, key, objv[0]->length, 0) == TCL_ERROR) { + return TCL_ERROR; + } + + entryPtr->key = ckstrdup(key); + entryPtr->valuePtr = Tcl_DuplicateObj(objv [1]); + Tcl_IncrRefCount(entryPtr->valuePtr); + + return TCL_OK; +} + +/*----------------------------------------------------------------------------- + * FreeKeyedListInternalRep -- + * Free the internal representation of a keyed list. + * + * Parameters: + * o keylPtr - Keyed list object being deleted. + *----------------------------------------------------------------------------- + */ +static void +FreeKeyedListInternalRep (keylPtr) + Tcl_Obj *keylPtr; +{ + FreeKeyedListData(keylPtr->internalRep.twoPtrValue.ptr1); +} + +/*----------------------------------------------------------------------------- + * DupKeyedListInternalRep -- + * Duplicate the internal representation of a keyed list. + * + * Parameters: + * o srcPtr - Keyed list object to copy. + * o copyPtr - Target object to copy internal representation to. + *----------------------------------------------------------------------------- + */ +static void +DupKeyedListInternalRep (srcPtr, copyPtr) + Tcl_Obj *srcPtr; + Tcl_Obj *copyPtr; +{ + keylIntObj_t *srcIntPtr = + srcPtr->internalRep.twoPtrValue.ptr1; + keylIntObj_t *copyIntPtr; + int idx; + + KEYL_REP_ASSERT (srcIntPtr); + + copyIntPtr = (keylIntObj_t *) ckalloc (sizeof (keylIntObj_t)); + copyIntPtr->arraySize = srcIntPtr->arraySize; + copyIntPtr->numEntries = srcIntPtr->numEntries; + copyIntPtr->entries = (keylEntry_t *) + ckalloc (copyIntPtr->arraySize * sizeof (keylEntry_t)); + + for (idx = 0; idx < srcIntPtr->numEntries ; idx++) { + copyIntPtr->entries [idx].key = + ckstrdup (srcIntPtr->entries [idx].key); + copyIntPtr->entries [idx].valuePtr = srcIntPtr->entries [idx].valuePtr; + Tcl_IncrRefCount (copyIntPtr->entries [idx].valuePtr); + } + + copyPtr->internalRep.twoPtrValue.ptr1 = copyIntPtr; + copyPtr->typePtr = &keyedListType; + + KEYL_REP_ASSERT (copyIntPtr); +} + +/*----------------------------------------------------------------------------- + * DupKeyedListInternalRepShared -- + * Same as DupKeyedListInternalRepbut does not reference objects + * from the srcPtr list. It duplicates them and stores the copy + * in the list-copy object. + * + * Parameters: + * o srcPtr - Keyed list object to copy. + * o copyPtr - Target object to copy internal representation to. + *----------------------------------------------------------------------------- + */ +void +DupKeyedListInternalRepShared (srcPtr, copyPtr) + Tcl_Obj *srcPtr; + Tcl_Obj *copyPtr; +{ + keylIntObj_t *srcIntPtr = + srcPtr->internalRep.twoPtrValue.ptr1; + keylIntObj_t *copyIntPtr; + int idx; + + KEYL_REP_ASSERT (srcIntPtr); + + copyIntPtr = (keylIntObj_t *) ckalloc (sizeof (keylIntObj_t)); + copyIntPtr->arraySize = srcIntPtr->arraySize; + copyIntPtr->numEntries = srcIntPtr->numEntries; + copyIntPtr->entries = (keylEntry_t *) + ckalloc (copyIntPtr->arraySize * sizeof (keylEntry_t)); + + for (idx = 0; idx < srcIntPtr->numEntries ; idx++) { + copyIntPtr->entries [idx].key = + ckstrdup (srcIntPtr->entries [idx].key); + copyIntPtr->entries [idx].valuePtr = + Sv_DuplicateObj (srcIntPtr->entries [idx].valuePtr); + Tcl_IncrRefCount(copyIntPtr->entries [idx].valuePtr); + } + + copyPtr->internalRep.twoPtrValue.ptr1 = copyIntPtr; + copyPtr->typePtr = &keyedListType; + + KEYL_REP_ASSERT (copyIntPtr); +} + +/*----------------------------------------------------------------------------- + * SetKeyedListFromAny -- + * Convert an object to a keyed list from its string representation. Only + * the first level is converted, as there is no way of knowing how far down + * the keyed list recurses until lower levels are accessed. + * + * Parameters: + * o objPtr - Object to convert to a keyed list. + *----------------------------------------------------------------------------- + */ +static int +SetKeyedListFromAny (interp, objPtr) + Tcl_Interp *interp; + Tcl_Obj *objPtr; +{ + keylIntObj_t *keylIntPtr; + int idx, objc; + Tcl_Obj **objv; + + if (Tcl_ListObjGetElements (interp, objPtr, &objc, &objv) != TCL_OK) + return TCL_ERROR; + + keylIntPtr = AllocKeyedListIntRep (); + + EnsureKeyedListSpace (keylIntPtr, objc); + + for (idx = 0; idx < objc; idx++) { + if (ObjToKeyedListEntry (interp, objv [idx], + &(keylIntPtr->entries [keylIntPtr->numEntries])) != TCL_OK) + goto errorExit; + keylIntPtr->numEntries++; + } + + if ((objPtr->typePtr != NULL) && + (objPtr->typePtr->freeIntRepProc != NULL)) { + (*objPtr->typePtr->freeIntRepProc) (objPtr); + } + objPtr->internalRep.twoPtrValue.ptr1 = keylIntPtr; + objPtr->typePtr = &keyedListType; + + KEYL_REP_ASSERT (keylIntPtr); + return TCL_OK; + + errorExit: + FreeKeyedListData (keylIntPtr); + return TCL_ERROR; +} + +/*----------------------------------------------------------------------------- + * UpdateStringOfKeyedList -- + * Update the string representation of a keyed list. + * + * Parameters: + * o objPtr - Object to convert to a keyed list. + *----------------------------------------------------------------------------- + */ +static void +UpdateStringOfKeyedList (keylPtr) + Tcl_Obj *keylPtr; +{ +#define UPDATE_STATIC_SIZE 32 + int idx; + Tcl_Obj **listObjv, *entryObjv [2], *tmpListObj; + Tcl_Obj *staticListObjv [UPDATE_STATIC_SIZE]; + char *listStr; + keylIntObj_t *keylIntPtr = + keylPtr->internalRep.twoPtrValue.ptr1; + + /* + * Conversion to strings is done via list objects to support binary data. + */ + if (keylIntPtr->numEntries > UPDATE_STATIC_SIZE) { + listObjv = + (Tcl_Obj **) ckalloc (keylIntPtr->numEntries * sizeof (Tcl_Obj *)); + } else { + listObjv = staticListObjv; + } + + /* + * Convert each keyed list entry to a two element list object. No + * need to incr/decr ref counts, the list objects will take care of that. + * FIX: Keeping key as string object will speed this up. + */ + for (idx = 0; idx < keylIntPtr->numEntries; idx++) { + entryObjv [0] = + Tcl_NewStringObj(keylIntPtr->entries [idx].key, + strlen (keylIntPtr->entries [idx].key)); + entryObjv [1] = keylIntPtr->entries [idx].valuePtr; + listObjv [idx] = Tcl_NewListObj (2, entryObjv); + } + + tmpListObj = Tcl_NewListObj (keylIntPtr->numEntries, listObjv); + listStr = Tcl_GetString(tmpListObj); + keylPtr->bytes = ckbinstrdup(listStr, tmpListObj->length); + keylPtr->length = tmpListObj->length; + + Tcl_DecrRefCount (tmpListObj); + if (listObjv != staticListObjv) + ckfree ((void*) listObjv); +} + +/*----------------------------------------------------------------------------- + * TclX_NewKeyedListObj -- + * Create and initialize a new keyed list object. + * + * Returns: + * A pointer to the object. + *----------------------------------------------------------------------------- + */ +Tcl_Obj * +TclX_NewKeyedListObj () +{ + Tcl_Obj *keylPtr = Tcl_NewObj (); + keylIntObj_t *keylIntPtr = AllocKeyedListIntRep (); + + keylPtr->internalRep.twoPtrValue.ptr1 = keylIntPtr; + keylPtr->typePtr = &keyedListType; + return keylPtr; +} + +/*----------------------------------------------------------------------------- + * TclX_KeyedListGet -- + * Retrieve a key value from a keyed list. + * + * Parameters: + * o interp - Error message will be return in result if there is an error. + * o keylPtr - Keyed list object to get key from. + * o key - The name of the key to extract. Will recusively process sub-keys + * seperated by `.'. + * o valueObjPtrPtr - If the key is found, a pointer to the key object + * is returned here. NULL is returned if the key is not present. + * Returns: + * o TCL_OK - If the key value was returned. + * o TCL_BREAK - If the key was not found. + * o TCL_ERROR - If an error occured. + *----------------------------------------------------------------------------- + */ +int +TclX_KeyedListGet (interp, keylPtr, key, valuePtrPtr) + Tcl_Interp *interp; + Tcl_Obj *keylPtr; + const char *key; + Tcl_Obj **valuePtrPtr; +{ + keylIntObj_t *keylIntPtr; + const char *nextSubKey; + int findIdx; + + if (keylPtr->typePtr != &keyedListType) { + if (SetKeyedListFromAny(interp, keylPtr) != TCL_OK) { + return TCL_ERROR; + } + } + keylIntPtr = keylPtr->internalRep.twoPtrValue.ptr1; + KEYL_REP_ASSERT (keylIntPtr); + + findIdx = FindKeyedListEntry (keylIntPtr, key, NULL, &nextSubKey); + + /* + * If not found, return status. + */ + if (findIdx < 0) { + *valuePtrPtr = NULL; + return TCL_BREAK; + } + + /* + * If we are at the last subkey, return the entry, otherwise recurse + * down looking for the entry. + */ + if (nextSubKey == NULL) { + *valuePtrPtr = keylIntPtr->entries [findIdx].valuePtr; + return TCL_OK; + } else { + return TclX_KeyedListGet (interp, + keylIntPtr->entries [findIdx].valuePtr, + nextSubKey, + valuePtrPtr); + } +} + +/*----------------------------------------------------------------------------- + * TclX_KeyedListSet -- + * Set a key value in keyed list object. + * + * Parameters: + * o interp - Error message will be return in result object. + * o keylPtr - Keyed list object to update. + * o key - The name of the key to extract. Will recusively process + * sub-key seperated by `.'. + * o valueObjPtr - The value to set for the key. + * Returns: + * TCL_OK or TCL_ERROR. + *----------------------------------------------------------------------------- + */ +int +TclX_KeyedListSet (interp, keylPtr, key, valuePtr) + Tcl_Interp *interp; + Tcl_Obj *keylPtr; + const char *key; + Tcl_Obj *valuePtr; +{ + keylIntObj_t *keylIntPtr; + const char *nextSubKey; + int findIdx, keyLen, status; + Tcl_Obj *newKeylPtr; + + if (keylPtr->typePtr != &keyedListType) { + if (SetKeyedListFromAny(interp, keylPtr) != TCL_OK) { + return TCL_ERROR; + } + } + keylIntPtr = keylPtr->internalRep.twoPtrValue.ptr1; + KEYL_REP_ASSERT (keylIntPtr); + + findIdx = FindKeyedListEntry (keylIntPtr, key, + &keyLen, &nextSubKey); + + /* + * If we are at the last subkey, either update or add an entry. + */ + if (nextSubKey == NULL) { + if (findIdx < 0) { + EnsureKeyedListSpace (keylIntPtr, 1); + findIdx = keylIntPtr->numEntries; + keylIntPtr->numEntries++; + } else { + ckfree (keylIntPtr->entries [findIdx].key); + Tcl_DecrRefCount (keylIntPtr->entries [findIdx].valuePtr); + } + keylIntPtr->entries [findIdx].key = + (char *) ckalloc (keyLen + 1); + strncpy (keylIntPtr->entries [findIdx].key, key, keyLen); + keylIntPtr->entries [findIdx].key [keyLen] = '\0'; + keylIntPtr->entries [findIdx].valuePtr = valuePtr; + Tcl_IncrRefCount (valuePtr); + Tcl_InvalidateStringRep (keylPtr); + + KEYL_REP_ASSERT (keylIntPtr); + return TCL_OK; + } + + /* + * If we are not at the last subkey, recurse down, creating new + * entries if neccessary. If this level key was not found, it + * means we must build new subtree. Don't insert the new tree until we + * come back without error. + */ + if (findIdx >= 0) { + DupSharedKeyListChild (keylIntPtr, findIdx); + status = + TclX_KeyedListSet (interp, + keylIntPtr->entries [findIdx].valuePtr, + nextSubKey, valuePtr); + if (status == TCL_OK) { + Tcl_InvalidateStringRep (keylPtr); + } + + KEYL_REP_ASSERT (keylIntPtr); + return status; + } else { + newKeylPtr = TclX_NewKeyedListObj (); + if (TclX_KeyedListSet (interp, newKeylPtr, + nextSubKey, valuePtr) != TCL_OK) { + Tcl_DecrRefCount (newKeylPtr); + return TCL_ERROR; + } + EnsureKeyedListSpace (keylIntPtr, 1); + findIdx = keylIntPtr->numEntries++; + keylIntPtr->entries [findIdx].key = + (char *) ckalloc (keyLen + 1); + strncpy (keylIntPtr->entries [findIdx].key, key, keyLen); + keylIntPtr->entries [findIdx].key [keyLen] = '\0'; + keylIntPtr->entries [findIdx].valuePtr = newKeylPtr; + Tcl_IncrRefCount (newKeylPtr); + Tcl_InvalidateStringRep (keylPtr); + + KEYL_REP_ASSERT (keylIntPtr); + return TCL_OK; + } +} + +/*----------------------------------------------------------------------------- + * TclX_KeyedListDelete -- + * Delete a key value from keyed list. + * + * Parameters: + * o interp - Error message will be return in result if there is an error. + * o keylPtr - Keyed list object to update. + * o key - The name of the key to extract. Will recusively process + * sub-key seperated by `.'. + * Returns: + * o TCL_OK - If the key was deleted. + * o TCL_BREAK - If the key was not found. + * o TCL_ERROR - If an error occured. + *----------------------------------------------------------------------------- + */ +int +TclX_KeyedListDelete (interp, keylPtr, key) + Tcl_Interp *interp; + Tcl_Obj *keylPtr; + const char *key; +{ + keylIntObj_t *keylIntPtr, *subKeylIntPtr; + const char *nextSubKey; + int findIdx, status; + + if (keylPtr->typePtr != &keyedListType) { + if (SetKeyedListFromAny(interp, keylPtr) != TCL_OK) { + return TCL_ERROR; + } + } + keylIntPtr = keylPtr->internalRep.twoPtrValue.ptr1; + + findIdx = FindKeyedListEntry (keylIntPtr, key, NULL, &nextSubKey); + + /* + * If not found, return status. + */ + if (findIdx < 0) { + KEYL_REP_ASSERT (keylIntPtr); + return TCL_BREAK; + } + + /* + * If we are at the last subkey, delete the entry. + */ + if (nextSubKey == NULL) { + DeleteKeyedListEntry (keylIntPtr, findIdx); + Tcl_InvalidateStringRep (keylPtr); + + KEYL_REP_ASSERT (keylIntPtr); + return TCL_OK; + } + + /* + * If we are not at the last subkey, recurse down. If the entry is + * deleted and the sub-keyed list is empty, delete it as well. Must + * invalidate string, as it caches all representations below it. + */ + DupSharedKeyListChild (keylIntPtr, findIdx); + + status = TclX_KeyedListDelete (interp, + keylIntPtr->entries [findIdx].valuePtr, + nextSubKey); + if (status == TCL_OK) { + subKeylIntPtr = + keylIntPtr->entries [findIdx].valuePtr->internalRep.twoPtrValue.ptr1; + if (subKeylIntPtr->numEntries == 0) { + DeleteKeyedListEntry (keylIntPtr, findIdx); + } + Tcl_InvalidateStringRep (keylPtr); + } + + KEYL_REP_ASSERT (keylIntPtr); + return status; +} + +/*----------------------------------------------------------------------------- + * TclX_KeyedListGetKeys -- + * Retrieve a list of keyed list keys. + * + * Parameters: + * o interp - Error message will be return in result if there is an error. + * o keylPtr - Keyed list object to get key from. + * o key - The name of the key to get the sub keys for. NULL or empty + * to retrieve all top level keys. + * o listObjPtrPtr - List object is returned here with key as values. + * Returns: + * o TCL_OK - If the zero or more key where returned. + * o TCL_BREAK - If the key was not found. + * o TCL_ERROR - If an error occured. + *----------------------------------------------------------------------------- + */ +int +TclX_KeyedListGetKeys (interp, keylPtr, key, listObjPtrPtr) + Tcl_Interp *interp; + Tcl_Obj *keylPtr; + const char *key; + Tcl_Obj **listObjPtrPtr; +{ + keylIntObj_t *keylIntPtr; + Tcl_Obj *nameObjPtr, *listObjPtr; + const char *nextSubKey; + int idx, findIdx; + + if (keylPtr->typePtr != &keyedListType) { + if (SetKeyedListFromAny(interp, keylPtr) != TCL_OK) { + return TCL_ERROR; + } + } + keylIntPtr = keylPtr->internalRep.twoPtrValue.ptr1; + + /* + * If key is not NULL or empty, then recurse down until we go past + * the end of all of the elements of the key. + */ + if ((key != NULL) && (key [0] != '\0')) { + findIdx = FindKeyedListEntry (keylIntPtr, key, NULL, &nextSubKey); + if (findIdx < 0) { + TclX_Assert (keylIntPtr->arraySize >= keylIntPtr->numEntries); + return TCL_BREAK; + } + TclX_Assert (keylIntPtr->arraySize >= keylIntPtr->numEntries); + return TclX_KeyedListGetKeys (interp, + keylIntPtr->entries [findIdx].valuePtr, + nextSubKey, + listObjPtrPtr); + } + + /* + * Reached the end of the full key, return all keys at this level. + */ + listObjPtr = Tcl_NewListObj (0, NULL); + for (idx = 0; idx < keylIntPtr->numEntries; idx++) { + nameObjPtr = Tcl_NewStringObj (keylIntPtr->entries [idx].key, + -1); + if (Tcl_ListObjAppendElement (interp, listObjPtr, + nameObjPtr) != TCL_OK) { + Tcl_DecrRefCount (nameObjPtr); + Tcl_DecrRefCount (listObjPtr); + return TCL_ERROR; + } + } + *listObjPtrPtr = listObjPtr; + TclX_Assert (keylIntPtr->arraySize >= keylIntPtr->numEntries); + return TCL_OK; +} + +/*----------------------------------------------------------------------------- + * Tcl_KeylgetObjCmd -- + * Implements the TCL keylget command: + * keylget listvar ?key? ?retvar | {}? + *----------------------------------------------------------------------------- + */ +static int +Tcl_KeylgetObjCmd (clientData, interp, objc, objv) + ClientData clientData; + Tcl_Interp *interp; + int objc; + Tcl_Obj *const objv[]; +{ + Tcl_Obj *keylPtr, *valuePtr; + const char *key; + int status; + + if ((objc < 2) || (objc > 4)) { + return TclX_WrongArgs (interp, objv [0], + "listvar ?key? ?retvar | {}?"); + } + /* + * Handle request for list of keys, use keylkeys command. + */ + if (objc == 2) + return Tcl_KeylkeysObjCmd (clientData, interp, objc, objv); + + keylPtr = Tcl_ObjGetVar2(interp, objv[1], NULL, TCL_LEAVE_ERR_MSG); + if (keylPtr == NULL) { + return TCL_ERROR; + } + + /* + * Handle retrieving a value for a specified key. + */ + key = Tcl_GetString(objv[2]); + if (ValidateKey(interp, key, objv[2]->length, 1) == TCL_ERROR) { + return TCL_ERROR; + } + + status = TclX_KeyedListGet (interp, keylPtr, key, &valuePtr); + if (status == TCL_ERROR) + return TCL_ERROR; + + /* + * Handle key not found. + */ + if (status == TCL_BREAK) { + if (objc == 3) { + TclX_AppendObjResult (interp, "key \"", key, + "\" not found in keyed list", + (char *) NULL); + return TCL_ERROR; + } else { + Tcl_ResetResult(interp); + Tcl_SetIntObj(Tcl_GetObjResult (interp), 0); + return TCL_OK; + } + } + + /* + * No variable specified, so return value in the result. + */ + if (objc == 3) { + Tcl_SetObjResult (interp, valuePtr); + return TCL_OK; + } + + /* + * Variable (or empty variable name) specified. + */ + if (!TclX_IsNullObj(objv [3])) { + if (Tcl_ObjSetVar2(interp, objv[3], NULL, + valuePtr, TCL_LEAVE_ERR_MSG) == NULL) + return TCL_ERROR; + } + Tcl_ResetResult(interp); + Tcl_SetIntObj(Tcl_GetObjResult (interp), 1); + return TCL_OK; +} + +/*----------------------------------------------------------------------------- + * Tcl_KeylsetObjCmd -- + * Implements the TCL keylset command: + * keylset listvar key value ?key value...? + *----------------------------------------------------------------------------- + */ +static int +Tcl_KeylsetObjCmd (clientData, interp, objc, objv) + ClientData clientData; + Tcl_Interp *interp; + int objc; + Tcl_Obj *const objv[]; +{ + Tcl_Obj *keylVarPtr, *newVarObj; + const char *key; + int idx; + + if ((objc < 4) || ((objc % 2) != 0)) { + return TclX_WrongArgs (interp, objv [0], + "listvar key value ?key value...?"); + } + + /* + * Get the variable that we are going to update. If the var doesn't exist, + * create it. If it is shared by more than being a variable, duplicated + * it. + */ + keylVarPtr = Tcl_ObjGetVar2(interp, objv[1], NULL, 0); + if ((keylVarPtr == NULL) || (Tcl_IsShared (keylVarPtr))) { + if (keylVarPtr == NULL) { + keylVarPtr = TclX_NewKeyedListObj (); + } else { + keylVarPtr = Tcl_DuplicateObj (keylVarPtr); + } + newVarObj = keylVarPtr; + } else { + newVarObj = NULL; + } + + for (idx = 2; idx < objc; idx += 2) { + key = Tcl_GetString(objv[idx]); + if (ValidateKey(interp, key, objv[idx]->length, 1) == TCL_ERROR) { + goto errorExit; + } + if (TclX_KeyedListSet (interp, keylVarPtr, key, objv [idx+1]) != TCL_OK) { + goto errorExit; + } + } + + if (Tcl_ObjSetVar2(interp, objv[1], NULL, keylVarPtr, + TCL_LEAVE_ERR_MSG) == NULL) { + goto errorExit; + } + + return TCL_OK; + + errorExit: + if (newVarObj != NULL) { + Tcl_DecrRefCount (newVarObj); + } + return TCL_ERROR; +} + +/*----------------------------------------------------------------------------- + * Tcl_KeyldelObjCmd -- + * Implements the TCL keyldel command: + * keyldel listvar key ?key ...? + *---------------------------------------------------------------------------- + */ +static int +Tcl_KeyldelObjCmd (clientData, interp, objc, objv) + ClientData clientData; + Tcl_Interp *interp; + int objc; + Tcl_Obj *const objv[]; +{ + Tcl_Obj *keylVarPtr, *keylPtr; + const char *key; + int idx, status; + + if (objc < 3) { + return TclX_WrongArgs (interp, objv [0], "listvar key ?key ...?"); + } + + /* + * Get the variable that we are going to update. If it is shared by more + * than being a variable, duplicated it. + */ + keylVarPtr = Tcl_ObjGetVar2(interp, objv[1], NULL, TCL_LEAVE_ERR_MSG); + if (keylVarPtr == NULL) { + return TCL_ERROR; + } + if (Tcl_IsShared (keylVarPtr)) { + keylPtr = Tcl_DuplicateObj (keylVarPtr); + keylVarPtr = Tcl_ObjSetVar2(interp, objv[1], NULL, keylPtr, TCL_LEAVE_ERR_MSG); + if (keylVarPtr == NULL) { + Tcl_DecrRefCount (keylPtr); + return TCL_ERROR; + } + if (keylVarPtr != keylPtr) { + Tcl_DecrRefCount (keylPtr); + } + } + keylPtr = keylVarPtr; + + for (idx = 2; idx < objc; idx++) { + key = Tcl_GetString(objv[idx]); + if (ValidateKey(interp, key, objv[idx]->length, 1) == TCL_ERROR) { + return TCL_ERROR; + } + + status = TclX_KeyedListDelete (interp, keylPtr, key); + switch (status) { + case TCL_BREAK: + TclX_AppendObjResult (interp, "key not found: \"", + key, "\"", (char *) NULL); + return TCL_ERROR; + case TCL_ERROR: + return TCL_ERROR; + } + } + + return TCL_OK; +} + +/*----------------------------------------------------------------------------- + * Tcl_KeylkeysObjCmd -- + * Implements the TCL keylkeys command: + * keylkeys listvar ?key? + *----------------------------------------------------------------------------- + */ +static int +Tcl_KeylkeysObjCmd (clientData, interp, objc, objv) + ClientData clientData; + Tcl_Interp *interp; + int objc; + Tcl_Obj *const objv[]; +{ + Tcl_Obj *keylPtr, *listObjPtr; + const char *key; + int status; + + if ((objc < 2) || (objc > 3)) { + return TclX_WrongArgs(interp, objv [0], "listvar ?key?"); + } + + keylPtr = Tcl_ObjGetVar2(interp, objv[1], NULL, TCL_LEAVE_ERR_MSG); + if (keylPtr == NULL) { + return TCL_ERROR; + } + + /* + * If key argument is not specified, then objv [2] is NULL or empty, + * meaning get top level keys. + */ + if (objc < 3) { + key = NULL; + } else { + key = Tcl_GetString(objv[2]); + if (ValidateKey(interp, key, objv[2]->length, 1) == TCL_ERROR) { + return TCL_ERROR; + } + } + + status = TclX_KeyedListGetKeys (interp, keylPtr, key, &listObjPtr); + switch (status) { + case TCL_BREAK: + TclX_AppendObjResult (interp, "key not found: \"", key, "\"", + (char *) NULL); + return TCL_ERROR; + case TCL_ERROR: + return TCL_ERROR; + } + + Tcl_SetObjResult (interp, listObjPtr); + + return TCL_OK; +} + +/*----------------------------------------------------------------------------- + * TclX_KeyedListInit -- + * Initialize the keyed list commands for this interpreter. + * + * Parameters: + * o interp - Interpreter to add commands to. + *----------------------------------------------------------------------------- + */ +void +TclX_KeyedListInit (interp) + Tcl_Interp *interp; +{ + Tcl_Obj *listobj; + Tcl_RegisterObjType(&keyedListType); + + listobj = Tcl_NewObj(); + listobj = Tcl_NewListObj(1, &listobj); + listType = listobj->typePtr; + Tcl_DecrRefCount(listobj); + + if (0) { + Tcl_CreateObjCommand (interp, + "keylget", + Tcl_KeylgetObjCmd, + (ClientData) NULL, + (Tcl_CmdDeleteProc*) NULL); + + Tcl_CreateObjCommand (interp, + "keylset", + Tcl_KeylsetObjCmd, + (ClientData) NULL, + (Tcl_CmdDeleteProc*) NULL); + + Tcl_CreateObjCommand (interp, + "keyldel", + Tcl_KeyldelObjCmd, + (ClientData) NULL, + (Tcl_CmdDeleteProc*) NULL); + + Tcl_CreateObjCommand (interp, + "keylkeys", + Tcl_KeylkeysObjCmd, + (ClientData) NULL, + (Tcl_CmdDeleteProc*) NULL); + } +} + + diff --git a/tcl8.6/pkgs/thread2.8.4/generic/tclXkeylist.h b/tcl8.6/pkgs/thread2.8.4/generic/tclXkeylist.h new file mode 100644 index 0000000..8abfac9 --- /dev/null +++ b/tcl8.6/pkgs/thread2.8.4/generic/tclXkeylist.h @@ -0,0 +1,52 @@ +/* + * 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**); + +/* + * 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: */ + diff --git a/tcl8.6/pkgs/thread2.8.4/generic/threadCmd.c b/tcl8.6/pkgs/thread2.8.4/generic/threadCmd.c new file mode 100644 index 0000000..cf8f19d --- /dev/null +++ b/tcl8.6/pkgs/thread2.8.4/generic/threadCmd.c @@ -0,0 +1,3923 @@ +/* + * threadCmd.c -- + * + * This file implements the Tcl thread commands that allow script + * level access to threading. It will not load into a core that was + * not compiled for thread support. + * + * See http://www.tcl.tk/doc/howto/thread_model.html + * + * Some of this code is based on work done by Richard Hipp on behalf of + * Conservation Through Innovation, Limited, with their permission. + * + * Copyright (c) 1998 by Sun Microsystems, Inc. + * Copyright (c) 1999,2000 by Scriptics 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. + * ---------------------------------------------------------------------------- + */ + +#include "tclThreadInt.h" + +/* + * Provide package version in build contexts which do not provide + * -DPACKAGE_VERSION, like building a shell with the Thread object + * files built as part of that shell. Example: basekits. + */ +#ifndef PACKAGE_VERSION +#define PACKAGE_VERSION "2.8.4" +#endif + +/* + * Check if this is Tcl 8.5 or higher. In that case, we will have the TIP + * #143 APIs (i.e. interpreter resource limiting) available. + */ + +#ifndef TCL_TIP143 +# if TCL_MINIMUM_VERSION(8,5) +# define TCL_TIP143 +# endif +#endif + +/* + * If TIP #143 support is enabled and we are compiling against a pre-Tcl 8.5 + * core, hard-wire the necessary APIs using the "well-known" offsets into the + * stubs table. + */ + +#define haveInterpLimit (threadTclVersion>=85) +#if defined(TCL_TIP143) && !TCL_MINIMUM_VERSION(8,5) +# if defined(USE_TCL_STUBS) +# define Tcl_LimitExceeded ((int (*)(Tcl_Interp *)) \ + ((&(tclStubsPtr->tcl_PkgProvideEx))[524])) +# else +# error "Supporting TIP #143 requires USE_TCL_STUBS before Tcl 8.5" +# endif +#endif + +/* + * Check if this is Tcl 8.6 or higher. In that case, we will have the TIP + * #285 APIs (i.e. asynchronous script cancellation) available. + */ + +#define haveInterpCancel (threadTclVersion>=86) +#ifndef TCL_TIP285 +# if TCL_MINIMUM_VERSION(8,6) +# define TCL_TIP285 +# endif +#endif + +/* + * If TIP #285 support is enabled and we are compiling against a pre-Tcl 8.6 + * core, hard-wire the necessary APIs using the "well-known" offsets into the + * stubs table. + */ + +#if defined(TCL_TIP285) && !TCL_MINIMUM_VERSION(8,6) +# if defined(USE_TCL_STUBS) +# define TCL_CANCEL_UNWIND 0x100000 +# define Tcl_CancelEval ((int (*)(Tcl_Interp *, Tcl_Obj *, ClientData, int)) \ + ((&(tclStubsPtr->tcl_PkgProvideEx))[580])) +# define Tcl_Canceled ((int (*)(Tcl_Interp *, int)) \ + ((&(tclStubsPtr->tcl_PkgProvideEx))[581])) +# else +# error "Supporting TIP #285 requires USE_TCL_STUBS before Tcl 8.6" +# endif +#endif + +/* + * Access to the list of threads and to the thread send results + * (defined below) is guarded by this mutex. + */ + +TCL_DECLARE_MUTEX(threadMutex) + +/* + * Each thread has an single instance of the following structure. There + * is one instance of this structure per thread even if that thread contains + * multiple interpreters. The interpreter identified by this structure is + * the main interpreter for the thread. The main interpreter is the one that + * will process any messages received by a thread. Any interpreter can send + * messages but only the main interpreter can receive them, unless you're + * not doing asynchronous script backfiring. In such cases the caller might + * signal the thread to which interpreter the result should be delivered. + */ + +typedef struct ThreadSpecificData { + Tcl_ThreadId threadId; /* The real ID of this thread */ + Tcl_Interp *interp; /* Main interp for this thread */ + Tcl_Condition doOneEvent; /* Signalled just before running + an event from the event loop */ + int flags; /* One of the ThreadFlags below */ + int refCount; /* Used for thread reservation */ + int eventsPending; /* # of unprocessed events */ + int maxEventsCount; /* Maximum # of pending events */ + struct ThreadEventResult *result; + struct ThreadSpecificData *nextPtr; + struct ThreadSpecificData *prevPtr; +} ThreadSpecificData; + +static Tcl_ThreadDataKey dataKey; + +#define THREAD_FLAGS_NONE 0 /* None */ +#define THREAD_FLAGS_STOPPED 1 /* Thread is being stopped */ +#define THREAD_FLAGS_INERROR 2 /* Thread is in error */ +#define THREAD_FLAGS_UNWINDONERROR 4 /* Thread unwinds on script error */ + +#define THREAD_RESERVE 1 /* Reserves the thread */ +#define THREAD_RELEASE 2 /* Releases the thread */ + +/* + * Length of storage for building the Tcl handle for the thread. + */ + +#define THREAD_HNDLPREFIX "tid" +#define THREAD_HNDLMAXLEN 32 + +/* + * This list is used to list all threads that have interpreters. + */ + +static struct ThreadSpecificData *threadList = NULL; + +/* + * Used to represent the empty result. + */ + +static char *threadEmptyResult = (char *)""; + +int threadTclVersion = 0; + +/* + * An instance of the following structure contains all information that is + * passed into a new thread when the thread is created using either the + * "thread create" Tcl command or the ThreadCreate() C function. + */ + +typedef struct ThreadCtrl { + char *script; /* Script to execute */ + int flags; /* Initial value of the "flags" + * field in ThreadSpecificData */ + Tcl_Condition condWait; /* Condition variable used to + * sync parent and child threads */ + ClientData cd; /* Opaque ptr to pass to thread */ +} ThreadCtrl; + +/* + * Structure holding result of the command executed in target thread. + */ + +typedef struct ThreadEventResult { + Tcl_Condition done; /* Set when the script completes */ + int code; /* Return value of the function */ + char *result; /* Result from the function */ + char *errorInfo; /* Copy of errorInfo variable */ + char *errorCode; /* Copy of errorCode variable */ + Tcl_ThreadId srcThreadId; /* Id of sender, if it dies */ + Tcl_ThreadId dstThreadId; /* Id of target, if it dies */ + struct ThreadEvent *eventPtr; /* Back pointer */ + struct ThreadEventResult *nextPtr; /* List for cleanup */ + struct ThreadEventResult *prevPtr; +} ThreadEventResult; + +/* + * This list links all active ThreadEventResult structures. This way + * an exiting thread can inform all threads waiting on jobs posted to + * his event queue that it is dying, so they might stop waiting. + */ + +static ThreadEventResult *resultList; + +/* + * This is the event used to send commands to other threads. + */ + +typedef struct ThreadEvent { + Tcl_Event event; /* Must be first */ + struct ThreadSendData *sendData; /* See below */ + struct ThreadClbkData *clbkData; /* See below */ + struct ThreadEventResult *resultPtr; /* To communicate the result back. + * NULL if we don't care about it */ +} ThreadEvent; + +typedef int (ThreadSendProc) (Tcl_Interp*, ClientData); +typedef void (ThreadSendFree) (ClientData); + +static ThreadSendProc ThreadSendEval; /* Does a regular Tcl_Eval */ +static ThreadSendProc ThreadClbkSetVar; /* Sets the named variable */ + +/* + * These structures are used to communicate commands between source and target + * threads. The ThreadSendData is used for source->target command passing, + * while the ThreadClbkData is used for doing asynchronous callbacks. + * + * Important: structures below must have first three elements identical! + */ + +typedef struct ThreadSendData { + ThreadSendProc *execProc; /* Func to exec in remote thread */ + ClientData clientData; /* Ptr to pass to send function */ + ThreadSendFree *freeProc; /* Function to free client data */ + /* ---- */ + Tcl_Interp *interp; /* Interp to run the command */ +} ThreadSendData; + +typedef struct ThreadClbkData { + ThreadSendProc *execProc; /* The callback function */ + ClientData clientData; /* Ptr to pass to clbk function */ + ThreadSendFree *freeProc; /* Function to free client data */ + /* ---- */ + Tcl_Interp *interp; /* Interp to run the command */ + Tcl_ThreadId threadId; /* Thread where to post callback */ + ThreadEventResult result; /* Returns result asynchronously */ +} ThreadClbkData; + +/* + * Event used to transfer a channel between threads. + */ +typedef struct TransferEvent { + Tcl_Event event; /* Must be first */ + Tcl_Channel chan; /* The channel to transfer */ + struct TransferResult *resultPtr; /* To communicate the result */ +} TransferEvent; + +typedef struct TransferResult { + Tcl_Condition done; /* Set when transfer is done */ + int resultCode; /* Set to TCL_OK or TCL_ERROR when + the transfer is done. Def = -1 */ + char *resultMsg; /* Initialized to NULL. Set to a + allocated string by the target + thread in case of an error */ + Tcl_ThreadId srcThreadId; /* Id of src thread, if it dies */ + Tcl_ThreadId dstThreadId; /* Id of tgt thread, if it dies */ + struct TransferEvent *eventPtr; /* Back pointer */ + struct TransferResult *nextPtr; /* Next in the linked list */ + struct TransferResult *prevPtr; /* Previous in the linked list */ +} TransferResult; + +static TransferResult *transferList; + +/* + * This is for simple error handling when a thread script exits badly. + */ + +static Tcl_ThreadId errorThreadId; /* Id of thread to post error message */ +static char *errorProcString; /* Tcl script to run when reporting error */ + +/* + * Definition of flags for ThreadSend. + */ + +#define THREAD_SEND_WAIT (1<<1) +#define THREAD_SEND_HEAD (1<<2) +#define THREAD_SEND_CLBK (1<<3) + +#ifdef BUILD_thread +# undef TCL_STORAGE_CLASS +# define TCL_STORAGE_CLASS DLLEXPORT +#endif + +/* + * Miscellaneous functions used within this file + */ + +static Tcl_EventDeleteProc ThreadDeleteEvent; + +static Tcl_ThreadCreateType +NewThread(ClientData clientData); + +static ThreadSpecificData* +ThreadExistsInner(Tcl_ThreadId id); + +static int +ThreadInit(Tcl_Interp *interp); + +static int +ThreadCreate(Tcl_Interp *interp, + const char *script, + int stacksize, + int flags, + int preserve); +static int +ThreadSend(Tcl_Interp *interp, + Tcl_ThreadId id, + ThreadSendData *sendPtr, + ThreadClbkData *clbkPtr, + int flags); +static void +ThreadSetResult(Tcl_Interp *interp, + int code, + ThreadEventResult *resultPtr); +static int +ThreadGetOption(Tcl_Interp *interp, + Tcl_ThreadId id, + char *option, + Tcl_DString *ds); +static int +ThreadSetOption(Tcl_Interp *interp, + Tcl_ThreadId id, + char *option, + char *value); +static int +ThreadReserve(Tcl_Interp *interp, + Tcl_ThreadId id, + int operation, + int wait); +static int +ThreadEventProc(Tcl_Event *evPtr, + int mask); +static int +ThreadWait(Tcl_Interp *interp); + +static int +ThreadExists(Tcl_ThreadId id); + +static int +ThreadList(Tcl_Interp *interp, + Tcl_ThreadId **thrIdArray); +static void +ThreadErrorProc(Tcl_Interp *interp); + +static void +ThreadFreeProc(ClientData clientData); + +static void +ThreadIdleProc(ClientData clientData); + +static void +ThreadExitProc(ClientData clientData); + +static void +ThreadFreeError(ClientData clientData); + +static void +ListRemove(ThreadSpecificData *tsdPtr); + +static void +ListRemoveInner(ThreadSpecificData *tsdPtr); + +static void +ListUpdate(ThreadSpecificData *tsdPtr); + +static void +ListUpdateInner(ThreadSpecificData *tsdPtr); + +static int +ThreadJoin(Tcl_Interp *interp, + Tcl_ThreadId id); +static int +ThreadTransfer(Tcl_Interp *interp, + Tcl_ThreadId id, + Tcl_Channel chan); +static int +ThreadDetach(Tcl_Interp *interp, + Tcl_Channel chan); +static int +ThreadAttach(Tcl_Interp *interp, + char *chanName); +static int +TransferEventProc(Tcl_Event *evPtr, + int mask); + +static void +ThreadGetHandle(Tcl_ThreadId, + char *handlePtr); + +static int +ThreadGetId(Tcl_Interp *interp, + Tcl_Obj *handleObj, + Tcl_ThreadId *thrIdPtr); +static void +ErrorNoSuchThread(Tcl_Interp *interp, + Tcl_ThreadId thrId); +static void +ThreadCutChannel(Tcl_Interp *interp, + Tcl_Channel channel); + +#ifdef TCL_TIP285 +static int +ThreadCancel(Tcl_Interp *interp, + Tcl_ThreadId thrId, + const char *result, + int flags); +#endif + +/* + * Functions implementing Tcl commands + */ + +static Tcl_ObjCmdProc ThreadCreateObjCmd; +static Tcl_ObjCmdProc ThreadReserveObjCmd; +static Tcl_ObjCmdProc ThreadReleaseObjCmd; +static Tcl_ObjCmdProc ThreadSendObjCmd; +static Tcl_ObjCmdProc ThreadBroadcastObjCmd; +static Tcl_ObjCmdProc ThreadUnwindObjCmd; +static Tcl_ObjCmdProc ThreadExitObjCmd; +static Tcl_ObjCmdProc ThreadIdObjCmd; +static Tcl_ObjCmdProc ThreadNamesObjCmd; +static Tcl_ObjCmdProc ThreadWaitObjCmd; +static Tcl_ObjCmdProc ThreadExistsObjCmd; +static Tcl_ObjCmdProc ThreadConfigureObjCmd; +static Tcl_ObjCmdProc ThreadErrorProcObjCmd; +static Tcl_ObjCmdProc ThreadJoinObjCmd; +static Tcl_ObjCmdProc ThreadTransferObjCmd; +static Tcl_ObjCmdProc ThreadDetachObjCmd; +static Tcl_ObjCmdProc ThreadAttachObjCmd; + +#ifdef TCL_TIP285 +static Tcl_ObjCmdProc ThreadCancelObjCmd; +#endif + +static int +ThreadInit(interp) + Tcl_Interp *interp; /* The current Tcl interpreter */ +{ + if (Tcl_InitStubs(interp, "8.4", 0) == NULL) { + return TCL_ERROR; + } + + if (!threadTclVersion) { + + /* + * Check whether we are running threaded Tcl. + * Get the current core version to decide whether to use + * some lately introduced core features or to back-off. + */ + + int major, minor; + + Tcl_MutexLock(&threadMutex); + if (threadMutex == NULL){ + /* If threadMutex==NULL here, it means that Tcl_MutexLock() is + * a dummy function, which is the case in unthreaded Tcl */ + const char *msg = "Tcl core wasn't compiled for threading"; + Tcl_SetObjResult(interp, Tcl_NewStringObj(msg, -1)); + return TCL_ERROR; + } + Tcl_GetVersion(&major, &minor, NULL, NULL); + threadTclVersion = 10 * major + minor; + Tcl_MutexUnlock(&threadMutex); + } + + TCL_CMD(interp, THREAD_CMD_PREFIX"create", ThreadCreateObjCmd); + TCL_CMD(interp, THREAD_CMD_PREFIX"send", ThreadSendObjCmd); + TCL_CMD(interp, THREAD_CMD_PREFIX"broadcast", ThreadBroadcastObjCmd); + TCL_CMD(interp, THREAD_CMD_PREFIX"exit", ThreadExitObjCmd); + TCL_CMD(interp, THREAD_CMD_PREFIX"unwind", ThreadUnwindObjCmd); + TCL_CMD(interp, THREAD_CMD_PREFIX"id", ThreadIdObjCmd); + TCL_CMD(interp, THREAD_CMD_PREFIX"names", ThreadNamesObjCmd); + TCL_CMD(interp, THREAD_CMD_PREFIX"exists", ThreadExistsObjCmd); + TCL_CMD(interp, THREAD_CMD_PREFIX"wait", ThreadWaitObjCmd); + TCL_CMD(interp, THREAD_CMD_PREFIX"configure", ThreadConfigureObjCmd); + TCL_CMD(interp, THREAD_CMD_PREFIX"errorproc", ThreadErrorProcObjCmd); + TCL_CMD(interp, THREAD_CMD_PREFIX"preserve", ThreadReserveObjCmd); + TCL_CMD(interp, THREAD_CMD_PREFIX"release", ThreadReleaseObjCmd); + TCL_CMD(interp, THREAD_CMD_PREFIX"join", ThreadJoinObjCmd); + TCL_CMD(interp, THREAD_CMD_PREFIX"transfer", ThreadTransferObjCmd); + TCL_CMD(interp, THREAD_CMD_PREFIX"detach", ThreadDetachObjCmd); + TCL_CMD(interp, THREAD_CMD_PREFIX"attach", ThreadAttachObjCmd); +#ifdef TCL_TIP285 + TCL_CMD(interp, THREAD_CMD_PREFIX"cancel", ThreadCancelObjCmd); +#endif + + /* + * Add shared variable commands + */ + + Sv_Init(interp); + + /* + * Add commands to access thread + * synchronization primitives. + */ + + Sp_Init(interp); + + /* + * Add threadpool commands. + */ + + Tpool_Init(interp); + + return TCL_OK; +} + + +/* + *---------------------------------------------------------------------- + * + * Thread_Init -- + * + * Initialize the thread commands. + * + * Results: + * TCL_OK if the package was properly initialized. + * + * Side effects: + * Adds package commands to the current interp. + * + *---------------------------------------------------------------------- + */ + +DLLEXPORT int +Thread_Init(interp) + Tcl_Interp *interp; /* The current Tcl interpreter */ +{ + int status = ThreadInit(interp); + + if (status != TCL_OK) { + return status; + } + + return Tcl_PkgProvideEx(interp, "Thread", PACKAGE_VERSION, NULL); +} + +/* + *---------------------------------------------------------------------- + * + * Init -- + * + * Make sure internal list of threads references the current thread. + * + * Results: + * None + * + * Side effects: + * The list of threads is initialized to include the current thread. + * + *---------------------------------------------------------------------- + */ + +static void +Init(interp) + Tcl_Interp *interp; /* Current interpreter. */ +{ + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + + if (tsdPtr->interp == (Tcl_Interp*)NULL) { + memset(tsdPtr, 0, sizeof(ThreadSpecificData)); + tsdPtr->interp = interp; + ListUpdate(tsdPtr); + Tcl_CreateThreadExitHandler(ThreadExitProc, + (ClientData)threadEmptyResult); + } +} + +/* + *---------------------------------------------------------------------- + * + * ThreadCreateObjCmd -- + * + * This procedure is invoked to process the "thread::create" Tcl + * command. See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ + +static int +ThreadCreateObjCmd(dummy, interp, objc, objv) + ClientData dummy; /* Not used. */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *const objv[]; /* Argument objects. */ +{ + int argc, rsrv = 0; + const char *arg, *script; + int flags = TCL_THREAD_NOFLAGS; + + Init(interp); + + /* + * Syntax: thread::create ?-joinable? ?-preserved? ?script? + */ + + script = THREAD_CMD_PREFIX"wait"; + + for (argc = 1; argc < objc; argc++) { + arg = Tcl_GetString(objv[argc]); + if (OPT_CMP(arg, "--")) { + argc++; + if ((argc + 1) == objc) { + script = Tcl_GetString(objv[argc]); + } else { + goto usage; + } + break; + } else if (OPT_CMP(arg, "-joinable")) { + flags |= TCL_THREAD_JOINABLE; + } else if (OPT_CMP(arg, "-preserved")) { + rsrv = 1; + } else if ((argc + 1) == objc) { + script = Tcl_GetString(objv[argc]); + } else { + goto usage; + } + } + + return ThreadCreate(interp, script, TCL_THREAD_STACK_DEFAULT, flags, rsrv); + + usage: + Tcl_WrongNumArgs(interp, 1, objv, "?-joinable? ?script?"); + return TCL_ERROR; +} + +/* + *---------------------------------------------------------------------- + * + * ThreadReserveObjCmd -- + * + * This procedure is invoked to process the "thread::preserve" and + * "thread::release" Tcl commands, depending on the flag passed by + * the ClientData argument. See the user documentation for details + * on what those command do. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ + +static int +ThreadReserveObjCmd(dummy, interp, objc, objv) + ClientData dummy; /* Not used. */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *const objv[]; /* Argument objects. */ +{ + Tcl_ThreadId thrId = (Tcl_ThreadId)0; + + Init(interp); + + if (objc > 2) { + Tcl_WrongNumArgs(interp, 1, objv, "?threadId?"); + return TCL_ERROR; + } + if (objc == 2) { + if (ThreadGetId(interp, objv[1], &thrId) != TCL_OK) { + return TCL_ERROR; + } + } + + return ThreadReserve(interp, thrId, THREAD_RESERVE, 0); +} + +/* + *---------------------------------------------------------------------- + * + * ThreadReleaseObjCmd -- + * + * This procedure is invoked to process the "thread::release" Tcl + * command. See the user documentation for details on what this + * command does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ + +static int +ThreadReleaseObjCmd(dummy, interp, objc, objv) + ClientData dummy; /* Not used. */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *const objv[]; /* Argument objects. */ +{ + int wait = 0; + Tcl_ThreadId thrId = (Tcl_ThreadId)0; + + Init(interp); + + if (objc > 3) { + Tcl_WrongNumArgs(interp, 1, objv, "?-wait? ?threadId?"); + return TCL_ERROR; + } + if (objc > 1) { + if (OPT_CMP(Tcl_GetString(objv[1]), "-wait")) { + wait = 1; + if (objc > 2) { + if (ThreadGetId(interp, objv[2], &thrId) != TCL_OK) { + return TCL_ERROR; + } + } + } else if (ThreadGetId(interp, objv[1], &thrId) != TCL_OK) { + return TCL_ERROR; + } + } + + return ThreadReserve(interp, thrId, THREAD_RELEASE, wait); +} + +/* + *---------------------------------------------------------------------- + * + * ThreadUnwindObjCmd -- + * + * This procedure is invoked to process the "thread::unwind" Tcl + * command. See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ + +static int +ThreadUnwindObjCmd(dummy, interp, objc, objv) + ClientData dummy; /* Not used. */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *const objv[]; /* Argument objects. */ +{ + Init(interp); + + if (objc > 1) { + Tcl_WrongNumArgs(interp, 1, objv, NULL); + return TCL_ERROR; + } + + return ThreadReserve(interp, 0, THREAD_RELEASE, 0); +} + +/* + *---------------------------------------------------------------------- + * + * ThreadExitObjCmd -- + * + * This procedure is invoked to process the "thread::exit" Tcl + * command. This causes an unconditional close of the thread + * and is GUARANTEED to cause memory leaks. Use this with caution. + * + * Results: + * Doesn't actually return. + * + * Side effects: + * Lots. improper clean up of resources. + * + *---------------------------------------------------------------------- + */ + +static int +ThreadExitObjCmd(dummy, interp, objc, objv) + ClientData dummy; /* Not used. */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *const objv[]; /* Argument objects. */ +{ + int status = 666; + + Init(interp); + + if (objc > 2) { + Tcl_WrongNumArgs(interp, 1, objv, "?status?"); + return TCL_ERROR; + } + + if (objc == 2) { + if (Tcl_GetIntFromObj(interp, objv[1], &status) != TCL_OK) { + return TCL_ERROR; + } + } + + ListRemove(NULL); + + Tcl_ExitThread(status); + + return TCL_OK; /* NOT REACHED */ +} + +/* + *---------------------------------------------------------------------- + * + * ThreadIdObjCmd -- + * + * This procedure is invoked to process the "thread::id" Tcl command. + * This returns the ID of the current thread. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static int +ThreadIdObjCmd(dummy, interp, objc, objv) + ClientData dummy; /* Not used. */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *const objv[]; /* Argument objects. */ +{ + char thrHandle[THREAD_HNDLMAXLEN]; + + Init(interp); + + if (objc > 1) { + Tcl_WrongNumArgs(interp, 1, objv, NULL); + return TCL_ERROR; + } + + ThreadGetHandle(Tcl_GetCurrentThread(), thrHandle); + Tcl_SetObjResult(interp, Tcl_NewStringObj(thrHandle, -1)); + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * ThreadNamesObjCmd -- + * + * This procedure is invoked to process the "thread::names" Tcl + * command. This returns a list of all known thread IDs. + * These are only threads created via this module (e.g., not + * driver threads or the notifier). + * + * Results: + * A standard Tcl result. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static int +ThreadNamesObjCmd(dummy, interp, objc, objv) + ClientData dummy; /* Not used. */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *const objv[]; /* Argument objects. */ +{ + int ii, length; + char *result, thrHandle[THREAD_HNDLMAXLEN]; + Tcl_ThreadId *thrIdArray; + Tcl_DString threadNames; + + Init(interp); + + if (objc > 1) { + Tcl_WrongNumArgs(interp, 1, objv, NULL); + return TCL_ERROR; + } + + length = ThreadList(interp, &thrIdArray); + + if (length == 0) { + return TCL_OK; + } + + Tcl_DStringInit(&threadNames); + + for (ii = 0; ii < length; ii++) { + ThreadGetHandle(thrIdArray[ii], thrHandle); + Tcl_DStringAppendElement(&threadNames, thrHandle); + } + + length = Tcl_DStringLength(&threadNames); + result = Tcl_DStringValue(&threadNames); + + Tcl_SetObjResult(interp, Tcl_NewStringObj(result, length)); + + Tcl_DStringFree(&threadNames); + ckfree((char*)thrIdArray); + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * ThreadSendObjCmd -- + * + * This procedure is invoked to process the "thread::send" Tcl + * command. This sends a script to another thread for execution. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static void +threadSendFree(ClientData ptr) +{ + ckfree((char *)ptr); +} + +static int +ThreadSendObjCmd(dummy, interp, objc, objv) + ClientData dummy; /* Not used. */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *const objv[]; /* Argument objects. */ +{ + size_t size; + int ret, ii = 0, flags = 0; + Tcl_ThreadId thrId; + const char *script, *arg; + Tcl_Obj *var = NULL; + + ThreadClbkData *clbkPtr = NULL; + ThreadSendData *sendPtr = NULL; + + Init(interp); + + /* + * Syntax: thread::send ?-async? ?-head? threadId script ?varName? + */ + + if (objc < 3 || objc > 6) { + goto usage; + } + + flags = THREAD_SEND_WAIT; + + for (ii = 1; ii < objc; ii++) { + arg = Tcl_GetString(objv[ii]); + if (OPT_CMP(arg, "-async")) { + flags &= ~THREAD_SEND_WAIT; + } else if (OPT_CMP(arg, "-head")) { + flags |= THREAD_SEND_HEAD; + } else { + break; + } + } + if (ii >= objc) { + goto usage; + } + if (ThreadGetId(interp, objv[ii], &thrId) != TCL_OK) { + return TCL_ERROR; + } + if (++ii >= objc) { + goto usage; + } + + script = Tcl_GetString(objv[ii]); + size = objv[ii]->length+1; + if (++ii < objc) { + var = objv[ii]; + } + if (var && (flags & THREAD_SEND_WAIT) == 0) { + const char *varName = Tcl_GetString(var); + size_t vsize = var->length + 1; + + if (thrId == Tcl_GetCurrentThread()) { + /* + * FIXME: Do something for callbacks to self + */ + Tcl_SetObjResult(interp, Tcl_NewStringObj("can't notify self", -1)); + return TCL_ERROR; + } + + /* + * Prepare record for the callback. This is asynchronously + * posted back to us when the target thread finishes processing. + * We should do a vwait on the "var" to get notified. + */ + + clbkPtr = (ThreadClbkData*)ckalloc(sizeof(ThreadClbkData)); + clbkPtr->execProc = ThreadClbkSetVar; + clbkPtr->freeProc = threadSendFree; + clbkPtr->interp = interp; + clbkPtr->threadId = Tcl_GetCurrentThread(); + clbkPtr->clientData = (ClientData)memcpy(ckalloc(vsize), varName, vsize); + } + + /* + * Prepare job record for the target thread + */ + + sendPtr = (ThreadSendData*)ckalloc(sizeof(ThreadSendData)); + sendPtr->interp = NULL; /* Signal to use thread main interp */ + sendPtr->execProc = ThreadSendEval; + sendPtr->freeProc = threadSendFree; + sendPtr->clientData = (ClientData)memcpy(ckalloc(size), script, size); + + ret = ThreadSend(interp, thrId, sendPtr, clbkPtr, flags); + + if (var && (flags & THREAD_SEND_WAIT)) { + + /* + * Leave job's result in passed variable + * and return the code, like "catch" does. + */ + + Tcl_Obj *resultObj = Tcl_GetObjResult(interp); + if (!Tcl_ObjSetVar2(interp, var, NULL, resultObj, TCL_LEAVE_ERR_MSG)) { + return TCL_ERROR; + } + Tcl_SetObjResult(interp, Tcl_NewIntObj(ret)); + return TCL_OK; + } + + return ret; + +usage: + Tcl_WrongNumArgs(interp,1,objv,"?-async? ?-head? id script ?varName?"); + return TCL_ERROR; +} + +/* + *---------------------------------------------------------------------- + * + * ThreadBroadcastObjCmd -- + * + * This procedure is invoked to process the "thread::broadcast" Tcl + * command. This asynchronously sends a script to all known threads. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * Script is sent to all known threads except the caller thread. + * + *---------------------------------------------------------------------- + */ + +static int +ThreadBroadcastObjCmd(dummy, interp, objc, objv) + ClientData dummy; /* Not used. */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *const objv[]; /* Argument objects. */ +{ + int ii, nthreads; + size_t size; + const char *script; + Tcl_ThreadId *thrIdArray; + ThreadSendData *sendPtr, job; + + Init(interp); + + if (objc != 2) { + Tcl_WrongNumArgs(interp, 1, objv, "script"); + return TCL_ERROR; + } + + script = Tcl_GetString(objv[1]); + size = objv[1]->length + 1; + + /* + * Get the list of known threads. Note that this one may + * actually change (thread may exit or otherwise cease to + * exist) while we circle in the loop below. We really do + * not care about that here since we don't return any + * script results to the caller. + */ + + nthreads = ThreadList(interp, &thrIdArray); + + if (nthreads == 0) { + return TCL_OK; + } + + /* + * Prepare the structure with the job description + * to be sent asynchronously to each known thread. + */ + + job.interp = NULL; /* Signal to use thread's main interp */ + job.execProc = ThreadSendEval; + job.freeProc = threadSendFree; + job.clientData = NULL; + + /* + * Now, circle this list and send each thread the script. + * This is sent asynchronously, since we do not care what + * are they going to do with it. Also, the event is queued + * to the head of the event queue (as out-of-band message). + */ + + for (ii = 0; ii < nthreads; ii++) { + if (thrIdArray[ii] == Tcl_GetCurrentThread()) { + continue; /* Do not broadcast self */ + } + sendPtr = (ThreadSendData*)ckalloc(sizeof(ThreadSendData)); + *sendPtr = job; + sendPtr->clientData = (ClientData)memcpy(ckalloc(size), script, size); + ThreadSend(interp, thrIdArray[ii], sendPtr, NULL, THREAD_SEND_HEAD); + } + + ckfree((char*)thrIdArray); + Tcl_ResetResult(interp); + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * ThreadWaitObjCmd -- + * + * This procedure is invoked to process the "thread::wait" Tcl + * command. This enters the event loop. + * + * Results: + * Standard Tcl result. + * + * Side effects: + * Enters the event loop. + * + *---------------------------------------------------------------------- + */ + +static int +ThreadWaitObjCmd(dummy, interp, objc, objv) + ClientData dummy; /* Not used. */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *const objv[]; /* Argument objects. */ +{ + Init(interp); + + if (objc > 1) { + Tcl_WrongNumArgs(interp, 1, objv, NULL); + return TCL_ERROR; + } + + return ThreadWait(interp); +} + +/* + *---------------------------------------------------------------------- + * + * ThreadErrorProcObjCmd -- + * + * This procedure is invoked to process the "thread::errorproc" + * command. This registers a procedure to handle thread errors. + * Empty string as the name of the procedure will reset the + * default behaviour, which is writing to standard error channel. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * Registers an errorproc. + * + *---------------------------------------------------------------------- + */ + +static int +ThreadErrorProcObjCmd(dummy, interp, objc, objv) + ClientData dummy; /* Not used. */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *const objv[]; /* Argument objects. */ +{ + size_t len; + char *proc; + + Init(interp); + + if (objc > 2) { + Tcl_WrongNumArgs(interp, 1, objv, "?proc?"); + return TCL_ERROR; + } + Tcl_MutexLock(&threadMutex); + if (objc == 1) { + if (errorProcString) { + Tcl_SetObjResult(interp, Tcl_NewStringObj(errorProcString, -1)); + } + } else { + if (errorProcString) { + ckfree(errorProcString); + } + proc = Tcl_GetString(objv[1]); + len = objv[1]->length; + if (len == 0) { + errorThreadId = NULL; + errorProcString = NULL; + } else { + errorThreadId = Tcl_GetCurrentThread(); + errorProcString = ckalloc(1+strlen(proc)); + strcpy(errorProcString, proc); + Tcl_DeleteThreadExitHandler(ThreadFreeError, NULL); + Tcl_CreateThreadExitHandler(ThreadFreeError, NULL); + } + } + Tcl_MutexUnlock(&threadMutex); + + return TCL_OK; +} + +static void +ThreadFreeError(clientData) + ClientData clientData; +{ + Tcl_MutexLock(&threadMutex); + if (errorThreadId != Tcl_GetCurrentThread()) { + Tcl_MutexUnlock(&threadMutex); + return; + } + ckfree(errorProcString); + errorThreadId = NULL; + errorProcString = NULL; + Tcl_MutexUnlock(&threadMutex); +} + +/* + *---------------------------------------------------------------------- + * + * ThreadJoinObjCmd -- + * + * This procedure is invoked to process the "thread::join" Tcl + * command. See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ + +static int +ThreadJoinObjCmd(dummy, interp, objc, objv) + ClientData dummy; /* Not used. */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *const objv[]; /* Argument objects. */ +{ + Tcl_ThreadId thrId; + + Init(interp); + + /* + * Syntax of 'join': id + */ + + if (objc != 2) { + Tcl_WrongNumArgs(interp, 1, objv, "id"); + return TCL_ERROR; + } + + if (ThreadGetId(interp, objv[1], &thrId) != TCL_OK) { + return TCL_ERROR; + } + + return ThreadJoin(interp, thrId); +} + +/* + *---------------------------------------------------------------------- + * + * ThreadTransferObjCmd -- + * + * This procedure is invoked to process the "thread::transfer" Tcl + * command. See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ + +static int +ThreadTransferObjCmd(dummy, interp, objc, objv) + ClientData dummy; /* Not used. */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *const objv[]; /* Argument objects. */ +{ + + Tcl_ThreadId thrId; + Tcl_Channel chan; + + Init(interp); + + /* + * Syntax of 'transfer': id channel + */ + + if (objc != 3) { + Tcl_WrongNumArgs(interp, 1, objv, "id channel"); + return TCL_ERROR; + } + if (ThreadGetId(interp, objv[1], &thrId) != TCL_OK) { + return TCL_ERROR; + } + + chan = Tcl_GetChannel(interp, Tcl_GetString(objv[2]), NULL); + if (chan == (Tcl_Channel)NULL) { + return TCL_ERROR; + } + + return ThreadTransfer(interp, thrId, Tcl_GetTopChannel(chan)); +} + +/* + *---------------------------------------------------------------------- + * + * ThreadDetachObjCmd -- + * + * This procedure is invoked to process the "thread::detach" Tcl + * command. See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ + +static int +ThreadDetachObjCmd(dummy, interp, objc, objv) + ClientData dummy; /* Not used. */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *const objv[]; /* Argument objects. */ +{ + Tcl_Channel chan; + + Init(interp); + + /* + * Syntax: thread::detach channel + */ + + if (objc != 2) { + Tcl_WrongNumArgs(interp, 1, objv, "channel"); + return TCL_ERROR; + } + + chan = Tcl_GetChannel(interp, Tcl_GetString(objv[1]), NULL); + if (chan == (Tcl_Channel)NULL) { + return TCL_ERROR; + } + + return ThreadDetach(interp, Tcl_GetTopChannel(chan)); +} + +/* + *---------------------------------------------------------------------- + * + * ThreadAttachObjCmd -- + * + * This procedure is invoked to process the "thread::attach" Tcl + * command. See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ + +static int +ThreadAttachObjCmd(dummy, interp, objc, objv) + ClientData dummy; /* Not used. */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *const objv[]; /* Argument objects. */ +{ + char *chanName; + + Init(interp); + + /* + * Syntax: thread::attach channel + */ + + if (objc != 2) { + Tcl_WrongNumArgs(interp, 1, objv, "channel"); + return TCL_ERROR; + } + + chanName = Tcl_GetString(objv[1]); + if (Tcl_IsChannelExisting(chanName)) { + return TCL_OK; + } + + return ThreadAttach(interp, chanName); +} + +/* + *---------------------------------------------------------------------- + * + * ThreadExistsObjCmd -- + * + * This procedure is invoked to process the "thread::exists" Tcl + * command. See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ + +static int +ThreadExistsObjCmd(dummy, interp, objc, objv) + ClientData dummy; /* Not used. */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *const objv[]; /* Argument objects. */ +{ + Tcl_ThreadId thrId; + + Init(interp); + + if (objc != 2) { + Tcl_WrongNumArgs(interp, 1, objv, "id"); + return TCL_ERROR; + } + + if (ThreadGetId(interp, objv[1], &thrId) != TCL_OK) { + return TCL_ERROR; + } + + Tcl_SetIntObj(Tcl_GetObjResult(interp), ThreadExists(thrId)!=0); + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * ThreadConfigureObjCmd -- + * + * This procedure is invoked to process the Tcl "thread::configure" + * command. See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * None. + *---------------------------------------------------------------------- + */ +static int +ThreadConfigureObjCmd(dummy, interp, objc, objv) + ClientData dummy; /* Not used. */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *const objv[]; /* Argument objects. */ +{ + char *option, *value; + Tcl_ThreadId thrId; /* Id of the thread to configure */ + int i; /* Iterate over arg-value pairs. */ + Tcl_DString ds; /* DString to hold result of + * calling GetThreadOption. */ + + if (objc < 2 || (objc % 2 == 1 && objc != 3)) { + Tcl_WrongNumArgs(interp, 1, objv, "threadlId ?optionName? " + "?value? ?optionName value?..."); + return TCL_ERROR; + } + + Init(interp); + + if (ThreadGetId(interp, objv[1], &thrId) != TCL_OK) { + return TCL_ERROR; + } + if (objc == 2) { + Tcl_DStringInit(&ds); + if (ThreadGetOption(interp, thrId, NULL, &ds) != TCL_OK) { + Tcl_DStringFree(&ds); + return TCL_ERROR; + } + Tcl_DStringResult(interp, &ds); + return TCL_OK; + } + if (objc == 3) { + Tcl_DStringInit(&ds); + option = Tcl_GetString(objv[2]); + if (ThreadGetOption(interp, thrId, option, &ds) != TCL_OK) { + Tcl_DStringFree(&ds); + return TCL_ERROR; + } + Tcl_DStringResult(interp, &ds); + return TCL_OK; + } + for (i = 3; i < objc; i += 2) { + option = Tcl_GetString(objv[i-1]); + value = Tcl_GetString(objv[i]); + if (ThreadSetOption(interp, thrId, option, value) != TCL_OK) { + return TCL_ERROR; + } + } + + return TCL_OK; +} + +#ifdef TCL_TIP285 +/* + *---------------------------------------------------------------------- + * + * ThreadCancelObjCmd -- + * + * This procedure is invoked to process the "thread::cancel" Tcl + * command. See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ + +static int +ThreadCancelObjCmd(dummy, interp, objc, objv) + ClientData dummy; /* Not used. */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *const objv[]; /* Argument objects. */ +{ + Tcl_ThreadId thrId; + int ii, flags; + const char *result; + + if ((objc < 2) || (objc > 4)) { + Tcl_WrongNumArgs(interp, 1, objv, "?-unwind? id ?result?"); + return TCL_ERROR; + } + + flags = 0; + ii = 1; + if ((objc == 3) || (objc == 4)) { + if (OPT_CMP(Tcl_GetString(objv[ii]), "-unwind")) { + flags |= TCL_CANCEL_UNWIND; + ii++; + } + } + + if (ThreadGetId(interp, objv[ii], &thrId) != TCL_OK) { + return TCL_ERROR; + } + + ii++; + if (ii < objc) { + result = Tcl_GetString(objv[ii]); + } else { + result = NULL; + } + + return ThreadCancel(interp, thrId, result, flags); +} +#endif + +/* + *---------------------------------------------------------------------- + * + * ThreadSendEval -- + * + * Evaluates Tcl script passed from source to target thread. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * + *---------------------------------------------------------------------- + */ + +static int +ThreadSendEval(interp, clientData) + Tcl_Interp *interp; + ClientData clientData; +{ + ThreadSendData *sendPtr = (ThreadSendData*)clientData; + char *script = (char*)sendPtr->clientData; + + return Tcl_EvalEx(interp, script, -1, TCL_EVAL_GLOBAL); +} + +/* + *---------------------------------------------------------------------- + * + * ThreadClbkSetVar -- + * + * Sets the Tcl variable in the source thread, as the result + * of the asynchronous callback. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * New Tcl variable may be created + * + *---------------------------------------------------------------------- + */ + +static int +ThreadClbkSetVar(interp, clientData) + Tcl_Interp *interp; + ClientData clientData; +{ + ThreadClbkData *clbkPtr = (ThreadClbkData*)clientData; + const char *var = (const char *)clbkPtr->clientData; + Tcl_Obj *valObj; + ThreadEventResult *resultPtr = &clbkPtr->result; + int rc = TCL_OK; + + /* + * Get the result of the posted command. + * We will use it to fill-in the result variable. + */ + + valObj = Tcl_NewStringObj(resultPtr->result, -1); + Tcl_IncrRefCount(valObj); + + if (resultPtr->result != threadEmptyResult) { + ckfree(resultPtr->result); + } + + /* + * Set the result variable + */ + + if (Tcl_SetVar2Ex(interp, var, NULL, valObj, + TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG) == NULL) { + rc = TCL_ERROR; + goto cleanup; + } + + /* + * In case of error, trigger the bgerror mechansim + */ + + if (resultPtr->code == TCL_ERROR) { + if (resultPtr->errorCode) { + var = "errorCode"; + Tcl_SetVar2Ex(interp, var, NULL, Tcl_NewStringObj(resultPtr->errorCode, -1), TCL_GLOBAL_ONLY); + ckfree((char*)resultPtr->errorCode); + } + if (resultPtr->errorInfo) { + var = "errorInfo"; + Tcl_SetVar2Ex(interp, var, NULL, Tcl_NewStringObj(resultPtr->errorInfo, -1), TCL_GLOBAL_ONLY); + ckfree((char*)resultPtr->errorInfo); + } + Tcl_SetObjResult(interp, valObj); + Tcl_BackgroundError(interp); + } + +cleanup: + Tcl_DecrRefCount(valObj); + return rc; +} + +/* + *---------------------------------------------------------------------- + * + * ThreadCreate -- + * + * This procedure is invoked to create a thread containing an + * interp to run a script. This returns after the thread has + * started executing. + * + * Results: + * A standard Tcl result, which is the thread ID. + * + * Side effects: + * Create a thread. + * + *---------------------------------------------------------------------- + */ + +static int +ThreadCreate(interp, script, stacksize, flags, preserve) + Tcl_Interp *interp; /* Current interpreter. */ + const char *script; /* Script to evaluate */ + int stacksize; /* Zero for default size */ + int flags; /* Zero for no flags */ + int preserve; /* If true, reserve the thread */ +{ + char thrHandle[THREAD_HNDLMAXLEN]; + ThreadCtrl ctrl; + Tcl_ThreadId thrId; + + ctrl.cd = Tcl_GetAssocData(interp, "thread:nsd", NULL); + ctrl.script = (char *)script; + ctrl.condWait = NULL; + ctrl.flags = 0; + + Tcl_MutexLock(&threadMutex); + if (Tcl_CreateThread(&thrId, NewThread, (ClientData)&ctrl, + stacksize, flags) != TCL_OK) { + Tcl_MutexUnlock(&threadMutex); + Tcl_SetObjResult(interp, Tcl_NewStringObj("can't create a new thread", -1)); + return TCL_ERROR; + } + + /* + * Wait for the thread to start because it is using + * the ThreadCtrl argument which is on our stack. + */ + + while (ctrl.script != NULL) { + Tcl_ConditionWait(&ctrl.condWait, &threadMutex, NULL); + } + if (preserve) { + ThreadSpecificData *tsdPtr = ThreadExistsInner(thrId); + if (tsdPtr == (ThreadSpecificData*)NULL) { + Tcl_MutexUnlock(&threadMutex); + Tcl_ConditionFinalize(&ctrl.condWait); + ErrorNoSuchThread(interp, thrId); + return TCL_ERROR; + } + tsdPtr->refCount++; + } + + Tcl_MutexUnlock(&threadMutex); + Tcl_ConditionFinalize(&ctrl.condWait); + + ThreadGetHandle(thrId, thrHandle); + Tcl_SetObjResult(interp, Tcl_NewStringObj(thrHandle, -1)); + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * NewThread -- + * + * This routine is the "main()" for a new thread whose task is to + * execute a single TCL script. The argument to this function is + * a pointer to a structure that contains the text of the Tcl script + * to be executed, plus some synchronization primitives. Those are + * used so the caller gets signalized when the new thread has + * done its initialization. + * + * Space to hold the ThreadControl structure itself is reserved on + * the stack of the calling function. The two condition variables + * in the ThreadControl structure are destroyed by the calling + * function as well. The calling function will destroy the + * ThreadControl structure and the condition variable as soon as + * ctrlPtr->condWait is signaled, so this routine must make copies + * of any data it might need after that point. + * + * Results: + * none + * + * Side effects: + * A Tcl script is executed in a new thread. + * + *---------------------------------------------------------------------- + */ + +Tcl_ThreadCreateType +NewThread(clientData) + ClientData clientData; +{ + ThreadCtrl *ctrlPtr = (ThreadCtrl *)clientData; + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + Tcl_Interp *interp; + int result = TCL_OK, scriptLen; + char *evalScript; + + /* + * Initialize the interpreter. The bad thing here is that we + * assume that initialization of the Tcl interp will be + * error free, which it may not. In the future we must recover + * from this and exit gracefully (this is not that easy as + * it seems on the first glance...) + */ + +#ifdef NS_AOLSERVER + NsThreadInterpData *md = (NsThreadInterpData *)ctrlPtr->cd; + Ns_ThreadSetName("-tclthread-"); + interp = (Tcl_Interp*)Ns_TclAllocateInterp(md ? md->server : NULL); +#else + interp = Tcl_CreateInterp(); + result = Tcl_Init(interp); +#endif + +#if !defined(NS_AOLSERVER) || (defined(NS_MAJOR_VERSION) && NS_MAJOR_VERSION >= 4) + result = Thread_Init(interp); +#endif + + tsdPtr->interp = interp; + + Tcl_MutexLock(&threadMutex); + + /* + * Update the list of threads. + */ + + ListUpdateInner(tsdPtr); + + /* + * We need to keep a pointer to the alloc'ed mem of the script + * we are eval'ing, for the case that we exit during evaluation + */ + + scriptLen = strlen(ctrlPtr->script); + evalScript = strcpy((char*)ckalloc(scriptLen+1), ctrlPtr->script); + Tcl_CreateThreadExitHandler(ThreadExitProc,(ClientData)evalScript); + + /* + * Notify the parent we are alive. + */ + + ctrlPtr->script = NULL; + Tcl_ConditionNotify(&ctrlPtr->condWait); + + Tcl_MutexUnlock(&threadMutex); + + /* + * Run the script. + */ + + Tcl_Preserve((ClientData)tsdPtr->interp); + result = Tcl_EvalEx(tsdPtr->interp, evalScript,scriptLen,TCL_EVAL_GLOBAL); + if (result != TCL_OK) { + ThreadErrorProc(tsdPtr->interp); + } + + /* + * Clean up. Note: add something like TlistRemove for the transfer list. + */ + + if (tsdPtr->doOneEvent) { + Tcl_ConditionFinalize(&tsdPtr->doOneEvent); + } + + ListRemove(tsdPtr); + + /* + * It is up to all other extensions, including Tk, to be responsible + * for their own events when they receive their Tcl_CallWhenDeleted + * notice when we delete this interp. + */ + +#ifdef NS_AOLSERVER + Ns_TclMarkForDelete(tsdPtr->interp); + Ns_TclDeAllocateInterp(tsdPtr->interp); +#else + Tcl_DeleteInterp(tsdPtr->interp); +#endif + Tcl_Release((ClientData)tsdPtr->interp); + + /*tsdPtr->interp = NULL;*/ + + /* + * Tcl_ExitThread calls Tcl_FinalizeThread() indirectly which calls + * ThreadExitHandlers and cleans the notifier as well as other sub- + * systems that save thread state data. + */ + + Tcl_ExitThread(result); + + TCL_THREAD_CREATE_RETURN; +} + +/* + *---------------------------------------------------------------------- + * + * ThreadErrorProc -- + * + * Send a message to the thread willing to hear about errors. + * + * Results: + * None + * + * Side effects: + * Send an event. + * + *---------------------------------------------------------------------- + */ + +static void +ThreadErrorProc(interp) + Tcl_Interp *interp; /* Interp that failed */ +{ + ThreadSendData *sendPtr; + const char *argv[3]; + char buf[THREAD_HNDLMAXLEN]; + const char *errorInfo; + + errorInfo = Tcl_GetVar2(interp, "errorInfo", NULL, TCL_GLOBAL_ONLY); + if (errorInfo == NULL) { + errorInfo = ""; + } + + if (errorProcString == NULL) { +#ifdef NS_AOLSERVER + Ns_Log(Error, "%s\n%s", Tcl_GetString(Tcl_GetObjResult(interp)), errorInfo); +#else + Tcl_Channel errChannel = Tcl_GetStdChannel(TCL_STDERR); + if (errChannel == NULL) { + /* Fixes the [#634845] bug; credits to + * Wojciech Kocjan <wojciech@kocjan.org> */ + return; + } + ThreadGetHandle(Tcl_GetCurrentThread(), buf); + Tcl_WriteChars(errChannel, "Error from thread ", -1); + Tcl_WriteChars(errChannel, buf, -1); + Tcl_WriteChars(errChannel, "\n", 1); + Tcl_WriteChars(errChannel, errorInfo, -1); + Tcl_WriteChars(errChannel, "\n", 1); +#endif + } else { + ThreadGetHandle(Tcl_GetCurrentThread(), buf); + argv[0] = errorProcString; + argv[1] = buf; + argv[2] = errorInfo; + + sendPtr = (ThreadSendData*)ckalloc(sizeof(ThreadSendData)); + sendPtr->execProc = ThreadSendEval; + sendPtr->freeProc = threadSendFree; + sendPtr->clientData = (ClientData) Tcl_Merge(3, argv); + sendPtr->interp = NULL; + + ThreadSend(interp, errorThreadId, sendPtr, NULL, 0); + } +} + +/* + *---------------------------------------------------------------------- + * + * ListUpdate -- + * + * Add the thread local storage to the list. This grabs the + * mutex to protect the list. + * + * Results: + * None + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static void +ListUpdate(tsdPtr) + ThreadSpecificData *tsdPtr; +{ + if (tsdPtr == NULL) { + tsdPtr = TCL_TSD_INIT(&dataKey); + } + + Tcl_MutexLock(&threadMutex); + ListUpdateInner(tsdPtr); + Tcl_MutexUnlock(&threadMutex); +} + +/* + *---------------------------------------------------------------------- + * + * ListUpdateInner -- + * + * Add the thread local storage to the list. This assumes the caller + * has obtained the threadMutex. + * + * Results: + * None + * + * Side effects: + * Add the thread local storage to its list. + * + *---------------------------------------------------------------------- + */ + +static void +ListUpdateInner(tsdPtr) + ThreadSpecificData *tsdPtr; +{ + if (threadList) { + threadList->prevPtr = tsdPtr; + } + + tsdPtr->nextPtr = threadList; + tsdPtr->prevPtr = NULL; + tsdPtr->threadId = Tcl_GetCurrentThread(); + + threadList = tsdPtr; +} + +/* + *---------------------------------------------------------------------- + * + * ListRemove -- + * + * Remove the thread local storage from its list. This grabs the + * mutex to protect the list. + * + * Results: + * None + * + * Side effects: + * Remove the thread local storage from its list. + * + *---------------------------------------------------------------------- + */ + +static void +ListRemove(tsdPtr) + ThreadSpecificData *tsdPtr; +{ + if (tsdPtr == NULL) { + tsdPtr = TCL_TSD_INIT(&dataKey); + } + + Tcl_MutexLock(&threadMutex); + ListRemoveInner(tsdPtr); + Tcl_MutexUnlock(&threadMutex); +} + +/* + *---------------------------------------------------------------------- + * + * ListRemoveInner -- + * + * Remove the thread local storage from its list. + * + * Results: + * None + * + * Side effects: + * Remove the thread local storage from its list. + * + *---------------------------------------------------------------------- + */ + +static void +ListRemoveInner(tsdPtr) + ThreadSpecificData *tsdPtr; +{ + if (tsdPtr->prevPtr || tsdPtr->nextPtr) { + if (tsdPtr->prevPtr) { + tsdPtr->prevPtr->nextPtr = tsdPtr->nextPtr; + } else { + threadList = tsdPtr->nextPtr; + } + if (tsdPtr->nextPtr) { + tsdPtr->nextPtr->prevPtr = tsdPtr->prevPtr; + } + tsdPtr->nextPtr = NULL; + tsdPtr->prevPtr = NULL; + } else if (tsdPtr == threadList) { + threadList = NULL; + } +} + +/* + *---------------------------------------------------------------------- + * + * ThreadList -- + * + * Return a list of threads running Tcl interpreters. + * + * Results: + * Number of threads. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static int +ThreadList(interp, thrIdArray) + Tcl_Interp *interp; + Tcl_ThreadId **thrIdArray; +{ + int ii, count = 0; + ThreadSpecificData *tsdPtr; + + Tcl_MutexLock(&threadMutex); + + /* + * First walk; find out how many threads are registered. + * We may avoid this and gain some speed by maintaining + * the counter of allocated structs in the threadList. + */ + + for (tsdPtr = threadList; tsdPtr; tsdPtr = tsdPtr->nextPtr) { + count++; + } + + if (count == 0) { + Tcl_MutexUnlock(&threadMutex); + return 0; + } + + /* + * Allocate storage for passing thread id's to caller + */ + + *thrIdArray = (Tcl_ThreadId*)ckalloc(count * sizeof(Tcl_ThreadId)); + + /* + * Second walk; fill-in the array with thread ID's + */ + + for (tsdPtr = threadList, ii = 0; tsdPtr; tsdPtr = tsdPtr->nextPtr, ii++) { + (*thrIdArray)[ii] = tsdPtr->threadId; + } + + Tcl_MutexUnlock(&threadMutex); + + return count; +} + +/* + *---------------------------------------------------------------------- + * + * ThreadExists -- + * + * Test whether a thread given by it's id is known to us. + * + * Results: + * Pointer to thread specific data structure or + * NULL if no thread with given ID found + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static int +ThreadExists(thrId) + Tcl_ThreadId thrId; +{ + ThreadSpecificData *tsdPtr; + + Tcl_MutexLock(&threadMutex); + tsdPtr = ThreadExistsInner(thrId); + Tcl_MutexUnlock(&threadMutex); + + return tsdPtr != NULL; +} + +/* + *---------------------------------------------------------------------- + * + * ThreadExistsInner -- + * + * Test whether a thread given by it's id is known to us. Assumes + * caller holds the thread mutex. + * + * Results: + * Pointer to thread specific data structure or + * NULL if no thread with given ID found + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static ThreadSpecificData * +ThreadExistsInner(thrId) + Tcl_ThreadId thrId; /* Thread id to look for. */ +{ + ThreadSpecificData *tsdPtr; + + for (tsdPtr = threadList; tsdPtr; tsdPtr = tsdPtr->nextPtr) { + if (tsdPtr->threadId == thrId) { + return tsdPtr; + } + } + + return NULL; +} + +#ifdef TCL_TIP285 +/* + *---------------------------------------------------------------------- + * + * ThreadCancel -- + * + * Cancels a script in another thread. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static int +ThreadCancel(interp, thrId, result, flags) + Tcl_Interp *interp; /* The current interpreter. */ + Tcl_ThreadId thrId; /* Thread ID of other interpreter. */ + const char *result; /* The error message or NULL for default. */ + int flags; /* Flags for Tcl_CancelEval. */ +{ + int code; + Tcl_Obj *resultObj = NULL; + ThreadSpecificData *tsdPtr; /* ... of the target thread */ + + Tcl_MutexLock(&threadMutex); + + tsdPtr = ThreadExistsInner(thrId); + if (tsdPtr == (ThreadSpecificData*)NULL) { + Tcl_MutexUnlock(&threadMutex); + ErrorNoSuchThread(interp, thrId); + return TCL_ERROR; + } + + if (!haveInterpCancel) { + Tcl_MutexUnlock(&threadMutex); + Tcl_AppendResult(interp, "not supported with this Tcl version", NULL); + return TCL_ERROR; + } + + if (result != NULL) { + resultObj = Tcl_NewStringObj(result, -1); + } + + code = Tcl_CancelEval(tsdPtr->interp, resultObj, NULL, flags); + + Tcl_MutexUnlock(&threadMutex); + return code; +} +#endif + +/* + *---------------------------------------------------------------------- + * + * ThreadJoin -- + * + * Wait for the exit of a different thread. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * The status of the exiting thread is left in the interp result + * area, but only in the case of success. + * + *---------------------------------------------------------------------- + */ + +static int +ThreadJoin(interp, thrId) + Tcl_Interp *interp; /* The current interpreter. */ + Tcl_ThreadId thrId; /* Thread ID of other interpreter. */ +{ + int ret, state; + + ret = Tcl_JoinThread(thrId, &state); + + if (ret == TCL_OK) { + Tcl_SetIntObj(Tcl_GetObjResult (interp), state); + } else { + char thrHandle[THREAD_HNDLMAXLEN]; + ThreadGetHandle(thrId, thrHandle); + Tcl_AppendResult(interp, "cannot join thread ", thrHandle, NULL); + } + + return ret; +} + +/* + *---------------------------------------------------------------------- + * + * ThreadTransfer -- + * + * Transfers the specified channel which must not be shared and has + * to be registered in the given interp from that location to the + * main interp of the specified thread. + * + * Thanks to Anreas Kupries for the initial implementation. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * The thread-global lists of all known channels of both threads + * involved (specified and current) are modified. The channel is + * moved, all event handling for the channel is killed. + * + *---------------------------------------------------------------------- + */ + +static int +ThreadTransfer(interp, thrId, chan) + Tcl_Interp *interp; /* The current interpreter. */ + Tcl_ThreadId thrId; /* Thread Id of other interpreter. */ + Tcl_Channel chan; /* The channel to transfer */ +{ + /* Steps to perform for the transfer: + * + * i. Sanity checks: chan has to registered in interp, must not be + * shared. This automatically excludes the special channels for + * stdin, stdout and stderr! + * ii. Clear event handling. + * iii. Bump reference counter up to prevent destruction during the + * following unregister, then unregister the channel from the + * interp. Remove it from the thread-global list of all channels + * too. + * iv. Wrap the channel into an event and send that to the other + * thread, then wait for the other thread to process our message. + * v. The event procedure called by the other thread is + * 'TransferEventProc'. It links the channel into the + * thread-global list of channels for that thread, registers it + * in the main interp of the other thread, removes the artificial + * reference, at last notifies this thread of the sucessful + * transfer. This allows this thread then to proceed. + */ + + TransferEvent *evPtr; + TransferResult *resultPtr; + + if (!Tcl_IsChannelRegistered(interp, chan)) { + Tcl_SetObjResult(interp, Tcl_NewStringObj("channel is not registered here", -1)); + } + if (Tcl_IsChannelShared(chan)) { + Tcl_SetObjResult(interp, Tcl_NewStringObj("channel is shared", -1)); + return TCL_ERROR; + } + + /* + * Short circuit transfers to ourself. Nothing to do. + */ + + if (thrId == Tcl_GetCurrentThread()) { + return TCL_OK; + } + + Tcl_MutexLock(&threadMutex); + + /* + * Verify the thread exists. + */ + + if (ThreadExistsInner(thrId) == NULL) { + Tcl_MutexUnlock(&threadMutex); + ErrorNoSuchThread(interp, thrId); + return TCL_ERROR; + } + + /* + * Cut the channel out of the interp/thread + */ + + ThreadCutChannel(interp, chan); + + /* + * Wrap it into an event. + */ + + resultPtr = (TransferResult*)ckalloc(sizeof(TransferResult)); + evPtr = (TransferEvent *)ckalloc(sizeof(TransferEvent)); + + evPtr->chan = chan; + evPtr->event.proc = TransferEventProc; + evPtr->resultPtr = resultPtr; + + /* + * Initialize the result fields. + */ + + resultPtr->done = (Tcl_Condition) NULL; + resultPtr->resultCode = -1; + resultPtr->resultMsg = (char *) NULL; + + /* + * Maintain the cleanup list. + */ + + resultPtr->srcThreadId = Tcl_GetCurrentThread(); + resultPtr->dstThreadId = thrId; + resultPtr->eventPtr = evPtr; + + SpliceIn(resultPtr, transferList); + + /* + * Queue the event and poke the other thread's notifier. + */ + + Tcl_ThreadQueueEvent(thrId, (Tcl_Event*)evPtr, TCL_QUEUE_TAIL); + Tcl_ThreadAlert(thrId); + + /* + * (*) Block until the other thread has either processed the transfer + * or rejected it. + */ + + while (resultPtr->resultCode < 0) { + Tcl_ConditionWait(&resultPtr->done, &threadMutex, NULL); + } + + /* + * Unlink result from the result list. + */ + + SpliceOut(resultPtr, transferList); + + resultPtr->eventPtr = NULL; + resultPtr->nextPtr = NULL; + resultPtr->prevPtr = NULL; + + Tcl_MutexUnlock(&threadMutex); + + Tcl_ConditionFinalize(&resultPtr->done); + + /* + * Process the result now. + */ + + if (resultPtr->resultCode != TCL_OK) { + + /* + * Transfer failed, restore old state of channel with respect + * to current thread and specified interp. + */ + + Tcl_SpliceChannel(chan); + Tcl_RegisterChannel(interp, chan); + Tcl_UnregisterChannel((Tcl_Interp *) NULL, chan); + Tcl_AppendResult(interp, "transfer failed: ", NULL); + + if (resultPtr->resultMsg) { + Tcl_AppendResult(interp, resultPtr->resultMsg, NULL); + ckfree(resultPtr->resultMsg); + } else { + Tcl_AppendResult(interp, "for reasons unknown", NULL); + } + ckfree((char *)resultPtr); + + return TCL_ERROR; + } + + if (resultPtr->resultMsg) { + ckfree(resultPtr->resultMsg); + } + ckfree((char *)resultPtr); + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * ThreadDetach -- + * + * Detaches the specified channel which must not be shared and has + * to be registered in the given interp. The detached channel is + * left in the transfer list until some other thread attaches it + + by calling the "thread::attach" command. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * The thread-global lists of all known channels (transferList) + * is modified. All event handling for the channel is killed. + * + *---------------------------------------------------------------------- + */ + +static int +ThreadDetach(interp, chan) + Tcl_Interp *interp; /* The current interpreter. */ + Tcl_Channel chan; /* The channel to detach */ +{ + TransferEvent *evPtr; + TransferResult *resultPtr; + + if (!Tcl_IsChannelRegistered(interp, chan)) { + Tcl_SetObjResult(interp, Tcl_NewStringObj("channel is not registered here", -1)); + } + if (Tcl_IsChannelShared(chan)) { + Tcl_SetObjResult(interp, Tcl_NewStringObj("channel is shared", -1)); + return TCL_ERROR; + } + + /* + * Cut the channel out of the interp/thread + */ + + ThreadCutChannel(interp, chan); + + /* + * Wrap it into the list of transfered channels. We generate no + * events associated with the detached channel, thus really not + * needing the transfer event structure allocated here. This + * is done purely to avoid having yet another wrapper. + */ + + resultPtr = (TransferResult*)ckalloc(sizeof(TransferResult)); + evPtr = (TransferEvent*)ckalloc(sizeof(TransferEvent)); + + evPtr->chan = chan; + evPtr->event.proc = NULL; + evPtr->resultPtr = resultPtr; + + /* + * Initialize the result fields. This is not used. + */ + + resultPtr->done = (Tcl_Condition)NULL; + resultPtr->resultCode = -1; + resultPtr->resultMsg = (char*)NULL; + + /* + * Maintain the cleanup list. By setting the dst/srcThreadId + * to zero we signal the code in ThreadAttach that this is the + * detached channel. Therefore it should not be mistaken for + * some regular TransferChannel operation underway. Also, this + * will prevent the code in ThreadExitProc to splice out this + * record from the list when the threads are exiting. + * A side effect of this is that we may have entries in this + * list which may never be removed (i.e. nobody attaches the + * channel later on). This will result in both Tcl channel and + * memory leak. + */ + + resultPtr->srcThreadId = (Tcl_ThreadId)0; + resultPtr->dstThreadId = (Tcl_ThreadId)0; + resultPtr->eventPtr = evPtr; + + Tcl_MutexLock(&threadMutex); + SpliceIn(resultPtr, transferList); + Tcl_MutexUnlock(&threadMutex); + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * ThreadAttach -- + * + * Attaches the previously detached channel into the current + * interpreter. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * The thread-global lists of all known channels (transferList) + * is modified. + * + *---------------------------------------------------------------------- + */ + +static int +ThreadAttach(interp, chanName) + Tcl_Interp *interp; /* The current interpreter. */ + char *chanName; /* The name of the channel to detach */ +{ + int found = 0; + Tcl_Channel chan = NULL; + TransferResult *resPtr; + + /* + * Locate the channel to attach by looking up its name in + * the list of transfered channels. Watch that we don't + * hit the regular channel transfer event. + */ + + Tcl_MutexLock(&threadMutex); + for (resPtr = transferList; resPtr; resPtr = resPtr->nextPtr) { + chan = resPtr->eventPtr->chan; + if (!strcmp(Tcl_GetChannelName(chan),chanName) + && !resPtr->dstThreadId) { + if (Tcl_IsChannelExisting(chanName)) { + Tcl_MutexUnlock(&threadMutex); + Tcl_AppendResult(interp, "channel already exists", NULL); + return TCL_ERROR; + } + SpliceOut(resPtr, transferList); + ckfree((char*)resPtr->eventPtr); + ckfree((char*)resPtr); + found = 1; + break; + } + } + Tcl_MutexUnlock(&threadMutex); + + if (found == 0) { + Tcl_AppendResult(interp, "channel not detached", NULL); + return TCL_ERROR; + } + + /* + * Splice channel into the current interpreter + */ + + Tcl_SpliceChannel(chan); + Tcl_RegisterChannel(interp, chan); + Tcl_UnregisterChannel((Tcl_Interp *)NULL, chan); + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * ThreadSend -- + * + * Run the procedure in other thread. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static int +ThreadSend(interp, thrId, send, clbk, flags) + Tcl_Interp *interp; /* The current interpreter. */ + Tcl_ThreadId thrId; /* Thread Id of other thread. */ + ThreadSendData *send; /* Pointer to structure with work to do */ + ThreadClbkData *clbk; /* Opt. callback structure (may be NULL) */ + int flags; /* Wait or queue to tail */ +{ + ThreadSpecificData *tsdPtr = NULL; /* ... of the target thread */ + + int code; + ThreadEvent *eventPtr; + ThreadEventResult *resultPtr; + + /* + * Verify the thread exists and is not in the error state. + * The thread is in the error state only if we've configured + * it to unwind on script evaluation error and last script + * evaluation resulted in error actually. + */ + + Tcl_MutexLock(&threadMutex); + + tsdPtr = ThreadExistsInner(thrId); + + if (tsdPtr == (ThreadSpecificData*)NULL + || (tsdPtr->flags & THREAD_FLAGS_INERROR)) { + int inerror = tsdPtr && (tsdPtr->flags & THREAD_FLAGS_INERROR); + Tcl_MutexUnlock(&threadMutex); + ThreadFreeProc((ClientData)send); + if (clbk) { + ThreadFreeProc((ClientData)clbk); + } + if (inerror) { + Tcl_SetObjResult(interp, Tcl_NewStringObj("thread is in error", -1)); + } else { + ErrorNoSuchThread(interp, thrId); + } + return TCL_ERROR; + } + + /* + * Short circuit sends to ourself. + */ + + if (thrId == Tcl_GetCurrentThread()) { + Tcl_MutexUnlock(&threadMutex); + if ((flags & THREAD_SEND_WAIT)) { + int code = (*send->execProc)(interp, (ClientData)send); + ThreadFreeProc((ClientData)send); + return code; + } else { + send->interp = interp; + Tcl_Preserve((ClientData)send->interp); + Tcl_DoWhenIdle((Tcl_IdleProc*)ThreadIdleProc, (ClientData)send); + return TCL_OK; + } + } + + /* + * Create the event for target thread event queue. + */ + + eventPtr = (ThreadEvent*)ckalloc(sizeof(ThreadEvent)); + eventPtr->sendData = send; + eventPtr->clbkData = clbk; + + /* + * Target thread about to service + * another event + */ + + if (tsdPtr->maxEventsCount) { + tsdPtr->eventsPending++; + } + + /* + * Caller wants to be notified, so we must take care + * it's interpreter stays alive until we've finished. + */ + + if (eventPtr->clbkData) { + Tcl_Preserve((ClientData)eventPtr->clbkData->interp); + } + if ((flags & THREAD_SEND_WAIT) == 0) { + resultPtr = NULL; + eventPtr->resultPtr = NULL; + } else { + resultPtr = (ThreadEventResult*)ckalloc(sizeof(ThreadEventResult)); + resultPtr->done = (Tcl_Condition)NULL; + resultPtr->result = NULL; + resultPtr->errorCode = NULL; + resultPtr->errorInfo = NULL; + resultPtr->dstThreadId = thrId; + resultPtr->srcThreadId = Tcl_GetCurrentThread(); + resultPtr->eventPtr = eventPtr; + + eventPtr->resultPtr = resultPtr; + + SpliceIn(resultPtr, resultList); + } + + /* + * Queue the event and poke the other thread's notifier. + */ + + eventPtr->event.proc = ThreadEventProc; + if ((flags & THREAD_SEND_HEAD)) { + Tcl_ThreadQueueEvent(thrId, (Tcl_Event*)eventPtr, TCL_QUEUE_HEAD); + } else { + Tcl_ThreadQueueEvent(thrId, (Tcl_Event*)eventPtr, TCL_QUEUE_TAIL); + } + Tcl_ThreadAlert(thrId); + + if ((flags & THREAD_SEND_WAIT) == 0) { + /* + * Might potentially spend some time here, until the + * worker thread cleans up its queue a little bit. + */ + if ((flags & THREAD_SEND_CLBK) == 0) { + while (tsdPtr->maxEventsCount && + tsdPtr->eventsPending > tsdPtr->maxEventsCount) { + Tcl_ConditionWait(&tsdPtr->doOneEvent, &threadMutex, NULL); + } + } + Tcl_MutexUnlock(&threadMutex); + return TCL_OK; + } + + /* + * Block on the result indefinitely. + */ + + Tcl_ResetResult(interp); + + while (resultPtr->result == NULL) { + Tcl_ConditionWait(&resultPtr->done, &threadMutex, NULL); + } + + SpliceOut(resultPtr, resultList); + + Tcl_MutexUnlock(&threadMutex); + + /* + * Return result to caller + */ + + if (resultPtr->code == TCL_ERROR) { + if (resultPtr->errorCode) { + Tcl_SetErrorCode(interp, resultPtr->errorCode, NULL); + ckfree(resultPtr->errorCode); + } + if (resultPtr->errorInfo) { + Tcl_AddErrorInfo(interp, resultPtr->errorInfo); + ckfree(resultPtr->errorInfo); + } + } + + code = resultPtr->code; + Tcl_SetObjResult(interp, Tcl_NewStringObj(resultPtr->result, -1)); + + /* + * Cleanup + */ + + Tcl_ConditionFinalize(&resultPtr->done); + if (resultPtr->result != threadEmptyResult) { + ckfree(resultPtr->result); + } + ckfree((char*)resultPtr); + + return code; +} + +/* + *---------------------------------------------------------------------- + * + * ThreadWait -- + * + * Waits for events and process them as they come, until signaled + * to stop. + * + * Results: + * Standard Tcl result. + * + * Side effects: + * Deletes any thread::send or thread::transfer events that are + * pending. + * + *---------------------------------------------------------------------- + */ +static int +ThreadWait(Tcl_Interp *interp) +{ + int code = TCL_OK; + int canrun = 1; + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + + /* + * Process events until signaled to stop. + */ + + while (canrun) { + + /* + * About to service another event. + * Wake-up eventual sleepers. + */ + + if (tsdPtr->maxEventsCount) { + Tcl_MutexLock(&threadMutex); + tsdPtr->eventsPending--; + Tcl_ConditionNotify(&tsdPtr->doOneEvent); + Tcl_MutexUnlock(&threadMutex); + } + + /* + * Attempt to process one event, blocking forever until an + * event is actually received. The event processed may cause + * a script in progress to be canceled or exceed its limit; + * therefore, check for these conditions if we are able to + * (i.e. we are running in a high enough version of Tcl). + */ + + Tcl_DoOneEvent(TCL_ALL_EVENTS); + +#ifdef TCL_TIP285 + if (haveInterpCancel) { + + /* + * If the script has been unwound, bail out immediately. This does + * not follow the recommended guidelines for how extensions should + * handle the script cancellation functionality because this is + * not a "normal" extension. Most extensions do not have a command + * that simply enters an infinite Tcl event loop. Normal extensions + * should not specify the TCL_CANCEL_UNWIND when calling the + * Tcl_Canceled function to check if the command has been canceled. + */ + + if (Tcl_Canceled(tsdPtr->interp, + TCL_LEAVE_ERR_MSG | TCL_CANCEL_UNWIND) == TCL_ERROR) { + code = TCL_ERROR; + break; + } + } +#endif +#ifdef TCL_TIP143 + if (haveInterpLimit) { + if (Tcl_LimitExceeded(tsdPtr->interp)) { + code = TCL_ERROR; + break; + } + } +#endif + + /* + * Test stop condition under mutex since + * some other thread may flip our flags. + */ + + Tcl_MutexLock(&threadMutex); + canrun = (tsdPtr->flags & THREAD_FLAGS_STOPPED) == 0; + Tcl_MutexUnlock(&threadMutex); + } + +#if defined(TCL_TIP143) || defined(TCL_TIP285) + /* + * If the event processing loop above was terminated due to a + * script in progress being canceled or exceeding its limits, + * transfer the error to the current interpreter. + */ + + if (code != TCL_OK) { + char buf[THREAD_HNDLMAXLEN]; + const char *errorInfo; + + errorInfo = Tcl_GetVar2(tsdPtr->interp, "errorInfo", NULL, TCL_GLOBAL_ONLY); + if (errorInfo == NULL) { + errorInfo = Tcl_GetString(Tcl_GetObjResult(tsdPtr->interp)); + } + + ThreadGetHandle(Tcl_GetCurrentThread(), buf); + Tcl_AppendResult(interp, "Error from thread ", buf, "\n", + errorInfo, NULL); + } +#endif + + /* + * Remove from the list of active threads, so nobody can post + * work to this thread, since it is just about to terminate. + */ + + ListRemove(tsdPtr); + + /* + * Now that the event processor for this thread is closing, + * delete all pending thread::send and thread::transfer events. + * These events are owned by us. We don't delete anyone else's + * events, but ours. + */ + + Tcl_DeleteEvents((Tcl_EventDeleteProc*)ThreadDeleteEvent, NULL); + + return code; +} + +/* + *---------------------------------------------------------------------- + * + * ThreadReserve -- + * + * Results: + * + * Side effects: + * + *---------------------------------------------------------------------- + */ + +static int +ThreadReserve(interp, thrId, operation, wait) + Tcl_Interp *interp; /* Current interpreter */ + Tcl_ThreadId thrId; /* Target thread ID */ + int operation; /* THREAD_RESERVE | THREAD_RELEASE */ + int wait; /* Wait for thread to exit */ +{ + int users, dowait = 0; + ThreadEvent *evPtr; + ThreadSpecificData *tsdPtr; + + Tcl_MutexLock(&threadMutex); + + /* + * Check the given thread + */ + + if (thrId == (Tcl_ThreadId)0) { + tsdPtr = TCL_TSD_INIT(&dataKey); + } else { + tsdPtr = ThreadExistsInner(thrId); + if (tsdPtr == (ThreadSpecificData*)NULL) { + Tcl_MutexUnlock(&threadMutex); + ErrorNoSuchThread(interp, thrId); + return TCL_ERROR; + } + } + + switch (operation) { + case THREAD_RESERVE: ++tsdPtr->refCount; break; + case THREAD_RELEASE: --tsdPtr->refCount; dowait = wait; break; + } + + users = tsdPtr->refCount; + + if (users <= 0) { + + /* + * We're last attached user, so tear down the *target* thread + */ + + tsdPtr->flags |= THREAD_FLAGS_STOPPED; + + if (thrId && thrId != Tcl_GetCurrentThread() /* Not current! */) { + ThreadEventResult *resultPtr = NULL; + + /* + * Remove from the list of active threads, so nobody can post + * work to this thread, since it is just about to terminate. + */ + + ListRemoveInner(tsdPtr); + + /* + * Send an dummy event, just to wake-up target thread. + * It should immediately exit thereafter. We might get + * stuck here for long time if user really wants to + * be absolutely sure that the thread has exited. + */ + + if (dowait) { + resultPtr = (ThreadEventResult*) + ckalloc(sizeof(ThreadEventResult)); + resultPtr->done = (Tcl_Condition)NULL; + resultPtr->result = NULL; + resultPtr->code = TCL_OK; + resultPtr->errorCode = NULL; + resultPtr->errorInfo = NULL; + resultPtr->dstThreadId = thrId; + resultPtr->srcThreadId = Tcl_GetCurrentThread(); + SpliceIn(resultPtr, resultList); + } + + evPtr = (ThreadEvent*)ckalloc(sizeof(ThreadEvent)); + evPtr->event.proc = ThreadEventProc; + evPtr->sendData = NULL; + evPtr->clbkData = NULL; + evPtr->resultPtr = resultPtr; + + Tcl_ThreadQueueEvent(thrId, (Tcl_Event*)evPtr, TCL_QUEUE_TAIL); + Tcl_ThreadAlert(thrId); + + if (dowait) { + while (resultPtr->result == NULL) { + Tcl_ConditionWait(&resultPtr->done, &threadMutex, NULL); + } + SpliceOut(resultPtr, resultList); + Tcl_ConditionFinalize(&resultPtr->done); + if (resultPtr->result != threadEmptyResult) { + ckfree(resultPtr->result); /* Will be ignored anyway */ + } + ckfree((char*)resultPtr); + } + } + } + + Tcl_MutexUnlock(&threadMutex); + Tcl_SetIntObj(Tcl_GetObjResult(interp), (users > 0) ? users : 0); + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * ThreadEventProc -- + * + * Handle the event in the target thread. + * + * Results: + * Returns 1 to indicate that the event was processed. + * + * Side effects: + * Fills out the ThreadEventResult struct. + * + *---------------------------------------------------------------------- + */ +static int +ThreadEventProc(evPtr, mask) + Tcl_Event *evPtr; /* Really ThreadEvent */ + int mask; +{ + ThreadSpecificData* tsdPtr = TCL_TSD_INIT(&dataKey); + + Tcl_Interp *interp = NULL; + Tcl_ThreadId thrId = Tcl_GetCurrentThread(); + ThreadEvent *eventPtr = (ThreadEvent*)evPtr; + ThreadSendData *sendPtr = eventPtr->sendData; + ThreadClbkData *clbkPtr = eventPtr->clbkData; + ThreadEventResult* resultPtr = eventPtr->resultPtr; + + int code = TCL_ERROR; /* Pessimistic assumption */ + + /* + * See whether user has any preferences about which interpreter + * to use for running this job. The job structure might identify + * one. If not, just use the thread's main interpreter which is + * stored in the thread specific data structure. + * Note that later on we might discover that we're running the + * async callback script. In this case, interpreter will be + * changed to one given in the callback. + */ + + interp = (sendPtr && sendPtr->interp) ? sendPtr->interp : tsdPtr->interp; + + if (interp != NULL) { + Tcl_Preserve((ClientData)interp); + + if (clbkPtr && clbkPtr->threadId == thrId) { + Tcl_Release((ClientData)interp); + /* Watch: this thread evaluates its own callback. */ + interp = clbkPtr->interp; + Tcl_Preserve((ClientData)interp); + } + + Tcl_ResetResult(interp); + + if (sendPtr) { + Tcl_CreateThreadExitHandler(ThreadFreeProc, (ClientData)sendPtr); + if (clbkPtr) { + Tcl_CreateThreadExitHandler(ThreadFreeProc, + (ClientData)clbkPtr); + } + code = (*sendPtr->execProc)(interp, (ClientData)sendPtr); + Tcl_DeleteThreadExitHandler(ThreadFreeProc, (ClientData)sendPtr); + if (clbkPtr) { + Tcl_DeleteThreadExitHandler(ThreadFreeProc, + (ClientData)clbkPtr); + } + } else { + code = TCL_OK; + } + } + + if (sendPtr) { + ThreadFreeProc((ClientData)sendPtr); + eventPtr->sendData = NULL; + } + + if (resultPtr) { + + /* + * Report job result synchronously to waiting caller + */ + + Tcl_MutexLock(&threadMutex); + ThreadSetResult(interp, code, resultPtr); + Tcl_ConditionNotify(&resultPtr->done); + Tcl_MutexUnlock(&threadMutex); + + /* + * We still need to release the reference to the Tcl + * interpreter added by ThreadSend whenever the callback + * data is not NULL. + */ + + if (clbkPtr) { + Tcl_Release((ClientData)clbkPtr->interp); + } + } else if (clbkPtr && clbkPtr->threadId != thrId) { + + ThreadSendData *tmpPtr = (ThreadSendData*)clbkPtr; + + /* + * Route the callback back to it's originator. + * Do not wait for the result. + */ + + if (code != TCL_OK) { + ThreadErrorProc(interp); + } + + ThreadSetResult(interp, code, &clbkPtr->result); + ThreadSend(interp, clbkPtr->threadId, tmpPtr, NULL, THREAD_SEND_CLBK); + + } else if (code != TCL_OK) { + /* + * Only pass errors onto the registered error handler + * when we don't have a result target for this event. + */ + ThreadErrorProc(interp); + + /* + * We still need to release the reference to the Tcl + * interpreter added by ThreadSend whenever the callback + * data is not NULL. + */ + + if (clbkPtr) { + Tcl_Release((ClientData)clbkPtr->interp); + } + } else { + /* + * We still need to release the reference to the Tcl + * interpreter added by ThreadSend whenever the callback + * data is not NULL. + */ + + if (clbkPtr) { + Tcl_Release((ClientData)clbkPtr->interp); + } + } + + if (interp != NULL) { + Tcl_Release((ClientData)interp); + } + + /* + * Mark unwind scenario for this thread if the script resulted + * in error condition and thread has been marked to unwind. + * This will cause thread to disappear from the list of active + * threads, clean-up its event queue and exit. + */ + + if (code != TCL_OK) { + Tcl_MutexLock(&threadMutex); + if (tsdPtr->flags & THREAD_FLAGS_UNWINDONERROR) { + tsdPtr->flags |= THREAD_FLAGS_INERROR; + if (tsdPtr->refCount == 0) { + tsdPtr->flags |= THREAD_FLAGS_STOPPED; + } + } + Tcl_MutexUnlock(&threadMutex); + } + + return 1; +} + +/* + *---------------------------------------------------------------------- + * + * ThreadSetResult -- + * + * Results: + * + * Side effects: + * + *---------------------------------------------------------------------- + */ + +static void +ThreadSetResult(interp, code, resultPtr) + Tcl_Interp *interp; + int code; + ThreadEventResult *resultPtr; +{ + size_t size; + const char *errorCode, *errorInfo, *result; + + if (interp == NULL) { + code = TCL_ERROR; + errorInfo = ""; + errorCode = "THREAD"; + result = "no target interp!"; + size = strlen(result); + resultPtr->result = (size) ? + memcpy(ckalloc(1+size), result, 1+size) : threadEmptyResult; + } else { + result = Tcl_GetString(Tcl_GetObjResult(interp)); + size = Tcl_GetObjResult(interp)->length; + resultPtr->result = (size) ? + memcpy(ckalloc(1+size), result, 1+size) : threadEmptyResult; + if (code == TCL_ERROR) { + errorCode = Tcl_GetVar2(interp, "errorCode", NULL, TCL_GLOBAL_ONLY); + errorInfo = Tcl_GetVar2(interp, "errorInfo", NULL, TCL_GLOBAL_ONLY); + } else { + errorCode = NULL; + errorInfo = NULL; + } + } + + resultPtr->code = code; + + if (errorCode != NULL) { + size = strlen(errorCode) + 1; + resultPtr->errorCode = memcpy(ckalloc(size), errorCode, size); + } else { + resultPtr->errorCode = NULL; + } + if (errorInfo != NULL) { + size = strlen(errorInfo) + 1; + resultPtr->errorInfo = memcpy(ckalloc(size), errorInfo, size); + } else { + resultPtr->errorInfo = NULL; + } +} + +/* + *---------------------------------------------------------------------- + * + * ThreadGetOption -- + * + * Results: + * + * Side effects: + * + *---------------------------------------------------------------------- + */ + +static int +ThreadGetOption(interp, thrId, option, dsPtr) + Tcl_Interp *interp; + Tcl_ThreadId thrId; + char *option; + Tcl_DString *dsPtr; +{ + int len; + ThreadSpecificData *tsdPtr = NULL; + + /* + * If the optionName is NULL it means that we want + * a list of all options and values. + */ + + len = (option == NULL) ? 0 : strlen(option); + + Tcl_MutexLock(&threadMutex); + + tsdPtr = ThreadExistsInner(thrId); + + if (tsdPtr == (ThreadSpecificData*)NULL) { + Tcl_MutexUnlock(&threadMutex); + ErrorNoSuchThread(interp, thrId); + return TCL_ERROR; + } + + if (len == 0 || (len > 3 && option[1] == 'e' && option[2] == 'v' + && !strncmp(option,"-eventmark", len))) { + char buf[16]; + if (len == 0) { + Tcl_DStringAppendElement(dsPtr, "-eventmark"); + } + sprintf(buf, "%d", tsdPtr->maxEventsCount); + Tcl_DStringAppendElement(dsPtr, buf); + if (len != 0) { + Tcl_MutexUnlock(&threadMutex); + return TCL_OK; + } + } + + if (len == 0 || (len > 2 && option[1] == 'u' + && !strncmp(option,"-unwindonerror", len))) { + int flag = tsdPtr->flags & THREAD_FLAGS_UNWINDONERROR; + if (len == 0) { + Tcl_DStringAppendElement(dsPtr, "-unwindonerror"); + } + Tcl_DStringAppendElement(dsPtr, flag ? "1" : "0"); + if (len != 0) { + Tcl_MutexUnlock(&threadMutex); + return TCL_OK; + } + } + + if (len == 0 || (len > 3 && option[1] == 'e' && option[2] == 'r' + && !strncmp(option,"-errorstate", len))) { + int flag = tsdPtr->flags & THREAD_FLAGS_INERROR; + if (len == 0) { + Tcl_DStringAppendElement(dsPtr, "-errorstate"); + } + Tcl_DStringAppendElement(dsPtr, flag ? "1" : "0"); + if (len != 0) { + Tcl_MutexUnlock(&threadMutex); + return TCL_OK; + } + } + + if (len != 0) { + Tcl_AppendResult(interp, "bad option \"", option, + "\", should be one of -eventmark, " + "-unwindonerror or -errorstate", NULL); + Tcl_MutexUnlock(&threadMutex); + return TCL_ERROR; + } + + Tcl_MutexUnlock(&threadMutex); + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * ThreadSetOption -- + * + * Results: + * + * Side effects: + * + *---------------------------------------------------------------------- + */ + +static int +ThreadSetOption(interp, thrId, option, value) + Tcl_Interp *interp; + Tcl_ThreadId thrId; + char *option; + char *value; +{ + int len = strlen(option); + ThreadSpecificData *tsdPtr = NULL; + + Tcl_MutexLock(&threadMutex); + + tsdPtr = ThreadExistsInner(thrId); + + if (tsdPtr == (ThreadSpecificData*)NULL) { + Tcl_MutexUnlock(&threadMutex); + ErrorNoSuchThread(interp, thrId); + return TCL_ERROR; + } + if (len > 3 && option[1] == 'e' && option[2] == 'v' + && !strncmp(option,"-eventmark", len)) { + if (sscanf(value, "%d", &tsdPtr->maxEventsCount) != 1) { + Tcl_AppendResult(interp, "expected integer but got \"", + value, "\"", NULL); + Tcl_MutexUnlock(&threadMutex); + return TCL_ERROR; + } + } else if (len > 2 && option[1] == 'u' + && !strncmp(option,"-unwindonerror", len)) { + int flag = 0; + if (Tcl_GetBoolean(interp, value, &flag) != TCL_OK) { + Tcl_MutexUnlock(&threadMutex); + return TCL_ERROR; + } + if (flag) { + tsdPtr->flags |= THREAD_FLAGS_UNWINDONERROR; + } else { + tsdPtr->flags &= ~THREAD_FLAGS_UNWINDONERROR; + } + } else if (len > 3 && option[1] == 'e' && option[2] == 'r' + && !strncmp(option,"-errorstate", len)) { + int flag = 0; + if (Tcl_GetBoolean(interp, value, &flag) != TCL_OK) { + Tcl_MutexUnlock(&threadMutex); + return TCL_ERROR; + } + if (flag) { + tsdPtr->flags |= THREAD_FLAGS_INERROR; + } else { + tsdPtr->flags &= ~THREAD_FLAGS_INERROR; + } + } + + Tcl_MutexUnlock(&threadMutex); + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * ThreadIdleProc -- + * + * Results: + * + * Side effects. + * + *---------------------------------------------------------------------- + */ + +static void +ThreadIdleProc(clientData) + ClientData clientData; +{ + int ret; + ThreadSendData *sendPtr = (ThreadSendData*)clientData; + + ret = (*sendPtr->execProc)(sendPtr->interp, (ClientData)sendPtr); + if (ret != TCL_OK) { + ThreadErrorProc(sendPtr->interp); + } + + Tcl_Release((ClientData)sendPtr->interp); + ThreadFreeProc(clientData); +} + +/* + *---------------------------------------------------------------------- + * + * TransferEventProc -- + * + * Handle a transfer event in the target thread. + * + * Results: + * Returns 1 to indicate that the event was processed. + * + * Side effects: + * Fills out the TransferResult struct. + * + *---------------------------------------------------------------------- + */ + +static int +TransferEventProc(evPtr, mask) + Tcl_Event *evPtr; /* Really ThreadEvent */ + int mask; +{ + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + TransferEvent *eventPtr = (TransferEvent *)evPtr; + TransferResult *resultPtr = eventPtr->resultPtr; + Tcl_Interp *interp = tsdPtr->interp; + int code; + const char* msg = NULL; + + if (interp == NULL) { + /* + * Reject transfer in case of a missing target. + */ + code = TCL_ERROR; + msg = "target interp missing"; + } else { + /* + * Add channel to current thread and interp. + * See ThreadTransfer for more explanations. + */ + if (Tcl_IsChannelExisting(Tcl_GetChannelName(eventPtr->chan))) { + /* + * Reject transfer. Channel of same name already exists in target. + */ + code = TCL_ERROR; + msg = "channel already exists in target"; + } else { + Tcl_SpliceChannel(eventPtr->chan); + Tcl_RegisterChannel(interp, eventPtr->chan); + Tcl_UnregisterChannel((Tcl_Interp *) NULL, eventPtr->chan); + code = TCL_OK; /* Return success. */ + } + } + if (resultPtr) { + Tcl_MutexLock(&threadMutex); + resultPtr->resultCode = code; + if (msg != NULL) { + size_t size = strlen(msg)+1; + resultPtr->resultMsg = memcpy(ckalloc(size), msg, size); + } + Tcl_ConditionNotify(&resultPtr->done); + Tcl_MutexUnlock(&threadMutex); + } + + return 1; +} + +/* + *---------------------------------------------------------------------- + * + * ThreadFreeProc -- + * + * Called when we are exiting and memory needs to be freed. + * + * Results: + * None. + * + * Side effects: + * Clears up mem specified in ClientData + * + *---------------------------------------------------------------------- + */ +static void +ThreadFreeProc(clientData) + ClientData clientData; +{ + /* + * This will free send and/or callback structures + * since both are the same in the beginning. + */ + + ThreadSendData *anyPtr = (ThreadSendData*)clientData; + + if (anyPtr) { + if (anyPtr->clientData) { + (*anyPtr->freeProc)(anyPtr->clientData); + } + ckfree((char*)anyPtr); + } +} + +/* + *---------------------------------------------------------------------- + * + * ThreadDeleteEvent -- + * + * This is called from the ThreadExitProc to delete memory related + * to events that we put on the queue. + * + * Results: + * 1 it was our event and we want it removed, 0 otherwise. + * + * Side effects: + * It cleans up our events in the event queue for this thread. + * + *---------------------------------------------------------------------- + */ +static int +ThreadDeleteEvent(eventPtr, clientData) + Tcl_Event *eventPtr; /* Really ThreadEvent */ + ClientData clientData; /* dummy */ +{ + if (eventPtr->proc == ThreadEventProc) { + /* + * Regular script event. Just dispose memory + */ + ThreadEvent *evPtr = (ThreadEvent*)eventPtr; + if (evPtr->sendData) { + ThreadFreeProc((ClientData)evPtr->sendData); + evPtr->sendData = NULL; + } + if (evPtr->clbkData) { + ThreadFreeProc((ClientData)evPtr->clbkData); + evPtr->clbkData = NULL; + } + return 1; + } + if (eventPtr->proc == TransferEventProc) { + /* + * A channel is in flight toward the thread just exiting. + * Pass it back to the originator, if possible. + * Else kill it. + */ + TransferEvent* evPtr = (TransferEvent *) eventPtr; + + if (evPtr->resultPtr == (TransferResult *) NULL) { + /* No thread to pass the channel back to. Kill it. + * This requires to splice it temporarily into our channel + * list and then forcing the ref.counter down to the real + * value of zero. This destroys the channel. + */ + + Tcl_SpliceChannel(evPtr->chan); + Tcl_UnregisterChannel((Tcl_Interp *) NULL, evPtr->chan); + return 1; + } + + /* Our caller (ThreadExitProc) will pass the channel back. + */ + + return 1; + } + + /* + * If it was NULL, we were in the middle of servicing the event + * and it should be removed + */ + + return (eventPtr->proc == NULL); +} + +/* + *---------------------------------------------------------------------- + * + * ThreadExitProc -- + * + * This is called when the thread exits. + * + * Results: + * None. + * + * Side effects: + * It unblocks anyone that is waiting on a send to this thread. + * It cleans up any events in the event queue for this thread. + * + *---------------------------------------------------------------------- + */ +static void +ThreadExitProc(clientData) + ClientData clientData; +{ + char *threadEvalScript = (char*)clientData; + const char *diemsg = "target thread died"; + ThreadEventResult *resultPtr, *nextPtr; + Tcl_ThreadId self = Tcl_GetCurrentThread(); + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + + TransferResult *tResultPtr, *tNextPtr; + + if (threadEvalScript && threadEvalScript != threadEmptyResult) { + ckfree((char*)threadEvalScript); + } + + Tcl_MutexLock(&threadMutex); + + /* + * NaviServer/AOLserver and threadpool threads get started/stopped + * out of the control of this interface so this is + * the first chance to split them out of the thread list. + */ + + ListRemoveInner(tsdPtr); + + /* + * Delete events posted to our queue while we were running. + * For threads exiting from the thread::wait command, this + * has already been done in ThreadWait() function. + * For one-shot threads, having something here is a very + * strange condition. It *may* happen if somebody posts us + * an event while we were in the middle of processing some + * lengthly user script. It is unlikely to happen, though. + */ + + Tcl_DeleteEvents((Tcl_EventDeleteProc*)ThreadDeleteEvent, NULL); + + /* + * Walk the list of threads waiting for result from us + * and inform them that we're about to exit. + */ + + for (resultPtr = resultList; resultPtr; resultPtr = nextPtr) { + nextPtr = resultPtr->nextPtr; + if (resultPtr->srcThreadId == self) { + + /* + * We are going away. By freeing up the result we signal + * to the other thread we don't care about the result. + */ + + SpliceOut(resultPtr, resultList); + ckfree((char*)resultPtr); + + } else if (resultPtr->dstThreadId == self) { + + /* + * Dang. The target is going away. Unblock the caller. + * The result string must be dynamically allocated + * because the main thread is going to call free on it. + */ + + resultPtr->result = strcpy(ckalloc(1+strlen(diemsg)), diemsg); + resultPtr->code = TCL_ERROR; + resultPtr->errorCode = resultPtr->errorInfo = NULL; + Tcl_ConditionNotify(&resultPtr->done); + } + } + for (tResultPtr = transferList; tResultPtr; tResultPtr = tNextPtr) { + tNextPtr = tResultPtr->nextPtr; + if (tResultPtr->srcThreadId == self) { + /* + * We are going away. By freeing up the result we signal + * to the other thread we don't care about the result. + * + * This should not happen, as this thread should be in + * ThreadTransfer at location (*). + */ + + SpliceOut(tResultPtr, transferList); + ckfree((char*)tResultPtr); + + } else if (tResultPtr->dstThreadId == self) { + /* + * Dang. The target is going away. Unblock the caller. + * The result string must be dynamically allocated + * because the main thread is going to call free on it. + */ + + tResultPtr->resultMsg = strcpy(ckalloc(1+strlen(diemsg)), + diemsg); + tResultPtr->resultCode = TCL_ERROR; + Tcl_ConditionNotify(&tResultPtr->done); + } + } + Tcl_MutexUnlock(&threadMutex); +} + +/* + *---------------------------------------------------------------------- + * + * ThreadGetHandle -- + * + * Construct the handle of the thread which is suitable + * to pass to Tcl. + * + * Results: + * None. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static void +ThreadGetHandle(thrId, handlePtr) + Tcl_ThreadId thrId; + char *handlePtr; +{ + sprintf(handlePtr, THREAD_HNDLPREFIX"%p", thrId); +} + +/* + *---------------------------------------------------------------------- + * + * ThreadGetId -- + * + * Returns the ID of thread given it's Tcl handle. + * + * Results: + * Thread ID. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static int +ThreadGetId(interp, handleObj, thrIdPtr) + Tcl_Interp *interp; + Tcl_Obj *handleObj; + Tcl_ThreadId *thrIdPtr; +{ + const char *thrHandle = Tcl_GetString(handleObj); + + if (sscanf(thrHandle, THREAD_HNDLPREFIX"%p", thrIdPtr) == 1) { + return TCL_OK; + } + + Tcl_AppendResult(interp, "invalid thread handle \"", + thrHandle, "\"", NULL); + return TCL_ERROR; +} + +/* + *---------------------------------------------------------------------- + * + * ErrorNoSuchThread -- + * + * Convenience function to set interpreter result when the thread + * given by it's ID cannot be found. + * + * Results: + * None. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static void +ErrorNoSuchThread(interp, thrId) + Tcl_Interp *interp; + Tcl_ThreadId thrId; +{ + char thrHandle[THREAD_HNDLMAXLEN]; + + ThreadGetHandle(thrId, thrHandle); + Tcl_AppendResult(interp, "thread \"", thrHandle, + "\" does not exist", NULL); +} + +/* + *---------------------------------------------------------------------- + * + * ThreadCutChannel -- + * + * Dissociate a Tcl channel from the current thread/interp. + * + * Results: + * None. + * + * Side effects: + * Events still pending in the thread event queue and ready to fire + * are not processed. + * + *---------------------------------------------------------------------- + */ + +static void +ThreadCutChannel(interp, chan) + Tcl_Interp *interp; + Tcl_Channel chan; +{ + Tcl_DriverWatchProc *watchProc; + + Tcl_ClearChannelHandlers(chan); + + watchProc = Tcl_ChannelWatchProc(Tcl_GetChannelType(chan)); + + /* + * This effectively disables processing of pending + * events which are ready to fire for the given + * channel. If we do not do this, events will hit + * the detached channel which is potentially being + * owned by some other thread. This will wreck havoc + * on our memory and eventually badly hurt us... + */ + + if (watchProc) { + (*watchProc)(Tcl_GetChannelInstanceData(chan), 0); + } + + /* + * Artificially bump the channel reference count + * which protects us from channel being closed + * during the Tcl_UnregisterChannel(). + */ + + Tcl_RegisterChannel((Tcl_Interp *) NULL, chan); + Tcl_UnregisterChannel(interp, chan); + + Tcl_CutChannel(chan); +} + +/* EOF $RCSfile: threadCmd.c,v $ */ + +/* Emacs Setup Variables */ +/* Local Variables: */ +/* mode: C */ +/* indent-tabs-mode: nil */ +/* c-basic-offset: 4 */ +/* End: */ diff --git a/tcl8.6/pkgs/thread2.8.4/generic/threadNs.c b/tcl8.6/pkgs/thread2.8.4/generic/threadNs.c new file mode 100644 index 0000000..45b6b09 --- /dev/null +++ b/tcl8.6/pkgs/thread2.8.4/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, (ClientData)md); + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------------- + * + * Ns_ModuleInit -- + * + * Called by the NaviServer/AOLserver when loading shared object file. + * + * Results: + * Standard NaviServer/AOLserver result + * + * Side effects: + * Many. Depends on the package. + * + *---------------------------------------------------------------------------- + */ + +int +Ns_ModuleInit(char *srv, char *mod) +{ + NsThreadInterpData *md = NULL; + + md = (NsThreadInterpData*)ns_malloc(sizeof(NsThreadInterpData)); + md->modname = strcpy(ns_malloc(strlen(mod)+1), mod); + md->server = strcpy(ns_malloc(strlen(srv)+1), srv); + + return Ns_TclRegisterTrace(srv, NsThread_Init, (void*)md, NS_TCL_TRACE_CREATE); +} + +#endif /* NS_AOLSERVER */ + +/* EOF $RCSfile: aolstub.cpp,v $ */ + +/* Emacs Setup Variables */ +/* Local Variables: */ +/* mode: C */ +/* indent-tabs-mode: nil */ +/* c-basic-offset: 4 */ +/* End: */ diff --git a/tcl8.6/pkgs/thread2.8.4/generic/threadPoolCmd.c b/tcl8.6/pkgs/thread2.8.4/generic/threadPoolCmd.c new file mode 100644 index 0000000..3252baf --- /dev/null +++ b/tcl8.6/pkgs/thread2.8.4/generic/threadPoolCmd.c @@ -0,0 +1,1949 @@ +/* + * threadPoolCmd.c -- + * + * This file implements the Tcl thread pools. + * + * 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. + * ---------------------------------------------------------------------------- + */ + +#include "tclThreadInt.h" + +/* + * Structure to maintain idle poster threads + */ + +typedef struct TpoolWaiter { + Tcl_ThreadId threadId; /* Thread id of the current thread */ + struct TpoolWaiter *nextPtr; /* Next structure in the list */ + struct TpoolWaiter *prevPtr; /* Previous structure in the list */ +} TpoolWaiter; + +/* + * Structure describing an instance of a thread pool. + */ + +typedef struct ThreadPool { + Tcl_WideInt jobId; /* Job counter */ + int idleTime; /* Time in secs a worker thread idles */ + int tearDown; /* Set to 1 to tear down the pool */ + int suspend; /* Set to 1 to suspend pool processing */ + char *initScript; /* Script to initialize worker thread */ + char *exitScript; /* Script to cleanup the worker */ + int minWorkers; /* Minimum number or worker threads */ + int maxWorkers; /* Maximum number of worker threads */ + int numWorkers; /* Current number of worker threads */ + int idleWorkers; /* Number of idle workers */ + int refCount; /* Reference counter for reserve/release */ + Tcl_Mutex mutex; /* Pool mutex */ + Tcl_Condition cond; /* Pool condition variable */ + Tcl_HashTable jobsDone; /* Stores processed job results */ + struct TpoolResult *workTail; /* Tail of the list with jobs pending*/ + struct TpoolResult *workHead; /* Head of the list with jobs pending*/ + struct TpoolWaiter *waitTail; /* Tail of the thread waiters list */ + struct TpoolWaiter *waitHead; /* Head of the thread waiters list */ + struct ThreadPool *nextPtr; /* Next structure in the threadpool list */ + struct ThreadPool *prevPtr; /* Previous structure in threadpool list */ +} ThreadPool; + +#define TPOOL_HNDLPREFIX "tpool" /* Prefix to generate Tcl pool handles */ +#define TPOOL_MINWORKERS 0 /* Default minimum # of worker threads */ +#define TPOOL_MAXWORKERS 4 /* Default maximum # of worker threads */ +#define TPOOL_IDLETIMER 0 /* Default worker thread idle timer */ + +/* + * Structure for passing evaluation results + */ + +typedef struct TpoolResult { + int detached; /* Result is to be ignored */ + Tcl_WideInt jobId; /* The job id of the current job */ + char *script; /* Script to evaluate in worker thread */ + int scriptLen; /* Length of the script */ + int retcode; /* Tcl return code of the current job */ + char *result; /* Tcl result of the current job */ + char *errorCode; /* On error: content of the errorCode */ + char *errorInfo; /* On error: content of the errorInfo */ + Tcl_ThreadId threadId; /* Originating thread id */ + ThreadPool *tpoolPtr; /* Current thread pool */ + struct TpoolResult *nextPtr; + struct TpoolResult *prevPtr; +} TpoolResult; + +/* + * Private structure for each worker/poster thread. + */ + +typedef struct ThreadSpecificData { + int stop; /* Set stop event; exit from event loop */ + TpoolWaiter *waitPtr; /* Threads private idle structure */ +} ThreadSpecificData; + +static Tcl_ThreadDataKey dataKey; + +/* + * This global list maintains thread pools. + */ + +static ThreadPool *tpoolList; +static Tcl_Mutex listMutex; +static Tcl_Mutex startMutex; + +/* + * Used to represent the empty result. + */ + +static char *threadEmptyResult = (char *)""; + +/* + * Functions implementing Tcl commands + */ + +static Tcl_ObjCmdProc TpoolCreateObjCmd; +static Tcl_ObjCmdProc TpoolPostObjCmd; +static Tcl_ObjCmdProc TpoolWaitObjCmd; +static Tcl_ObjCmdProc TpoolCancelObjCmd; +static Tcl_ObjCmdProc TpoolGetObjCmd; +static Tcl_ObjCmdProc TpoolReserveObjCmd; +static Tcl_ObjCmdProc TpoolReleaseObjCmd; +static Tcl_ObjCmdProc TpoolSuspendObjCmd; +static Tcl_ObjCmdProc TpoolResumeObjCmd; +static Tcl_ObjCmdProc TpoolNamesObjCmd; + +/* + * Miscelaneous functions used within this file + */ + +static int +CreateWorker(Tcl_Interp *interp, ThreadPool *tpoolPtr); + +static Tcl_ThreadCreateType +TpoolWorker(ClientData clientData); + +static int +RunStopEvent(Tcl_Event *evPtr, int mask); + +static void +PushWork(TpoolResult *rPtr, ThreadPool *tpoolPtr); + +static TpoolResult* +PopWork(ThreadPool *tpoolPtr); + +static void +PushWaiter(ThreadPool *tpoolPtr); + +static TpoolWaiter* +PopWaiter(ThreadPool *tpoolPtr); + +static void +SignalWaiter(ThreadPool *tpoolPtr); + +static int +TpoolEval(Tcl_Interp *interp, char *script, int scriptLen, + TpoolResult *rPtr); +static void +SetResult(Tcl_Interp *interp, TpoolResult *rPtr); + +static ThreadPool* +GetTpool(const char *tpoolName); + +static ThreadPool* +GetTpoolUnl(const char *tpoolName); + +static void +ThrExitHandler(ClientData clientData); + +static void +AppExitHandler(ClientData clientData); + +static int +TpoolReserve(ThreadPool *tpoolPtr); + +static int +TpoolRelease(ThreadPool *tpoolPtr); + +static void +TpoolSuspend(ThreadPool *tpoolPtr); + +static void +TpoolResume(ThreadPool *tpoolPtr); + +static void +InitWaiter(void); + + +/* + *---------------------------------------------------------------------- + * + * TpoolCreateObjCmd -- + * + * This procedure is invoked to process the "tpool::create" Tcl + * command. See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static int +TpoolCreateObjCmd(dummy, interp, objc, objv) + ClientData dummy; /* Not used. */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *const objv[]; /* Argument objects. */ +{ + int ii, minw, maxw, idle; + char buf[64], *exs = NULL, *cmd = NULL; + ThreadPool *tpoolPtr; + + /* + * Syntax: tpool::create ?-minworkers count? + * ?-maxworkers count? + * ?-initcmd script? + * ?-exitcmd script? + * ?-idletime seconds? + */ + + if (((objc-1) % 2)) { + goto usage; + } + + minw = TPOOL_MINWORKERS; + maxw = TPOOL_MAXWORKERS; + idle = TPOOL_IDLETIMER; + + /* + * Parse the optional arguments + */ + + for (ii = 1; ii < objc; ii += 2) { + char *opt = Tcl_GetString(objv[ii]); + if (OPT_CMP(opt, "-minworkers")) { + if (Tcl_GetIntFromObj(interp, objv[ii+1], &minw) != TCL_OK) { + return TCL_ERROR; + } + } else if (OPT_CMP(opt, "-maxworkers")) { + if (Tcl_GetIntFromObj(interp, objv[ii+1], &maxw) != TCL_OK) { + return TCL_ERROR; + } + } else if (OPT_CMP(opt, "-idletime")) { + if (Tcl_GetIntFromObj(interp, objv[ii+1], &idle) != TCL_OK) { + return TCL_ERROR; + } + } else if (OPT_CMP(opt, "-initcmd")) { + const char *val = Tcl_GetString(objv[ii+1]); + cmd = strcpy(ckalloc(objv[ii+1]->length+1), val); + } else if (OPT_CMP(opt, "-exitcmd")) { + const char *val = Tcl_GetString(objv[ii+1]); + exs = strcpy(ckalloc(objv[ii+1]->length+1), val); + } else { + goto usage; + } + } + + /* + * Do some consistency checking + */ + + if (minw < 0) { + minw = 0; + } + if (maxw < 0) { + maxw = TPOOL_MAXWORKERS; + } + if (minw > maxw) { + maxw = minw; + } + + /* + * Allocate and initialize thread pool structure + */ + + tpoolPtr = (ThreadPool*)ckalloc(sizeof(ThreadPool)); + memset(tpoolPtr, 0, sizeof(ThreadPool)); + + tpoolPtr->minWorkers = minw; + tpoolPtr->maxWorkers = maxw; + tpoolPtr->idleTime = idle; + tpoolPtr->initScript = cmd; + tpoolPtr->exitScript = exs; + Tcl_InitHashTable(&tpoolPtr->jobsDone, TCL_ONE_WORD_KEYS); + + Tcl_MutexLock(&listMutex); + SpliceIn(tpoolPtr, tpoolList); + Tcl_MutexUnlock(&listMutex); + + /* + * Start the required number of worker threads. + * On failure to start any of them, tear-down + * partially initialized pool. + */ + + Tcl_MutexLock(&tpoolPtr->mutex); + for (ii = 0; ii < tpoolPtr->minWorkers; ii++) { + if (CreateWorker(interp, tpoolPtr) != TCL_OK) { + Tcl_MutexUnlock(&tpoolPtr->mutex); + Tcl_MutexLock(&listMutex); + TpoolRelease(tpoolPtr); + Tcl_MutexUnlock(&listMutex); + return TCL_ERROR; + } + } + Tcl_MutexUnlock(&tpoolPtr->mutex); + + sprintf(buf, "%s%p", TPOOL_HNDLPREFIX, tpoolPtr); + Tcl_SetObjResult(interp, Tcl_NewStringObj(buf, -1)); + + return TCL_OK; + + usage: + Tcl_WrongNumArgs(interp, 1, objv, + "?-minworkers count? ?-maxworkers count? " + "?-initcmd script? ?-exitcmd script? " + "?-idletime seconds?"); + return TCL_ERROR; +} + +/* + *---------------------------------------------------------------------- + * + * TpoolPostObjCmd -- + * + * This procedure is invoked to process the "tpool::post" Tcl + * command. See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static int +TpoolPostObjCmd(dummy, interp, objc, objv) + ClientData dummy; /* Not used. */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *const objv[]; /* Argument objects. */ +{ + Tcl_WideInt jobId = 0; + int ii, detached = 0, nowait = 0; + size_t len; + const char *tpoolName, *script; + TpoolResult *rPtr; + ThreadPool *tpoolPtr; + + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + + /* + * Syntax: tpool::post ?-detached? ?-nowait? tpoolId script + */ + + if (objc < 3 || objc > 5) { + goto usage; + } + for (ii = 1; ii < objc; ii++) { + char *opt = Tcl_GetString(objv[ii]); + if (*opt != '-') { + break; + } else if (OPT_CMP(opt, "-detached")) { + detached = 1; + } else if (OPT_CMP(opt, "-nowait")) { + nowait = 1; + } else { + goto usage; + } + } + + /* + * We expect exactly two arguments remaining after options + */ + if (objc - ii != 2) + { + goto usage; + } + + tpoolName = Tcl_GetString(objv[ii]); + script = Tcl_GetString(objv[ii+1]); + len = objv[ii+1]->length; + tpoolPtr = GetTpool(tpoolName); + if (tpoolPtr == NULL) { + Tcl_AppendResult(interp, "can not find threadpool \"", tpoolName, + "\"", NULL); + return TCL_ERROR; + } + + /* + * Initialize per-thread private data for this caller + */ + + InitWaiter(); + + /* + * See if any worker available to run the job. + */ + + Tcl_MutexLock(&tpoolPtr->mutex); + if (nowait) { + if (tpoolPtr->numWorkers == 0) { + + /* + * Assure there is at least one worker running. + */ + + PushWaiter(tpoolPtr); + if (CreateWorker(interp, tpoolPtr) != TCL_OK) { + Tcl_MutexUnlock(&tpoolPtr->mutex); + return TCL_ERROR; + } + + /* + * Wait for worker to start while servicing the event loop + */ + + Tcl_MutexUnlock(&tpoolPtr->mutex); + tsdPtr->stop = -1; + while(tsdPtr->stop == -1) { + Tcl_DoOneEvent(TCL_ALL_EVENTS); + } + Tcl_MutexLock(&tpoolPtr->mutex); + } + } else { + + /* + * If there are no idle worker threads, start some new + * unless we are already running max number of workers. + * In that case wait for the next one to become idle. + */ + + while (tpoolPtr->idleWorkers == 0) { + PushWaiter(tpoolPtr); + if (tpoolPtr->numWorkers < tpoolPtr->maxWorkers) { + + /* + * No more free workers; start new one + */ + + if (CreateWorker(interp, tpoolPtr) != TCL_OK) { + Tcl_MutexUnlock(&tpoolPtr->mutex); + return TCL_ERROR; + } + } + + /* + * Wait for worker to start while servicing the event loop + */ + + Tcl_MutexUnlock(&tpoolPtr->mutex); + tsdPtr->stop = -1; + while(tsdPtr->stop == -1) { + Tcl_DoOneEvent(TCL_ALL_EVENTS); + } + Tcl_MutexLock(&tpoolPtr->mutex); + } + } + + /* + * Create new job ticket and put it on the list. + */ + + rPtr = (TpoolResult*)ckalloc(sizeof(TpoolResult)); + memset(rPtr, 0, sizeof(TpoolResult)); + + if (detached == 0) { + jobId = ++tpoolPtr->jobId; + rPtr->jobId = jobId; + } + + rPtr->script = strcpy(ckalloc(len+1), script); + rPtr->scriptLen = len; + rPtr->detached = detached; + rPtr->threadId = Tcl_GetCurrentThread(); + + PushWork(rPtr, tpoolPtr); + Tcl_ConditionNotify(&tpoolPtr->cond); + Tcl_MutexUnlock(&tpoolPtr->mutex); + + if (detached == 0) { + Tcl_SetObjResult(interp, Tcl_NewWideIntObj(jobId)); + } + + return TCL_OK; + + usage: + Tcl_WrongNumArgs(interp, 1, objv, "?-detached? ?-nowait? tpoolId script"); + return TCL_ERROR; +} + +/* + *---------------------------------------------------------------------- + * + * TpoolWaitObjCmd -- + * + * This procedure is invoked to process the "tpool::wait" Tcl + * command. See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ +static int +TpoolWaitObjCmd(dummy, interp, objc, objv) + ClientData dummy; /* Not used. */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *const objv[]; /* Argument objects. */ +{ + int ii, done, wObjc; + Tcl_WideInt jobId; + char *tpoolName; + Tcl_Obj *listVar = NULL; + Tcl_Obj *waitList, *doneList, **wObjv; + ThreadPool *tpoolPtr; + TpoolResult *rPtr; + Tcl_HashEntry *hPtr; + + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + + /* + * Syntax: tpool::wait tpoolId jobIdList ?listVar? + */ + + if (objc < 3 || objc > 4) { + Tcl_WrongNumArgs(interp, 1, objv, "tpoolId jobIdList ?listVar"); + return TCL_ERROR; + } + if (objc == 4) { + listVar = objv[3]; + } + if (Tcl_ListObjGetElements(interp, objv[2], &wObjc, &wObjv) != TCL_OK) { + return TCL_ERROR; + } + tpoolName = Tcl_GetString(objv[1]); + tpoolPtr = GetTpool(tpoolName); + if (tpoolPtr == NULL) { + Tcl_AppendResult(interp, "can not find threadpool \"", tpoolName, + "\"", NULL); + return TCL_ERROR; + } + + InitWaiter(); + done = 0; /* Number of elements in the done list */ + doneList = Tcl_NewListObj(0, NULL); + + Tcl_MutexLock(&tpoolPtr->mutex); + while (1) { + waitList = Tcl_NewListObj(0, NULL); + for (ii = 0; ii < wObjc; ii++) { + if (Tcl_GetWideIntFromObj(interp, wObjv[ii], &jobId) != TCL_OK) { + Tcl_MutexUnlock(&tpoolPtr->mutex); + return TCL_ERROR; + } + hPtr = Tcl_FindHashEntry(&tpoolPtr->jobsDone, (void *)(size_t)jobId); + if (hPtr) { + rPtr = (TpoolResult*)Tcl_GetHashValue(hPtr); + } else { + rPtr = NULL; + } + if (rPtr == NULL) { + if (listVar) { + Tcl_ListObjAppendElement(interp, waitList, wObjv[ii]); + } + } else if (!rPtr->detached && rPtr->result) { + done++; + Tcl_ListObjAppendElement(interp, doneList, wObjv[ii]); + } else if (listVar) { + Tcl_ListObjAppendElement(interp, waitList, wObjv[ii]); + } + } + if (done) { + break; + } + + /* + * None of the jobs done, wait for completion + * of the next job and try again. + */ + + Tcl_DecrRefCount(waitList); + PushWaiter(tpoolPtr); + + Tcl_MutexUnlock(&tpoolPtr->mutex); + tsdPtr->stop = -1; + while (tsdPtr->stop == -1) { + Tcl_DoOneEvent(TCL_ALL_EVENTS); + } + Tcl_MutexLock(&tpoolPtr->mutex); + } + Tcl_MutexUnlock(&tpoolPtr->mutex); + + if (listVar) { + Tcl_ObjSetVar2(interp, listVar, NULL, waitList, 0); + } + + Tcl_SetObjResult(interp, doneList); + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * TpoolCancelObjCmd -- + * + * This procedure is invoked to process the "tpool::cancel" Tcl + * command. See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ +static int +TpoolCancelObjCmd(dummy, interp, objc, objv) + ClientData dummy; /* Not used. */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *const objv[]; /* Argument objects. */ +{ + int ii, wObjc; + Tcl_WideInt jobId; + char *tpoolName; + Tcl_Obj *listVar = NULL; + Tcl_Obj *doneList, *waitList, **wObjv; + ThreadPool *tpoolPtr; + TpoolResult *rPtr; + + /* + * Syntax: tpool::cancel tpoolId jobIdList ?listVar? + */ + + if (objc < 3 || objc > 4) { + Tcl_WrongNumArgs(interp, 1, objv, "tpoolId jobIdList ?listVar"); + return TCL_ERROR; + } + if (objc == 4) { + listVar = objv[3]; + } + if (Tcl_ListObjGetElements(interp, objv[2], &wObjc, &wObjv) != TCL_OK) { + return TCL_ERROR; + } + tpoolName = Tcl_GetString(objv[1]); + tpoolPtr = GetTpool(tpoolName); + if (tpoolPtr == NULL) { + Tcl_AppendResult(interp, "can not find threadpool \"", tpoolName, + "\"", NULL); + return TCL_ERROR; + } + + InitWaiter(); + doneList = Tcl_NewListObj(0, NULL); + waitList = Tcl_NewListObj(0, NULL); + + Tcl_MutexLock(&tpoolPtr->mutex); + for (ii = 0; ii < wObjc; ii++) { + if (Tcl_GetWideIntFromObj(interp, wObjv[ii], &jobId) != TCL_OK) { + return TCL_ERROR; + } + for (rPtr = tpoolPtr->workHead; rPtr; rPtr = rPtr->nextPtr) { + if (rPtr->jobId == jobId) { + if (rPtr->prevPtr != NULL) { + rPtr->prevPtr->nextPtr = rPtr->nextPtr; + } else { + tpoolPtr->workHead = rPtr->nextPtr; + } + if (rPtr->nextPtr != NULL) { + rPtr->nextPtr->prevPtr = rPtr->prevPtr; + } else { + tpoolPtr->workTail = rPtr->prevPtr; + } + SetResult(NULL, rPtr); /* Just to free the result */ + ckfree(rPtr->script); + ckfree((char*)rPtr); + Tcl_ListObjAppendElement(interp, doneList, wObjv[ii]); + break; + } + } + if (rPtr == NULL && listVar) { + Tcl_ListObjAppendElement(interp, waitList, wObjv[ii]); + } + } + Tcl_MutexUnlock(&tpoolPtr->mutex); + + if (listVar) { + Tcl_ObjSetVar2(interp, listVar, NULL, waitList, 0); + } + + Tcl_SetObjResult(interp, doneList); + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * TpoolGetObjCmd -- + * + * This procedure is invoked to process the "tpool::get" Tcl + * command. See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ +static int +TpoolGetObjCmd(dummy, interp, objc, objv) + ClientData dummy; /* Not used. */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *const objv[]; /* Argument objects. */ +{ + int ret; + Tcl_WideInt jobId; + char *tpoolName; + Tcl_Obj *resVar = NULL; + ThreadPool *tpoolPtr; + TpoolResult *rPtr; + Tcl_HashEntry *hPtr; + + /* + * Syntax: tpool::get tpoolId jobId ?result? + */ + + if (objc < 3 || objc > 4) { + Tcl_WrongNumArgs(interp, 1, objv, "tpoolId jobId ?result?"); + return TCL_ERROR; + } + if (Tcl_GetWideIntFromObj(interp, objv[2], &jobId) != TCL_OK) { + return TCL_ERROR; + } + if (objc == 4) { + resVar = objv[3]; + } + + /* + * Locate the threadpool + */ + + tpoolName = Tcl_GetString(objv[1]); + tpoolPtr = GetTpool(tpoolName); + if (tpoolPtr == NULL) { + Tcl_AppendResult(interp, "can not find threadpool \"", tpoolName, + "\"", NULL); + return TCL_ERROR; + } + + /* + * Locate the job in question. It is an error to + * do a "get" on bogus job handle or on the job + * which did not complete yet. + */ + + Tcl_MutexLock(&tpoolPtr->mutex); + hPtr = Tcl_FindHashEntry(&tpoolPtr->jobsDone, (void *)(size_t)jobId); + if (hPtr == NULL) { + Tcl_MutexUnlock(&tpoolPtr->mutex); + Tcl_AppendResult(interp, "no such job", NULL); + return TCL_ERROR; + } + rPtr = (TpoolResult*)Tcl_GetHashValue(hPtr); + if (rPtr->result == NULL) { + Tcl_MutexUnlock(&tpoolPtr->mutex); + Tcl_AppendResult(interp, "job not completed", NULL); + return TCL_ERROR; + } + + Tcl_DeleteHashEntry(hPtr); + Tcl_MutexUnlock(&tpoolPtr->mutex); + + ret = rPtr->retcode; + SetResult(interp, rPtr); + ckfree((char*)rPtr); + + if (resVar) { + Tcl_ObjSetVar2(interp, resVar, NULL, Tcl_GetObjResult(interp), 0); + Tcl_SetObjResult(interp, Tcl_NewIntObj(ret)); + ret = TCL_OK; + } + + return ret; +} + +/* + *---------------------------------------------------------------------- + * + * TpoolReserveObjCmd -- + * + * This procedure is invoked to process the "tpool::preserve" Tcl + * command. See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static int +TpoolReserveObjCmd(dummy, interp, objc, objv) + ClientData dummy; /* Not used. */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *const objv[]; /* Argument objects. */ +{ + int ret; + char *tpoolName; + ThreadPool *tpoolPtr; + + /* + * Syntax: tpool::preserve tpoolId + */ + + if (objc != 2) { + Tcl_WrongNumArgs(interp, 1, objv, "tpoolId"); + return TCL_ERROR; + } + + tpoolName = Tcl_GetString(objv[1]); + + Tcl_MutexLock(&listMutex); + tpoolPtr = GetTpoolUnl(tpoolName); + if (tpoolPtr == NULL) { + Tcl_MutexUnlock(&listMutex); + Tcl_AppendResult(interp, "can not find threadpool \"", tpoolName, + "\"", NULL); + return TCL_ERROR; + } + + ret = TpoolReserve(tpoolPtr); + Tcl_MutexUnlock(&listMutex); + Tcl_SetObjResult(interp, Tcl_NewIntObj(ret)); + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * TpoolReleaseObjCmd -- + * + * This procedure is invoked to process the "tpool::release" Tcl + * command. See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static int +TpoolReleaseObjCmd(dummy, interp, objc, objv) + ClientData dummy; /* Not used. */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *const objv[]; /* Argument objects. */ +{ + int ret; + char *tpoolName; + ThreadPool *tpoolPtr; + + /* + * Syntax: tpool::release tpoolId + */ + + if (objc != 2) { + Tcl_WrongNumArgs(interp, 1, objv, "tpoolId"); + return TCL_ERROR; + } + + tpoolName = Tcl_GetString(objv[1]); + + Tcl_MutexLock(&listMutex); + tpoolPtr = GetTpoolUnl(tpoolName); + if (tpoolPtr == NULL) { + Tcl_MutexUnlock(&listMutex); + Tcl_AppendResult(interp, "can not find threadpool \"", tpoolName, + "\"", NULL); + return TCL_ERROR; + } + + ret = TpoolRelease(tpoolPtr); + Tcl_MutexUnlock(&listMutex); + Tcl_SetObjResult(interp, Tcl_NewIntObj(ret)); + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * TpoolSuspendObjCmd -- + * + * This procedure is invoked to process the "tpool::suspend" Tcl + * command. See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static int +TpoolSuspendObjCmd(dummy, interp, objc, objv) + ClientData dummy; /* Not used. */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *const objv[]; /* Argument objects. */ +{ + char *tpoolName; + ThreadPool *tpoolPtr; + + /* + * Syntax: tpool::suspend tpoolId + */ + + if (objc != 2) { + Tcl_WrongNumArgs(interp, 1, objv, "tpoolId"); + return TCL_ERROR; + } + + tpoolName = Tcl_GetString(objv[1]); + tpoolPtr = GetTpool(tpoolName); + + if (tpoolPtr == NULL) { + Tcl_AppendResult(interp, "can not find threadpool \"", tpoolName, + "\"", NULL); + return TCL_ERROR; + } + + TpoolSuspend(tpoolPtr); + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * TpoolResumeObjCmd -- + * + * This procedure is invoked to process the "tpool::resume" Tcl + * command. See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static int +TpoolResumeObjCmd(dummy, interp, objc, objv) + ClientData dummy; /* Not used. */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *const objv[]; /* Argument objects. */ +{ + char *tpoolName; + ThreadPool *tpoolPtr; + + /* + * Syntax: tpool::resume tpoolId + */ + + if (objc != 2) { + Tcl_WrongNumArgs(interp, 1, objv, "tpoolId"); + return TCL_ERROR; + } + + tpoolName = Tcl_GetString(objv[1]); + tpoolPtr = GetTpool(tpoolName); + + if (tpoolPtr == NULL) { + Tcl_AppendResult(interp, "can not find threadpool \"", tpoolName, + "\"", NULL); + return TCL_ERROR; + } + + TpoolResume(tpoolPtr); + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * TpoolNamesObjCmd -- + * + * This procedure is invoked to process the "tpool::names" Tcl + * command. See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static int +TpoolNamesObjCmd(dummy, interp, objc, objv) + ClientData dummy; /* Not used. */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *const objv[]; /* Argument objects. */ +{ + ThreadPool *tpoolPtr; + Tcl_Obj *listObj = Tcl_NewListObj(0, NULL); + + Tcl_MutexLock(&listMutex); + for (tpoolPtr = tpoolList; tpoolPtr; tpoolPtr = tpoolPtr->nextPtr) { + char buf[32]; + sprintf(buf, "%s%p", TPOOL_HNDLPREFIX, tpoolPtr); + Tcl_ListObjAppendElement(interp, listObj, Tcl_NewStringObj(buf,-1)); + } + Tcl_MutexUnlock(&listMutex); + Tcl_SetObjResult(interp, listObj); + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * CreateWorker -- + * + * Creates new worker thread for the given pool. Assumes the caller + * holds the pool mutex. + * + * Results: + * None. + * + * Side effects: + * Informs waiter thread (if any) about the new worker thread. + * + *---------------------------------------------------------------------- + */ +static int +CreateWorker(interp, tpoolPtr) + Tcl_Interp *interp; + ThreadPool *tpoolPtr; +{ + Tcl_ThreadId id; + TpoolResult result; + + /* + * Initialize the result structure to be + * passed to the new thread. This is used + * as communication to and from the thread. + */ + + memset(&result, 0, sizeof(TpoolResult)); + result.retcode = -1; + result.tpoolPtr = tpoolPtr; + + /* + * Create new worker thread here. Wait for the thread to start + * because it's using the ThreadResult arg which is on our stack. + */ + + Tcl_MutexLock(&startMutex); + if (Tcl_CreateThread(&id, TpoolWorker, (ClientData)&result, + TCL_THREAD_STACK_DEFAULT, 0) != TCL_OK) { + Tcl_SetObjResult(interp, Tcl_NewStringObj("can't create a new thread", -1)); + Tcl_MutexUnlock(&startMutex); + return TCL_ERROR; + } + while(result.retcode == -1) { + Tcl_ConditionWait(&tpoolPtr->cond, &startMutex, NULL); + } + Tcl_MutexUnlock(&startMutex); + + /* + * Set error-related information if the thread + * failed to initialize correctly. + */ + + if (result.retcode == 1) { + result.retcode = TCL_ERROR; + SetResult(interp, &result); + return TCL_ERROR; + } + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * TpoolWorker -- + * + * This is the main function of each of the threads in the pool. + * + * Results: + * None. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static Tcl_ThreadCreateType +TpoolWorker(clientData) + ClientData clientData; +{ + TpoolResult *rPtr = (TpoolResult*)clientData; + ThreadPool *tpoolPtr = rPtr->tpoolPtr; + + int tout = 0; + Tcl_Interp *interp; + Tcl_Time waitTime, *idlePtr; + const char *errMsg; + + Tcl_MutexLock(&startMutex); + + /* + * Initialize the Tcl interpreter + */ + +#ifdef NS_AOLSERVER + interp = (Tcl_Interp*)Ns_TclAllocateInterp(NULL); + rPtr->retcode = 0; +#else + interp = Tcl_CreateInterp(); + if (Tcl_Init(interp) != TCL_OK) { + rPtr->retcode = 1; + } else if (Thread_Init(interp) != TCL_OK) { + rPtr->retcode = 1; + } else { + rPtr->retcode = 0; + } +#endif + + if (rPtr->retcode == 1) { + errMsg = Tcl_GetString(Tcl_GetObjResult(interp)); + rPtr->result = strcpy(ckalloc(strlen(errMsg)+1), errMsg); + Tcl_ConditionNotify(&tpoolPtr->cond); + Tcl_MutexUnlock(&startMutex); + goto out; + } + + /* + * Initialize the interpreter + */ + + if (tpoolPtr->initScript) { + TpoolEval(interp, tpoolPtr->initScript, -1, rPtr); + if (rPtr->retcode != TCL_OK) { + rPtr->retcode = 1; + errMsg = Tcl_GetString(Tcl_GetObjResult(interp)); + rPtr->result = strcpy(ckalloc(strlen(errMsg)+1), errMsg); + Tcl_ConditionNotify(&tpoolPtr->cond); + Tcl_MutexUnlock(&startMutex); + goto out; + } + } + + /* + * Setup idle timer + */ + + if (tpoolPtr->idleTime == 0) { + idlePtr = NULL; + } else { + waitTime.sec = tpoolPtr->idleTime; + waitTime.usec = 0; + idlePtr = &waitTime; + } + + /* + * Tell caller we've started + */ + + tpoolPtr->numWorkers++; + Tcl_ConditionNotify(&tpoolPtr->cond); + Tcl_MutexUnlock(&startMutex); + + /* + * Wait for jobs to arrive. Note the handcrafted time test. + * Tcl API misses the return value of the Tcl_ConditionWait(). + * Hence, we do not know why the call returned. Was it someone + * signalled the variable or has the idle timer expired? + */ + + Tcl_MutexLock(&tpoolPtr->mutex); + while (!tpoolPtr->tearDown) { + SignalWaiter(tpoolPtr); + tpoolPtr->idleWorkers++; + rPtr = NULL; + tout = 0; + while (tpoolPtr->suspend + || (!tpoolPtr->tearDown && !tout + && (rPtr = PopWork(tpoolPtr)) == NULL)) { + if (tpoolPtr->suspend && rPtr == NULL) { + Tcl_ConditionWait(&tpoolPtr->cond, &tpoolPtr->mutex, NULL); + } else if (rPtr == NULL) { + Tcl_Time t1, t2; + Tcl_GetTime(&t1); + Tcl_ConditionWait(&tpoolPtr->cond, &tpoolPtr->mutex, idlePtr); + Tcl_GetTime(&t2); + if (tpoolPtr->idleTime > 0) { + tout = (t2.sec - t1.sec) >= tpoolPtr->idleTime; + } + } + } + tpoolPtr->idleWorkers--; + if (rPtr == NULL) { + if (tpoolPtr->numWorkers > tpoolPtr->minWorkers) { + break; /* Enough workers, can safely kill this one */ + } else { + continue; /* Worker count at min, leave this one alive */ + } + } else if (tpoolPtr->tearDown) { + PushWork(rPtr, tpoolPtr); + break; /* Kill worker because pool is going down */ + } + Tcl_MutexUnlock(&tpoolPtr->mutex); + TpoolEval(interp, rPtr->script, rPtr->scriptLen, rPtr); + ckfree(rPtr->script); + Tcl_MutexLock(&tpoolPtr->mutex); + if (!rPtr->detached) { + int new; + Tcl_SetHashValue(Tcl_CreateHashEntry(&tpoolPtr->jobsDone, + (void *)(size_t)rPtr->jobId, &new), + (ClientData)rPtr); + SignalWaiter(tpoolPtr); + } else { + ckfree((char*)rPtr); + } + } + + /* + * Tear down the worker + */ + + if (tpoolPtr->exitScript) { + TpoolEval(interp, tpoolPtr->exitScript, -1, NULL); + } + + tpoolPtr->numWorkers--; + SignalWaiter(tpoolPtr); + Tcl_MutexUnlock(&tpoolPtr->mutex); + + out: + +#ifdef NS_AOLSERVER + Ns_TclMarkForDelete(interp); + Ns_TclDeAllocateInterp(interp); +#else + Tcl_DeleteInterp(interp); +#endif + Tcl_ExitThread(0); + + TCL_THREAD_CREATE_RETURN; +} + +/* + *---------------------------------------------------------------------- + * + * RunStopEvent -- + * + * Signalizes the waiter thread to stop waiting. + * + * Results: + * 1 (always) + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ +static int +RunStopEvent(eventPtr, mask) + Tcl_Event *eventPtr; + int mask; +{ + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + + tsdPtr->stop = 1; + return 1; +} + +/* + *---------------------------------------------------------------------- + * + * PushWork -- + * + * Adds a worker thread to the end of the workers list. + * + * Results: + * None. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static void +PushWork(rPtr, tpoolPtr) + TpoolResult *rPtr; + ThreadPool *tpoolPtr; +{ + SpliceIn(rPtr, tpoolPtr->workHead); + if (tpoolPtr->workTail == NULL) { + tpoolPtr->workTail = rPtr; + } +} + +/* + *---------------------------------------------------------------------- + * + * PopWork -- + * + * Pops the work ticket from the list + * + * Results: + * None. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static TpoolResult * +PopWork(tpoolPtr) + ThreadPool *tpoolPtr; +{ + TpoolResult *rPtr = tpoolPtr->workTail; + + if (rPtr == NULL) { + return NULL; + } + + tpoolPtr->workTail = rPtr->prevPtr; + SpliceOut(rPtr, tpoolPtr->workHead); + + rPtr->nextPtr = rPtr->prevPtr = NULL; + + return rPtr; +} + +/* + *---------------------------------------------------------------------- + * + * PushWaiter -- + * + * Adds a waiter thread to the end of the waiters list. + * + * Results: + * None. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static void +PushWaiter(tpoolPtr) + ThreadPool *tpoolPtr; +{ + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + + SpliceIn(tsdPtr->waitPtr, tpoolPtr->waitHead); + if (tpoolPtr->waitTail == NULL) { + tpoolPtr->waitTail = tsdPtr->waitPtr; + } +} + +/* + *---------------------------------------------------------------------- + * + * PopWaiter -- + * + * Pops the first waiter from the head of the waiters list. + * + * Results: + * None. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static TpoolWaiter* +PopWaiter(tpoolPtr) + ThreadPool *tpoolPtr; +{ + TpoolWaiter *waitPtr = tpoolPtr->waitTail; + + if (waitPtr == NULL) { + return NULL; + } + + tpoolPtr->waitTail = waitPtr->prevPtr; + SpliceOut(waitPtr, tpoolPtr->waitHead); + + waitPtr->prevPtr = waitPtr->nextPtr = NULL; + + return waitPtr; +} + +/* + *---------------------------------------------------------------------- + * + * GetTpool + * + * Parses the Tcl threadpool handle and locates the + * corresponding threadpool maintenance structure. + * + * Results: + * Pointer to the threadpool struct or NULL if none found, + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ +static ThreadPool* +GetTpool(tpoolName) + const char *tpoolName; +{ + ThreadPool *tpoolPtr; + + Tcl_MutexLock(&listMutex); + tpoolPtr = GetTpoolUnl(tpoolName); + Tcl_MutexUnlock(&listMutex); + + return tpoolPtr; +} + +/* + *---------------------------------------------------------------------- + * + * GetTpoolUnl + * + * Parses the threadpool handle and locates the + * corresponding threadpool maintenance structure. + * Assumes caller holds the listMutex, + * + * Results: + * Pointer to the threadpool struct or NULL if none found, + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static ThreadPool* +GetTpoolUnl (tpoolName) + const char *tpoolName; +{ + ThreadPool *tpool; + ThreadPool *tpoolPtr = NULL; + + if (sscanf(tpoolName, TPOOL_HNDLPREFIX"%p", &tpool) != 1) { + return NULL; + } + for (tpoolPtr = tpoolList; tpoolPtr; tpoolPtr = tpoolPtr->nextPtr) { + if (tpoolPtr == tpool) { + break; + } + } + + return tpoolPtr; +} + +/* + *---------------------------------------------------------------------- + * + * TpoolEval + * + * Evaluates the script and fills in the result structure. + * + * Results: + * Standard Tcl result, + * + * Side effects: + * Many, depending on the script. + * + *---------------------------------------------------------------------- + */ +static int +TpoolEval(interp, script, scriptLen, rPtr) + Tcl_Interp *interp; + char *script; + int scriptLen; + TpoolResult *rPtr; +{ + int ret; + size_t reslen; + const char *result; + const char *errorCode, *errorInfo; + + ret = Tcl_EvalEx(interp, script, scriptLen, TCL_EVAL_GLOBAL); + if (rPtr == NULL || rPtr->detached) { + return ret; + } + rPtr->retcode = ret; + if (ret == TCL_ERROR) { + errorCode = Tcl_GetVar2(interp, "errorCode", NULL, TCL_GLOBAL_ONLY); + errorInfo = Tcl_GetVar2(interp, "errorInfo", NULL, TCL_GLOBAL_ONLY); + if (errorCode != NULL) { + rPtr->errorCode = ckalloc(1 + strlen(errorCode)); + strcpy(rPtr->errorCode, errorCode); + } + if (errorInfo != NULL) { + rPtr->errorInfo = ckalloc(1 + strlen(errorInfo)); + strcpy(rPtr->errorInfo, errorInfo); + } + } + + result = Tcl_GetString(Tcl_GetObjResult(interp)); + reslen = Tcl_GetObjResult(interp)->length; + + if (reslen == 0) { + rPtr->result = threadEmptyResult; + } else { + rPtr->result = strcpy(ckalloc(1 + reslen), result); + } + + return ret; +} + +/* + *---------------------------------------------------------------------- + * + * SetResult + * + * Sets the result in current interpreter. + * + * Results: + * Standard Tcl result, + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ +static void +SetResult(interp, rPtr) + Tcl_Interp *interp; + TpoolResult *rPtr; +{ + if (rPtr->retcode == TCL_ERROR) { + if (rPtr->errorCode) { + if (interp) { + Tcl_SetObjErrorCode(interp,Tcl_NewStringObj(rPtr->errorCode,-1)); + } + ckfree(rPtr->errorCode); + rPtr->errorCode = NULL; + } + if (rPtr->errorInfo) { + if (interp) { + Tcl_AddErrorInfo(interp, rPtr->errorInfo); + } + ckfree(rPtr->errorInfo); + rPtr->errorInfo = NULL; + } + } + if (rPtr->result) { + if (rPtr->result == threadEmptyResult) { + if (interp) { + Tcl_ResetResult(interp); + } + } else { + if (interp) { + Tcl_SetObjResult(interp, Tcl_NewStringObj(rPtr->result,-1)); + } + ckfree(rPtr->result); + rPtr->result = NULL; + } + } +} + +/* + *---------------------------------------------------------------------- + * + * TpoolReserve -- + * + * Does the pool preserve and/or release. Assumes caller holds + * the listMutex. + * + * Results: + * None. + * + * Side effects: + * May tear-down the threadpool if refcount drops to 0 or below. + * + *---------------------------------------------------------------------- + */ +static int +TpoolReserve(tpoolPtr) + ThreadPool *tpoolPtr; +{ + return ++tpoolPtr->refCount; +} + +/* + *---------------------------------------------------------------------- + * + * TpoolRelease -- + * + * Does the pool preserve and/or release. Assumes caller holds + * the listMutex. + * + * Results: + * None. + * + * Side effects: + * May tear-down the threadpool if refcount drops to 0 or below. + * + *---------------------------------------------------------------------- + */ +static int +TpoolRelease(tpoolPtr) + ThreadPool *tpoolPtr; +{ + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + TpoolResult *rPtr; + Tcl_HashEntry *hPtr; + Tcl_HashSearch search; + + if (--tpoolPtr->refCount > 0) { + return tpoolPtr->refCount; + } + + /* + * Pool is going away; remove from the list of pools, + */ + + SpliceOut(tpoolPtr, tpoolList); + InitWaiter(); + + /* + * Signal and wait for all workers to die. + */ + + Tcl_MutexLock(&tpoolPtr->mutex); + tpoolPtr->tearDown = 1; + while (tpoolPtr->numWorkers > 0) { + PushWaiter(tpoolPtr); + Tcl_ConditionNotify(&tpoolPtr->cond); + Tcl_MutexUnlock(&tpoolPtr->mutex); + tsdPtr->stop = -1; + while(tsdPtr->stop == -1) { + Tcl_DoOneEvent(TCL_ALL_EVENTS); + } + Tcl_MutexLock(&tpoolPtr->mutex); + } + Tcl_MutexUnlock(&tpoolPtr->mutex); + + /* + * Tear down the pool structure + */ + + if (tpoolPtr->initScript) { + ckfree(tpoolPtr->initScript); + } + if (tpoolPtr->exitScript) { + ckfree(tpoolPtr->exitScript); + } + + /* + * Cleanup completed but not collected jobs + */ + + hPtr = Tcl_FirstHashEntry(&tpoolPtr->jobsDone, &search); + while (hPtr != NULL) { + rPtr = (TpoolResult*)Tcl_GetHashValue(hPtr); + if (rPtr->result && rPtr->result != threadEmptyResult) { + ckfree(rPtr->result); + } + if (rPtr->retcode == TCL_ERROR) { + if (rPtr->errorInfo) { + ckfree(rPtr->errorInfo); + } + if (rPtr->errorCode) { + ckfree(rPtr->errorCode); + } + } + ckfree((char*)rPtr); + Tcl_DeleteHashEntry(hPtr); + hPtr = Tcl_NextHashEntry(&search); + } + Tcl_DeleteHashTable(&tpoolPtr->jobsDone); + + /* + * Cleanup jobs posted but never completed. + */ + + for (rPtr = tpoolPtr->workHead; rPtr; rPtr = rPtr->nextPtr) { + ckfree(rPtr->script); + ckfree((char*)rPtr); + } + Tcl_MutexFinalize(&tpoolPtr->mutex); + Tcl_ConditionFinalize(&tpoolPtr->cond); + ckfree((char*)tpoolPtr); + + return 0; +} + +/* + *---------------------------------------------------------------------- + * + * TpoolSuspend -- + * + * Marks the pool as suspended. This prevents pool workers to drain + * the pool work queue. + * + * Results: + * Value of the suspend flag (1 always). + * + * Side effects: + * During the suspended state, pool worker threads wlll not timeout + * even if the worker inactivity timer has been configured. + * + *---------------------------------------------------------------------- + */ +static void +TpoolSuspend(tpoolPtr) + ThreadPool *tpoolPtr; +{ + Tcl_MutexLock(&tpoolPtr->mutex); + tpoolPtr->suspend = 1; + Tcl_MutexUnlock(&tpoolPtr->mutex); +} + +/* + *---------------------------------------------------------------------- + * + * TpoolResume -- + * + * Clears the pool suspended state. This allows pool workers to drain + * the pool work queue again. + * + * Results: + * None. + * + * Side effects: + * Pool workers may be started or awaken. + * + *---------------------------------------------------------------------- + */ +static void +TpoolResume(tpoolPtr) + ThreadPool *tpoolPtr; +{ + Tcl_MutexLock(&tpoolPtr->mutex); + tpoolPtr->suspend = 0; + Tcl_ConditionNotify(&tpoolPtr->cond); + Tcl_MutexUnlock(&tpoolPtr->mutex); +} + +/* + *---------------------------------------------------------------------- + * + * SignalWaiter -- + * + * Signals the waiter thread. + * + * Results: + * None. + * + * Side effects: + * The waiter thread will exit from the event loop. + * + *---------------------------------------------------------------------- + */ +static void +SignalWaiter(tpoolPtr) + ThreadPool *tpoolPtr; +{ + TpoolWaiter *waitPtr; + Tcl_Event *evPtr; + + waitPtr = PopWaiter(tpoolPtr); + if (waitPtr == NULL) { + return; + } + + evPtr = (Tcl_Event*)ckalloc(sizeof(Tcl_Event)); + evPtr->proc = RunStopEvent; + + Tcl_ThreadQueueEvent(waitPtr->threadId,(Tcl_Event*)evPtr,TCL_QUEUE_TAIL); + Tcl_ThreadAlert(waitPtr->threadId); +} + +/* + *---------------------------------------------------------------------- + * + * InitWaiter -- + * + * Setup poster thread to be able to wait in the event loop. + * + * Results: + * None. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ +static void +InitWaiter () +{ + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + + if (tsdPtr->waitPtr == NULL) { + tsdPtr->waitPtr = (TpoolWaiter*)ckalloc(sizeof(TpoolWaiter)); + tsdPtr->waitPtr->prevPtr = NULL; + tsdPtr->waitPtr->nextPtr = NULL; + tsdPtr->waitPtr->threadId = Tcl_GetCurrentThread(); + Tcl_CreateThreadExitHandler(ThrExitHandler, (ClientData)tsdPtr); + } +} + +/* + *---------------------------------------------------------------------- + * + * ThrExitHandler -- + * + * Performs cleanup when a caller (poster) thread exits. + * + * Results: + * None. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ +static void +ThrExitHandler(clientData) + ClientData clientData; +{ + ThreadSpecificData *tsdPtr = (ThreadSpecificData *)clientData; + + ckfree((char*)tsdPtr->waitPtr); +} + +/* + *---------------------------------------------------------------------- + * + * AppExitHandler + * + * Deletes all threadpools on application exit. + * + * Results: + * None. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ +static void +AppExitHandler(clientData) + ClientData clientData; +{ + ThreadPool *tpoolPtr; + + Tcl_MutexLock(&listMutex); + /* + * Restart with head of list each time until empty. [Bug 1427570] + */ + for (tpoolPtr = tpoolList; tpoolPtr; tpoolPtr = tpoolList) { + TpoolRelease(tpoolPtr); + } + Tcl_MutexUnlock(&listMutex); +} + +/* + *---------------------------------------------------------------------- + * + * Tpool_Init -- + * + * Create commands in current interpreter. + * + * Results: + * None. + * + * Side effects: + * On first load, creates application exit handler to clean up + * any threadpools left. + * + *---------------------------------------------------------------------- + */ + +int +Tpool_Init (interp) + Tcl_Interp *interp; /* Interp where to create cmds */ +{ + static int initialized; + + TCL_CMD(interp, TPOOL_CMD_PREFIX"create", TpoolCreateObjCmd); + TCL_CMD(interp, TPOOL_CMD_PREFIX"names", TpoolNamesObjCmd); + TCL_CMD(interp, TPOOL_CMD_PREFIX"post", TpoolPostObjCmd); + TCL_CMD(interp, TPOOL_CMD_PREFIX"wait", TpoolWaitObjCmd); + TCL_CMD(interp, TPOOL_CMD_PREFIX"cancel", TpoolCancelObjCmd); + TCL_CMD(interp, TPOOL_CMD_PREFIX"get", TpoolGetObjCmd); + TCL_CMD(interp, TPOOL_CMD_PREFIX"preserve", TpoolReserveObjCmd); + TCL_CMD(interp, TPOOL_CMD_PREFIX"release", TpoolReleaseObjCmd); + TCL_CMD(interp, TPOOL_CMD_PREFIX"suspend", TpoolSuspendObjCmd); + TCL_CMD(interp, TPOOL_CMD_PREFIX"resume", TpoolResumeObjCmd); + + if (initialized == 0) { + Tcl_MutexLock(&listMutex); + if (initialized == 0) { + Tcl_CreateExitHandler(AppExitHandler, (ClientData)-1); + initialized = 1; + } + Tcl_MutexUnlock(&listMutex); + } + return TCL_OK; +} + +/* EOF $RCSfile: threadPoolCmd.c,v $ */ + +/* Emacs Setup Variables */ +/* Local Variables: */ +/* mode: C */ +/* indent-tabs-mode: nil */ +/* c-basic-offset: 4 */ +/* End: */ diff --git a/tcl8.6/pkgs/thread2.8.4/generic/threadSpCmd.c b/tcl8.6/pkgs/thread2.8.4/generic/threadSpCmd.c new file mode 100644 index 0000000..dbb849e --- /dev/null +++ b/tcl8.6/pkgs/thread2.8.4/generic/threadSpCmd.c @@ -0,0 +1,1930 @@ +/* + * threadSpCmd.c -- + * + * This file implements commands for script-level access to thread + * synchronization primitives. Currently, the exclusive mutex, the + * recursive mutex. the reader/writer mutex and condition variable + * objects are exposed to the script programmer. + * + * Additionaly, a locked eval is also implemented. This is a practical + * convenience function which relieves the programmer from the need + * to take care about unlocking some mutex after evaluating a protected + * part of code. The locked eval is recursive-savvy since it used the + * recursive mutex for internal locking. + * + * The Tcl interface to the locking and synchronization primitives + * attempts to catch some very common problems in thread programming + * like attempting to lock an exclusive mutex twice from the same + * thread (deadlock), waiting on the condition variable without + * locking the mutex, destroying primitives while being used, etc... + * This all comes with some additional internal locking costs but + * the benefits outweight the costs, especially considering overall + * performance (or lack of it) of an interpreted laguage like Tcl is. + * + * 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. + * ---------------------------------------------------------------------------- + */ + +#include "tclThreadInt.h" +#include "threadSpCmd.h" + +/* + * Types of synchronization variables we support. + */ + +#define EMUTEXID 'm' /* First letter of the exclusive mutex name */ +#define RMUTEXID 'r' /* First letter of the recursive mutex name */ +#define WMUTEXID 'w' /* First letter of the read/write mutex name */ +#define CONDVID 'c' /* First letter of the condition variable name */ + +#define SP_MUTEX 1 /* Any kind of mutex */ +#define SP_CONDV 2 /* The condition variable sync type */ + +/* + * Structure representing one sync primitive (mutex, condition variable). + * We use buckets to manage Tcl names of sync primitives. Each bucket + * is associated with a mutex. Each time we process the Tcl name of an + * sync primitive, we compute it's (trivial) hash and use this hash to + * address one of pre-allocated buckets. + * The bucket internally utilzes a hash-table to store item pointers. + * Item pointers are identified by a simple xid1, xid2... counting + * handle. This format is chosen to simplify distribution of handles + * across buckets (natural distribution vs. hash-one as in shared vars). + */ + +typedef struct _SpItem { + int refcnt; /* Number of threads operating on the item */ + SpBucket *bucket; /* Bucket where this item is stored */ + Tcl_HashEntry *hentry; /* Hash table entry where this item is stored */ +} SpItem; + +/* + * Structure representing a mutex. + */ + +typedef struct _SpMutex { + int refcnt; /* Number of threads operating on the mutex */ + SpBucket *bucket; /* Bucket where mutex is stored */ + Tcl_HashEntry *hentry; /* Hash table entry where mutex is stored */ + /* --- */ + char type; /* Type of the mutex */ + Sp_AnyMutex *lock; /* Exclusive, recursive or read/write mutex */ +} SpMutex; + +/* + * Structure representing a condition variable. + */ + +typedef struct _SpCondv { + int refcnt; /* Number of threads operating on the variable */ + SpBucket *bucket; /* Bucket where this variable is stored */ + Tcl_HashEntry *hentry; /* Hash table entry where variable is stored */ + /* --- */ + SpMutex *mutex; /* Set when waiting on the variable */ + Tcl_Condition cond; /* The condition variable itself */ +} SpCondv; + +/* + * This global data is used to map opaque Tcl-level names + * to pointers of their corresponding synchronization objects. + */ + +static int initOnce; /* Flag for initializing tables below */ +static Tcl_Mutex initMutex; /* Controls initialization of primitives */ +static SpBucket muxBuckets[NUMSPBUCKETS]; /* Maps mutex names/handles */ +static SpBucket varBuckets[NUMSPBUCKETS]; /* Maps condition variable + * names/handles */ + +/* + * Functions implementing Tcl commands + */ + +static Tcl_ObjCmdProc ThreadMutexObjCmd; +static Tcl_ObjCmdProc ThreadRWMutexObjCmd; +static Tcl_ObjCmdProc ThreadCondObjCmd; +static Tcl_ObjCmdProc ThreadEvalObjCmd; + +/* + * Forward declaration of functions used only within this file + */ + +static int SpMutexLock (SpMutex *); +static int SpMutexUnlock (SpMutex *); +static int SpMutexFinalize (SpMutex *); + +static int SpCondvWait (SpCondv *, SpMutex *, int); +static void SpCondvNotify (SpCondv *); +static int SpCondvFinalize (SpCondv *); + +static void AddAnyItem (int, const char *, size_t, SpItem *); +static SpItem* GetAnyItem (int, const char *, size_t); +static void PutAnyItem (SpItem *); +static SpItem * RemoveAnyItem (int, const char*, size_t); + +static int RemoveMutex (const char *, size_t); +static int RemoveCondv (const char *, size_t); + +static Tcl_Obj* GetName (int, void *); +static SpBucket* GetBucket (int, const char *, size_t); + +static int AnyMutexIsLocked (Sp_AnyMutex *mPtr, Tcl_ThreadId); + +/* + * Function-like macros for some frequently used calls + */ + +#define AddMutex(a,b,c) AddAnyItem(SP_MUTEX, (a), (b), (SpItem*)(c)) +#define GetMutex(a,b) (SpMutex*)GetAnyItem(SP_MUTEX, (a), (b)) +#define PutMutex(a) PutAnyItem((SpItem*)(a)) + +#define AddCondv(a,b,c) AddAnyItem(SP_CONDV, (a), (b), (SpItem*)(c)) +#define GetCondv(a,b) (SpCondv*)GetAnyItem(SP_CONDV, (a), (b)) +#define PutCondv(a) PutAnyItem((SpItem*)(a)) + +#define IsExclusive(a) ((a)->type == EMUTEXID) +#define IsRecursive(a) ((a)->type == RMUTEXID) +#define IsReadWrite(a) ((a)->type == WMUTEXID) + +/* + * This macro produces a hash-value for table-lookups given a handle + * and its length. It is implemented as macro just for speed. + * It is actually a trivial thing because the handles are simple + * counting values with a small three-letter prefix. + */ + +#define GetHash(a,b) (atoi((a)+((b) < 4 ? 0 : 3)) % NUMSPBUCKETS) + + +/* + *---------------------------------------------------------------------- + * + * ThreadMutexObjCmd -- + * + * This procedure is invoked to process "thread::mutex" Tcl command. + * See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ + +static int +ThreadMutexObjCmd(dummy, interp, objc, objv) + ClientData dummy; /* Not used. */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *const objv[]; /* Argument objects. */ +{ + int opt, ret; + size_t nameLen; + const char *mutexName; + char type; + SpMutex *mutexPtr; + + static const char *cmdOpts[] = { + "create", "destroy", "lock", "unlock", NULL + }; + enum options { + m_CREATE, m_DESTROY, m_LOCK, m_UNLOCK + }; + + /* + * Syntax: + * + * thread::mutex create ?-recursive? + * thread::mutex destroy <mutexHandle> + * thread::mutex lock <mutexHandle> + * thread::mutex unlock <mutexHandle> + */ + + if (objc < 2) { + Tcl_WrongNumArgs(interp, 1, objv, "option ?args?"); + return TCL_ERROR; + } + ret = Tcl_GetIndexFromObjStruct(interp, objv[1], cmdOpts, sizeof(char *), "option", 0, &opt); + if (ret != TCL_OK) { + return TCL_ERROR; + } + + /* + * Cover the "create" option first. It needs no existing handle. + */ + + if (opt == (int)m_CREATE) { + Tcl_Obj *nameObj; + const char *arg; + + /* + * Parse out which type of mutex to create + */ + + if (objc == 2) { + type = EMUTEXID; + } else if (objc > 3) { + Tcl_WrongNumArgs(interp, 2, objv, "?-recursive?"); + return TCL_ERROR; + } else { + arg = Tcl_GetString(objv[2]); + if (OPT_CMP(arg, "-recursive")) { + type = RMUTEXID; + } else { + Tcl_WrongNumArgs(interp, 2, objv, "?-recursive?"); + return TCL_ERROR; + } + } + + /* + * Create the requested mutex + */ + + mutexPtr = (SpMutex*)ckalloc(sizeof(SpMutex)); + mutexPtr->type = type; + mutexPtr->bucket = NULL; + mutexPtr->hentry = NULL; + mutexPtr->lock = NULL; /* Will be auto-initialized */ + + /* + * Generate Tcl name for this mutex + */ + + nameObj = GetName(mutexPtr->type, (void*)mutexPtr); + mutexName = Tcl_GetString(nameObj); + nameLen = nameObj->length; + AddMutex(mutexName, nameLen, mutexPtr); + Tcl_SetObjResult(interp, nameObj); + return TCL_OK; + } + + /* + * All other options require a valid name. + */ + + if (objc != 3) { + Tcl_WrongNumArgs(interp, 2, objv, "mutexHandle"); + return TCL_ERROR; + } + + mutexName = Tcl_GetString(objv[2]); + nameLen = objv[2]->length; + + /* + * Try mutex destroy + */ + + if (opt == (int)m_DESTROY) { + ret = RemoveMutex(mutexName, nameLen); + if (ret <= 0) { + if (ret == -1) { + notfound: + Tcl_AppendResult(interp, "no such mutex \"", mutexName, + "\"", NULL); + return TCL_ERROR; + } else { + Tcl_AppendResult(interp, "mutex is in use", NULL); + return TCL_ERROR; + } + } + return TCL_OK; + } + + /* + * Try all other options + */ + + mutexPtr = GetMutex(mutexName, nameLen); + if (mutexPtr == NULL) { + goto notfound; + } + if (!IsExclusive(mutexPtr) && !IsRecursive(mutexPtr)) { + PutMutex(mutexPtr); + Tcl_AppendResult(interp, "wrong mutex type, must be either" + " exclusive or recursive", NULL); + return TCL_ERROR; + } + + switch ((enum options)opt) { + case m_LOCK: + if (!SpMutexLock(mutexPtr)) { + PutMutex(mutexPtr); + Tcl_AppendResult(interp, "locking the same exclusive mutex " + "twice from the same thread", NULL); + return TCL_ERROR; + } + break; + case m_UNLOCK: + if (!SpMutexUnlock(mutexPtr)) { + PutMutex(mutexPtr); + Tcl_AppendResult(interp, "mutex is not locked", NULL); + return TCL_ERROR; + } + break; + default: + break; + } + + PutMutex(mutexPtr); + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * ThreadRwMutexObjCmd -- + * + * This procedure is invoked to process "thread::rwmutex" Tcl command. + * See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ + +static int +ThreadRWMutexObjCmd(dummy, interp, objc, objv) + ClientData dummy; /* Not used. */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *const objv[]; /* Argument objects. */ +{ + int opt, ret; + size_t nameLen; + const char *mutexName; + SpMutex *mutexPtr; + Sp_ReadWriteMutex *rwPtr; + Sp_AnyMutex **lockPtr; + + static const char *cmdOpts[] = { + "create", "destroy", "rlock", "wlock", "unlock", NULL + }; + enum options { + w_CREATE, w_DESTROY, w_RLOCK, w_WLOCK, w_UNLOCK + }; + + /* + * Syntax: + * + * thread::rwmutex create + * thread::rwmutex destroy <mutexHandle> + * thread::rwmutex rlock <mutexHandle> + * thread::rwmutex wlock <mutexHandle> + * thread::rwmutex unlock <mutexHandle> + */ + + if (objc < 2) { + Tcl_WrongNumArgs(interp, 1, objv, "option ?args?"); + return TCL_ERROR; + } + ret = Tcl_GetIndexFromObjStruct(interp, objv[1], cmdOpts, sizeof(char *), "option", 0, &opt); + if (ret != TCL_OK) { + return TCL_ERROR; + } + + /* + * Cover the "create" option first, since it needs no existing name. + */ + + if (opt == (int)w_CREATE) { + Tcl_Obj *nameObj; + if (objc > 2) { + Tcl_WrongNumArgs(interp, 1, objv, "create"); + return TCL_ERROR; + } + mutexPtr = (SpMutex*)ckalloc(sizeof(SpMutex)); + mutexPtr->type = WMUTEXID; + mutexPtr->refcnt = 0; + mutexPtr->bucket = NULL; + mutexPtr->hentry = NULL; + mutexPtr->lock = NULL; /* Will be auto-initialized */ + + nameObj = GetName(mutexPtr->type, (void*)mutexPtr); + mutexName = Tcl_GetString(nameObj); + AddMutex(mutexName, nameObj->length, mutexPtr); + Tcl_SetObjResult(interp, nameObj); + return TCL_OK; + } + + /* + * All other options require a valid name. + */ + + if (objc != 3) { + Tcl_WrongNumArgs(interp, 2, objv, "mutexHandle"); + return TCL_ERROR; + } + + mutexName = Tcl_GetString(objv[2]); + nameLen = objv[2]->length; + + /* + * Try mutex destroy + */ + + if (opt == (int)w_DESTROY) { + ret = RemoveMutex(mutexName, nameLen); + if (ret <= 0) { + if (ret == -1) { + notfound: + Tcl_AppendResult(interp, "no such mutex \"", mutexName, + "\"", NULL); + return TCL_ERROR; + } else { + Tcl_AppendResult(interp, "mutex is in use", NULL); + return TCL_ERROR; + } + } + return TCL_OK; + } + + /* + * Try all other options + */ + + mutexPtr = GetMutex(mutexName, nameLen); + if (mutexPtr == NULL) { + goto notfound; + } + if (!IsReadWrite(mutexPtr)) { + PutMutex(mutexPtr); + Tcl_AppendResult(interp, "wrong mutex type, must be readwrite", NULL); + return TCL_ERROR; + } + + lockPtr = &mutexPtr->lock; + rwPtr = (Sp_ReadWriteMutex*) lockPtr; + + switch ((enum options)opt) { + case w_RLOCK: + if (!Sp_ReadWriteMutexRLock(rwPtr)) { + PutMutex(mutexPtr); + Tcl_AppendResult(interp, "read-locking already write-locked mutex ", + "from the same thread", NULL); + return TCL_ERROR; + } + break; + case w_WLOCK: + if (!Sp_ReadWriteMutexWLock(rwPtr)) { + PutMutex(mutexPtr); + Tcl_AppendResult(interp, "write-locking the same read-write " + "mutex twice from the same thread", NULL); + return TCL_ERROR; + } + break; + case w_UNLOCK: + if (!Sp_ReadWriteMutexUnlock(rwPtr)) { + PutMutex(mutexPtr); + Tcl_AppendResult(interp, "mutex is not locked", NULL); + return TCL_ERROR; + } + break; + default: + break; + } + + PutMutex(mutexPtr); + + return TCL_OK; +} + + +/* + *---------------------------------------------------------------------- + * + * ThreadCondObjCmd -- + * + * This procedure is invoked to process "thread::cond" Tcl command. + * See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ + +static int +ThreadCondObjCmd(dummy, interp, objc, objv) + ClientData dummy; /* Not used. */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *const objv[]; /* Argument objects. */ +{ + int opt, ret, timeMsec = 0; + size_t nameLen; + const char *condvName, *mutexName; + SpMutex *mutexPtr; + SpCondv *condvPtr; + + static const char *cmdOpts[] = { + "create", "destroy", "notify", "wait", NULL + }; + enum options { + c_CREATE, c_DESTROY, c_NOTIFY, c_WAIT + }; + + /* + * Syntax: + * + * thread::cond create + * thread::cond destroy <condHandle> + * thread::cond notify <condHandle> + * thread::cond wait <condHandle> <mutexHandle> ?timeout? + */ + + if (objc < 2) { + Tcl_WrongNumArgs(interp, 1, objv, "option ?args?"); + return TCL_ERROR; + } + ret = Tcl_GetIndexFromObjStruct(interp, objv[1], cmdOpts, sizeof(char *), "option", 0, &opt); + if (ret != TCL_OK) { + return TCL_ERROR; + } + + /* + * Cover the "create" option since it needs no existing name. + */ + + if (opt == (int)c_CREATE) { + Tcl_Obj *nameObj; + if (objc > 2) { + Tcl_WrongNumArgs(interp, 1, objv, "create"); + return TCL_ERROR; + } + condvPtr = (SpCondv*)ckalloc(sizeof(SpCondv)); + condvPtr->refcnt = 0; + condvPtr->bucket = NULL; + condvPtr->hentry = NULL; + condvPtr->mutex = NULL; + condvPtr->cond = NULL; /* Will be auto-initialized */ + + nameObj = GetName(CONDVID, (void*)condvPtr); + condvName = Tcl_GetString(nameObj); + AddCondv(condvName, nameObj->length, condvPtr); + Tcl_SetObjResult(interp, nameObj); + return TCL_OK; + } + + /* + * All others require at least a valid handle. + */ + + if (objc < 3) { + Tcl_WrongNumArgs(interp, 2, objv, "condHandle ?args?"); + return TCL_ERROR; + } + + condvName = Tcl_GetString(objv[2]); + nameLen = objv[2]->length; + + /* + * Try variable destroy. + */ + + if (opt == (int)c_DESTROY) { + ret = RemoveCondv(condvName, nameLen); + if (ret <= 0) { + if (ret == -1) { + notfound: + Tcl_AppendResult(interp, "no such condition variable \"", + condvName, "\"", NULL); + return TCL_ERROR; + } else { + Tcl_AppendResult(interp, "condition variable is in use", NULL); + return TCL_ERROR; + } + } + return TCL_OK; + } + + /* + * Try all other options + */ + + condvPtr = GetCondv(condvName, nameLen); + if (condvPtr == NULL) { + goto notfound; + } + + switch ((enum options)opt) { + case c_WAIT: + + /* + * May improve the Tcl_ConditionWait() to report timeouts so we can + * inform script programmer about this interesting fact. I think + * there is still a place for something like Tcl_ConditionWaitEx() + * or similar in the core. + */ + + if (objc < 4 || objc > 5) { + PutCondv(condvPtr); + Tcl_WrongNumArgs(interp, 2, objv, "condHandle mutexHandle ?timeout?"); + return TCL_ERROR; + } + if (objc == 5) { + if (Tcl_GetIntFromObj(interp, objv[4], &timeMsec) != TCL_OK) { + PutCondv(condvPtr); + return TCL_ERROR; + } + } + mutexName = Tcl_GetString(objv[3]); + mutexPtr = GetMutex(mutexName, objv[3]->length); + if (mutexPtr == NULL) { + PutCondv(condvPtr); + Tcl_AppendResult(interp, "no such mutex \"",mutexName,"\"", NULL); + return TCL_ERROR; + } + if (!IsExclusive(mutexPtr) + || SpCondvWait(condvPtr, mutexPtr, timeMsec) == 0) { + PutCondv(condvPtr); + PutMutex(mutexPtr); + Tcl_AppendResult(interp, "mutex not locked or wrong type", NULL); + return TCL_ERROR; + } + PutMutex(mutexPtr); + break; + case c_NOTIFY: + SpCondvNotify(condvPtr); + break; + default: + break; + } + + PutCondv(condvPtr); + + return TCL_OK; +} +/* + *---------------------------------------------------------------------- + * + * ThreadEvalObjCmd -- + * + * This procedure is invoked to process "thread::eval" Tcl command. + * See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ + +static int +ThreadEvalObjCmd(dummy, interp, objc, objv) + ClientData dummy; /* Not used. */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *const objv[]; /* Argument objects. */ +{ + int ret, optx, internal; + const char *mutexName; + Tcl_Obj *scriptObj; + SpMutex *mutexPtr = NULL; + static Sp_RecursiveMutex evalMutex; + + /* + * Syntax: + * + * thread::eval ?-lock <mutexHandle>? arg ?arg ...? + */ + + if (objc < 2) { + syntax: + Tcl_WrongNumArgs(interp, 1, objv, + "?-lock <mutexHandle>? arg ?arg...?"); + return TCL_ERROR; + } + + /* + * Find out wether to use the internal (recursive) mutex + * or external mutex given on the command line, and lock + * the corresponding mutex immediately. + * + * We are using recursive internal mutex so we can easily + * support the recursion w/o danger of deadlocking. If + * however, user gives us an exclusive mutex, we will + * throw error on attempt to recursively call us. + */ + + if (OPT_CMP(Tcl_GetString(objv[1]), "-lock") == 0) { + internal = 1; + optx = 1; + Sp_RecursiveMutexLock(&evalMutex); + } else { + internal = 0; + optx = 3; + if ((objc - optx) < 1) { + goto syntax; + } + mutexName = Tcl_GetString(objv[2]); + mutexPtr = GetMutex(mutexName, objv[2]->length); + if (mutexPtr == NULL) { + Tcl_AppendResult(interp, "no such mutex \"",mutexName,"\"", NULL); + return TCL_ERROR; + } + if (IsReadWrite(mutexPtr)) { + Tcl_AppendResult(interp, "wrong mutex type, must be exclusive " + "or recursive", NULL); + return TCL_ERROR; + } + if (!SpMutexLock(mutexPtr)) { + Tcl_AppendResult(interp, "locking the same exclusive mutex " + "twice from the same thread", NULL); + return TCL_ERROR; + } + } + + objc -= optx; + + /* + * Evaluate passed arguments as Tcl script. Note that + * Tcl_EvalObjEx throws away the passed object by + * doing an decrement reference count on it. This also + * means we need not build object bytecode rep. + */ + + if (objc == 1) { + scriptObj = Tcl_DuplicateObj(objv[optx]); + } else { + scriptObj = Tcl_ConcatObj(objc, objv + optx); + } + + Tcl_IncrRefCount(scriptObj); + ret = Tcl_EvalObjEx(interp, scriptObj, TCL_EVAL_DIRECT); + Tcl_DecrRefCount(scriptObj); + + if (ret == TCL_ERROR) { + char msg[32 + TCL_INTEGER_SPACE]; + /* Next line generates a Deprecation warning when compiled with Tcl 8.6. + * See Tcl bug #3562640 */ + sprintf(msg, "\n (\"eval\" body line %d)", Tcl_GetErrorLine(interp)); + Tcl_AddErrorInfo(interp, msg); + } + + /* + * Unlock the mutex. + */ + + if (internal) { + Sp_RecursiveMutexUnlock(&evalMutex); + } else { + SpMutexUnlock(mutexPtr); + } + + return ret; +} + +/* + *---------------------------------------------------------------------- + * + * GetName -- + * + * Construct a Tcl name for the given sync primitive. + * The name is in the simple counted form: XidN + * where "X" designates the type of the primitive + * and "N" is a increasing integer. + * + * Results: + * Tcl string object with the constructed name. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static Tcl_Obj* +GetName(int type, void *addrPtr) +{ + char name[32]; + unsigned int id; + static unsigned int idcounter; + + Tcl_MutexLock(&initMutex); + id = idcounter++; + Tcl_MutexUnlock(&initMutex); + + sprintf(name, "%cid%d", type, id); + + return Tcl_NewStringObj(name, -1); +} + +/* + *---------------------------------------------------------------------- + * + * GetBucket -- + * + * Returns the bucket for the given name. + * + * Results: + * Pointer to the bucket. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static SpBucket* +GetBucket(int type, const char *name, size_t len) +{ + switch (type) { + case SP_MUTEX: return &muxBuckets[GetHash(name, len)]; + case SP_CONDV: return &varBuckets[GetHash(name, len)]; + } + + return NULL; /* Never reached */ +} + +/* + *---------------------------------------------------------------------- + * + * GetAnyItem -- + * + * Retrieves the item structure from it's corresponding bucket. + * + * Results: + * Item pointer or NULL + * + * Side effects: + * Increment the item's ref count preventing it's deletion. + * + *---------------------------------------------------------------------- + */ + +static SpItem* +GetAnyItem(int type, const char *name, size_t len) +{ + SpItem *itemPtr = NULL; + SpBucket *bucketPtr = GetBucket(type, name, len); + Tcl_HashEntry *hashEntryPtr = NULL; + + Tcl_MutexLock(&bucketPtr->lock); + hashEntryPtr = Tcl_FindHashEntry(&bucketPtr->handles, name); + if (hashEntryPtr != (Tcl_HashEntry*)NULL) { + itemPtr = (SpItem*)Tcl_GetHashValue(hashEntryPtr); + itemPtr->refcnt++; + } + Tcl_MutexUnlock(&bucketPtr->lock); + + return itemPtr; +} + +/* + *---------------------------------------------------------------------- + * + * PutAnyItem -- + * + * Current thread detaches from the item. + * + * Results: + * None. + * + * Side effects: + * Decrement item's ref count allowing for it's deletion + * and signalize any threads waiting to delete the item. + * + *---------------------------------------------------------------------- + */ + +static void +PutAnyItem(SpItem *itemPtr) +{ + Tcl_MutexLock(&itemPtr->bucket->lock); + itemPtr->refcnt--; + Tcl_ConditionNotify(&itemPtr->bucket->cond); + Tcl_MutexUnlock(&itemPtr->bucket->lock); +} + +/* + *---------------------------------------------------------------------- + * + * AddAnyItem -- + * + * Puts any item in the corresponding bucket. + * + * Results: + * None. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static void +AddAnyItem(int type, const char *handle, size_t len, SpItem *itemPtr) +{ + int new; + SpBucket *bucketPtr = GetBucket(type, handle, len); + Tcl_HashEntry *hashEntryPtr; + + Tcl_MutexLock(&bucketPtr->lock); + + hashEntryPtr = Tcl_CreateHashEntry(&bucketPtr->handles, handle, &new); + Tcl_SetHashValue(hashEntryPtr, (ClientData)itemPtr); + + itemPtr->refcnt = 0; + itemPtr->bucket = bucketPtr; + itemPtr->hentry = hashEntryPtr; + + Tcl_MutexUnlock(&bucketPtr->lock); +} + +/* + *---------------------------------------------------------------------- + * + * RemoveAnyItem -- + * + * Removes the item from it's bucket. + * + * Results: + * Item's pointer or NULL if none found. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static SpItem * +RemoveAnyItem(int type, const char *name, size_t len) +{ + SpItem *itemPtr = NULL; + SpBucket *bucketPtr = GetBucket(type, name, len); + Tcl_HashEntry *hashEntryPtr = NULL; + + Tcl_MutexLock(&bucketPtr->lock); + hashEntryPtr = Tcl_FindHashEntry(&bucketPtr->handles, name); + if (hashEntryPtr == (Tcl_HashEntry*)NULL) { + Tcl_MutexUnlock(&bucketPtr->lock); + return NULL; + } + itemPtr = (SpItem*)Tcl_GetHashValue(hashEntryPtr); + Tcl_DeleteHashEntry(hashEntryPtr); + while (itemPtr->refcnt > 0) { + Tcl_ConditionWait(&bucketPtr->cond, &bucketPtr->lock, NULL); + } + Tcl_MutexUnlock(&bucketPtr->lock); + + return itemPtr; +} + +/* + *---------------------------------------------------------------------- + * + * RemoveMutex -- + * + * Removes the mutex from it's bucket and finalizes it. + * + * Results: + * 1 - mutex is finalized and removed + * 0 - mutex is not finalized + + -1 - mutex is not found + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static int +RemoveMutex(const char *name, size_t len) +{ + SpMutex *mutexPtr = GetMutex(name, len); + if (mutexPtr == NULL) { + return -1; + } + if (!SpMutexFinalize(mutexPtr)) { + PutMutex(mutexPtr); + return 0; + } + PutMutex(mutexPtr); + RemoveAnyItem(SP_MUTEX, name, len); + ckfree((char*)mutexPtr); + + return 1; +} + +/* + *---------------------------------------------------------------------- + * + * RemoveCondv -- + * + * Removes the cond variable from it's bucket and finalizes it. + * + * Results: + * 1 - variable is finalized and removed + * 0 - variable is not finalized + + -1 - variable is not found + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static int +RemoveCondv(const char *name, size_t len) +{ + SpCondv *condvPtr = GetCondv(name, len); + if (condvPtr == NULL) { + return -1; + } + if (!SpCondvFinalize(condvPtr)) { + PutCondv(condvPtr); + return 0; + } + PutCondv(condvPtr); + RemoveAnyItem(SP_CONDV, name, len); + ckfree((char*)condvPtr); + + return 1; +} + +/* + *---------------------------------------------------------------------- + * + * Sp_Init -- + * + * Create commands in current interpreter. + * + * Results: + * Standard Tcl result. + * + * Side effects: + * Initializes shared hash table for storing sync primitive + * handles and pointers. + * + *---------------------------------------------------------------------- + */ + +int +Sp_Init (interp) + Tcl_Interp *interp; /* Interp where to create cmds */ +{ + SpBucket *bucketPtr; + + if (!initOnce) { + Tcl_MutexLock(&initMutex); + if (!initOnce) { + int ii; + for (ii = 0; ii < NUMSPBUCKETS; ii++) { + bucketPtr = &muxBuckets[ii]; + memset(bucketPtr, 0, sizeof(SpBucket)); + Tcl_InitHashTable(&bucketPtr->handles, TCL_STRING_KEYS); + } + for (ii = 0; ii < NUMSPBUCKETS; ii++) { + bucketPtr = &varBuckets[ii]; + memset(bucketPtr, 0, sizeof(SpBucket)); + Tcl_InitHashTable(&bucketPtr->handles, TCL_STRING_KEYS); + } + initOnce = 1; + } + Tcl_MutexUnlock(&initMutex); + } + + TCL_CMD(interp, THREAD_CMD_PREFIX"::mutex", ThreadMutexObjCmd); + TCL_CMD(interp, THREAD_CMD_PREFIX"::rwmutex", ThreadRWMutexObjCmd); + TCL_CMD(interp, THREAD_CMD_PREFIX"::cond", ThreadCondObjCmd); + TCL_CMD(interp, THREAD_CMD_PREFIX"::eval", ThreadEvalObjCmd); + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * SpMutexLock -- + * + * Locks the typed mutex. + * + * Results: + * 1 - mutex is locked + * 0 - mutex is not locked (pending deadlock?) + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static int +SpMutexLock(SpMutex *mutexPtr) +{ + Sp_AnyMutex **lockPtr = &mutexPtr->lock; + + switch (mutexPtr->type) { + case EMUTEXID: + return Sp_ExclusiveMutexLock((Sp_ExclusiveMutex*)lockPtr); + break; + case RMUTEXID: + return Sp_RecursiveMutexLock((Sp_RecursiveMutex*)lockPtr); + break; + } + + return 0; +} + +/* + *---------------------------------------------------------------------- + * + * SpMutexUnlock -- + * + * Unlocks the typed mutex. + * + * Results: + * 1 - mutex is unlocked + * 0 - mutex was not locked + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static int +SpMutexUnlock(SpMutex *mutexPtr) +{ + Sp_AnyMutex **lockPtr = &mutexPtr->lock; + + switch (mutexPtr->type) { + case EMUTEXID: + return Sp_ExclusiveMutexUnlock((Sp_ExclusiveMutex*)lockPtr); + break; + case RMUTEXID: + return Sp_RecursiveMutexUnlock((Sp_RecursiveMutex*)lockPtr); + break; + } + + return 0; +} + +/* + *---------------------------------------------------------------------- + * + * SpMutexFinalize -- + * + * Finalizes the typed mutex. This should never be called without + * some external mutex protection. + * + * Results: + * 1 - mutex is finalized + * 0 - mutex is still in use + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static int +SpMutexFinalize(SpMutex *mutexPtr) +{ + Sp_AnyMutex **lockPtr = &mutexPtr->lock; + + if (AnyMutexIsLocked((Sp_AnyMutex*)mutexPtr->lock, (Tcl_ThreadId)0)) { + return 0; + } + + /* + * At this point, the mutex could be locked again, hence it + * is important never to call this function unprotected. + */ + + switch (mutexPtr->type) { + case EMUTEXID: + Sp_ExclusiveMutexFinalize((Sp_ExclusiveMutex*)lockPtr); + break; + case RMUTEXID: + Sp_RecursiveMutexFinalize((Sp_RecursiveMutex*)lockPtr); + break; + case WMUTEXID: + Sp_ReadWriteMutexFinalize((Sp_ReadWriteMutex*)lockPtr); + break; + default: + break; + } + + return 1; +} + +/* + *---------------------------------------------------------------------- + * + * SpCondvWait -- + * + * Waits on the condition variable. + * + * Results: + * 1 - wait ok + * 0 - not waited as mutex is not locked in the same thread + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static int +SpCondvWait(SpCondv *condvPtr, SpMutex *mutexPtr, int msec) +{ + Sp_AnyMutex **lock = &mutexPtr->lock; + Sp_ExclusiveMutex_ *emPtr = *(Sp_ExclusiveMutex_**)lock; + Tcl_Time waitTime, *wt = NULL; + Tcl_ThreadId threadId = Tcl_GetCurrentThread(); + + if (msec > 0) { + wt = &waitTime; + wt->sec = (msec/1000); + wt->usec = (msec%1000) * 1000; + } + if (!AnyMutexIsLocked((Sp_AnyMutex*)mutexPtr->lock, threadId)) { + return 0; /* Mutex not locked by the current thread */ + } + + /* + * It is safe to operate on mutex struct because caller + * is holding the emPtr->mutex locked before we enter + * the Tcl_ConditionWait and after we return out of it. + */ + + condvPtr->mutex = mutexPtr; + + emPtr->owner = (Tcl_ThreadId)0; + emPtr->lockcount = 0; + + Tcl_ConditionWait(&condvPtr->cond, &emPtr->mutex, wt); + + emPtr->owner = threadId; + emPtr->lockcount = 1; + + condvPtr->mutex = NULL; + + return 1; +} + +/* + *---------------------------------------------------------------------- + * + * SpCondvNotify -- + * + * Signalizes the condition variable. + * + * Results: + * None. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static void +SpCondvNotify(SpCondv *condvPtr) +{ + if (condvPtr->cond) { + Tcl_ConditionNotify(&condvPtr->cond); + } +} + +/* + *---------------------------------------------------------------------- + * + * SpCondvFinalize -- + * + * Finalizes the condition variable. + * + * Results: + * 1 - variable is finalized + * 0 - variable is in use + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static int +SpCondvFinalize(SpCondv *condvPtr) +{ + if (condvPtr->mutex != NULL) { + return 0; /* Somebody is waiting on the variable */ + } + + if (condvPtr->cond) { + Tcl_ConditionFinalize(&condvPtr->cond); + } + + return 1; +} + +/* + *---------------------------------------------------------------------- + * + * Sp_ExclusiveMutexLock -- + * + * Locks the exclusive mutex. + * + * Results: + * 1 - mutex is locked + * 0 - mutex is not locked; same thread tries to locks twice + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +int +Sp_ExclusiveMutexLock(Sp_ExclusiveMutex *muxPtr) +{ + Sp_ExclusiveMutex_ *emPtr; + Tcl_ThreadId thisThread = Tcl_GetCurrentThread(); + + /* + * Allocate the mutex structure on first access + */ + + if (*muxPtr == (Sp_ExclusiveMutex_*)0) { + Tcl_MutexLock(&initMutex); + if (*muxPtr == (Sp_ExclusiveMutex_*)0) { + *muxPtr = (Sp_ExclusiveMutex_*) + ckalloc(sizeof(Sp_ExclusiveMutex_)); + memset(*muxPtr, 0, sizeof(Sp_ExclusiveMutex_)); + } + Tcl_MutexUnlock(&initMutex); + } + + /* + * Try locking if not currently locked by anybody. + */ + + emPtr = *(Sp_ExclusiveMutex_**)muxPtr; + Tcl_MutexLock(&emPtr->lock); + if (emPtr->lockcount && emPtr->owner == thisThread) { + Tcl_MutexUnlock(&emPtr->lock); + return 0; /* Already locked by the same thread */ + } + Tcl_MutexUnlock(&emPtr->lock); + + /* + * Many threads can come to this point. + * Only one will succeed locking the + * mutex. Others will block... + */ + + Tcl_MutexLock(&emPtr->mutex); + + Tcl_MutexLock(&emPtr->lock); + emPtr->owner = thisThread; + emPtr->lockcount = 1; + Tcl_MutexUnlock(&emPtr->lock); + + return 1; +} + +/* + *---------------------------------------------------------------------- + * + * Sp_ExclusiveMutexIsLocked -- + * + * Checks wether the mutex is locked or not. + * + * Results: + * 1 - mutex is locked + * 0 - mutex is not locked + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +int +Sp_ExclusiveMutexIsLocked(Sp_ExclusiveMutex *muxPtr) +{ + return AnyMutexIsLocked((Sp_AnyMutex*)*muxPtr, (Tcl_ThreadId)0); +} + +/* + *---------------------------------------------------------------------- + * + * Sp_ExclusiveMutexUnlock -- + * + * Unlock the exclusive mutex. + * + * Results: + * 1 - mutex is unlocked + ? 0 - mutex was never locked + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +int +Sp_ExclusiveMutexUnlock(Sp_ExclusiveMutex *muxPtr) +{ + Sp_ExclusiveMutex_ *emPtr; + + if (*muxPtr == (Sp_ExclusiveMutex_*)0) { + return 0; /* Never locked before */ + } + + emPtr = *(Sp_ExclusiveMutex_**)muxPtr; + + Tcl_MutexLock(&emPtr->lock); + if (emPtr->lockcount == 0) { + Tcl_MutexUnlock(&emPtr->lock); + return 0; /* Not locked */ + } + emPtr->owner = (Tcl_ThreadId)0; + emPtr->lockcount = 0; + Tcl_MutexUnlock(&emPtr->lock); + + /* + * Only one thread should be able + * to come to this point and unlock... + */ + + Tcl_MutexUnlock(&emPtr->mutex); + + return 1; +} + +/* + *---------------------------------------------------------------------- + * + * Sp_ExclusiveMutexFinalize -- + * + * Finalize the exclusive mutex. It is not safe for two or + * more threads to finalize the mutex at the same time. + * + * Results: + * None. + * + * Side effects: + * Mutex is destroyed. + * + *---------------------------------------------------------------------- + */ + +void +Sp_ExclusiveMutexFinalize(Sp_ExclusiveMutex *muxPtr) +{ + if (*muxPtr != (Sp_ExclusiveMutex_*)0) { + Sp_ExclusiveMutex_ *emPtr = *(Sp_ExclusiveMutex_**)muxPtr; + if (emPtr->lock) { + Tcl_MutexFinalize(&emPtr->lock); + } + if (emPtr->mutex) { + Tcl_MutexFinalize(&emPtr->mutex); + } + ckfree((char*)*muxPtr); + } +} + +/* + *---------------------------------------------------------------------- + * + * Sp_RecursiveMutexLock -- + * + * Locks the recursive mutex. + * + * Results: + * 1 - mutex is locked (as it always should be) + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +int +Sp_RecursiveMutexLock(Sp_RecursiveMutex *muxPtr) +{ + Sp_RecursiveMutex_ *rmPtr; + Tcl_ThreadId thisThread = Tcl_GetCurrentThread(); + + /* + * Allocate the mutex structure on first access + */ + + if (*muxPtr == (Sp_RecursiveMutex_*)0) { + Tcl_MutexLock(&initMutex); + if (*muxPtr == (Sp_RecursiveMutex_*)0) { + *muxPtr = (Sp_RecursiveMutex_*) + ckalloc(sizeof(Sp_RecursiveMutex_)); + memset(*muxPtr, 0, sizeof(Sp_RecursiveMutex_)); + } + Tcl_MutexUnlock(&initMutex); + } + + rmPtr = *(Sp_RecursiveMutex_**)muxPtr; + Tcl_MutexLock(&rmPtr->lock); + + if (rmPtr->owner == thisThread) { + /* + * We are already holding the mutex + * so just count one more lock. + */ + rmPtr->lockcount++; + } else { + if (rmPtr->owner == (Tcl_ThreadId)0) { + /* + * Nobody holds the mutex, we do now. + */ + rmPtr->owner = thisThread; + rmPtr->lockcount = 1; + } else { + /* + * Somebody else holds the mutex; wait. + */ + while (1) { + Tcl_ConditionWait(&rmPtr->cond, &rmPtr->lock, NULL); + if (rmPtr->owner == (Tcl_ThreadId)0) { + rmPtr->owner = thisThread; + rmPtr->lockcount = 1; + break; + } + } + } + } + + Tcl_MutexUnlock(&rmPtr->lock); + + return 1; +} + +/* + *---------------------------------------------------------------------- + * + * Sp_RecursiveMutexIsLocked -- + * + * Checks wether the mutex is locked or not. + * + * Results: + * 1 - mutex is locked + * 0 - mutex is not locked + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +int +Sp_RecursiveMutexIsLocked(Sp_RecursiveMutex *muxPtr) +{ + return AnyMutexIsLocked((Sp_AnyMutex*)*muxPtr, (Tcl_ThreadId)0); +} + +/* + *---------------------------------------------------------------------- + * + * Sp_RecursiveMutexUnlock -- + * + * Unlock the recursive mutex. + * + * Results: + * 1 - mutex unlocked + * 0 - mutex never locked + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +int +Sp_RecursiveMutexUnlock(Sp_RecursiveMutex *muxPtr) +{ + Sp_RecursiveMutex_ *rmPtr; + + if (*muxPtr == (Sp_RecursiveMutex_*)0) { + return 0; /* Never locked before */ + } + + rmPtr = *(Sp_RecursiveMutex_**)muxPtr; + Tcl_MutexLock(&rmPtr->lock); + if (rmPtr->lockcount == 0) { + Tcl_MutexUnlock(&rmPtr->lock); + return 0; /* Not locked now */ + } + if (--rmPtr->lockcount <= 0) { + rmPtr->lockcount = 0; + rmPtr->owner = (Tcl_ThreadId)0; + if (rmPtr->cond) { + Tcl_ConditionNotify(&rmPtr->cond); + } + } + Tcl_MutexUnlock(&rmPtr->lock); + + return 1; +} + +/* + *---------------------------------------------------------------------- + * + * Sp_RecursiveMutexFinalize -- + * + * Finalize the recursive mutex. It is not safe for two or + * more threads to finalize the mutex at the same time. + * + * Results: + * None. + * + * Side effects: + * Mutex is destroyed. + * + *---------------------------------------------------------------------- + */ + +void +Sp_RecursiveMutexFinalize(Sp_RecursiveMutex *muxPtr) +{ + if (*muxPtr != (Sp_RecursiveMutex_*)0) { + Sp_RecursiveMutex_ *rmPtr = *(Sp_RecursiveMutex_**)muxPtr; + if (rmPtr->lock) { + Tcl_MutexFinalize(&rmPtr->lock); + } + if (rmPtr->cond) { + Tcl_ConditionFinalize(&rmPtr->cond); + } + ckfree((char*)*muxPtr); + } +} + +/* + *---------------------------------------------------------------------- + * + * Sp_ReadWriteMutexRLock -- + * + * Read-locks the reader/writer mutex. + * + * Results: + * 1 - mutex is locked + * 0 - mutex is not locked as we already hold the write lock + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +int +Sp_ReadWriteMutexRLock(Sp_ReadWriteMutex *muxPtr) +{ + Sp_ReadWriteMutex_ *rwPtr; + Tcl_ThreadId thisThread = Tcl_GetCurrentThread(); + + /* + * Allocate the mutex structure on first access + */ + + if (*muxPtr == (Sp_ReadWriteMutex_*)0) { + Tcl_MutexLock(&initMutex); + if (*muxPtr == (Sp_ReadWriteMutex_*)0) { + *muxPtr = (Sp_ReadWriteMutex_*) + ckalloc(sizeof(Sp_ReadWriteMutex_)); + memset(*muxPtr, 0, sizeof(Sp_ReadWriteMutex_)); + } + Tcl_MutexUnlock(&initMutex); + } + + rwPtr = *(Sp_ReadWriteMutex_**)muxPtr; + Tcl_MutexLock(&rwPtr->lock); + if (rwPtr->lockcount == -1 && rwPtr->owner == thisThread) { + Tcl_MutexUnlock(&rwPtr->lock); + return 0; /* We already hold the write lock */ + } + while (rwPtr->lockcount < 0) { + rwPtr->numrd++; + Tcl_ConditionWait(&rwPtr->rcond, &rwPtr->lock, NULL); + rwPtr->numrd--; + } + rwPtr->lockcount++; + rwPtr->owner = (Tcl_ThreadId)0; /* Many threads can read-lock */ + Tcl_MutexUnlock(&rwPtr->lock); + + return 1; +} + +/* + *---------------------------------------------------------------------- + * + * Sp_ReadWriteMutexWLock -- + * + * Write-locks the reader/writer mutex. + * + * Results: + * 1 - mutex is locked + * 0 - same thread attempts to write-lock the mutex twice + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +int +Sp_ReadWriteMutexWLock(Sp_ReadWriteMutex *muxPtr) +{ + Sp_ReadWriteMutex_ *rwPtr; + Tcl_ThreadId thisThread = Tcl_GetCurrentThread(); + + /* + * Allocate the mutex structure on first access + */ + + if (*muxPtr == (Sp_ReadWriteMutex_*)0) { + Tcl_MutexLock(&initMutex); + if (*muxPtr == (Sp_ReadWriteMutex_*)0) { + *muxPtr = (Sp_ReadWriteMutex_*) + ckalloc(sizeof(Sp_ReadWriteMutex_)); + memset(*muxPtr, 0, sizeof(Sp_ReadWriteMutex_)); + } + Tcl_MutexUnlock(&initMutex); + } + + rwPtr = *(Sp_ReadWriteMutex_**)muxPtr; + Tcl_MutexLock(&rwPtr->lock); + if (rwPtr->owner == thisThread && rwPtr->lockcount == -1) { + Tcl_MutexUnlock(&rwPtr->lock); + return 0; /* The same thread attempts to write-lock again */ + } + while (rwPtr->lockcount != 0) { + rwPtr->numwr++; + Tcl_ConditionWait(&rwPtr->wcond, &rwPtr->lock, NULL); + rwPtr->numwr--; + } + rwPtr->lockcount = -1; /* This designates the sole writer */ + rwPtr->owner = thisThread; /* which is our current thread */ + Tcl_MutexUnlock(&rwPtr->lock); + + return 1; +} + +/* + *---------------------------------------------------------------------- + * + * Sp_ReadWriteMutexIsLocked -- + * + * Checks wether the mutex is locked or not. + * + * Results: + * 1 - mutex is locked + * 0 - mutex is not locked + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +int +Sp_ReadWriteMutexIsLocked(Sp_ReadWriteMutex *muxPtr) +{ + return AnyMutexIsLocked((Sp_AnyMutex*)*muxPtr, (Tcl_ThreadId)0); +} + +/* + *---------------------------------------------------------------------- + * + * Sp_ReadWriteMutexUnlock -- + * + * Unlock the reader/writer mutex. + * + * Results: + * None. + * + * Side effects: + * + *---------------------------------------------------------------------- + */ + +int +Sp_ReadWriteMutexUnlock(Sp_ReadWriteMutex *muxPtr) +{ + Sp_ReadWriteMutex_ *rwPtr; + + if (*muxPtr == (Sp_ReadWriteMutex_*)0) { + return 0; /* Never locked before */ + } + + rwPtr = *(Sp_ReadWriteMutex_**)muxPtr; + Tcl_MutexLock(&rwPtr->lock); + if (rwPtr->lockcount == 0) { + Tcl_MutexUnlock(&rwPtr->lock); + return 0; /* Not locked now */ + } + if (--rwPtr->lockcount <= 0) { + rwPtr->lockcount = 0; + rwPtr->owner = (Tcl_ThreadId)0; + } + if (rwPtr->numwr) { + Tcl_ConditionNotify(&rwPtr->wcond); + } else if (rwPtr->numrd) { + Tcl_ConditionNotify(&rwPtr->rcond); + } + + Tcl_MutexUnlock(&rwPtr->lock); + + return 1; +} + +/* + *---------------------------------------------------------------------- + * + * Sp_ReadWriteMutexFinalize -- + * + * Finalize the reader/writer mutex. It is not safe for two or + * more threads to finalize the mutex at the same time. + * + * Results: + * None. + * + * Side effects: + * Mutex is destroyed. + * + *---------------------------------------------------------------------- + */ + +void +Sp_ReadWriteMutexFinalize(Sp_ReadWriteMutex *muxPtr) +{ + if (*muxPtr != (Sp_ReadWriteMutex_*)0) { + Sp_ReadWriteMutex_ *rwPtr = *(Sp_ReadWriteMutex_**)muxPtr; + if (rwPtr->lock) { + Tcl_MutexFinalize(&rwPtr->lock); + } + if (rwPtr->rcond) { + Tcl_ConditionFinalize(&rwPtr->rcond); + } + if (rwPtr->wcond) { + Tcl_ConditionFinalize(&rwPtr->wcond); + } + ckfree((char*)*muxPtr); + } +} + +/* + *---------------------------------------------------------------------- + * + * AnyMutexIsLocked -- + * + * Checks wether the mutex is locked. If optional threadId + * is given (i.e. != 0) it checks if the given thread also + * holds the lock. + * + * Results: + * 1 - mutex is locked (optionally by the given thread) + * 0 - mutex is not locked (optionally by the given thread) + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ +static int +AnyMutexIsLocked(Sp_AnyMutex *mPtr, Tcl_ThreadId threadId) +{ + int locked = 0; + + if (mPtr != NULL) { + Tcl_MutexLock(&mPtr->lock); + locked = mPtr->lockcount != 0; + if (locked && threadId != (Tcl_ThreadId)0) { + locked = mPtr->owner == threadId; + } + Tcl_MutexUnlock(&mPtr->lock); + } + + return locked; +} + + +/* EOF $RCSfile: threadSpCmd.c,v $ */ + +/* Emacs Setup Variables */ +/* Local Variables: */ +/* mode: C */ +/* indent-tabs-mode: nil */ +/* c-basic-offset: 4 */ +/* End: */ diff --git a/tcl8.6/pkgs/thread2.8.4/generic/threadSpCmd.h b/tcl8.6/pkgs/thread2.8.4/generic/threadSpCmd.h new file mode 100644 index 0000000..70fcc4f --- /dev/null +++ b/tcl8.6/pkgs/thread2.8.4/generic/threadSpCmd.h @@ -0,0 +1,128 @@ +/* + * This is the header file for the module that implements some missing + * synchronization priomitives 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: */ diff --git a/tcl8.6/pkgs/thread2.8.4/generic/threadSvCmd.c b/tcl8.6/pkgs/thread2.8.4/generic/threadSvCmd.c new file mode 100644 index 0000000..a54f3b1 --- /dev/null +++ b/tcl8.6/pkgs/thread2.8.4/generic/threadSvCmd.c @@ -0,0 +1,2438 @@ +/* + * This file implements a family of commands for sharing variables + * between threads. + * + * Initial code is taken from nsd/tclvar.c found in AOLserver 3.+ + * distribution and modified to support Tcl 8.0+ command object interface + * and internal storage in private shared Tcl objects. + * + * 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. + * ---------------------------------------------------------------------------- + */ + +#include "tclThreadInt.h" +#include "threadSvCmd.h" + +#include "threadSvListCmd.h" /* Shared variants of list commands */ +#include "threadSvKeylistCmd.h" /* Shared variants of list commands */ +#include "psGdbm.h" /* The gdbm persistent store implementation */ +#include "psLmdb.h" /* The lmdb persistent store implementation */ + +#define SV_FINALIZE + +/* + * Number of buckets to spread shared arrays into. Each bucket is + * associated with one mutex so locking a bucket locks all arrays + * in that bucket as well. The number of buckets should be a prime. + */ + +#define NUMBUCKETS 31 + +/* + * Number of object containers + * to allocate in one shot. + */ + +#define OBJS_TO_ALLOC_EACH_TIME 100 + +/* + * Reference to Tcl object types used in object-copy code. + * Those are referenced read-only, thus no mutex protection. + */ + +static const Tcl_ObjType* booleanObjTypePtr; +static const Tcl_ObjType* byteArrayObjTypePtr; +static const Tcl_ObjType* doubleObjTypePtr; +static const Tcl_ObjType* intObjTypePtr; +static const Tcl_ObjType* wideIntObjTypePtr; +static const Tcl_ObjType* stringObjTypePtr; + +/* + * In order to be fully stub enabled, a small + * hack is needed to query the tclEmptyStringRep + * global symbol defined by Tcl. See Sv_Init. + */ + +static char *Sv_tclEmptyStringRep = NULL; + +/* + * Global variables used within this file. + */ + +#ifdef SV_FINALIZE +static size_t nofThreads; /* Number of initialized threads */ +static Tcl_Mutex nofThreadsMutex; /* Protects the nofThreads variable */ +#endif /* SV_FINALIZE */ + +static Bucket* buckets; /* Array of buckets. */ +static Tcl_Mutex bucketsMutex; /* Protects the array of buckets */ + +static SvCmdInfo* svCmdInfo; /* Linked list of registered commands */ +static RegType* regType; /* Linked list of registered obj types */ +static PsStore* psStore; /* Linked list of registered pers. stores */ + +static Tcl_Mutex svMutex; /* Protects inserts into above lists */ +static Tcl_Mutex initMutex; /* Serializes initialization issues */ + +/* + * The standard commands found in NaviServer/AOLserver nsv_* interface. + * For sharp-eye readers: the implementation of the "lappend" command + * is moved to new list-command package, since it really belongs there. + */ + +static Tcl_ObjCmdProc SvObjObjCmd; +static Tcl_ObjCmdProc SvAppendObjCmd; +static Tcl_ObjCmdProc SvIncrObjCmd; +static Tcl_ObjCmdProc SvSetObjCmd; +static Tcl_ObjCmdProc SvExistsObjCmd; +static Tcl_ObjCmdProc SvGetObjCmd; +static Tcl_ObjCmdProc SvArrayObjCmd; +static Tcl_ObjCmdProc SvUnsetObjCmd; +static Tcl_ObjCmdProc SvNamesObjCmd; +static Tcl_ObjCmdProc SvHandlersObjCmd; + +/* + * New commands added to + * standard set of nsv_* + */ + +static Tcl_ObjCmdProc SvPopObjCmd; +static Tcl_ObjCmdProc SvMoveObjCmd; +static Tcl_ObjCmdProc SvLockObjCmd; + +/* + * Forward declarations for functions to + * manage buckets, arrays and shared objects. + */ + +static Container* CreateContainer(Array*, Tcl_HashEntry*, Tcl_Obj*); +static Container* AcquireContainer(Array*, const char*, int); + +static Array* CreateArray(Bucket*, const char*); +static Array* LockArray(Tcl_Interp*, const char*, int); + +static int ReleaseContainer(Tcl_Interp*, Container*, int); +static int DeleteContainer(Container*); +static int FlushArray(Array*); +static int DeleteArray(Tcl_Interp *, Array*); + +static void SvAllocateContainers(Bucket*); +static void SvRegisterStdCommands(void); + +#ifdef SV_FINALIZE +static void SvFinalizeContainers(Bucket*); +static void SvFinalize(ClientData); +#endif /* SV_FINALIZE */ + +static PsStore* GetPsStore(const char *handle); + +static int SvObjDispatchObjCmd(ClientData arg, + Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); + +/* + *----------------------------------------------------------------------------- + * + * Sv_RegisterCommand -- + * + * Utility to register commands to be loaded at module start. + * + * Results: + * None. + * + * Side effects; + * New command will be added to a linked list of registered commands. + * + *----------------------------------------------------------------------------- + */ + +void +Sv_RegisterCommand( + const char *cmdName, /* Name of command to register */ + Tcl_ObjCmdProc *objProc, /* Object-based command procedure */ + Tcl_CmdDeleteProc *delProc, /* Command delete procedure */ + int aolSpecial) +{ + int len = strlen(cmdName) + strlen(TSV_CMD_PREFIX) + 1; + int len2 = strlen(cmdName) + strlen(TSV_CMD2_PREFIX) + 1; + SvCmdInfo *newCmd = (SvCmdInfo*)ckalloc(sizeof(SvCmdInfo) + len + len2); + + /* + * Setup new command structure + */ + + newCmd->cmdName = (char*)((char*)newCmd + sizeof(SvCmdInfo)); + newCmd->cmdName2 = newCmd->cmdName + len; + newCmd->aolSpecial = aolSpecial; + + newCmd->objProcPtr = objProc; + newCmd->delProcPtr = delProc; + + /* + * Rewrite command name. This is needed so we can + * easily turn-on the compatiblity with NaviServer/AOLserver + * command names. + */ + + strcpy(newCmd->cmdName, TSV_CMD_PREFIX); + strcat(newCmd->cmdName, cmdName); + newCmd->name = newCmd->cmdName + strlen(TSV_CMD_PREFIX); + strcpy(newCmd->cmdName2, TSV_CMD2_PREFIX); + strcat(newCmd->cmdName2, cmdName); + + /* + * Plug-in in shared list of commands. + */ + + Tcl_MutexLock(&svMutex); + if (svCmdInfo == NULL) { + svCmdInfo = newCmd; + newCmd->nextPtr = NULL; + } else { + newCmd->nextPtr = svCmdInfo; + svCmdInfo = newCmd; + } + Tcl_MutexUnlock(&svMutex); + + return; +} + +/* + *----------------------------------------------------------------------------- + * + * Sv_RegisterObjType -- + * + * Registers custom object duplicator function for a specific + * object type. Registered function will be called by the + * private object creation routine every time an object is + * plugged out or in the shared array. This way we assure that + * Tcl objects do not get shared per-reference between threads. + * + * Results: + * None. + * + * Side effects; + * Memory gets allocated. + * + *----------------------------------------------------------------------------- + */ + +void +Sv_RegisterObjType( + const Tcl_ObjType *typePtr, /* Type of object to register */ + Tcl_DupInternalRepProc *dupProc) /* Custom object duplicator */ +{ + RegType *newType = (RegType*)ckalloc(sizeof(RegType)); + + /* + * Setup new type structure + */ + + newType->typePtr = typePtr; + newType->dupIntRepProc = dupProc; + + /* + * Plug-in in shared list + */ + + Tcl_MutexLock(&svMutex); + newType->nextPtr = regType; + regType = newType; + Tcl_MutexUnlock(&svMutex); +} + +/* + *----------------------------------------------------------------------------- + * + * Sv_RegisterPsStore -- + * + * Registers a handler to the persistent storage. + * + * Results: + * None. + * + * Side effects; + * Memory gets allocated. + * + *----------------------------------------------------------------------------- + */ + +void +Sv_RegisterPsStore(const PsStore *psStorePtr) +{ + + PsStore *psPtr = (PsStore*)ckalloc(sizeof(PsStore)); + + *psPtr = *psStorePtr; + + /* + * Plug-in in shared list + */ + + Tcl_MutexLock(&svMutex); + if (psStore == NULL) { + psStore = psPtr; + psStore->nextPtr = NULL; + } else { + psPtr->nextPtr = psStore; + psStore = psPtr; + } + Tcl_MutexUnlock(&svMutex); +} + +/* + *----------------------------------------------------------------------------- + * + * Sv_GetContainer -- + * + * This is the workhorse of the module. It returns the container + * with the shared Tcl object. It also locks the container, so + * when finished with operation on the Tcl object, one has to + * unlock the container by calling the Sv_PutContainer(). + * If instructed, this command might also create new container + * with empty Tcl object. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * New container might be created. + * + *----------------------------------------------------------------------------- + */ + +int +Sv_GetContainer( + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments */ + Tcl_Obj *const objv[], /* Argument objects. */ + Container **retObj, /* OUT: shared object container */ + int *offset, /* Shift in argument list */ + int flags) /* Options for locking shared array */ +{ + const char *array, *key; + + if (*retObj == NULL) { + Array *arrayPtr = NULL; + + /* + * Parse mandatory arguments: <cmd> array key + */ + + if (objc < 3) { + Tcl_WrongNumArgs(interp, 1, objv, "array key ?args?"); + return TCL_ERROR; + } + + array = Tcl_GetString(objv[1]); + key = Tcl_GetString(objv[2]); + + *offset = 3; /* Consumed three arguments: cmd, array, key */ + + /* + * Lock the shared array and locate the shared object + */ + + arrayPtr = LockArray(interp, array, flags); + if (arrayPtr == NULL) { + return TCL_BREAK; + } + *retObj = AcquireContainer(arrayPtr, Tcl_GetString(objv[2]), flags); + if (*retObj == NULL) { + UnlockArray(arrayPtr); + Tcl_AppendResult(interp, "no key ", array, "(", key, ")", NULL); + return TCL_BREAK; + } + } else { + Tcl_HashTable *handles = &((*retObj)->bucketPtr->handles); + LOCK_CONTAINER(*retObj); + if (Tcl_FindHashEntry(handles, (char*)(*retObj)) == NULL) { + UNLOCK_CONTAINER(*retObj); + Tcl_SetObjResult(interp, Tcl_NewStringObj("key has been deleted", -1)); + return TCL_BREAK; + } + *offset = 2; /* Consumed two arguments: object, cmd */ + } + + return TCL_OK; +} + +/* + *----------------------------------------------------------------------------- + * + * Sv_PutContainer -- + * + * Releases the container obtained by the Sv_GetContainer. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * For bound arrays, update the underlying persistent storage. + * + *----------------------------------------------------------------------------- + */ + +int +Sv_PutContainer( + Tcl_Interp *interp, /* For error reporting; might be NULL */ + Container *svObj, /* Shared object container */ + int mode) /* One of SV_XXX modes */ +{ + int ret; + + ret = ReleaseContainer(interp, svObj, mode); + UnlockArray(svObj->arrayPtr); + + return ret; +} + +/* + *----------------------------------------------------------------------------- + * + * GetPsStore -- + * + * Performs a lookup in the list of registered persistent storage + * handlers. If the match is found, duplicates the persistent + * storage record and passes the copy to the caller. + * + * Results: + * Pointer to the newly allocated persistent storage handler. Caller + * must free this block when done with it. If none found, returns NULL, + * + * Side effects; + * Memory gets allocated. Caller should free the return value of this + * function using ckfree(). + * + *----------------------------------------------------------------------------- + */ + +static PsStore* +GetPsStore(const char *handle) +{ + int i; + const char *type = handle; + char *addr, *delimiter = strchr(handle, ':'); + PsStore *tmpPtr, *psPtr = NULL; + + /* + * Expect the handle in the following format: <type>:<address> + * where "type" must match one of the registered presistent store + * types (gdbm, tcl, whatever) and <address> is what is passed to + * the open procedure of the registered store. + * + * Example: gdbm:/path/to/gdbm/file + */ + + /* + * Try to see wether some array is already bound to the + * same persistent storage address. + */ + + for (i = 0; i < NUMBUCKETS; i++) { + Tcl_HashSearch search; + Tcl_HashEntry *hPtr; + Bucket *bucketPtr = &buckets[i]; + LOCK_BUCKET(bucketPtr); + hPtr = Tcl_FirstHashEntry(&bucketPtr->arrays, &search); + while (hPtr) { + Array *arrayPtr = (Array*)Tcl_GetHashValue(hPtr); + if (arrayPtr->bindAddr && arrayPtr->psPtr) { + if (strcmp(arrayPtr->bindAddr, handle) == 0) { + UNLOCK_BUCKET(bucketPtr); + return NULL; /* Array already bound */ + } + } + hPtr = Tcl_NextHashEntry(&search); + } + UNLOCK_BUCKET(bucketPtr); + } + + /* + * Split the address and storage handler + */ + + if (delimiter == NULL) { + addr = NULL; + } else { + *delimiter = 0; + addr = delimiter + 1; + } + + /* + * No array was bound to the same persistent storage. + * Lookup the persistent storage to bind to. + */ + + Tcl_MutexLock(&svMutex); + for (tmpPtr = psStore; tmpPtr; tmpPtr = tmpPtr->nextPtr) { + if (strcmp(tmpPtr->type, type) == 0) { + tmpPtr->psHandle = tmpPtr->psOpen(addr); + if (tmpPtr->psHandle) { + psPtr = (PsStore*)ckalloc(sizeof(PsStore)); + *psPtr = *tmpPtr; + psPtr->nextPtr = NULL; + } + break; + } + } + Tcl_MutexUnlock(&svMutex); + + if (delimiter) { + *delimiter = ':'; + } + + return psPtr; +} + +/* + *----------------------------------------------------------------------------- + * + * AcquireContainer -- + * + * Finds a variable within an array and returns it's container. + * + * Results: + * Pointer to variable object. + * + * Side effects; + * New variable may be created. For bound arrays, try to locate + * the key in the persistent storage as well. + * + *----------------------------------------------------------------------------- + */ + +static Container * +AcquireContainer( + Array *arrayPtr, + const char *key, + int flags) +{ + int new; + Tcl_Obj *tclObj = NULL; + Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&arrayPtr->vars, key); + + if (hPtr == NULL) { + PsStore *psPtr = arrayPtr->psPtr; + if (psPtr) { + char *val = NULL; + size_t len = 0; + if (psPtr->psGet(psPtr->psHandle, key, &val, &len) == 0) { + tclObj = Tcl_NewStringObj(val, len); + psPtr->psFree(psPtr->psHandle, val); + } + } + if (!(flags & FLAGS_CREATEVAR) && tclObj == NULL) { + return NULL; + } + if (tclObj == NULL) { + tclObj = Tcl_NewObj(); + } + hPtr = Tcl_CreateHashEntry(&arrayPtr->vars, key, &new); + Tcl_SetHashValue(hPtr, CreateContainer(arrayPtr, hPtr, tclObj)); + } + + return (Container*)Tcl_GetHashValue(hPtr); +} + +/* + *----------------------------------------------------------------------------- + * + * ReleaseContainer -- + * + * Does some post-processing on the used container. This is mostly + * needed when the container has been modified and needs to be + * saved in the bound persistent storage. + * + * Results: + * A standard Tcl result + * + * Side effects: + * Persistent storage, if bound, might be modified. + * + *----------------------------------------------------------------------------- + */ + +static int +ReleaseContainer( + Tcl_Interp *interp, + Container *svObj, + int mode) +{ + const PsStore *psPtr = svObj->arrayPtr->psPtr; + size_t len; + char *key, *val; + + switch (mode) { + case SV_UNCHANGED: return TCL_OK; + case SV_ERROR: return TCL_ERROR; + case SV_CHANGED: + if (psPtr) { + key = Tcl_GetHashKey(&svObj->arrayPtr->vars, svObj->entryPtr); + val = Tcl_GetString(svObj->tclObj); + len = svObj->tclObj->length; + if (psPtr->psPut(psPtr->psHandle, key, val, len) == -1) { + const char *err = psPtr->psError(psPtr->psHandle); + Tcl_SetObjResult(interp, Tcl_NewStringObj(err, -1)); + return TCL_ERROR; + } + } + return TCL_OK; + } + + return TCL_ERROR; /* Should never be reached */ +} + +/* + *----------------------------------------------------------------------------- + * + * CreateContainer -- + * + * Creates new shared container holding Tcl object to be stored + * in the shared array + * + * Results: + * The container pointer. + * + * Side effects: + * Memory gets allocated. + * + *----------------------------------------------------------------------------- + */ + +static Container * +CreateContainer( + Array *arrayPtr, + Tcl_HashEntry *entryPtr, + Tcl_Obj *tclObj) +{ + Container *svObj; + + if (arrayPtr->bucketPtr->freeCt == NULL) { + SvAllocateContainers(arrayPtr->bucketPtr); + } + + svObj = arrayPtr->bucketPtr->freeCt; + arrayPtr->bucketPtr->freeCt = svObj->nextPtr; + + svObj->arrayPtr = arrayPtr; + svObj->bucketPtr = arrayPtr->bucketPtr; + svObj->tclObj = tclObj; + svObj->entryPtr = entryPtr; + svObj->handlePtr = NULL; + + if (svObj->tclObj) { + Tcl_IncrRefCount(svObj->tclObj); + } + + return svObj; +} + +/* + *----------------------------------------------------------------------------- + * + * DeleteContainer -- + * + * Destroys the container and the Tcl object within it. For bound + * shared arrays, the underlying persistent store is updated as well. + * + * Results: + * None. + * + * Side effects: + * Memory gets reclaimed. If the shared array was bound to persistent + * storage, it removes the corresponding record. + * + *----------------------------------------------------------------------------- + */ + +static int +DeleteContainer( + Container *svObj) +{ + if (svObj->tclObj) { + Tcl_DecrRefCount(svObj->tclObj); + } + if (svObj->handlePtr) { + Tcl_DeleteHashEntry(svObj->handlePtr); + } + if (svObj->entryPtr) { + PsStore *psPtr = svObj->arrayPtr->psPtr; + if (psPtr) { + char *key = Tcl_GetHashKey(&svObj->arrayPtr->vars,svObj->entryPtr); + if (psPtr->psDelete(psPtr->psHandle, key) == -1) { + return TCL_ERROR; + } + } + Tcl_DeleteHashEntry(svObj->entryPtr); + } + + svObj->arrayPtr = NULL; + svObj->entryPtr = NULL; + svObj->handlePtr = NULL; + svObj->tclObj = NULL; + + svObj->nextPtr = svObj->bucketPtr->freeCt; + svObj->bucketPtr->freeCt = svObj; + + return TCL_OK; +} + +/* + *----------------------------------------------------------------------------- + * + * LockArray -- + * + * Find (or create) the array structure for shared array and lock it. + * Array structure must be later unlocked with UnlockArray. + * + * Results: + * TCL_OK or TCL_ERROR if no such array. + * + * Side effects: + * Sets *arrayPtrPtr with Array pointer or leave error in given interp. + * + *----------------------------------------------------------------------------- + */ + +static Array * +LockArray( + Tcl_Interp *interp, /* Interpreter to leave result. */ + const char *array, /* Name of array to lock */ + int flags) /* FLAGS_CREATEARRAY/FLAGS_NOERRMSG*/ +{ + register const char *p; + register unsigned int result; + register int i; + Bucket *bucketPtr; + Array *arrayPtr; + + /* + * Compute a hash to map an array to a bucket. + */ + + p = array; + result = 0; + while (*p++) { + i = *p; + result += (result << 3) + i; + } + i = result % NUMBUCKETS; + bucketPtr = &buckets[i]; + + /* + * Lock the bucket and find the array, or create a new one. + * The bucket will be left locked on success. + */ + + LOCK_BUCKET(bucketPtr); /* Note: no matching unlock below ! */ + if (flags & FLAGS_CREATEARRAY) { + arrayPtr = CreateArray(bucketPtr, array); + } else { + Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&bucketPtr->arrays, array); + if (hPtr == NULL) { + UNLOCK_BUCKET(bucketPtr); + if (!(flags & FLAGS_NOERRMSG)) { + Tcl_AppendResult(interp, "\"", array, + "\" is not a thread shared array", NULL); + } + return NULL; + } + arrayPtr = (Array*)Tcl_GetHashValue(hPtr); + } + + return arrayPtr; +} +/* + *----------------------------------------------------------------------------- + * + * FlushArray -- + * + * Unset all keys in an array. + * + * Results: + * None. + * + * Side effects: + * Array is cleaned but it's variable hash-hable still lives. + * For bound arrays, the persistent store is updated accordingly. + * + *----------------------------------------------------------------------------- + */ + +static int +FlushArray(Array *arrayPtr) /* Name of array to flush */ +{ + Tcl_HashEntry *hPtr; + Tcl_HashSearch search; + + for (hPtr = Tcl_FirstHashEntry(&arrayPtr->vars, &search); hPtr; + hPtr = Tcl_NextHashEntry(&search)) { + if (DeleteContainer((Container*)Tcl_GetHashValue(hPtr)) != TCL_OK) { + return TCL_ERROR; + } + } + + return TCL_OK; +} + +/* + *----------------------------------------------------------------------------- + * + * CreateArray -- + * + * Creates new shared array instance. + * + * Results: + * Pointer to the newly created array + * + * Side effects: + * Memory gets allocated + * + *----------------------------------------------------------------------------- + */ + +static Array * +CreateArray( + Bucket *bucketPtr, + const char *arrayName) +{ + int new; + Array *arrayPtr; + Tcl_HashEntry *hPtr; + + hPtr = Tcl_CreateHashEntry(&bucketPtr->arrays, arrayName, &new); + if (!new) { + return (Array*)Tcl_GetHashValue(hPtr); + } + + arrayPtr = (Array*)ckalloc(sizeof(Array)); + arrayPtr->bucketPtr = bucketPtr; + arrayPtr->entryPtr = hPtr; + arrayPtr->psPtr = NULL; + arrayPtr->bindAddr = NULL; + + Tcl_InitHashTable(&arrayPtr->vars, TCL_STRING_KEYS); + Tcl_SetHashValue(hPtr, arrayPtr); + + return arrayPtr; +} + +/* + *----------------------------------------------------------------------------- + * + * DeleteArray -- + * + * Deletes the shared array. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * Memory gets reclaimed. + * + *----------------------------------------------------------------------------- + */ + +static int +UnbindArray(Tcl_Interp *interp, Array *arrayPtr) +{ + PsStore *psPtr = arrayPtr->psPtr; + if (arrayPtr->bindAddr) { + ckfree(arrayPtr->bindAddr); + arrayPtr->bindAddr = NULL; + } + if (psPtr) { + if (psPtr->psClose(psPtr->psHandle) == -1) { + if (interp) { + const char *err = psPtr->psError(psPtr->psHandle); + Tcl_SetObjResult(interp, Tcl_NewStringObj(err, -1)); + } + return TCL_ERROR; + } + ckfree((char*)arrayPtr->psPtr), arrayPtr->psPtr = NULL; + arrayPtr->psPtr = NULL; + } + return TCL_OK; +} + +static int +DeleteArray(Tcl_Interp *interp, Array *arrayPtr) +{ + if (FlushArray(arrayPtr) == -1) { + return TCL_ERROR; + } + if (arrayPtr->psPtr) { + if (UnbindArray(interp, arrayPtr) != TCL_OK) { + return TCL_ERROR; + }; + } + if (arrayPtr->entryPtr) { + Tcl_DeleteHashEntry(arrayPtr->entryPtr); + } + + Tcl_DeleteHashTable(&arrayPtr->vars); + ckfree((char*)arrayPtr); + + return TCL_OK; +} + +/* + *----------------------------------------------------------------------------- + * + * SvAllocateContainers -- + * + * Any similarity with the Tcl AllocateFreeObj function is purely + * coincidental... Just joking; this is (almost) 100% copy of it! :-) + * + * Results: + * None. + * + * Side effects: + * Allocates memory for many containers at the same time + * + *----------------------------------------------------------------------------- + */ + +static void +SvAllocateContainers(Bucket *bucketPtr) +{ + Container tmp[2]; + size_t objSizePlusPadding = (size_t)(((char*)(tmp+1))-(char*)tmp); + size_t bytesToAlloc = (OBJS_TO_ALLOC_EACH_TIME * objSizePlusPadding); + char *basePtr; + register Container *prevPtr = NULL, *objPtr = NULL; + register int i; + + basePtr = (char*)ckalloc(bytesToAlloc); + memset(basePtr, 0, bytesToAlloc); + + objPtr = (Container*)basePtr; + objPtr->chunkAddr = basePtr; /* Mark chunk address for reclaim */ + + for (i = 0; i < OBJS_TO_ALLOC_EACH_TIME; i++) { + objPtr->nextPtr = prevPtr; + prevPtr = objPtr; + objPtr = (Container*)(((char*)objPtr) + objSizePlusPadding); + } + bucketPtr->freeCt = prevPtr; +} + +#ifdef SV_FINALIZE +/* + *----------------------------------------------------------------------------- + * + * SvFinalizeContainers -- + * + * Reclaim memory for free object containers per bucket. + * + * Results: + * None. + * + * Side effects: + * Memory gets reclaimed + * + *----------------------------------------------------------------------------- + */ + +static void +SvFinalizeContainers(Bucket *bucketPtr) +{ + Container *tmpPtr, *objPtr = bucketPtr->freeCt; + + while (objPtr) { + if (objPtr->chunkAddr == (char*)objPtr) { + tmpPtr = objPtr->nextPtr; + ckfree((char*)objPtr); + objPtr = tmpPtr; + } else { + objPtr = objPtr->nextPtr; + } + } +} +#endif /* SV_FINALIZE */ + +/* + *----------------------------------------------------------------------------- + * + * Sv_DuplicateObj -- + * + * Create and return a new object that is (mostly) a duplicate of the + * argument object. We take care that the duplicate object is either + * a proper object copy, i.e. w/o hidden references to original object + * elements or a plain string object, i.e one w/o internal representation. + * + * Decision about wether to produce a real duplicate or a string object + * is done as follows: + * + * 1) Scalar Tcl object types are properly copied by default; + * these include: boolean, int double, string and byteArray types. + * 2) Object registered with Sv_RegisterObjType are duplicated + * using custom duplicator function which is guaranteed to + * produce a proper deep copy of the object in question. + * 3) All other object types are stringified; these include + * miscelaneous Tcl objects (cmdName, nsName, bytecode, etc, etc) + * and all user-defined objects. + * + * Results: + * The return value is a pointer to a newly created Tcl_Obj. This + * object has reference count 0 and the same type, if any, as the + * source object objPtr. Also: + * + * 1) If the source object has a valid string rep, we copy it; + * otherwise, the new string rep is marked invalid. + * 2) If the source object has an internal representation (i.e. its + * typePtr is non-NULL), the new object's internal rep is set to + * a copy; otherwise the new internal rep is marked invalid. + * + * Side effects: + * Some object may, when copied, loose their type, i.e. will become + * just plain string objects. + * + *----------------------------------------------------------------------------- + */ + +Tcl_Obj * +Sv_DuplicateObj(objPtr) + register Tcl_Obj *objPtr; /* The object to duplicate. */ +{ + register Tcl_Obj *dupPtr = Tcl_NewObj(); + + /* + * Handle the internal rep + */ + + if (objPtr->typePtr != NULL) { + if (objPtr->typePtr->dupIntRepProc == NULL) { + dupPtr->internalRep = objPtr->internalRep; + dupPtr->typePtr = objPtr->typePtr; + Tcl_InvalidateStringRep(dupPtr); + } else { + if ( objPtr->typePtr == booleanObjTypePtr \ + || objPtr->typePtr == byteArrayObjTypePtr \ + || objPtr->typePtr == doubleObjTypePtr \ + || objPtr->typePtr == intObjTypePtr \ + || objPtr->typePtr == wideIntObjTypePtr \ + || objPtr->typePtr == stringObjTypePtr) { + /* + * Cover all "safe" obj types (see header comment) + */ + (*objPtr->typePtr->dupIntRepProc)(objPtr, dupPtr); + Tcl_InvalidateStringRep(dupPtr); + } else { + int found = 0; + register RegType *regPtr; + /* + * Cover special registered types. Assume not + * very many of those, so this sequential walk + * should be fast enough. + */ + for (regPtr = regType; regPtr; regPtr = regPtr->nextPtr) { + if (objPtr->typePtr == regPtr->typePtr) { + (*regPtr->dupIntRepProc)(objPtr, dupPtr); + Tcl_InvalidateStringRep(dupPtr); + found = 1; + break; + } + } + /* + * Assure at least string rep of the source + * is present, which will be copied below. + */ + if (found == 0 && objPtr->bytes == NULL + && objPtr->typePtr->updateStringProc != NULL) { + (*objPtr->typePtr->updateStringProc)(objPtr); + } + } + } + } + + /* + * Handle the string rep + */ + + if (objPtr->bytes == NULL) { + dupPtr->bytes = NULL; + } else if (objPtr->bytes != Sv_tclEmptyStringRep) { + /* A copy of TclInitStringRep macro */ + dupPtr->bytes = (char*)ckalloc((unsigned)objPtr->length + 1); + if (objPtr->length > 0) { + memcpy((void*)dupPtr->bytes,(void*)objPtr->bytes, + (unsigned)objPtr->length); + } + dupPtr->length = objPtr->length; + dupPtr->bytes[objPtr->length] = '\0'; + } + + return dupPtr; +} + +/* + *----------------------------------------------------------------------------- + * + * SvObjDispatchObjCmd -- + * + * The method command for dispatching sub-commands of the shared + * object. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * Depends on the dispatched command + * + *----------------------------------------------------------------------------- + */ + +static int +SvObjDispatchObjCmd( + ClientData arg, /* Pointer to object container. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ +{ + const char *cmdName; + SvCmdInfo *cmdPtr; + + if (objc < 2) { + Tcl_WrongNumArgs(interp, 1, objv, "args"); + return TCL_ERROR; + } + + cmdName = Tcl_GetString(objv[1]); + + /* + * Do simple linear search. We may later replace this list + * with the hash table to gain speed. Currently, the list + * of registered commands is so small, so this will work + * fast enough. + */ + + for (cmdPtr = svCmdInfo; cmdPtr; cmdPtr = cmdPtr->nextPtr) { + if (!strcmp(cmdPtr->name, cmdName)) { + return (*cmdPtr->objProcPtr)(arg, interp, objc, objv); + } + } + + Tcl_AppendResult(interp, "invalid command name \"", cmdName, "\"", NULL); + return TCL_ERROR; +} + +/* + *----------------------------------------------------------------------------- + * + * SvObjObjCmd -- + * + * Creates the object command for a shared array. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * New Tcl command gets created. + * + *----------------------------------------------------------------------------- + */ + +static int +SvObjObjCmd( + ClientData arg, /* != NULL if aolSpecial */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ +{ + int new, off, ret, flg; + char buf[128]; + Tcl_Obj *val = NULL; + Container *svObj = NULL; + + /* + * Syntax: sv::object array key ?var? + */ + + ret = Sv_GetContainer(interp, objc, objv, &svObj, &off, 0); + switch (ret) { + case TCL_BREAK: /* Shared array was not found */ + if ((objc - off)) { + val = objv[off]; + } + Tcl_ResetResult(interp); + flg = FLAGS_CREATEARRAY | FLAGS_CREATEVAR; + ret = Sv_GetContainer(interp, objc, objv, &svObj, &off, flg); + if (ret != TCL_OK) { + return TCL_ERROR; + } + Tcl_DecrRefCount(svObj->tclObj); + svObj->tclObj = Sv_DuplicateObj(val ? val : Tcl_NewObj()); + Tcl_IncrRefCount(svObj->tclObj); + break; + case TCL_ERROR: + return TCL_ERROR; + } + + if (svObj->handlePtr == NULL) { + Tcl_HashTable *handles = &svObj->arrayPtr->bucketPtr->handles; + svObj->handlePtr = Tcl_CreateHashEntry(handles, (char*)svObj, &new); + } + + /* + * Format the command name + */ + + sprintf(buf, "::%p", (int*)svObj); + svObj->aolSpecial = (arg != NULL); + Tcl_CreateObjCommand(interp, buf, (ClientData)SvObjDispatchObjCmd, (ClientData)svObj, NULL); + Tcl_ResetResult(interp); + Tcl_SetObjResult(interp, Tcl_NewStringObj(buf, -1)); + + return Sv_PutContainer(interp, svObj, SV_UNCHANGED); +} + +/* + *----------------------------------------------------------------------------- + * + * SvArrayObjCmd -- + * + * This procedure is invoked to process the "tsv::array" command. + * See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *----------------------------------------------------------------------------- + */ + +static int +SvArrayObjCmd( + ClientData arg, /* Pointer to object container. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ +{ + int i, argx = 0, lobjc = 0, index, ret = TCL_OK; + const char *arrayName = NULL; + Array *arrayPtr = NULL; + Tcl_Obj **lobjv = NULL; + Container *svObj, *elObj = NULL; + + static const char *opts[] = { + "set", "reset", "get", "names", "size", "exists", "isbound", + "bind", "unbind", NULL + }; + enum options { + ASET, ARESET, AGET, ANAMES, ASIZE, AEXISTS, AISBOUND, + ABIND, AUNBIND + }; + + svObj = (Container*)arg; + + if (objc < 3) { + Tcl_WrongNumArgs(interp, 1, objv, "option array"); + return TCL_ERROR; + } + + arrayName = Tcl_GetString(objv[2]); + arrayPtr = LockArray(interp, arrayName, FLAGS_NOERRMSG); + + if (objc > 3) { + argx = 3; + } + + Tcl_ResetResult(interp); + + if (Tcl_GetIndexFromObjStruct(interp,objv[1],opts, sizeof(char *),"option",0,&index) != TCL_OK) { + ret = TCL_ERROR; + + } else if (index == AEXISTS) { + Tcl_SetIntObj(Tcl_GetObjResult(interp), arrayPtr!=0); + + } else if (index == AISBOUND) { + if (arrayPtr == NULL) { + Tcl_SetIntObj(Tcl_GetObjResult(interp), 0); + } else { + Tcl_SetIntObj(Tcl_GetObjResult(interp), arrayPtr->psPtr!=0); + } + + } else if (index == ASIZE) { + if (arrayPtr == NULL) { + Tcl_SetIntObj(Tcl_GetObjResult(interp), 0); + } else { + Tcl_SetWideIntObj(Tcl_GetObjResult(interp),arrayPtr->vars.numEntries); + } + + } else if (index == ASET || index == ARESET) { + if (argx == (objc - 1)) { + if (argx && Tcl_ListObjGetElements(interp, objv[argx], &lobjc, + &lobjv) != TCL_OK) { + ret = TCL_ERROR; + goto cmdExit; + } + } else { + lobjc = objc - 3; + lobjv = (Tcl_Obj**)objv + 3; + } + if (lobjc & 1) { + Tcl_AppendResult(interp, "list must have an even number" + " of elements", NULL); + ret = TCL_ERROR; + goto cmdExit; + } + if (arrayPtr == NULL) { + arrayPtr = LockArray(interp, arrayName, FLAGS_CREATEARRAY); + } + if (index == ARESET) { + ret = FlushArray(arrayPtr); + if (ret != TCL_OK) { + if (arrayPtr->psPtr) { + PsStore *psPtr = arrayPtr->psPtr; + const char *err = psPtr->psError(psPtr->psHandle); + Tcl_SetObjResult(interp, Tcl_NewStringObj(err, -1)); + } + goto cmdExit; + } + } + for (i = 0; i < lobjc; i += 2) { + const char *key = Tcl_GetString(lobjv[i]); + elObj = AcquireContainer(arrayPtr, key, FLAGS_CREATEVAR); + Tcl_DecrRefCount(elObj->tclObj); + elObj->tclObj = Sv_DuplicateObj(lobjv[i+1]); + Tcl_IncrRefCount(elObj->tclObj); + if (ReleaseContainer(interp, elObj, SV_CHANGED) != TCL_OK) { + ret = TCL_ERROR; + goto cmdExit; + } + } + + } else if (index == AGET || index == ANAMES) { + if (arrayPtr) { + Tcl_HashSearch search; + Tcl_Obj *resObj = Tcl_NewListObj(0, NULL); + const char *pattern = (argx == 0) ? NULL : Tcl_GetString(objv[argx]); + Tcl_HashEntry *hPtr = Tcl_FirstHashEntry(&arrayPtr->vars,&search); + while (hPtr) { + char *key = Tcl_GetHashKey(&arrayPtr->vars, hPtr); + if (pattern == NULL || Tcl_StringMatch(key, pattern)) { + Tcl_ListObjAppendElement(interp, resObj, + Tcl_NewStringObj(key, -1)); + if (index == AGET) { + elObj = (Container*)Tcl_GetHashValue(hPtr); + Tcl_ListObjAppendElement(interp, resObj, + Sv_DuplicateObj(elObj->tclObj)); + } + } + hPtr = Tcl_NextHashEntry(&search); + } + Tcl_SetObjResult(interp, resObj); + } + + } else if (index == ABIND) { + + /* + * This is more complex operation, requiring some clarification. + * + * When binding an already existing array, we walk the array + * first and store all key/value pairs found there in the + * persistent storage. Then we proceed with the below. + * + * When binding an non-existent array, we open the persistent + * storage and cache all key/value pairs found there into tne + * newly created shared array. + */ + + PsStore *psPtr; + Tcl_HashEntry *hPtr; + size_t len; + int new; + char *psurl, *key = NULL, *val = NULL; + + if (objc < 4) { + Tcl_WrongNumArgs(interp, 2, objv, "array handle"); + ret = TCL_ERROR; + goto cmdExit; + } + + if (arrayPtr && arrayPtr->psPtr) { + Tcl_AppendResult(interp, "array is already bound", NULL); + ret = TCL_ERROR; + goto cmdExit; + } + + psurl = Tcl_GetString(objv[3]); + len = objv[3]->length; + psPtr = GetPsStore(psurl); + + if (psPtr == NULL) { + Tcl_AppendResult(interp, "can't open persistent storage on \"", + psurl, "\"", NULL); + ret = TCL_ERROR; + goto cmdExit; + } + if (arrayPtr) { + Tcl_HashSearch search; + hPtr = Tcl_FirstHashEntry(&arrayPtr->vars,&search); + arrayPtr->psPtr = psPtr; + arrayPtr->bindAddr = strcpy(ckalloc(len+1), psurl); + while (hPtr) { + svObj = Tcl_GetHashValue(hPtr); + if (ReleaseContainer(interp, svObj, SV_CHANGED) != TCL_OK) { + ret = TCL_ERROR; + goto cmdExit; + } + hPtr = Tcl_NextHashEntry(&search); + } + } else { + arrayPtr = LockArray(interp, arrayName, FLAGS_CREATEARRAY); + arrayPtr->psPtr = psPtr; + arrayPtr->bindAddr = strcpy(ckalloc(len+1), psurl); + } + if (!psPtr->psFirst(psPtr->psHandle, &key, &val, &len)) { + do { + Tcl_Obj * tclObj = Tcl_NewStringObj(val, len); + hPtr = Tcl_CreateHashEntry(&arrayPtr->vars, key, &new); + Tcl_SetHashValue(hPtr, CreateContainer(arrayPtr, hPtr, tclObj)); + psPtr->psFree(psPtr->psHandle, val); + } while (!psPtr->psNext(psPtr->psHandle, &key, &val, &len)); + } + + } else if (index == AUNBIND) { + if (!arrayPtr || !arrayPtr->psPtr) { + Tcl_AppendResult(interp, "shared variable is not bound", NULL); + ret = TCL_ERROR; + goto cmdExit; + } + if (UnbindArray(interp, arrayPtr) != TCL_OK) { + ret = TCL_ERROR; + goto cmdExit; + } + } + + cmdExit: + if (arrayPtr) { + UnlockArray(arrayPtr); + } + + return ret; +} + +/* + *----------------------------------------------------------------------------- + * + * SvUnsetObjCmd -- + * + * This procedure is invoked to process the "tsv::unset" command. + * See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *----------------------------------------------------------------------------- + */ + +static int +SvUnsetObjCmd( + ClientData dummy, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ +{ + int ii; + const char *arrayName; + Array *arrayPtr; + + if (objc < 2) { + Tcl_WrongNumArgs(interp, 1, objv, "array ?key ...?"); + return TCL_ERROR; + } + + arrayName = Tcl_GetString(objv[1]); + arrayPtr = LockArray(interp, arrayName, 0); + + if (arrayPtr == NULL) { + return TCL_ERROR; + } + if (objc == 2) { + UnlockArray(arrayPtr); + if (DeleteArray(interp, arrayPtr) != TCL_OK) { + return TCL_ERROR; + } + } else { + for (ii = 2; ii < objc; ii++) { + const char *key = Tcl_GetString(objv[ii]); + Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&arrayPtr->vars, key); + if (hPtr) { + if (DeleteContainer((Container*)Tcl_GetHashValue(hPtr)) + != TCL_OK) { + UnlockArray(arrayPtr); + return TCL_ERROR; + } + } else { + UnlockArray(arrayPtr); + Tcl_AppendResult(interp,"no key ",arrayName,"(",key,")",NULL); + return TCL_ERROR; + } + } + UnlockArray(arrayPtr); + } + + return TCL_OK; +} + +/* + *----------------------------------------------------------------------------- + * + * SvNamesObjCmd -- + * + * This procedure is invoked to process the "tsv::names" command. + * See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *----------------------------------------------------------------------------- + */ + +static int +SvNamesObjCmd( + ClientData arg, /* != NULL if aolSpecial */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ +{ + int i; + const char *pattern = NULL; + Tcl_HashEntry *hPtr; + Tcl_HashSearch search; + Tcl_Obj *resObj; + + if (objc > 2) { + Tcl_WrongNumArgs(interp, 1, objv, "?pattern?"); + return TCL_ERROR; + } + if (objc == 2) { + pattern = Tcl_GetString(objv[1]); + } + + resObj = Tcl_NewListObj(0, NULL); + + for (i = 0; i < NUMBUCKETS; i++) { + Bucket *bucketPtr = &buckets[i]; + LOCK_BUCKET(bucketPtr); + hPtr = Tcl_FirstHashEntry(&bucketPtr->arrays, &search); + while (hPtr) { + char *key = Tcl_GetHashKey(&bucketPtr->arrays, hPtr); + if ((arg==NULL || (*key != '.')) /* Hide .<name> arrays for AOL*/ && + (pattern == NULL || Tcl_StringMatch(key, pattern))) { + Tcl_ListObjAppendElement(interp, resObj, + Tcl_NewStringObj(key, -1)); + } + hPtr = Tcl_NextHashEntry(&search); + } + UNLOCK_BUCKET(bucketPtr); + } + + Tcl_SetObjResult(interp, resObj); + + return TCL_OK; +} + +/* + *----------------------------------------------------------------------------- + * + * SvGetObjCmd -- + * + * This procedure is invoked to process "tsv::get" command. + * See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *----------------------------------------------------------------------------- + */ + +static int +SvGetObjCmd( + ClientData arg, /* Pointer to object container. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ +{ + int off, ret; + Tcl_Obj *res; + Container *svObj = (Container*)arg; + + /* + * Syntax: + * tsv::get array key ?var? + * $object get ?var? + */ + + ret = Sv_GetContainer(interp, objc, objv, &svObj, &off, 0); + switch (ret) { + case TCL_BREAK: + if ((objc - off) == 0) { + return TCL_ERROR; + } else { + Tcl_SetObjResult(interp, Tcl_NewIntObj(0)); + return TCL_OK; + } + case TCL_ERROR: + return TCL_ERROR; + } + + res = Sv_DuplicateObj(svObj->tclObj); + + if ((objc - off) == 0) { + Tcl_SetObjResult(interp, res); + } else { + if (Tcl_ObjSetVar2(interp, objv[off], NULL, res, 0) == NULL) { + Tcl_DecrRefCount(res); + goto cmd_err; + } + Tcl_SetObjResult(interp, Tcl_NewIntObj(1)); + } + + return Sv_PutContainer(interp, svObj, SV_UNCHANGED); + + cmd_err: + return Sv_PutContainer(interp, svObj, SV_ERROR); +} + +/* + *----------------------------------------------------------------------------- + * + * SvExistsObjCmd -- + * + * This procedure is invoked to process "tsv::exists" command. + * See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *----------------------------------------------------------------------------- + */ + +static int +SvExistsObjCmd( + ClientData arg, /* Pointer to object container. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ +{ + int off, ret; + Container *svObj = (Container*)arg; + + /* + * Syntax: + * tsv::exists array key + * $object exists + */ + + ret = Sv_GetContainer(interp, objc, objv, &svObj, &off, 0); + switch (ret) { + case TCL_BREAK: /* Array/key not found */ + Tcl_SetObjResult(interp, Tcl_NewIntObj(0)); + return TCL_OK; + case TCL_ERROR: + return TCL_ERROR; + } + + Tcl_SetObjResult(interp, Tcl_NewIntObj(1)); + + return Sv_PutContainer(interp, svObj, SV_UNCHANGED); +} + +/* + *----------------------------------------------------------------------------- + * + * SvSetObjCmd -- + * + * This procedure is invoked to process the "tsv::set" command. + * See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *----------------------------------------------------------------------------- + */ + +static int +SvSetObjCmd( + ClientData arg, /* Pointer to object container */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ +{ + int ret, off, flg, mode; + Tcl_Obj *val; + Container *svObj = (Container*)arg; + + /* + * Syntax: + * tsv::set array key ?value? + * $object set ?value? + */ + + ret = Sv_GetContainer(interp, objc, objv, &svObj, &off, 0); + switch (ret) { + case TCL_BREAK: + if ((objc - off) == 0) { + return TCL_ERROR; + } else { + Tcl_ResetResult(interp); + flg = FLAGS_CREATEARRAY | FLAGS_CREATEVAR; + ret = Sv_GetContainer(interp, objc, objv, &svObj, &off, flg); + if (ret != TCL_OK) { + return TCL_ERROR; + } + } + break; + case TCL_ERROR: + return TCL_ERROR; + } + if ((objc - off)) { + val = objv[off]; + Tcl_DecrRefCount(svObj->tclObj); + svObj->tclObj = Sv_DuplicateObj(val); + Tcl_IncrRefCount(svObj->tclObj); + mode = SV_CHANGED; + } else { + val = Sv_DuplicateObj(svObj->tclObj); + mode = SV_UNCHANGED; + } + + Tcl_SetObjResult(interp, val); + + return Sv_PutContainer(interp, svObj, mode); +} + +/* + *----------------------------------------------------------------------------- + * + * SvIncrObjCmd -- + * + * This procedure is invoked to process the "tsv::incr" command. + * See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *----------------------------------------------------------------------------- + */ + +static int +SvIncrObjCmd( + ClientData arg, /* Pointer to object container */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ +{ + int off, ret, flg, new = 0; + Tcl_WideInt incrValue = 1, currValue = 0; + Container *svObj = (Container*)arg; + + /* + * Syntax: + * tsv::incr array key ?increment? + * $object incr ?increment? + */ + + ret = Sv_GetContainer(interp, objc, objv, &svObj, &off, 0); + if (ret != TCL_OK) { + if (ret != TCL_BREAK) { + return TCL_ERROR; + } + flg = FLAGS_CREATEARRAY | FLAGS_CREATEVAR; + Tcl_ResetResult(interp); + ret = Sv_GetContainer(interp, objc, objv, &svObj, &off, flg); + if (ret != TCL_OK) { + return TCL_ERROR; + } + new = 1; + } + if ((objc - off)) { + ret = Tcl_GetWideIntFromObj(interp, objv[off], &incrValue); + if (ret != TCL_OK) { + goto cmd_err; + } + } + if (new) { + currValue = 0; + } else { + ret = Tcl_GetWideIntFromObj(interp, svObj->tclObj, &currValue); + if (ret != TCL_OK) { + goto cmd_err; + } + } + + incrValue += currValue; + Tcl_SetWideIntObj(svObj->tclObj, incrValue); + Tcl_ResetResult(interp); + Tcl_SetWideIntObj(Tcl_GetObjResult(interp), incrValue); + + return Sv_PutContainer(interp, svObj, SV_CHANGED); + + cmd_err: + return Sv_PutContainer(interp, svObj, SV_ERROR); +} + +/* + *----------------------------------------------------------------------------- + * + * SvAppendObjCmd -- + * + * This procedure is invoked to process the "tsv::append" command. + * See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *----------------------------------------------------------------------------- + */ + +static int +SvAppendObjCmd( + ClientData arg, /* Pointer to object container */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ +{ + int i, off, flg, ret; + Container *svObj = (Container*)arg; + + /* + * Syntax: + * tsv::append array key value ?value ...? + * $object append value ?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) < 1) { + Tcl_WrongNumArgs(interp, off, objv, "value ?value ...?"); + goto cmd_err; + } + for (i = off; i < objc; ++i) { + Tcl_AppendObjToObj(svObj->tclObj, Sv_DuplicateObj(objv[i])); + } + + Tcl_SetObjResult(interp, Sv_DuplicateObj(svObj->tclObj)); + + return Sv_PutContainer(interp, svObj, SV_CHANGED); + + cmd_err: + return Sv_PutContainer(interp, svObj, SV_ERROR); +} + +/* + *----------------------------------------------------------------------------- + * + * SvPopObjCmd -- + * + * This procedure is invoked to process "tsv::pop" command. + * See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *----------------------------------------------------------------------------- + */ + +static int +SvPopObjCmd( + ClientData arg, /* Pointer to object container */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ +{ + int ret, off; + Tcl_Obj *retObj; + Array *arrayPtr = NULL; + Container *svObj = (Container*)arg; + + /* + * Syntax: + * tsv::pop array key ?var? + * $object pop ?var? + * + * Note: the object command will run into error next time ! + */ + + ret = Sv_GetContainer(interp, objc, objv, &svObj, &off, 0); + switch (ret) { + case TCL_BREAK: + if ((objc - off) == 0) { + return TCL_ERROR; + } else { + Tcl_SetObjResult(interp, Tcl_NewIntObj(0)); + return TCL_OK; + } + case TCL_ERROR: + return TCL_ERROR; + } + + arrayPtr = svObj->arrayPtr; + + retObj = svObj->tclObj; + svObj->tclObj = NULL; + + if (DeleteContainer(svObj) != TCL_OK) { + if (svObj->arrayPtr->psPtr) { + PsStore *psPtr = svObj->arrayPtr->psPtr; + const char *err = psPtr->psError(psPtr->psHandle); + Tcl_SetObjResult(interp, Tcl_NewStringObj(err,-1)); + } + ret = TCL_ERROR; + goto cmd_exit; + } + + if ((objc - off) == 0) { + Tcl_SetObjResult(interp, retObj); + } else { + if (Tcl_ObjSetVar2(interp, objv[off], NULL, retObj, 0) == NULL) { + ret = TCL_ERROR; + goto cmd_exit; + } + Tcl_SetObjResult(interp, Tcl_NewIntObj(1)); + } + + cmd_exit: + Tcl_DecrRefCount(retObj); + UnlockArray(arrayPtr); + + return ret; +} + +/* + *----------------------------------------------------------------------------- + * + * SvMoveObjCmd -- + * + * This procedure is invoked to process the "tsv::move" command. + * See the user documentation for details on what it does. + * + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *----------------------------------------------------------------------------- + */ + +static int +SvMoveObjCmd( + ClientData arg, /* Pointer to object container. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ +{ + int ret, off, new; + const char *toKey; + Tcl_HashEntry *hPtr; + Container *svObj = (Container*)arg; + + /* + * Syntax: + * tsv::move array key to + * $object move to + */ + + ret = Sv_GetContainer(interp, objc, objv, &svObj, &off, 0); + if (ret != TCL_OK) { + return TCL_ERROR; + } + + toKey = Tcl_GetString(objv[off]); + hPtr = Tcl_CreateHashEntry(&svObj->arrayPtr->vars, toKey, &new); + + if (!new) { + Tcl_AppendResult(interp, "key \"", toKey, "\" exists", NULL); + goto cmd_err; + } + if (svObj->entryPtr) { + char *key = Tcl_GetHashKey(&svObj->arrayPtr->vars, svObj->entryPtr); + if (svObj->arrayPtr->psPtr) { + PsStore *psPtr = svObj->arrayPtr->psPtr; + if (psPtr->psDelete(psPtr->psHandle, key) == -1) { + const char *err = psPtr->psError(psPtr->psHandle); + Tcl_SetObjResult(interp, Tcl_NewStringObj(err, -1)); + return TCL_ERROR; + } + } + Tcl_DeleteHashEntry(svObj->entryPtr); + } + + svObj->entryPtr = hPtr; + Tcl_SetHashValue(hPtr, svObj); + + return Sv_PutContainer(interp, svObj, SV_CHANGED); + + cmd_err: + return Sv_PutContainer(interp, svObj, SV_ERROR); + +} + +/* + *---------------------------------------------------------------------- + * + * SvLockObjCmd -- + * + * This procedure is invoked to process "tsv::lock" Tcl command. + * See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ + +static int +SvLockObjCmd( + ClientData dummy, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ +{ + int ret; + Tcl_Obj *scriptObj; + Bucket *bucketPtr; + Array *arrayPtr = NULL; + + /* + * Syntax: + * + * tsv::lock array arg ?arg ...? + */ + + if (objc < 3) { + Tcl_WrongNumArgs(interp, 1, objv, "array arg ?arg...?"); + return TCL_ERROR; + } + + arrayPtr = LockArray(interp, Tcl_GetString(objv[1]), FLAGS_CREATEARRAY); + bucketPtr = arrayPtr->bucketPtr; + + /* + * Evaluate passed arguments as Tcl script. Note that + * Tcl_EvalObjEx throws away the passed object by + * doing an decrement reference count on it. This also + * means we need not build object bytecode rep. + */ + + if (objc == 3) { + scriptObj = Tcl_DuplicateObj(objv[2]); + } else { + scriptObj = Tcl_ConcatObj(objc-2, objv + 2); + } + + Tcl_AllowExceptions(interp); + ret = Tcl_EvalObjEx(interp, scriptObj, TCL_EVAL_DIRECT); + + if (ret == TCL_ERROR) { + char msg[32 + TCL_INTEGER_SPACE]; + /* Next line generates a Deprecation warning when compiled with Tcl 8.6. + * See Tcl bug #3562640 */ + sprintf(msg, "\n (\"eval\" body line %d)", Tcl_GetErrorLine(interp)); + Tcl_AddErrorInfo(interp, msg); + } + + /* + * We unlock the bucket directly, w/o going to Sv_Unlock() + * since it needs the array which may be unset by the script. + */ + + UNLOCK_BUCKET(bucketPtr); + + return ret; +} + +/* + *----------------------------------------------------------------------------- + * + * SvHandlersObjCmd -- + * + * This procedure is invoked to process "tsv::handlers" Tcl command. + * See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * None. + * + *----------------------------------------------------------------------------- + */ +static int +SvHandlersObjCmd( + ClientData arg, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ +{ + PsStore *tmpPtr = NULL; + + /* + * Syntax: + * + * tsv::handlers + */ + + if (objc != 1) { + Tcl_WrongNumArgs(interp, 1, objv, NULL); + return TCL_ERROR; + } + + Tcl_ResetResult(interp); + Tcl_MutexLock(&svMutex); + for (tmpPtr = psStore; tmpPtr; tmpPtr = tmpPtr->nextPtr) { + Tcl_AppendElement(interp, tmpPtr->type); + } + Tcl_MutexUnlock(&svMutex); + + return TCL_OK; +} + + +/* + *----------------------------------------------------------------------------- + * + * Sv_RegisterStdCommands -- + * + * Register standard shared variable commands + * + * Results: + * A standard Tcl result. + * + * Side effects: + * Memory gets allocated + * + *----------------------------------------------------------------------------- + */ + +static void +SvRegisterStdCommands(void) +{ + static int initialized = 0; + + if (initialized == 0) { + Tcl_MutexLock(&initMutex); + if (initialized == 0) { + Sv_RegisterCommand("var", SvObjObjCmd, NULL, 1); + Sv_RegisterCommand("object", SvObjObjCmd, NULL, 1); + Sv_RegisterCommand("set", SvSetObjCmd, NULL, 0); + Sv_RegisterCommand("unset", SvUnsetObjCmd, NULL, 0); + Sv_RegisterCommand("get", SvGetObjCmd, NULL, 0); + Sv_RegisterCommand("incr", SvIncrObjCmd, NULL, 0); + Sv_RegisterCommand("exists", SvExistsObjCmd, NULL, 0); + Sv_RegisterCommand("append", SvAppendObjCmd, NULL, 0); + Sv_RegisterCommand("array", SvArrayObjCmd, NULL, 0); + Sv_RegisterCommand("names", SvNamesObjCmd, NULL, 0); + Sv_RegisterCommand("pop", SvPopObjCmd, NULL, 0); + Sv_RegisterCommand("move", SvMoveObjCmd, NULL, 0); + Sv_RegisterCommand("lock", SvLockObjCmd, NULL, 0); + Sv_RegisterCommand("handlers", SvHandlersObjCmd, NULL, 0); + initialized = 1; + } + Tcl_MutexUnlock(&initMutex); + } +} + +/* + *----------------------------------------------------------------------------- + * + * Sv_Init -- + * + * Creates commands in current interpreter. + * + * Results: + * None. + * + * Side effects + * Many new command created in current interpreter. Global data + * structures used by them initialized as well. + * + *----------------------------------------------------------------------------- + */ +int +Sv_Init (interp) + Tcl_Interp *interp; +{ + int i; + Bucket *bucketPtr; + SvCmdInfo *cmdPtr; + const Tcl_UniChar no[3] = {'n', 'o', 0} ; + Tcl_Obj *obj; + +#ifdef SV_FINALIZE + /* + * Create exit handler for this thread + */ + Tcl_CreateThreadExitHandler(SvFinalize, NULL); + + /* + * Increment number of threads + */ + Tcl_MutexLock(&nofThreadsMutex); + ++nofThreads; + Tcl_MutexUnlock(&nofThreadsMutex); +#endif /* SV_FINALIZE */ + + /* + * Add keyed-list datatype + */ + + TclX_KeyedListInit(interp); + Sv_RegisterKeylistCommands(); + + /* + * Register standard (nsv_* compatible) and our + * own extensive set of list manipulating commands + */ + + SvRegisterStdCommands(); + Sv_RegisterListCommands(); + + /* + * Get Tcl object types. These are used + * in custom object duplicator function. + */ + + obj = Tcl_NewUnicodeObj(no, -1); + stringObjTypePtr = obj->typePtr; + Tcl_GetBooleanFromObj(NULL, obj, &i); + booleanObjTypePtr = obj->typePtr; + Tcl_DecrRefCount(obj); + + obj = Tcl_NewByteArrayObj((unsigned char *)no, 2); + byteArrayObjTypePtr = obj->typePtr; + Tcl_DecrRefCount(obj); + + obj = Tcl_NewDoubleObj(0.0); + doubleObjTypePtr = obj->typePtr; + Tcl_DecrRefCount(obj); + + obj = Tcl_NewIntObj(0); + intObjTypePtr = obj->typePtr; + Tcl_DecrRefCount(obj); + + obj = Tcl_NewWideIntObj(((Tcl_WideInt)1)<<35); + wideIntObjTypePtr = obj->typePtr; + Tcl_DecrRefCount(obj); + + /* + * Plug-in registered commands in current interpreter + */ + + for (cmdPtr = svCmdInfo; cmdPtr; cmdPtr = cmdPtr->nextPtr) { + Tcl_CreateObjCommand(interp, cmdPtr->cmdName, cmdPtr->objProcPtr, + (ClientData)0, (Tcl_CmdDeleteProc*)0); +#ifdef NS_AOLSERVER + Tcl_CreateObjCommand(interp, cmdPtr->cmdName2, cmdPtr->objProcPtr, + (ClientData)(size_t)cmdPtr->aolSpecial, (Tcl_CmdDeleteProc*)0); +#endif + } + + /* + * Create array of buckets and initialize each bucket + */ + + if (buckets == NULL) { + Tcl_MutexLock(&bucketsMutex); + if (buckets == NULL) { + buckets = (Bucket *)ckalloc(sizeof(Bucket) * NUMBUCKETS); + + for (i = 0; i < NUMBUCKETS; ++i) { + bucketPtr = &buckets[i]; + memset(bucketPtr, 0, sizeof(Bucket)); + Tcl_InitHashTable(&bucketPtr->arrays, TCL_STRING_KEYS); + Tcl_InitHashTable(&bucketPtr->handles, TCL_ONE_WORD_KEYS); + } + + /* + * There is no other way to get Sv_tclEmptyStringRep + * pointer value w/o this trick. + */ + + { + Tcl_Obj *dummy = Tcl_NewObj(); + Sv_tclEmptyStringRep = dummy->bytes; + Tcl_DecrRefCount(dummy); + } + + /* + * Register persistent store handlers + */ +#ifdef HAVE_GDBM + Sv_RegisterGdbmStore(); +#endif +#ifdef HAVE_LMDB + Sv_RegisterLmdbStore(); +#endif + } + Tcl_MutexUnlock(&bucketsMutex); + } + + return TCL_OK; +} + +#ifdef SV_FINALIZE +/* + * Left for reference, but unused since multithreaded finalization is + * unsolvable in the general case. Brave souls can revive this by + * installing a late exit handler on Thread's behalf, bringing the + * function back onto the Tcl_Finalize (but not Tcl_Exit) path. + */ + +/* + *----------------------------------------------------------------------------- + * + * SvFinalize -- + * + * Unset all arrays and reclaim all buckets. + * + * Results: + * None. + * + * Side effects + * Memory gets reclaimed. + * + *----------------------------------------------------------------------------- + */ + +static void +SvFinalize (ClientData clientData) +{ + register int i; + SvCmdInfo *cmdPtr; + RegType *regPtr; + + Tcl_HashEntry *hashPtr; + Tcl_HashSearch search; + + /* + * Decrement number of threads. Proceed only if I was the last one. The + * mutex is unlocked at the end of this function, so new threads that might + * want to register in the meanwhile will find a clean environment when + * they eventually succeed acquiring nofThreadsMutex. + */ + Tcl_MutexLock(&nofThreadsMutex); + if (nofThreads > 1) + { + goto done; + } + + /* + * Reclaim memory for shared arrays + */ + + if (buckets != NULL) { + Tcl_MutexLock(&bucketsMutex); + if (buckets != NULL) { + for (i = 0; i < NUMBUCKETS; ++i) { + Bucket *bucketPtr = &buckets[i]; + hashPtr = Tcl_FirstHashEntry(&bucketPtr->arrays, &search); + while (hashPtr != NULL) { + Array *arrayPtr = (Array*)Tcl_GetHashValue(hashPtr); + UnlockArray(arrayPtr); + /* unbind array before delete (avoid flush of persistent storage) */ + UnbindArray(NULL, arrayPtr); + /* flush, delete etc. */ + DeleteArray(NULL, arrayPtr); + hashPtr = Tcl_NextHashEntry(&search); + } + if (bucketPtr->lock) { + Sp_RecursiveMutexFinalize(&bucketPtr->lock); + } + SvFinalizeContainers(bucketPtr); + Tcl_DeleteHashTable(&bucketPtr->handles); + Tcl_DeleteHashTable(&bucketPtr->arrays); + } + ckfree((char *)buckets), buckets = NULL; + } + buckets = NULL; + Tcl_MutexUnlock(&bucketsMutex); + } + + Tcl_MutexLock(&svMutex); + + /* + * Reclaim memory for registered commands + */ + + if (svCmdInfo != NULL) { + cmdPtr = svCmdInfo; + while (cmdPtr) { + SvCmdInfo *tmpPtr = cmdPtr->nextPtr; + ckfree((char*)cmdPtr); + cmdPtr = tmpPtr; + } + svCmdInfo = NULL; + } + + /* + * Reclaim memory for registered object types + */ + + if (regType != NULL) { + regPtr = regType; + while (regPtr) { + RegType *tmpPtr = regPtr->nextPtr; + ckfree((char*)regPtr); + regPtr = tmpPtr; + } + regType = NULL; + } + + Tcl_MutexUnlock(&svMutex); + +done: + --nofThreads; + Tcl_MutexUnlock(&nofThreadsMutex); +} +#endif /* SV_FINALIZE */ + +/* EOF $RCSfile: threadSvCmd.c,v $ */ + +/* Emacs Setup Variables */ +/* Local Variables: */ +/* mode: C */ +/* indent-tabs-mode: nil */ +/* c-basic-offset: 4 */ +/* End: */ + diff --git a/tcl8.6/pkgs/thread2.8.4/generic/threadSvCmd.h b/tcl8.6/pkgs/thread2.8.4/generic/threadSvCmd.h new file mode 100644 index 0000000..228d134 --- /dev/null +++ b/tcl8.6/pkgs/thread2.8.4/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: */ + diff --git a/tcl8.6/pkgs/thread2.8.4/generic/threadSvKeylistCmd.c b/tcl8.6/pkgs/thread2.8.4/generic/threadSvKeylistCmd.c new file mode 100644 index 0000000..67a84d1 --- /dev/null +++ b/tcl8.6/pkgs/thread2.8.4/generic/threadSvKeylistCmd.c @@ -0,0 +1,360 @@ +/* + * 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" + +/* + * 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. + */ + +extern Tcl_ObjType keyedListType; + +/* + * 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(arg, interp, objc, objv) + ClientData 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(arg, interp, objc, objv) + ClientData 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(arg, interp, objc, objv) + ClientData 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(arg, interp, objc, objv) + ClientData 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: */ + diff --git a/tcl8.6/pkgs/thread2.8.4/generic/threadSvKeylistCmd.h b/tcl8.6/pkgs/thread2.8.4/generic/threadSvKeylistCmd.h new file mode 100644 index 0000000..1f23554 --- /dev/null +++ b/tcl8.6/pkgs/thread2.8.4/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: */ + diff --git a/tcl8.6/pkgs/thread2.8.4/generic/threadSvListCmd.c b/tcl8.6/pkgs/thread2.8.4/generic/threadSvListCmd.c new file mode 100644 index 0000000..e23ee28 --- /dev/null +++ b/tcl8.6/pkgs/thread2.8.4/generic/threadSvListCmd.c @@ -0,0 +1,1171 @@ +/* + * Implementation of most standard Tcl list processing commands + * suitable for operation on thread shared (list) variables. + * + * 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. + * ---------------------------------------------------------------------------- + */ + +#include "threadSvCmd.h" +#include "threadSvListCmd.h" + +/* + * Implementation of list commands for shared variables. + * Most of the standard Tcl list commands are implemented. + * There are also two new commands: "lpop" and "lpush". + * Those are very convenient for simple stack operations. + * + * Main difference to standard Tcl commands is that our commands + * operate on list variable per-reference instead per-value. + * This way we avoid frequent object shuffling between shared + * containers and current interpreter, thus increasing speed. + */ + +static Tcl_ObjCmdProc SvLpopObjCmd; /* lpop */ +static Tcl_ObjCmdProc SvLpushObjCmd; /* lpush */ +static Tcl_ObjCmdProc SvLappendObjCmd; /* lappend */ +static Tcl_ObjCmdProc SvLreplaceObjCmd; /* lreplace */ +static Tcl_ObjCmdProc SvLlengthObjCmd; /* llength */ +static Tcl_ObjCmdProc SvLindexObjCmd; /* lindex */ +static Tcl_ObjCmdProc SvLinsertObjCmd; /* linsert */ +static Tcl_ObjCmdProc SvLrangeObjCmd; /* lrange */ +static Tcl_ObjCmdProc SvLsearchObjCmd; /* lsearch */ +static Tcl_ObjCmdProc SvLsetObjCmd; /* lset */ + +/* + * These two are copied verbatim from the tclUtil.c + * since not found in the public stubs table. + * I was just too lazy to rewrite them from scratch. + */ + +static int SvCheckBadOctal(Tcl_Interp*, const char *); +static int SvGetIntForIndex(Tcl_Interp*, Tcl_Obj *, int, int*); + +/* + * Inefficient list duplicator function which, + * however, produces deep list copies, unlike + * the original, which just makes shallow copies. + */ + +static void DupListObjShared(Tcl_Obj*, Tcl_Obj*); + +/* + * This mutex protects a static variable which tracks + * registration of commands and object types. + */ + +static Tcl_Mutex initMutex; + +/* + * Functions for implementing the "lset" list command + */ + +static Tcl_Obj* +SvLsetFlat(Tcl_Interp *interp, Tcl_Obj *listPtr, int indexCount, + Tcl_Obj **indexArray, Tcl_Obj *valuePtr); + + +/* + *----------------------------------------------------------------------------- + * + * Sv_RegisterListCommands -- + * + * Register list commands with shared variable module. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * Memory gets allocated + * + *----------------------------------------------------------------------------- + */ + +void +Sv_RegisterListCommands(void) +{ + static int initialized = 0; + + if (initialized == 0) { + Tcl_MutexLock(&initMutex); + if (initialized == 0) { + /* Create list with 1 empty element. */ + Tcl_Obj *listobj = Tcl_NewObj(); + listobj = Tcl_NewListObj(1, &listobj); + Sv_RegisterObjType(listobj->typePtr, DupListObjShared); + Tcl_DecrRefCount(listobj); + + Sv_RegisterCommand("lpop", SvLpopObjCmd, NULL, 0); + Sv_RegisterCommand("lpush", SvLpushObjCmd, NULL, 0); + Sv_RegisterCommand("lappend", SvLappendObjCmd, NULL, 0); + Sv_RegisterCommand("lreplace", SvLreplaceObjCmd, NULL, 0); + Sv_RegisterCommand("linsert", SvLinsertObjCmd, NULL, 0); + Sv_RegisterCommand("llength", SvLlengthObjCmd, NULL, 0); + Sv_RegisterCommand("lindex", SvLindexObjCmd, NULL, 0); + Sv_RegisterCommand("lrange", SvLrangeObjCmd, NULL, 0); + Sv_RegisterCommand("lsearch", SvLsearchObjCmd, NULL, 0); + Sv_RegisterCommand("lset", SvLsetObjCmd, NULL, 0); + + initialized = 1; + } + Tcl_MutexUnlock(&initMutex); + } +} + +/* + *----------------------------------------------------------------------------- + * + * SvLpopObjCmd -- + * + * This procedure is invoked to process the "tsv::lpop" command. + * See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *----------------------------------------------------------------------------- + */ + +static int +SvLpopObjCmd (arg, interp, objc, objv) + ClientData arg; + Tcl_Interp *interp; + int objc; + Tcl_Obj *const objv[]; +{ + int ret, off, llen, index = 0, iarg = 0; + Tcl_Obj *elPtr = NULL; + Container *svObj = (Container*)arg; + + /* + * Syntax: + * tsv::lpop array key ?index? + * $list lpop ?index? + */ + + 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, "?index?"); + goto cmd_err; + } + if ((objc - off) == 1) { + iarg = off; + } + ret = Tcl_ListObjLength(interp, svObj->tclObj, &llen); + if (ret != TCL_OK) { + goto cmd_err; + } + if (iarg) { + ret = SvGetIntForIndex(interp, objv[iarg], llen-1, &index); + if (ret != TCL_OK) { + goto cmd_err; + } + } + if (index < 0 || index >= llen) { + goto cmd_ok; /* Ignore out-of bounds, like Tcl does */ + } + ret = Tcl_ListObjIndex(interp, svObj->tclObj, index, &elPtr); + if (ret != TCL_OK) { + goto cmd_err; + } + + Tcl_IncrRefCount(elPtr); + ret = Tcl_ListObjReplace(interp, svObj->tclObj, index, 1, 0, NULL); + if (ret != TCL_OK) { + Tcl_DecrRefCount(elPtr); + goto cmd_err; + } + Tcl_SetObjResult(interp, elPtr); + Tcl_DecrRefCount(elPtr); + + cmd_ok: + return Sv_PutContainer(interp, svObj, SV_CHANGED); + + cmd_err: + return Sv_PutContainer(interp, svObj, SV_ERROR); +} + +/* + *----------------------------------------------------------------------------- + * + * SvLpushObjCmd -- + * + * This procedure is invoked to process the "tsv::lpush" command. + * See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *----------------------------------------------------------------------------- + */ + +static int +SvLpushObjCmd (arg, interp, objc, objv) + ClientData arg; + Tcl_Interp *interp; + int objc; + Tcl_Obj *const objv[]; +{ + int off, ret, flg, llen, index = 0; + Tcl_Obj *args[1]; + Container *svObj = (Container*)arg; + + /* + * Syntax: + * tsv::lpush array key element ?index? + * $list lpush element ?index? + */ + + flg = FLAGS_CREATEARRAY | FLAGS_CREATEVAR; + ret = Sv_GetContainer(interp, objc, objv, &svObj, &off, flg); + if (ret != TCL_OK) { + return TCL_ERROR; + } + if ((objc - off) < 1) { + Tcl_WrongNumArgs(interp, off, objv, "element ?index?"); + goto cmd_err; + } + ret = Tcl_ListObjLength(interp, svObj->tclObj, &llen); + if (ret != TCL_OK) { + goto cmd_err; + } + if ((objc - off) == 2) { + ret = SvGetIntForIndex(interp, objv[off+1], llen, &index); + if (ret != TCL_OK) { + goto cmd_err; + } + if (index < 0) { + index = 0; + } else if (index > llen) { + index = llen; + } + } + + args[0] = Sv_DuplicateObj(objv[off]); + ret = Tcl_ListObjReplace(interp, svObj->tclObj, index, 0, 1, args); + if (ret != TCL_OK) { + Tcl_DecrRefCount(args[0]); + goto cmd_err; + } + + return Sv_PutContainer(interp, svObj, SV_CHANGED); + + cmd_err: + return Sv_PutContainer(interp, svObj, SV_ERROR); +} + +/* + *----------------------------------------------------------------------------- + * + * SvLappendObjCmd -- + * + * This procedure is invoked to process the "tsv::lappend" command. + * See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *----------------------------------------------------------------------------- + */ + +static int +SvLappendObjCmd(arg, interp, objc, objv) + ClientData arg; + Tcl_Interp *interp; + int objc; + Tcl_Obj *const objv[]; +{ + int i, ret, flg, off; + Tcl_Obj *dup; + Container *svObj = (Container*)arg; + + /* + * Syntax: + * tsv::lappend array key value ?value ...? + * $list lappend value ?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) < 1) { + Tcl_WrongNumArgs(interp, off, objv, "value ?value ...?"); + goto cmd_err; + } + for (i = off; i < objc; i++) { + dup = Sv_DuplicateObj(objv[i]); + ret = Tcl_ListObjAppendElement(interp, svObj->tclObj, dup); + if (ret != TCL_OK) { + Tcl_DecrRefCount(dup); + goto cmd_err; + } + } + + Tcl_SetObjResult(interp, Sv_DuplicateObj(svObj->tclObj)); + + return Sv_PutContainer(interp, svObj, SV_CHANGED); + + cmd_err: + return Sv_PutContainer(interp, svObj, SV_ERROR); +} + +/* + *----------------------------------------------------------------------------- + * + * SvLreplaceObjCmd -- + * + * This procedure is invoked to process the "tsv::lreplace" command. + * See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *----------------------------------------------------------------------------- + */ + +static int +SvLreplaceObjCmd (arg, interp, objc, objv) + ClientData arg; + Tcl_Interp *interp; + int objc; + Tcl_Obj *const objv[]; +{ + const char *firstArg; + size_t argLen; + int ret, off, llen, first, last, ndel, nargs, i, j; + Tcl_Obj **args = NULL; + Container *svObj = (Container*)arg; + + /* + * Syntax: + * tsv::lreplace array key first last ?element ...? + * $list lreplace first last ?element ...? + */ + + ret = Sv_GetContainer(interp, objc, objv, &svObj, &off, 0); + if (ret != TCL_OK) { + return TCL_ERROR; + } + if ((objc - off) < 2) { + Tcl_WrongNumArgs(interp, off, objv, "first last ?element ...?"); + goto cmd_err; + } + ret = Tcl_ListObjLength(interp, svObj->tclObj, &llen); + if (ret != TCL_OK) { + goto cmd_err; + } + ret = SvGetIntForIndex(interp, objv[off], llen-1, &first); + if (ret != TCL_OK) { + goto cmd_err; + } + ret = SvGetIntForIndex(interp, objv[off+1], llen-1, &last); + if (ret != TCL_OK) { + goto cmd_err; + } + + firstArg = Tcl_GetString(objv[off]); + argLen = objv[off]->length; + if (first < 0) { + first = 0; + } + if (llen && first >= llen && strncmp(firstArg, "end", argLen)) { + Tcl_AppendResult(interp, "list doesn't have element ", firstArg, NULL); + goto cmd_err; + } + if (last >= llen) { + last = llen - 1; + } + if (first <= last) { + ndel = last - first + 1; + } else { + ndel = 0; + } + + nargs = objc - (off + 2); + if (nargs) { + args = (Tcl_Obj**)ckalloc(nargs * sizeof(Tcl_Obj*)); + for(i = off + 2, j = 0; i < objc; i++, j++) { + args[j] = Sv_DuplicateObj(objv[i]); + } + } + + ret = Tcl_ListObjReplace(interp, svObj->tclObj, first, ndel, nargs, args); + if (args) { + if (ret != TCL_OK) { + for(i = off + 2, j = 0; i < objc; i++, j++) { + Tcl_DecrRefCount(args[j]); + } + } + ckfree((char*)args); + } + + return Sv_PutContainer(interp, svObj, SV_CHANGED); + + cmd_err: + return Sv_PutContainer(interp, svObj, SV_ERROR); +} + +/* + *----------------------------------------------------------------------------- + * + * SvLrangeObjCmd -- + * + * This procedure is invoked to process the "tsv::lrange" command. + * See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *----------------------------------------------------------------------------- + */ + +static int +SvLrangeObjCmd (arg, interp, objc, objv) + ClientData arg; + Tcl_Interp *interp; + int objc; + Tcl_Obj *const objv[]; +{ + int ret, off, llen, first, last, nargs, i, j; + Tcl_Obj **elPtrs, **args; + Container *svObj = (Container*)arg; + + /* + * Syntax: + * tsv::lrange array key first last + * $list lrange first last + */ + + ret = Sv_GetContainer(interp, objc, objv, &svObj, &off, 0); + if (ret != TCL_OK) { + return TCL_ERROR; + } + if ((objc - off) != 2) { + Tcl_WrongNumArgs(interp, off, objv, "first last"); + goto cmd_err; + } + ret = Tcl_ListObjGetElements(interp, svObj->tclObj, &llen, &elPtrs); + if (ret != TCL_OK) { + goto cmd_err; + } + ret = SvGetIntForIndex(interp, objv[off], llen-1, &first); + if (ret != TCL_OK) { + goto cmd_err; + } + ret = SvGetIntForIndex(interp, objv[off+1], llen-1, &last); + if (ret != TCL_OK) { + goto cmd_err; + } + if (first < 0) { + first = 0; + } + if (last >= llen) { + last = llen - 1; + } + if (first > last) { + goto cmd_ok; + } + + nargs = last - first + 1; + args = (Tcl_Obj**)ckalloc(nargs * sizeof(Tcl_Obj*)); + for (i = first, j = 0; i <= last; i++, j++) { + args[j] = Sv_DuplicateObj(elPtrs[i]); + } + + Tcl_ResetResult(interp); + Tcl_SetListObj(Tcl_GetObjResult(interp), nargs, args); + ckfree((char*)args); + + cmd_ok: + return Sv_PutContainer(interp, svObj, SV_UNCHANGED); + + cmd_err: + return Sv_PutContainer(interp, svObj, SV_ERROR); +} + +/* + *----------------------------------------------------------------------------- + * + * SvLinsertObjCmd -- + * + * This procedure is invoked to process the "tsv::linsert" command. + * See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *----------------------------------------------------------------------------- + */ + +static int +SvLinsertObjCmd (arg, interp, objc, objv) + ClientData arg; + Tcl_Interp *interp; + int objc; + Tcl_Obj *const objv[]; +{ + int off, ret, flg, llen, nargs, index = 0, i, j; + Tcl_Obj **args; + Container *svObj = (Container*)arg; + + /* + * Syntax: + * tsv::linsert array key index element ?element ...? + * $list linsert element ?element ...? + */ + + 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, "index element ?element ...?"); + goto cmd_err; + } + ret = Tcl_ListObjLength(interp, svObj->tclObj, &llen); + if (ret != TCL_OK) { + goto cmd_err; + } + ret = SvGetIntForIndex(interp, objv[off], llen, &index); + if (ret != TCL_OK) { + goto cmd_err; + } + if (index < 0) { + index = 0; + } else if (index > llen) { + index = llen; + } + + nargs = objc - (off + 1); + args = (Tcl_Obj**)ckalloc(nargs * sizeof(Tcl_Obj*)); + for (i = off + 1, j = 0; i < objc; i++, j++) { + args[j] = Sv_DuplicateObj(objv[i]); + } + ret = Tcl_ListObjReplace(interp, svObj->tclObj, index, 0, nargs, args); + if (ret != TCL_OK) { + for (i = off + 1, j = 0; i < objc; i++, j++) { + Tcl_DecrRefCount(args[j]); + } + ckfree((char*)args); + goto cmd_err; + } + + ckfree((char*)args); + + return Sv_PutContainer(interp, svObj, SV_CHANGED); + + cmd_err: + return Sv_PutContainer(interp, svObj, SV_ERROR); +} + +/* + *----------------------------------------------------------------------------- + * + * SvLlengthObjCmd -- + * + * This procedure is invoked to process the "tsv::llength" command. + * See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *----------------------------------------------------------------------------- + */ + +static int +SvLlengthObjCmd (arg, interp, objc, objv) + ClientData arg; + Tcl_Interp *interp; + int objc; + Tcl_Obj *const objv[]; +{ + int llen, off, ret; + Container *svObj = (Container*)arg; + + /* + * Syntax: + * tsv::llength array key + * $list llength + */ + + ret = Sv_GetContainer(interp, objc, objv, &svObj, &off, 0); + if (ret != TCL_OK) { + return TCL_ERROR; + } + + ret = Tcl_ListObjLength(interp, svObj->tclObj, &llen); + if (ret == TCL_OK) { + Tcl_SetObjResult(interp, Tcl_NewIntObj(llen)); + } + if (Sv_PutContainer(interp, svObj, SV_UNCHANGED) != TCL_OK) { + return TCL_ERROR; + } + + return ret; +} + +/* + *----------------------------------------------------------------------------- + * + * SvLsearchObjCmd -- + * + * This procedure is invoked to process the "tsv::lsearch" command. + * See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *----------------------------------------------------------------------------- + */ + +static int +SvLsearchObjCmd (arg, interp, objc, objv) + ClientData arg; + Tcl_Interp *interp; + int objc; + Tcl_Obj *const objv[]; +{ + size_t length; + int ret, off, listc, mode, imode, ipatt, index, match, i; + const char *patBytes; + Tcl_Obj **listv; + Container *svObj = (Container*)arg; + + static const char *modes[] = {"-exact", "-glob", "-regexp", NULL}; + enum {LS_EXACT, LS_GLOB, LS_REGEXP}; + + mode = LS_GLOB; + + /* + * Syntax: + * tsv::lsearch array key ?mode? pattern + * $list lsearch ?mode? pattern + */ + + ret = Sv_GetContainer(interp, objc, objv, &svObj, &off, 0); + if (ret != TCL_OK) { + return TCL_ERROR; + } + if ((objc - off) == 2) { + imode = off; + ipatt = off + 1; + } else if ((objc - off) == 1) { + imode = 0; + ipatt = off; + } else { + Tcl_WrongNumArgs(interp, off, objv, "?mode? pattern"); + goto cmd_err; + } + if (imode) { + ret = Tcl_GetIndexFromObjStruct(interp, objv[imode], modes, sizeof(char *), "search mode", + 0, &mode); + if (ret != TCL_OK) { + goto cmd_err; + } + } + ret = Tcl_ListObjGetElements(interp, svObj->tclObj, &listc, &listv); + if (ret != TCL_OK) { + goto cmd_err; + } + + index = -1; + patBytes = Tcl_GetString(objv[ipatt]); + length = objv[ipatt]->length; + + for (i = 0; i < listc; i++) { + match = 0; + switch (mode) { + case LS_GLOB: + match = Tcl_StringMatch(Tcl_GetString(listv[i]), patBytes); + break; + + case LS_EXACT: { + const char *bytes = Tcl_GetString(listv[i]); + if (length == (size_t)listv[i]->length) { + match = (memcmp(bytes, patBytes, length) == 0); + } + break; + } + case LS_REGEXP: + match = Tcl_RegExpMatchObj(interp, listv[i], objv[ipatt]); + if (match < 0) { + goto cmd_err; + } + break; + } + if (match) { + index = i; + break; + } + } + + Tcl_SetObjResult(interp, Tcl_NewIntObj(index)); + + return Sv_PutContainer(interp, svObj, SV_UNCHANGED); + + cmd_err: + return Sv_PutContainer(interp, svObj, SV_ERROR); +} + +/* + *----------------------------------------------------------------------------- + * + * SvLindexObjCmd -- + * + * This procedure is invoked to process the "tsv::lindex" command. + * See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *----------------------------------------------------------------------------- + */ + +static int +SvLindexObjCmd (arg, interp, objc, objv) + ClientData arg; + Tcl_Interp *interp; + int objc; + Tcl_Obj *const objv[]; +{ + Tcl_Obj **elPtrs; + int ret, off, llen, index; + Container *svObj = (Container*)arg; + + /* + * Syntax: + * tsv::lindex array key index + * $list lindex index + */ + + 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, "index"); + goto cmd_err; + } + ret = Tcl_ListObjGetElements(interp, svObj->tclObj, &llen, &elPtrs); + if (ret != TCL_OK) { + goto cmd_err; + } + ret = SvGetIntForIndex(interp, objv[off], llen-1, &index); + if (ret != TCL_OK) { + goto cmd_err; + } + if (index >= 0 && index < llen) { + Tcl_SetObjResult(interp, Sv_DuplicateObj(elPtrs[index])); + } + + return Sv_PutContainer(interp, svObj, SV_UNCHANGED); + + cmd_err: + return Sv_PutContainer(interp, svObj, SV_ERROR); +} + +/* + *----------------------------------------------------------------------------- + * + * SvLsetObjCmd -- + * + * This procedure is invoked to process the "tsv::lset" command. + * See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *----------------------------------------------------------------------------- + */ + +static int +SvLsetObjCmd (arg, interp, objc, objv) + ClientData arg; + Tcl_Interp *interp; + int objc; + Tcl_Obj *const objv[]; +{ + Tcl_Obj *lPtr; + int ret, argc, off; + Container *svObj = (Container*)arg; + + /* + * Syntax: + * tsv::lset array key index ?index ...? value + * $list lset index ?index ...? value + */ + + ret = Sv_GetContainer(interp, objc, objv, &svObj, &off, 0); + if (ret != TCL_OK) { + return TCL_ERROR; + } + if ((objc - off) < 2) { + Tcl_WrongNumArgs(interp, off, objv, "index ?index...? value"); + goto cmd_err; + } + + lPtr = svObj->tclObj; + argc = objc - off - 1; + + if (!SvLsetFlat(interp, lPtr, argc, (Tcl_Obj**)objv+off,objv[objc-1])) { + return TCL_ERROR; + } + + Tcl_SetObjResult(interp, Sv_DuplicateObj(lPtr)); + + return Sv_PutContainer(interp, svObj, SV_CHANGED); + + cmd_err: + return Sv_PutContainer(interp, svObj, SV_ERROR); +} + +/* + *----------------------------------------------------------------------------- + * + * DupListObjShared -- + * + * Help function to make a proper deep copy of the list object. + * This is used as the replacement-hook for list object native + * DupInternalRep function. We need it since the native function + * does a shallow list copy, i.e. retains references to list + * element objects from the original list. This gives us trouble + * when making the list object shared between threads. + * + * Results: + * None. + * + * Side effects; + * This is not a very efficient implementation, but that's all what's + * available to Tcl API programmer. We could include the tclInt.h and + * get the copy more efficient using list internals, but ... + * + *----------------------------------------------------------------------------- + */ + +static void +DupListObjShared(srcPtr, copyPtr) + Tcl_Obj *srcPtr; /* Object with internal rep to copy. */ + Tcl_Obj *copyPtr; /* Object with internal rep to set. */ +{ + int i, llen; + Tcl_Obj *elObj, **newObjList; + + Tcl_ListObjLength(NULL, srcPtr, &llen); + if (llen == 0) { + (*srcPtr->typePtr->dupIntRepProc)(srcPtr, copyPtr); + copyPtr->refCount = 0; + return; + } + + newObjList = (Tcl_Obj**)ckalloc(llen*sizeof(Tcl_Obj*)); + + for (i = 0; i < llen; i++) { + Tcl_ListObjIndex(NULL, srcPtr, i, &elObj); + newObjList[i] = Sv_DuplicateObj(elObj); + } + + Tcl_SetListObj(copyPtr, llen, newObjList); + + ckfree((char*)newObjList); +} + +/* + *----------------------------------------------------------------------------- + * + * SvCheckBadOctal -- + * + * Exact copy from the TclCheckBadOctal found in tclUtil.c + * since this is not in the stubs table. + * + *----------------------------------------------------------------------------- + */ + +static int +SvCheckBadOctal(interp, value) + Tcl_Interp *interp; /* Interpreter to use for error reporting. + * If NULL, then no error message is left + * after errors. */ + const char *value; /* String to check. */ +{ + register const char *p = value; + + /* + * A frequent mistake is invalid octal values due to an unwanted + * leading zero. Try to generate a meaningful error message. + */ + + while (isspace((unsigned char)(*p))) { /* INTL: ISO space. */ + p++; + } + if (*p == '+' || *p == '-') { + p++; + } + if (*p == '0') { + while (isdigit((unsigned char)(*p))) { /* INTL: digit. */ + p++; + } + while (isspace((unsigned char)(*p))) { /* INTL: ISO space. */ + p++; + } + if (*p == '\0') { + /* Reached end of string */ + if (interp != NULL) { + Tcl_AppendResult(interp, " (looks like invalid octal number)", + (char *) NULL); + } + return 1; + } + } + return 0; +} + +/* + *----------------------------------------------------------------------------- + * + * SvGetIntForIndex -- + * + * Exact copy from the TclGetIntForIndex found in tclUtil.c + * since this is not in the stubs table. + * + *----------------------------------------------------------------------------- + */ + +static int +SvGetIntForIndex(interp, objPtr, endValue, indexPtr) + Tcl_Interp *interp; /* Interpreter to use for error reporting. + * If NULL, then no error message is left + * after errors. */ + Tcl_Obj *objPtr; /* Points to an object containing either + * "end" or an integer. */ + int endValue; /* The value to be stored at "indexPtr" if + * "objPtr" holds "end". */ + int *indexPtr; /* Location filled in with an integer + * representing an index. */ +{ + const char *bytes; + size_t length; + int offset; + + bytes = Tcl_GetString(objPtr); + length = objPtr->length; + + if ((*bytes != 'e') + || (strncmp(bytes, "end",((length > 3) ? 3 : length)) != 0)) { + if (Tcl_GetIntFromObj(NULL, objPtr, &offset) != TCL_OK) { + goto intforindex_error; + } + *indexPtr = offset; + return TCL_OK; + } + if (length <= 3) { + *indexPtr = endValue; + } else if (bytes[3] == '-') { + /* + * This is our limited string expression evaluator + */ + if (Tcl_GetInt(interp, bytes+3, &offset) != TCL_OK) { + return TCL_ERROR; + } + *indexPtr = endValue + offset; + } else { + intforindex_error: + if (interp != NULL) { + Tcl_ResetResult(interp); + Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "bad index \"", + bytes, "\": must be integer or end?-integer?",(char*)NULL); + SvCheckBadOctal(interp, bytes); + } + return TCL_ERROR; + } + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * SvLsetFlat -- + * + * Almost exact copy from the TclLsetFlat found in tclListObj.c. + * Simplified in a sense that thread shared objects are guaranteed + * to be non-shared. + * + * Actual return value of this procedure is irrelevant to the caller, + * and it should be either NULL or non-NULL. + * + *---------------------------------------------------------------------- + */ + +static Tcl_Obj* +SvLsetFlat(interp, listPtr, indexCount, indexArray, valuePtr) + Tcl_Interp *interp; /* Tcl interpreter */ + Tcl_Obj *listPtr; /* Pointer to the list being modified */ + int indexCount; /* Number of index args */ + Tcl_Obj **indexArray; + Tcl_Obj *valuePtr; /* Value arg to 'lset' */ +{ + int elemCount, index, result, i; + Tcl_Obj **elemPtrs, *chainPtr, *subListPtr; + + /* + * Determine whether the index arg designates a list + * or a single index. + */ + + if (indexCount == 1 && + Tcl_ListObjGetElements(interp, indexArray[0], &indexCount, + &indexArray) != TCL_OK) { + /* + * Index arg designates something that is neither an index + * nor a well formed list. + */ + + return NULL; + } + + /* + * If there are no indices, then simply return the new value, + * counting the returned pointer as a reference + */ + + if (indexCount == 0) { + return valuePtr; + } + + /* + * Anchor the linked list of Tcl_Obj's whose string reps must be + * invalidated if the operation succeeds. + */ + + chainPtr = NULL; + + /* + * Handle each index arg by diving into the appropriate sublist + */ + + for (i = 0; ; ++i) { + + /* + * Take the sublist apart. + */ + + result = Tcl_ListObjGetElements(interp,listPtr,&elemCount,&elemPtrs); + if (result != TCL_OK) { + break; + } + + listPtr->internalRep.twoPtrValue.ptr2 = (void*)chainPtr; + + /* + * Determine the index of the requested element. + */ + + result = SvGetIntForIndex(interp, indexArray[i], elemCount-1, &index); + if (result != TCL_OK) { + break; + } + + /* + * Check that the index is in range. + */ + + if (index < 0 || index >= elemCount) { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("list index out of range", -1)); + result = TCL_ERROR; + break; + } + + /* + * Break the loop after extracting the innermost sublist + */ + + if (i >= (indexCount - 1)) { + result = TCL_OK; + break; + } + + /* + * Extract the appropriate sublist and chain it onto the linked + * list of Tcl_Obj's whose string reps must be spoilt. + */ + + subListPtr = elemPtrs[index]; + chainPtr = listPtr; + listPtr = subListPtr; + } + + /* Store the result in the list element */ + + if (result == TCL_OK) { + result = Tcl_ListObjGetElements(interp,listPtr,&elemCount,&elemPtrs); + if (result == TCL_OK) { + Tcl_DecrRefCount(elemPtrs[index]); + elemPtrs[index] = Sv_DuplicateObj(valuePtr); + Tcl_IncrRefCount(elemPtrs[index]); + } + } + + if (result == TCL_OK) { + listPtr->internalRep.twoPtrValue.ptr2 = (void*)chainPtr; + /* Spoil all the string reps */ + while (listPtr != NULL) { + subListPtr = (Tcl_Obj*)listPtr->internalRep.twoPtrValue.ptr2; + Tcl_InvalidateStringRep(listPtr); + listPtr->internalRep.twoPtrValue.ptr2 = NULL; + listPtr = subListPtr; + } + + return valuePtr; + } + + return NULL; +} + +/* EOF $RCSfile: threadSvListCmd.c,v $ */ + +/* Emacs Setup Variables */ +/* Local Variables: */ +/* mode: C */ +/* indent-tabs-mode: nil */ +/* c-basic-offset: 4 */ +/* End: */ + diff --git a/tcl8.6/pkgs/thread2.8.4/generic/threadSvListCmd.h b/tcl8.6/pkgs/thread2.8.4/generic/threadSvListCmd.h new file mode 100644 index 0000000..7647810 --- /dev/null +++ b/tcl8.6/pkgs/thread2.8.4/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: */ + diff --git a/tcl8.6/pkgs/thread2.8.4/lib/ttrace.tcl b/tcl8.6/pkgs/thread2.8.4/lib/ttrace.tcl new file mode 100644 index 0000000..f90ef89 --- /dev/null +++ b/tcl8.6/pkgs/thread2.8.4/lib/ttrace.tcl @@ -0,0 +1,942 @@ +# +# ttrace.tcl -- +# +# Copyright (C) 2003 Zoran Vasiljevic, Archiware GmbH. All Rights Reserved. +# +# See the file "license.terms" for information on usage and redistribution of +# this file, and for a DISCLAIMER OF ALL WARRANTIES. +# ---------------------------------------------------------------------------- +# +# User level commands: +# +# ttrace::eval top-level wrapper (ttrace-savvy eval) +# ttrace::enable activates registered Tcl command traces +# ttrace::disable terminates tracing of Tcl commands +# ttrace::isenabled returns true if ttrace is enabled +# ttrace::cleanup bring the interp to a pristine state +# ttrace::update update interp to the latest trace epoch +# ttrace::config setup some configuration options +# ttrace::getscript returns a script for initializing interps +# +# Commands used for/from trace callbacks: +# +# ttrace::atenable register callback to be done at trace enable +# ttrace::atdisable register callback to be done at trace disable +# ttrace::addtrace register user-defined tracer callback +# ttrace::addscript register user-defined script generator +# ttrace::addresolver register user-defined command resolver +# ttrace::addcleanup register user-defined cleanup procedures +# ttrace::addentry adds one entry into the named trace store +# ttrace::getentry returns the entry value from the named store +# ttrace::delentry removes the entry from the named store +# ttrace::getentries returns all entries from the named store +# ttrace::preload register procedures to be preloaded always +# +# +# Limitations: +# +# o. [namespace forget] is still not implemented +# o. [namespace origin cmd] breaks if cmd is not already defined +# +# I left this deliberately. I didn't want to override the [namespace] +# command in order to avoid potential slowdown. +# + +namespace eval ttrace { + + # Setup some compatibility wrappers + if {[info commands nsv_set] != ""} { + variable tvers 0 + variable mutex ns_mutex + variable elock [$mutex create traceepochmutex] + # Import the underlying API; faster than recomputing + interp alias {} [namespace current]::_array {} nsv_array + interp alias {} [namespace current]::_incr {} nsv_incr + interp alias {} [namespace current]::_lappend {} nsv_lappend + interp alias {} [namespace current]::_names {} nsv_names + interp alias {} [namespace current]::_set {} nsv_set + interp alias {} [namespace current]::_unset {} nsv_unset + } elseif {![catch { + variable tvers [package require Thread] + }]} { + variable mutex thread::mutex + variable elock [$mutex create] + # Import the underlying API; faster than recomputing + interp alias {} [namespace current]::_array {} tsv::array + interp alias {} [namespace current]::_incr {} tsv::incr + interp alias {} [namespace current]::_lappend {} tsv::lappend + interp alias {} [namespace current]::_names {} tsv::names + interp alias {} [namespace current]::_set {} tsv::set + interp alias {} [namespace current]::_unset {} tsv::unset + } else { + error "requires NaviServer/AOLserver or Tcl threading extension" + } + + # Keep in sync with the Thread package + package provide Ttrace 2.8.4 + + # Package variables + variable resolvers "" ; # List of registered resolvers + variable tracers "" ; # List of registered cmd tracers + variable scripts "" ; # List of registered script makers + variable enables "" ; # List of trace-enable callbacks + variable disables "" ; # List of trace-disable callbacks + variable preloads "" ; # List of procedure names to preload + variable enabled 0 ; # True if trace is enabled + variable config ; # Array with config options + + variable epoch -1 ; # The initialization epoch + variable cleancnt 0 ; # Counter of registered cleaners + + # Package private namespaces + namespace eval resolve "" ; # Commands for resolving commands + namespace eval trace "" ; # Commands registered for tracing + namespace eval enable "" ; # Commands invoked at trace enable + namespace eval disable "" ; # Commands invoked at trace disable + namespace eval script "" ; # Commands for generating scripts + + # Exported commands + namespace export unknown + + # Initialize ttrace shared state + if {[_array exists ttrace] == 0} { + _set ttrace lastepoch $epoch + _set ttrace epochlist "" + } + + # Initially, allow creation of epochs + set config(-doepochs) 1 + + proc eval {cmd args} { + enable + set code [catch {uplevel 1 [concat $cmd $args]} result] + disable + if {$code == 0} { + if {[llength [info commands ns_ictl]]} { + ns_ictl save [getscript] + } else { + thread::broadcast { + package require Ttrace + ttrace::update + } + } + } + return -code $code \ + -errorinfo $::errorInfo -errorcode $::errorCode $result + } + + proc config {args} { + variable config + if {[llength $args] == 0} { + array get config + } elseif {[llength $args] == 1} { + set opt [lindex $args 0] + set config($opt) + } else { + set opt [lindex $args 0] + set val [lindex $args 1] + set config($opt) $val + } + } + + proc enable {} { + variable config + variable tracers + variable enables + variable enabled + incr enabled 1 + if {$enabled > 1} { + return + } + if {$config(-doepochs) != 0} { + variable epoch [_newepoch] + } + set nsp [namespace current] + foreach enabler $enables { + enable::_$enabler + } + foreach trace $tracers { + if {[info commands $trace] != ""} { + trace add execution $trace leave ${nsp}::trace::_$trace + } + } + } + + proc disable {} { + variable enabled + variable tracers + variable disables + incr enabled -1 + if {$enabled > 0} { + return + } + set nsp [namespace current] + foreach disabler $disables { + disable::_$disabler + } + foreach trace $tracers { + if {[info commands $trace] != ""} { + trace remove execution $trace leave ${nsp}::trace::_$trace + } + } + } + + proc isenabled {} { + variable enabled + expr {$enabled > 0} + } + + proc update {{from -1}} { + if {$from == -1} { + variable epoch [_set ttrace lastepoch] + } else { + if {[lsearch [_set ttrace epochlist] $from] == -1} { + error "no such epoch: $from" + } + variable epoch $from + } + uplevel [getscript] + } + + proc getscript {} { + variable preloads + variable epoch + variable scripts + append script [_serializensp] \n + append script "::namespace eval [namespace current] {" \n + append script "::namespace export unknown" \n + append script "_useepoch $epoch" \n + append script "}" \n + foreach cmd $preloads { + append script [_serializeproc $cmd] \n + } + foreach maker $scripts { + append script [script::_$maker] + } + return $script + } + + proc cleanup {args} { + foreach cmd [info commands resolve::cleaner_*] { + uplevel $cmd $args + } + } + + proc preload {cmd} { + variable preloads + if {[lsearch $preloads $cmd] == -1} { + lappend preloads $cmd + } + } + + proc atenable {cmd arglist body} { + variable enables + if {[lsearch $enables $cmd] == -1} { + lappend enables $cmd + set cmd [namespace current]::enable::_$cmd + proc $cmd $arglist $body + return $cmd + } + } + + proc atdisable {cmd arglist body} { + variable disables + if {[lsearch $disables $cmd] == -1} { + lappend disables $cmd + set cmd [namespace current]::disable::_$cmd + proc $cmd $arglist $body + return $cmd + } + } + + proc addtrace {cmd arglist body} { + variable tracers + if {[lsearch $tracers $cmd] == -1} { + lappend tracers $cmd + set tracer [namespace current]::trace::_$cmd + proc $tracer $arglist $body + if {[isenabled]} { + trace add execution $cmd leave $tracer + } + return $tracer + } + } + + proc addscript {cmd body} { + variable scripts + if {[lsearch $scripts $cmd] == -1} { + lappend scripts $cmd + set cmd [namespace current]::script::_$cmd + proc $cmd args $body + return $cmd + } + } + + proc addresolver {cmd arglist body} { + variable resolvers + if {[lsearch $resolvers $cmd] == -1} { + lappend resolvers $cmd + set cmd [namespace current]::resolve::$cmd + proc $cmd $arglist $body + return $cmd + } + } + + proc addcleanup {body} { + variable cleancnt + set cmd [namespace current]::resolve::cleaner_[incr cleancnt] + proc $cmd args $body + return $cmd + } + + proc addentry {cmd var val} { + variable epoch + _set ${epoch}-$cmd $var $val + } + + proc delentry {cmd var} { + variable epoch + set ei $::errorInfo + set ec $::errorCode + catch {_unset ${epoch}-$cmd $var} + set ::errorInfo $ei + set ::errorCode $ec + } + + proc getentry {cmd var} { + variable epoch + set ei $::errorInfo + set ec $::errorCode + if {[catch {_set ${epoch}-$cmd $var} val]} { + set ::errorInfo $ei + set ::errorCode $ec + set val "" + } + return $val + } + + proc getentries {cmd {pattern *}} { + variable epoch + _array names ${epoch}-$cmd $pattern + } + + proc unknown {args} { + set cmd [lindex $args 0] + if {[uplevel ttrace::_resolve [list $cmd]]} { + set c [catch {uplevel $cmd [lrange $args 1 end]} r] + } else { + set c [catch {::eval ::tcl::unknown $args} r] + } + return -code $c -errorcode $::errorCode -errorinfo $::errorInfo $r + } + + proc _resolve {cmd} { + variable resolvers + foreach resolver $resolvers { + if {[uplevel [info comm resolve::$resolver] [list $cmd]]} { + return 1 + } + } + return 0 + } + + proc _getthread {} { + if {[info commands ns_thread] == ""} { + thread::id + } else { + ns_thread getid + } + } + + proc _getthreads {} { + if {[info commands ns_thread] == ""} { + return [thread::names] + } else { + foreach entry [ns_info threads] { + lappend threads [lindex $entry 2] + } + return $threads + } + } + + proc _newepoch {} { + variable elock + variable mutex + $mutex lock $elock + set old [_set ttrace lastepoch] + set new [_incr ttrace lastepoch] + _lappend ttrace $new [_getthread] + if {$old >= 0} { + _copyepoch $old $new + _delepochs + } + _lappend ttrace epochlist $new + $mutex unlock $elock + return $new + } + + proc _copyepoch {old new} { + foreach var [_names $old-*] { + set cmd [lindex [split $var -] 1] + _array reset $new-$cmd [_array get $var] + } + } + + proc _delepochs {} { + set tlist [_getthreads] + set elist "" + foreach epoch [_set ttrace epochlist] { + if {[_dropepoch $epoch $tlist] == 0} { + lappend elist $epoch + } else { + _unset ttrace $epoch + } + } + _set ttrace epochlist $elist + } + + proc _dropepoch {epoch threads} { + set self [_getthread] + foreach tid [_set ttrace $epoch] { + if {$tid != $self && [lsearch $threads $tid] >= 0} { + lappend alive $tid + } + } + if {[info exists alive]} { + _set ttrace $epoch $alive + return 0 + } else { + foreach var [_names $epoch-*] { + _unset $var + } + return 1 + } + } + + proc _useepoch {epoch} { + if {$epoch >= 0} { + set tid [_getthread] + if {[lsearch [_set ttrace $epoch] $tid] == -1} { + _lappend ttrace $epoch $tid + } + } + } + + proc _serializeproc {cmd} { + set dargs [info args $cmd] + set pbody [info body $cmd] + set pargs "" + foreach arg $dargs { + if {![info default $cmd $arg def]} { + lappend pargs $arg + } else { + lappend pargs [list $arg $def] + } + } + set nsp [namespace qual $cmd] + if {$nsp == ""} { + set nsp "::" + } + append res [list ::namespace eval $nsp] " {" \n + append res [list ::proc [namespace tail $cmd] $pargs $pbody] \n + append res "}" \n + } + + proc _serializensp {{nsp ""} {result _}} { + upvar $result res + if {$nsp == ""} { + set nsp [namespace current] + } + append res [list ::namespace eval $nsp] " {" \n + foreach var [info vars ${nsp}::*] { + set vname [namespace tail $var] + if {[array exists $var] == 0} { + append res [list ::variable $vname [set $var]] \n + } else { + append res [list ::variable $vname] \n + append res [list ::array set $vname [array get $var]] \n + } + } + foreach cmd [info procs ${nsp}::*] { + append res [_serializeproc $cmd] \n + } + append res "}" \n + foreach nn [namespace children $nsp] { + _serializensp $nn res + } + return $res + } +} + +# +# The code below is ment to be run once during the application start. It +# provides implementation of tracing callbacks for some Tcl commands. Users +# can supply their own tracer implementations on-the-fly. +# +# The code below will create traces for the following Tcl commands: +# "namespace", "variable", "load", "proc" and "rename" +# +# Also, the Tcl object extension XOTcl 1.1.0 is handled and all XOTcl related +# things, like classes and objects are traced (many thanks to Gustaf Neumann +# from XOTcl for his kind help and support). +# + +eval { + + # + # Register the "load" trace. This will create the following key/value pair + # in the "load" store: + # + # --- key ---- --- value --- + # <path_of_loaded_image> <name_of_the_init_proc> + # + # We normally need only the name_of_the_init_proc for being able to load + # the package in other interpreters, but we store the path to the image + # file as well. + # + + ttrace::addtrace load {cmdline code args} { + if {$code != 0} { + return + } + set image [lindex $cmdline 1] + set initp [lindex $cmdline 2] + if {$initp == ""} { + foreach pkg [info loaded] { + if {[lindex $pkg 0] == $image} { + set initp [lindex $pkg 1] + } + } + } + ttrace::addentry load $image $initp + } + + ttrace::addscript load { + append res "\n" + foreach entry [ttrace::getentries load] { + set initp [ttrace::getentry load $entry] + append res "::load {} $initp" \n + } + return $res + } + + # + # Register the "namespace" trace. This will create the following key/value + # entry in "namespace" store: + # + # --- key ---- --- value --- + # ::fully::qualified::namespace 1 + # + # It will also fill the "proc" store for procedures and commands imported + # in this namespace with following: + # + # --- key ---- --- value --- + # ::fully::qualified::proc [list <ns> "" ""] + # + # The <ns> is the name of the namespace where the command or procedure is + # imported from. + # + + ttrace::addtrace namespace {cmdline code args} { + if {$code != 0} { + return + } + set nop [lindex $cmdline 1] + set cns [uplevel namespace current] + if {$cns == "::"} { + set cns "" + } + switch -glob $nop { + eva* { + set nsp [lindex $cmdline 2] + if {![string match "::*" $nsp]} { + set nsp ${cns}::$nsp + } + ttrace::addentry namespace $nsp 1 + } + imp* { + # - parse import arguments (skip opt "-force") + set opts [lrange $cmdline 2 end] + if {[string match "-fo*" [lindex $opts 0]]} { + set opts [lrange $cmdline 3 end] + } + # - register all imported procs and commands + foreach opt $opts { + if {![string match "::*" [::namespace qual $opt]]} { + set opt ${cns}::$opt + } + # - first import procs + foreach entry [ttrace::getentries proc $opt] { + set cmd ${cns}::[::namespace tail $entry] + set nsp [::namespace qual $entry] + set done($cmd) 1 + set entry [list 0 $nsp "" ""] + ttrace::addentry proc $cmd $entry + } + + # - then import commands + foreach entry [info commands $opt] { + set cmd ${cns}::[::namespace tail $entry] + set nsp [::namespace qual $entry] + if {[info exists done($cmd)] == 0} { + set entry [list 0 $nsp "" ""] + ttrace::addentry proc $cmd $entry + } + } + } + } + } + } + + ttrace::addscript namespace { + append res \n + foreach entry [ttrace::getentries namespace] { + append res "::namespace eval $entry {}" \n + } + return $res + } + + # + # Register the "variable" trace. This will create the following key/value + # entry in the "variable" store: + # + # --- key ---- --- value --- + # ::fully::qualified::variable 1 + # + # The variable value itself is ignored at the time of + # trace/collection. Instead, we take the real value at the time of script + # generation. + # + + ttrace::addtrace variable {cmdline code args} { + if {$code != 0} { + return + } + set opts [lrange $cmdline 1 end] + if {[llength $opts]} { + set cns [uplevel namespace current] + if {$cns == "::"} { + set cns "" + } + foreach {var val} $opts { + if {![string match "::*" $var]} { + set var ${cns}::$var + } + ttrace::addentry variable $var 1 + } + } + } + + ttrace::addscript variable { + append res \n + foreach entry [ttrace::getentries variable] { + set cns [namespace qual $entry] + set var [namespace tail $entry] + append res "::namespace eval $cns {" \n + append res "::variable $var" + if {[array exists $entry]} { + append res "\n::array set $var [list [array get $entry]]" \n + } elseif {[info exists $entry]} { + append res " [list [set $entry]]" \n + } else { + append res \n + } + append res "}" \n + } + return $res + } + + + # + # Register the "rename" trace. It will create the following key/value pair + # in "rename" store: + # + # --- key ---- --- value --- + # ::fully::qualified::old ::fully::qualified::new + # + # The "new" value may be empty, for commands that have been deleted. In + # such cases we also remove any traced procedure definitions. + # + + ttrace::addtrace rename {cmdline code args} { + if {$code != 0} { + return + } + set cns [uplevel namespace current] + if {$cns == "::"} { + set cns "" + } + set old [lindex $cmdline 1] + if {![string match "::*" $old]} { + set old ${cns}::$old + } + set new [lindex $cmdline 2] + if {$new != ""} { + if {![string match "::*" $new]} { + set new ${cns}::$new + } + ttrace::addentry rename $old $new + } else { + ttrace::delentry proc $old + } + } + + ttrace::addscript rename { + append res \n + foreach old [ttrace::getentries rename] { + set new [ttrace::getentry rename $old] + append res "::rename $old {$new}" \n + } + return $res + } + + # + # Register the "proc" trace. This will create the following key/value pair + # in the "proc" store: + # + # --- key ---- --- value --- + # ::fully::qualified::proc [list <epoch> <ns> <arglist> <body>] + # + # The <epoch> chages anytime one (re)defines a proc. The <ns> is the + # namespace where the command was imported from. If empty, the <arglist> + # and <body> will hold the actual procedure definition. See the + # "namespace" tracer implementation also. + # + + ttrace::addtrace proc {cmdline code args} { + if {$code != 0} { + return + } + set cns [uplevel namespace current] + if {$cns == "::"} { + set cns "" + } + set cmd [lindex $cmdline 1] + if {![string match "::*" $cmd]} { + set cmd ${cns}::$cmd + } + set dargs [info args $cmd] + set pbody [info body $cmd] + set pargs "" + foreach arg $dargs { + if {![info default $cmd $arg def]} { + lappend pargs $arg + } else { + lappend pargs [list $arg $def] + } + } + set pdef [ttrace::getentry proc $cmd] + if {$pdef == ""} { + set epoch -1 ; # never traced before + } else { + set epoch [lindex $pdef 0] + } + ttrace::addentry proc $cmd [list [incr epoch] "" $pargs $pbody] + } + + ttrace::addscript proc { + return { + if {[info command ::tcl::unknown] == ""} { + rename ::unknown ::tcl::unknown + namespace import -force ::ttrace::unknown + } + if {[info command ::tcl::info] == ""} { + rename ::info ::tcl::info + } + proc ::info args { + set cmd [lindex $args 0] + set hit [lsearch -glob {commands procs args default body} $cmd*] + if {$hit > 1} { + if {[catch {uplevel ::tcl::info $args}]} { + uplevel ttrace::_resolve [list [lindex $args 1]] + } + return [uplevel ::tcl::info $args] + } + if {$hit == -1} { + return [uplevel ::tcl::info $args] + } + set cns [uplevel namespace current] + if {$cns == "::"} { + set cns "" + } + set pat [lindex $args 1] + if {![string match "::*" $pat]} { + set pat ${cns}::$pat + } + set fns [ttrace::getentries proc $pat] + if {[string match $cmd* commands]} { + set fns [concat $fns [ttrace::getentries xotcl $pat]] + } + foreach entry $fns { + if {$cns != [namespace qual $entry]} { + set lazy($entry) 1 + } else { + set lazy([namespace tail $entry]) 1 + } + } + foreach entry [uplevel ::tcl::info $args] { + set lazy($entry) 1 + } + array names lazy + } + } + } + + # + # Register procedure resolver. This will try to resolve the command in the + # current namespace first, and if not found, in global namespace. It also + # handles commands imported from other namespaces. + # + + ttrace::addresolver resolveprocs {cmd {export 0}} { + set cns [uplevel namespace current] + set name [namespace tail $cmd] + if {$cns == "::"} { + set cns "" + } + if {![string match "::*" $cmd]} { + set ncmd ${cns}::$cmd + set gcmd ::$cmd + } else { + set ncmd $cmd + set gcmd $cmd + } + set pdef [ttrace::getentry proc $ncmd] + if {$pdef == ""} { + set pdef [ttrace::getentry proc $gcmd] + if {$pdef == ""} { + return 0 + } + set cmd $gcmd + } else { + set cmd $ncmd + } + set epoch [lindex $pdef 0] + set pnsp [lindex $pdef 1] + if {$pnsp != ""} { + set nsp [namespace qual $cmd] + if {$nsp == ""} { + set nsp :: + } + set cmd ${pnsp}::$name + if {[resolveprocs $cmd 1] == 0 && [info commands $cmd] == ""} { + return 0 + } + namespace eval $nsp "namespace import -force $cmd" + } else { + uplevel 0 [list ::proc $cmd [lindex $pdef 2] [lindex $pdef 3]] + if {$export} { + set nsp [namespace qual $cmd] + if {$nsp == ""} { + set nsp :: + } + namespace eval $nsp "namespace export $name" + } + } + variable resolveproc + set resolveproc($cmd) $epoch + return 1 + } + + # + # For XOTcl, the entire item introspection/tracing is delegated to XOTcl + # itself. The xotcl store is filled with this: + # + # --- key ---- --- value --- + # ::fully::qualified::item <body> + # + # The <body> is the script used to generate the entire item (class, + # object). Note that we do not fill in this during code tracing. It is + # done during the script generation. In this step, only the placeholder is + # set. + # + # NOTE: we assume all XOTcl commands are imported in global namespace + # + + ttrace::atenable XOTclEnabler {args} { + if {[info commands ::xotcl::Class] == ""} { + return + } + if {[info commands ::xotcl::_creator] == ""} { + ::xotcl::Class create ::xotcl::_creator -instproc create {args} { + set result [next] + if {![string match ::xotcl::_* $result]} { + ttrace::addentry xotcl $result "" + } + return $result + } + } + ::xotcl::Class instmixin ::xotcl::_creator + } + + ttrace::atdisable XOTclDisabler {args} { + if { [info commands ::xotcl::Class] == "" + || [info commands ::xotcl::_creator] == ""} { + return + } + ::xotcl::Class instmixin "" + ::xotcl::_creator destroy + } + + set resolver [ttrace::addresolver resolveclasses {classname} { + set cns [uplevel namespace current] + set script [ttrace::getentry xotcl $classname] + if {$script == ""} { + set name [namespace tail $classname] + if {$cns == "::"} { + set script [ttrace::getentry xotcl ::$name] + } else { + set script [ttrace::getentry xotcl ${cns}::$name] + if {$script == ""} { + set script [ttrace::getentry xotcl ::$name] + } + } + if {$script == ""} { + return 0 + } + } + uplevel [list namespace eval $cns $script] + return 1 + }] + + ttrace::addscript xotcl [subst -nocommands { + if {![catch {Serializer new} ss]} { + foreach entry [ttrace::getentries xotcl] { + if {[ttrace::getentry xotcl \$entry] == ""} { + ttrace::addentry xotcl \$entry [\$ss serialize \$entry] + } + } + \$ss destroy + return {::xotcl::Class proc __unknown name {$resolver \$name}} + } + }] + + # + # Register callback to be called on cleanup. This will trash lazily loaded + # procs which have changed since. + # + + ttrace::addcleanup { + variable resolveproc + foreach cmd [array names resolveproc] { + set def [ttrace::getentry proc $cmd] + if {$def != ""} { + set new [lindex $def 0] + set old $resolveproc($cmd) + if {[info command $cmd] != "" && $new != $old} { + catch {rename $cmd ""} + } + } + } + } +} + +# EOF +return + +# Local Variables: +# mode: tcl +# fill-column: 78 +# tab-width: 8 +# indent-tabs-mode: nil +# End: diff --git a/tcl8.6/pkgs/thread2.8.4/license.terms b/tcl8.6/pkgs/thread2.8.4/license.terms new file mode 100644 index 0000000..f87ed92 --- /dev/null +++ b/tcl8.6/pkgs/thread2.8.4/license.terms @@ -0,0 +1,39 @@ +This software is copyrighted by the Regents of the University of +California, Sun Microsystems, Inc., Scriptics Corporation, +and other parties. The following terms apply to all files associated +with the software unless explicitly disclaimed in individual files. + +The authors hereby grant permission to use, copy, modify, distribute, +and license this software and its documentation for any purpose, provided +that existing copyright notices are retained in all copies and that this +notice is included verbatim in any distributions. No written agreement, +license, or royalty fee is required for any of the authorized uses. +Modifications to this software may be copyrighted by their authors +and need not follow the licensing terms described here, provided that +the new terms are clearly indicated on the first page of each file where +they apply. + +IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY +FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES +ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY +DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE +POSSIBILITY OF SUCH DAMAGE. + +THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES, +INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE +IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE +NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR +MODIFICATIONS. + +GOVERNMENT USE: If you are acquiring this software on behalf of the +U.S. government, the Government shall have only "Restricted Rights" +in the software and related documentation as defined in the Federal +Acquisition Regulations (FARs) in Clause 52.227.19 (c) (2). If you +are acquiring the software on behalf of the Department of Defense, the +software shall be classified as "Commercial Computer Software" and the +Government shall have only "Restricted Rights" as defined in Clause +252.227-7013 (c) (1) of DFARs. Notwithstanding the foregoing, the +authors grant the U.S. Government and others acting in its behalf +permission to use and distribute the software in accordance with the +terms specified in this license. diff --git a/tcl8.6/pkgs/thread2.8.4/naviserver.m4 b/tcl8.6/pkgs/thread2.8.4/naviserver.m4 new file mode 100644 index 0000000..f0ab1fc --- /dev/null +++ b/tcl8.6/pkgs/thread2.8.4/naviserver.m4 @@ -0,0 +1,57 @@ + +#------------------------------------------------------------------------ +# NS_PATH_AOLSERVER +# +# Allows the building with support for NaviServer/AOLserver +# +# Arguments: +# none +# +# Results: +# +# Adds the following arguments to configure: +# --with-naviserver=... +# +# Defines the following vars: +# NS_DIR Full path to the directory containing NaviServer/AOLserver distro +# NS_INCLUDES +# NS_LIBS +# +# Sets the following vars: +# NS_AOLSERVER +# +# Updates following vars: +#------------------------------------------------------------------------ + +AC_DEFUN(NS_PATH_AOLSERVER, [ + AC_MSG_CHECKING([for NaviServer/AOLserver configuration]) + AC_ARG_WITH(naviserver, + [ --with-naviserver directory with NaviServer/AOLserver distribution],\ + with_naviserver=${withval}) + + AC_CACHE_VAL(ac_cv_c_naviserver,[ + if test x"${with_naviserver}" != x ; then + if test -f "${with_naviserver}/include/ns.h" ; then + ac_cv_c_naviserver=`(cd ${with_naviserver}; pwd)` + else + AC_MSG_ERROR([${with_naviserver} directory doesn't contain ns.h]) + fi + fi + ]) + if test x"${ac_cv_c_naviserver}" = x ; then + AC_MSG_RESULT([none found]) + else + NS_DIR=${ac_cv_c_naviserver} + AC_MSG_RESULT([found NaviServer/AOLserver in $NS_DIR]) + NS_INCLUDES="-I\"${NS_DIR}/include\"" + if test "`uname -s`" = Darwin ; then + aollibs=`ls ${NS_DIR}/lib/libns* 2>/dev/null` + if test x"$aollibs" != x ; then + NS_LIBS="-L\"${NS_DIR}/lib\" -lnsd -lnsthread" + fi + fi + AC_DEFINE(NS_AOLSERVER) + fi +]) + +# EOF diff --git a/tcl8.6/pkgs/thread2.8.4/pkgIndex.tcl.in b/tcl8.6/pkgs/thread2.8.4/pkgIndex.tcl.in new file mode 100644 index 0000000..22f5f8f --- /dev/null +++ b/tcl8.6/pkgs/thread2.8.4/pkgIndex.tcl.in @@ -0,0 +1,68 @@ +# -*- tcl -*- +# Tcl package index file, version 1.1 +# + +if {![package vsatisfies [package provide Tcl] 8.4]} { + # Pre-8.4 Tcl interps we dont support at all. Bye! + # 9.0+ Tcl interps are only supported on 32-bit platforms. + if {![package vsatisfies [package provide Tcl] 9.0] + || ($::tcl_platform(pointerSize) != 4)} { + return + } +} + +# All Tcl 8.4+ interps can [load] Thread @PACKAGE_VERSION@ +# +# For interps that are not thread-enabled, we still call [package ifneeded]. +# This is contrary to the usual convention, but is a good idea because we +# cannot imagine any other version of Thread that might succeed in a +# thread-disabled interp. There's nothing to gain by yielding to other +# competing callers of [package ifneeded Thread]. On the other hand, +# deferring the error has the advantage that a script calling +# [package require Thread] in a thread-disabled interp gets an error message +# about a thread-disabled interp, instead of the message +# "can't find package Thread". + +package ifneeded Thread @PACKAGE_VERSION@ [list load [file join $dir @PKG_LIB_FILE@]] + +# package Ttrace uses some support machinery. + +# In Tcl 8.4 interps we use some older interfaces +if {![package vsatisfies [package provide Tcl] 8.5]} { + package ifneeded Ttrace @PACKAGE_VERSION@ " + [list proc @PACKAGE_NAME@_source {dir} { + if {[info exists ::env(TCL_THREAD_LIBRARY)] && + [file readable $::env(TCL_THREAD_LIBRARY)/ttrace.tcl]} { + source $::env(TCL_THREAD_LIBRARY)/ttrace.tcl + } elseif {[file readable [file join $dir .. lib ttrace.tcl]]} { + source [file join $dir .. lib ttrace.tcl] + } elseif {[file readable [file join $dir ttrace.tcl]]} { + source [file join $dir ttrace.tcl] + } + if {[namespace which ::ttrace::update] ne ""} { + ::ttrace::update + } + }] + [list @PACKAGE_NAME@_source $dir] + [list rename @PACKAGE_NAME@_source {}]" + return +} + +# In Tcl 8.5+ interps; use [::apply] + +package ifneeded Ttrace @PACKAGE_VERSION@ [list ::apply {{dir} { + if {[info exists ::env(TCL_THREAD_LIBRARY)] && + [file readable $::env(TCL_THREAD_LIBRARY)/ttrace.tcl]} { + source $::env(TCL_THREAD_LIBRARY)/ttrace.tcl + } elseif {[file readable [file join $dir .. lib ttrace.tcl]]} { + source [file join $dir .. lib ttrace.tcl] + } elseif {[file readable [file join $dir ttrace.tcl]]} { + source [file join $dir ttrace.tcl] + } + if {[namespace which ::ttrace::update] ne ""} { + ::ttrace::update + } +}} $dir] + + + diff --git a/tcl8.6/pkgs/thread2.8.4/tcl/README b/tcl8.6/pkgs/thread2.8.4/tcl/README new file mode 100644 index 0000000..15e1edd --- /dev/null +++ b/tcl8.6/pkgs/thread2.8.4/tcl/README @@ -0,0 +1,32 @@ + +Software here is provided as example of making some interesting +things and applications using the Tcl threading extension. + +Currently, following packages are supplied: + + tpool/ Example Tcl-only implementation of thread pools. + The threading extension includes an efficient + threadpool implementation in C. This file is + provided as a fully functional example on how this + functionality could be implemented in Tcl alone. + + phttpd/ MT-enabled httpd server. It uses threadpool to + distribute incoming requests among several worker + threads in the threadpool. This way blocking + requests may be handled much better, w/o halting + the event loop of the main responder thread. + In this directory you will also find the uhttpd. + This is the same web-server but operating in the + event-loop mode alone, no threadpool support. + This is good for comparison purposes. + + cmdsrv/ Socket command-line server. Each new connection + gets new thread, thus allowing multiple outstanding + blocking calls without halting the event loop. + +To play around with above packages, change to the corresponding +directory and source files in the Tcl8.4 (or later) Tcl shell. +Be sure to have the latest Tcl threading extension installed in +your package path. + +- EOF diff --git a/tcl8.6/pkgs/thread2.8.4/tcl/cmdsrv/cmdsrv.tcl b/tcl8.6/pkgs/thread2.8.4/tcl/cmdsrv/cmdsrv.tcl new file mode 100644 index 0000000..01ec508 --- /dev/null +++ b/tcl8.6/pkgs/thread2.8.4/tcl/cmdsrv/cmdsrv.tcl @@ -0,0 +1,310 @@ +# +# cmdsrv.tcl -- +# +# Simple socket command server. Supports many simultaneous sessions. +# Works in thread mode with each new connection receiving a new thread. +# +# Usage: +# cmdsrv::create port ?-idletime value? ?-initcmd cmd? +# +# port Tcp port where the server listens +# -idletime # of sec to idle before tearing down socket (def: 300 sec) +# -initcmd script to initialize new worker thread (def: empty) +# +# Example: +# +# # tclsh8.4 +# % source cmdsrv.tcl +# % cmdsrv::create 5000 -idletime 60 +# % vwait forever +# +# Starts the server on the port 5000, sets idle timer to 1 minute. +# You can now use "telnet" utility to connect. +# +# 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. +# ----------------------------------------------------------------------------- + +package require Tcl 8.4 +package require Thread 2.5 + +namespace eval cmdsrv { + variable data; # Stores global configuration options +} + +# +# cmdsrv::create -- +# +# Start the server on the given Tcp port. +# +# Arguments: +# port Port where the server is listening +# args Variable number of arguments +# +# Side Effects: +# None. +# +# Results: +# None. +# + +proc cmdsrv::create {port args} { + + variable data + + if {[llength $args] % 2} { + error "wrong \# arguments, should be: key1 val1 key2 val2..." + } + + # + # Setup default pool data. + # + + array set data { + -idletime 300000 + -initcmd {source cmdsrv.tcl} + } + + # + # Override with user-supplied data + # + + foreach {arg val} $args { + switch -- $arg { + -idletime {set data($arg) [expr {$val*1000}]} + -initcmd {append data($arg) \n $val} + default { + error "unsupported pool option \"$arg\"" + } + } + } + + # + # Start the server on the given port. Note that we wrap + # the actual accept with a helper after/idle callback. + # This is a workaround for a well-known Tcl bug. + # + + socket -server [namespace current]::_Accept -myaddr 127.0.0.1 $port +} + +# +# cmdsrv::_Accept -- +# +# Helper procedure to solve Tcl shared channel bug when responding +# to incoming socket connection and transfering the channel to other +# thread(s). +# +# Arguments: +# s incoming socket +# ipaddr IP address of the remote peer +# port Tcp port used for this connection +# +# Side Effects: +# None. +# +# Results: +# None. +# + +proc cmdsrv::_Accept {s ipaddr port} { + after idle [list [namespace current]::Accept $s $ipaddr $port] +} + +# +# cmdsrv::Accept -- +# +# Accepts the incoming socket connection, creates the worker thread. +# +# Arguments: +# s incoming socket +# ipaddr IP address of the remote peer +# port Tcp port used for this connection +# +# Side Effects: +# Creates new worker thread. +# +# Results: +# None. +# + +proc cmdsrv::Accept {s ipaddr port} { + + variable data + + # + # Configure socket for sane operation + # + + fconfigure $s -blocking 0 -buffering none -translation {auto crlf} + + # + # Emit the prompt + # + + puts -nonewline $s "% " + + # + # Create worker thread and transfer socket ownership + # + + set tid [thread::create [append data(-initcmd) \n thread::wait]] + thread::transfer $tid $s ; # This flushes the socket as well + + # + # Start event-loop processing in the remote thread + # + + thread::send -async $tid [subst { + array set [namespace current]::data {[array get data]} + fileevent $s readable {[namespace current]::Read $s} + proc exit args {[namespace current]::SockDone $s} + [namespace current]::StartIdleTimer $s + }] +} + +# +# cmdsrv::Read -- +# +# Event loop procedure to read data from socket and collect the +# command to execute. If the command read from socket is complete +# it executes the command are prints the result back. +# +# Arguments: +# s incoming socket +# +# Side Effects: +# None. +# +# Results: +# None. +# + +proc cmdsrv::Read {s} { + + variable data + + StopIdleTimer $s + + # + # Cover client closing connection + # + + if {[eof $s] || [catch {read $s} line]} { + return [SockDone $s] + } + if {$line == "\n" || $line == ""} { + if {[catch {puts -nonewline $s "% "}]} { + return [SockDone $s] + } + return [StartIdleTimer $s] + } + + # + # Construct command line to eval + # + + append data(cmd) $line + if {[info complete $data(cmd)] == 0} { + if {[catch {puts -nonewline $s "> "}]} { + return [SockDone $s] + } + return [StartIdleTimer $s] + } + + # + # Run the command + # + + catch {uplevel \#0 $data(cmd)} ret + if {[catch {puts $s $ret}]} { + return [SockDone $s] + } + set data(cmd) "" + if {[catch {puts -nonewline $s "% "}]} { + return [SockDone $s] + } + StartIdleTimer $s +} + +# +# cmdsrv::SockDone -- +# +# Tears down the thread and closes the socket if the remote peer has +# closed his side of the comm channel. +# +# Arguments: +# s incoming socket +# +# Side Effects: +# Worker thread gets released. +# +# Results: +# None. +# + +proc cmdsrv::SockDone {s} { + + catch {close $s} + thread::release +} + +# +# cmdsrv::StopIdleTimer -- +# +# Cancel the connection idle timer. +# +# Arguments: +# s incoming socket +# +# Side Effects: +# After event gets cancelled. +# +# Results: +# None. +# + +proc cmdsrv::StopIdleTimer {s} { + + variable data + + if {[info exists data(idleevent)]} { + after cancel $data(idleevent) + unset data(idleevent) + } +} + +# +# cmdsrv::StartIdleTimer -- +# +# Initiates the connection idle timer. +# +# Arguments: +# s incoming socket +# +# Side Effects: +# After event gets posted. +# +# Results: +# None. +# + +proc cmdsrv::StartIdleTimer {s} { + + variable data + + set data(idleevent) \ + [after $data(-idletime) [list [namespace current]::SockDone $s]] +} + +# EOF $RCSfile: cmdsrv.tcl,v $ + +# Emacs Setup Variables +# Local Variables: +# mode: Tcl +# indent-tabs-mode: nil +# tcl-basic-offset: 4 +# End: + diff --git a/tcl8.6/pkgs/thread2.8.4/tcl/phttpd/index.htm b/tcl8.6/pkgs/thread2.8.4/tcl/phttpd/index.htm new file mode 100644 index 0000000..324f1f7 --- /dev/null +++ b/tcl8.6/pkgs/thread2.8.4/tcl/phttpd/index.htm @@ -0,0 +1,5 @@ +<html> +<body> +<h3>Hallo World</h3> +</body> +</html> diff --git a/tcl8.6/pkgs/thread2.8.4/tcl/phttpd/phttpd.tcl b/tcl8.6/pkgs/thread2.8.4/tcl/phttpd/phttpd.tcl new file mode 100644 index 0000000..8f0c42d --- /dev/null +++ b/tcl8.6/pkgs/thread2.8.4/tcl/phttpd/phttpd.tcl @@ -0,0 +1,686 @@ +# +# phttpd.tcl -- +# +# Simple Sample httpd/1.0 server in 250 lines of Tcl. +# Stephen Uhler / Brent Welch (c) 1996 Sun Microsystems. +# +# Modified to use namespaces, direct url-to-procedure access +# and thread pool package. Grown little larger since ;) +# +# Usage: +# phttpd::create port +# +# port Tcp port where the server listens +# +# Example: +# +# # tclsh8.4 +# % source phttpd.tcl +# % phttpd::create 5000 +# % vwait forever +# +# Starts the server on the port 5000. Also, look at the Httpd array +# definition in the "phttpd" namespace declaration to find out +# about other options you may put on the command line. +# +# You can use: http://localhost:5000/monitor URL to test the +# server functionality. +# +# 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. +# ----------------------------------------------------------------------------- + +package require Tcl 8.4 +package require Thread 2.5 + +# +# Modify the following in order to load the +# example Tcl implementation of threadpools. +# Per default, the C-level threadpool is used. +# + +if {0} { + eval [set TCL_TPOOL {source ../tpool/tpool.tcl}] +} + +namespace eval phttpd { + + variable Httpd; # Internal server state and config params + variable MimeTypes; # Cache of file-extension/mime-type + variable HttpCodes; # Portion of well-known http return codes + variable ErrorPage; # Format of error response page in html + + array set Httpd { + -name phttpd + -vers 1.0 + -root "." + -index index.htm + } + array set HttpCodes { + 400 "Bad Request" + 401 "Not Authorized" + 404 "Not Found" + 500 "Server error" + } + array set MimeTypes { + {} "text/plain" + .txt "text/plain" + .htm "text/html" + .htm "text/html" + .gif "image/gif" + .jpg "image/jpeg" + .png "image/png" + } + set ErrorPage { + <title>Error: %1$s %2$s</title> + <h1>%3$s</h1> + <p>Problem in accessing "%4$s" on this server.</p> + <hr> + <i>%5$s/%6$s Server at %7$s Port %8$s</i> + } +} + +# +# phttpd::create -- +# +# Start the server by listening for connections on the desired port. +# +# Arguments: +# port +# args +# +# Side Effects: +# None.. +# +# Results: +# None. +# + +proc phttpd::create {port args} { + + variable Httpd + + set arglen [llength $args] + if {$arglen} { + if {$arglen % 2} { + error "wrong \# args, should be: key1 val1 key2 val2..." + } + set opts [array names Httpd] + foreach {arg val} $args { + if {[lsearch $opts $arg] == -1} { + error "unknown option \"$arg\"" + } + set Httpd($arg) $val + } + } + + # + # Create thread pool with max 8 worker threads. + # + + if {[info exists ::TCL_TPOOL] == 0} { + # + # Using the internal C-based thread pool + # + set initcmd "source ../phttpd/phttpd.tcl" + } else { + # + # Using the Tcl-level hand-crafted thread pool + # + append initcmd "source ../phttpd/phttpd.tcl" \n $::TCL_TPOOL + } + + set Httpd(tpid) [tpool::create -maxworkers 8 -initcmd $initcmd] + + # + # Start the server on the given port. Note that we wrap + # the actual accept with a helper after/idle callback. + # This is a workaround for a well-known Tcl bug. + # + + socket -server [namespace current]::_Accept $port +} + +# +# phttpd::_Accept -- +# +# Helper procedure to solve Tcl shared-channel bug when responding +# to incoming connection and transfering the channel to other thread(s). +# +# Arguments: +# sock incoming socket +# ipaddr IP address of the remote peer +# port Tcp port used for this connection +# +# Side Effects: +# None. +# +# Results: +# None. +# + +proc phttpd::_Accept {sock ipaddr port} { + after idle [list [namespace current]::Accept $sock $ipaddr $port] +} + +# +# phttpd::Accept -- +# +# Accept a new connection from the client. +# +# Arguments: +# sock +# ipaddr +# port +# +# Side Effects: +# None.. +# +# Results: +# None. +# + +proc phttpd::Accept {sock ipaddr port} { + + variable Httpd + + # + # Setup the socket for sane operation + # + + fconfigure $sock -blocking 0 -translation {auto crlf} + + # + # Detach the socket from current interpreter/tnread. + # One of the worker threads will attach it again. + # + + thread::detach $sock + + # + # Send the work ticket to threadpool. + # + + tpool::post -detached $Httpd(tpid) [list [namespace current]::Ticket $sock] +} + +# +# phttpd::Ticket -- +# +# Job ticket to run in the thread pool thread. +# +# Arguments: +# sock +# +# Side Effects: +# None.. +# +# Results: +# None. +# + +proc phttpd::Ticket {sock} { + + thread::attach $sock + fileevent $sock readable [list [namespace current]::Read $sock] + + # + # End of processing is signalized here. + # This will release the worker thread. + # + + vwait [namespace current]::done +} + + +# +# phttpd::Read -- +# +# Read data from client and parse incoming http request. +# +# Arguments: +# sock +# +# Side Effects: +# None. +# +# Results: +# None. +# + +proc phttpd::Read {sock} { + + variable Httpd + variable data + + set data(sock) $sock + + while {1} { + if {[catch {gets $data(sock) line} readCount] || [eof $data(sock)]} { + return [Done] + } + if {![info exists data(state)]} { + set pat {(POST|GET) ([^?]+)\??([^ ]*) HTTP/1\.[0-9]} + if {[regexp $pat $line x data(proto) data(url) data(query)]} { + set data(state) mime + continue + } else { + Log error "bad request line: (%s)" $line + Error 400 + return [Done] + } + } + + # string compare $readCount 0 maps -1 to -1, 0 to 0, and > 0 to 1 + + set state [string compare $readCount 0],$data(state),$data(proto) + switch -- $state { + "0,mime,GET" - "0,query,POST" { + Respond + return [Done] + } + "0,mime,POST" { + set data(state) query + set data(query) "" + } + "1,mime,POST" - "1,mime,GET" { + if [regexp {([^:]+):[ ]*(.*)} $line dummy key value] { + set data(mime,[string tolower $key]) $value + } + } + "1,query,POST" { + append data(query) $line + set clen $data(mime,content-length) + if {($clen - [string length $data(query)]) <= 0} { + Respond + return [Done] + } + } + default { + if [eof $data(sock)] { + Log error "unexpected eof; client closed connection" + return [Done] + } else { + Log error "bad http protocol state: %s" $state + Error 400 + return [Done] + } + } + } + } +} + +# +# phttpd::Done -- +# +# Close the connection socket +# +# Arguments: +# s +# +# Side Effects: +# None.. +# +# Results: +# None. +# + +proc phttpd::Done {} { + + variable done + variable data + + close $data(sock) + + if {[info exists data]} { + unset data + } + + set done 1 ; # Releases the request thread (See Ticket procedure) +} + +# +# phttpd::Respond -- +# +# Respond to the query. +# +# Arguments: +# s +# +# Side Effects: +# None.. +# +# Results: +# None. +# + +proc phttpd::Respond {} { + + variable data + + if {[info commands $data(url)] == $data(url)} { + + # + # Service URL-procedure + # + + if {[catch { + puts $data(sock) "HTTP/1.0 200 OK" + puts $data(sock) "Date: [Date]" + puts $data(sock) "Last-Modified: [Date]" + } err]} { + Log error "client closed connection prematurely: %s" $err + return + } + if {[catch {$data(url) data} err]} { + Log error "%s: %s" $data(url) $err + } + + } else { + + # + # Service regular file path + # + + set mypath [Url2File $data(url)] + if {![catch {open $mypath} i]} { + if {[catch { + puts $data(sock) "HTTP/1.0 200 OK" + puts $data(sock) "Date: [Date]" + puts $data(sock) "Last-Modified: [Date [file mtime $mypath]]" + puts $data(sock) "Content-Type: [ContentType $mypath]" + puts $data(sock) "Content-Length: [file size $mypath]" + puts $data(sock) "" + fconfigure $data(sock) -translation binary -blocking 0 + fconfigure $i -translation binary + fcopy $i $data(sock) + close $i + } err]} { + Log error "client closed connection prematurely: %s" $err + } + } else { + Log error "%s: %s" $data(url) $i + Error 404 + } + } +} + +# +# phttpd::ContentType -- +# +# Convert the file suffix into a mime type. +# +# Arguments: +# path +# +# Side Effects: +# None.. +# +# Results: +# None. +# + +proc phttpd::ContentType {path} { + + # @c Convert the file suffix into a mime type. + + variable MimeTypes + + set type "text/plain" + catch {set type $MimeTypes([file extension $path])} + + return $type +} + +# +# phttpd::Error -- +# +# Emit error page +# +# Arguments: +# s +# code +# +# Side Effects: +# None.. +# +# Results: +# None. +# + +proc phttpd::Error {code} { + + variable Httpd + variable HttpCodes + variable ErrorPage + variable data + + append data(url) "" + set msg \ + [format $ErrorPage \ + $code \ + $HttpCodes($code) \ + $HttpCodes($code) \ + $data(url) \ + $Httpd(-name) \ + $Httpd(-vers) \ + [info hostname] \ + 80 \ + ] + if {[catch { + puts $data(sock) "HTTP/1.0 $code $HttpCodes($code)" + puts $data(sock) "Date: [Date]" + puts $data(sock) "Content-Length: [string length $msg]" + puts $data(sock) "" + puts $data(sock) $msg + } err]} { + Log error "client closed connection prematurely: %s" $err + } +} + +# +# phttpd::Date -- +# +# Generate a date string in HTTP format. +# +# Arguments: +# seconds +# +# Side Effects: +# None.. +# +# Results: +# None. +# + +proc phttpd::Date {{seconds 0}} { + + # @c Generate a date string in HTTP format. + + if {$seconds == 0} { + set seconds [clock seconds] + } + clock format $seconds -format {%a, %d %b %Y %T %Z} -gmt 1 +} + +# +# phttpd::Log -- +# +# Log an httpd transaction. +# +# Arguments: +# reason +# format +# args +# +# Side Effects: +# None.. +# +# Results: +# None. +# + +proc phttpd::Log {reason format args} { + + set messg [eval format [list $format] $args] + set stamp [clock format [clock seconds] -format "%d/%b/%Y:%H:%M:%S"] + + puts stderr "\[$stamp\]\[-thread[thread::id]-\] $reason: $messg" +} + +# +# phttpd::Url2File -- +# +# Convert a url into a pathname. +# +# Arguments: +# url +# +# Side Effects: +# None.. +# +# Results: +# None. +# + +proc phttpd::Url2File {url} { + + variable Httpd + + lappend pathlist $Httpd(-root) + set level 0 + + foreach part [split $url /] { + set part [CgiMap $part] + if [regexp {[:/]} $part] { + return "" + } + switch -- $part { + "." { } + ".." {incr level -1} + default {incr level} + } + if {$level <= 0} { + return "" + } + lappend pathlist $part + } + + set file [eval file join $pathlist] + + if {[file isdirectory $file]} { + return [file join $file $Httpd(-index)] + } else { + return $file + } +} + +# +# phttpd::CgiMap -- +# +# Decode url-encoded strings. +# +# Arguments: +# data +# +# Side Effects: +# None.. +# +# Results: +# None. +# + +proc phttpd::CgiMap {data} { + + regsub -all {\+} $data { } data + regsub -all {([][$\\])} $data {\\\1} data + regsub -all {%([0-9a-fA-F][0-9a-fA-F])} $data {[format %c 0x\1]} data + + return [subst $data] +} + +# +# phttpd::QueryMap -- +# +# Decode url-encoded query into key/value pairs. +# +# Arguments: +# query +# +# Side Effects: +# None.. +# +# Results: +# None. +# + +proc phttpd::QueryMap {query} { + + set res [list] + + regsub -all {[&=]} $query { } query + regsub -all { } $query { {} } query; # Othewise we lose empty values + + foreach {key val} $query { + lappend res [CgiMap $key] [CgiMap $val] + } + return $res +} + +# +# monitor -- +# +# Procedure used to test the phttpd server. It responds on the +# http://<hostname>:<port>/monitor +# +# Arguments: +# array +# +# Side Effects: +# None.. +# +# Results: +# None. +# + +proc /monitor {array} { + + upvar $array data ; # Holds the socket to remote client + + # + # Emit headers + # + + puts $data(sock) "HTTP/1.0 200 OK" + puts $data(sock) "Date: [phttpd::Date]" + puts $data(sock) "Content-Type: text/html" + puts $data(sock) "" + + # + # Emit body + # + + puts $data(sock) [subst { + <html> + <body> + <h3>[clock format [clock seconds]]</h3> + }] + + after 1 ; # Simulate blocking call + + puts $data(sock) [subst { + </body> + </html> + }] +} + +# EOF $RCSfile: phttpd.tcl,v $ +# Emacs Setup Variables +# Local Variables: +# mode: Tcl +# indent-tabs-mode: nil +# tcl-basic-offset: 4 +# End: + diff --git a/tcl8.6/pkgs/thread2.8.4/tcl/phttpd/uhttpd.tcl b/tcl8.6/pkgs/thread2.8.4/tcl/phttpd/uhttpd.tcl new file mode 100644 index 0000000..b44338a --- /dev/null +++ b/tcl8.6/pkgs/thread2.8.4/tcl/phttpd/uhttpd.tcl @@ -0,0 +1,416 @@ +# +# uhttpd.tcl -- +# +# Simple Sample httpd/1.0 server in 250 lines of Tcl. +# Stephen Uhler / Brent Welch (c) 1996 Sun Microsystems. +# +# Modified to use namespaces and direct url-to-procedure access (zv). +# Eh, due to this, and nicer indenting, it's now 150 lines longer :-) +# +# Usage: +# phttpd::create port +# +# port Tcp port where the server listens +# +# Example: +# +# # tclsh8.4 +# % source uhttpd.tcl +# % uhttpd::create 5000 +# % vwait forever +# +# Starts the server on the port 5000. Also, look at the Httpd array +# definition in the "uhttpd" namespace declaration to find out +# about other options you may put on the command line. +# +# You can use: http://localhost:5000/monitor URL to test the +# server functionality. +# +# Copyright (c) Stephen Uhler / Brent Welch (c) 1996 Sun Microsystems. +# 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. +# ----------------------------------------------------------------------------- + +namespace eval uhttpd { + + variable Httpd; # Internal server state and config params + variable MimeTypes; # Cache of file-extension/mime-type + variable HttpCodes; # Portion of well-known http return codes + variable ErrorPage; # Format of error response page in html + + array set Httpd { + -name uhttpd + -vers 1.0 + -root "" + -index index.htm + } + array set HttpCodes { + 400 "Bad Request" + 401 "Not Authorized" + 404 "Not Found" + 500 "Server error" + } + array set MimeTypes { + {} "text/plain" + .txt "text/plain" + .htm "text/html" + .htm "text/html" + .gif "image/gif" + .jpg "image/jpeg" + .png "image/png" + } + set ErrorPage { + <title>Error: %1$s %2$s</title> + <h1>%3$s</h1> + <p>Problem in accessing "%4$s" on this server.</p> + <hr> + <i>%5$s/%6$s Server at %7$s Port %8$s</i> + } +} + +proc uhttpd::create {port args} { + + # @c Start the server by listening for connections on the desired port. + + variable Httpd + set arglen [llength $args] + + if {$arglen} { + if {$arglen % 2} { + error "wrong \# arguments, should be: key1 val1 key2 val2..." + } + set opts [array names Httpd] + foreach {arg val} $args { + if {[lsearch $opts $arg] == -1} { + error "unknown option \"$arg\"" + } + set Httpd($arg) $val + } + } + + set Httpd(port) $port + set Httpd(host) [info hostname] + + socket -server [namespace current]::Accept $port +} + +proc uhttpd::respond {s status contype data {length 0}} { + + puts $s "HTTP/1.0 $status" + puts $s "Date: [Date]" + puts $s "Content-Type: $contype" + + if {$length} { + puts $s "Content-Length: $length" + } else { + puts $s "Content-Length: [string length $data]" + } + + puts $s "" + puts $s $data +} + +proc uhttpd::Accept {newsock ipaddr port} { + + # @c Accept a new connection from the client. + + variable Httpd + upvar \#0 [namespace current]::Httpd$newsock data + + fconfigure $newsock -blocking 0 -translation {auto crlf} + + set data(ipaddr) $ipaddr + fileevent $newsock readable [list [namespace current]::Read $newsock] +} + +proc uhttpd::Read {s} { + + # @c Read data from client + + variable Httpd + upvar \#0 [namespace current]::Httpd$s data + + if {[catch {gets $s line} readCount] || [eof $s]} { + return [Done $s] + } + if {$readCount == -1} { + return ;# Insufficient data on non-blocking socket ! + } + if {![info exists data(state)]} { + set pat {(POST|GET) ([^?]+)\??([^ ]*) HTTP/1\.[0-9]} + if {[regexp $pat $line x data(proto) data(url) data(query)]} { + return [set data(state) mime] + } else { + Log error "bad request line: %s" $line + Error $s 400 + return [Done $s] + } + } + + # string compare $readCount 0 maps -1 to -1, 0 to 0, and > 0 to 1 + + set state [string compare $readCount 0],$data(state),$data(proto) + switch -- $state { + "0,mime,GET" - "0,query,POST" { + Respond $s + } + "0,mime,POST" { + set data(state) query + set data(query) "" + } + "1,mime,POST" - "1,mime,GET" { + if [regexp {([^:]+):[ ]*(.*)} $line dummy key value] { + set data(mime,[string tolower $key]) $value + } + } + "1,query,POST" { + append data(query) $line + set clen $data(mime,content-length) + if {($clen - [string length $data(query)]) <= 0} { + Respond $s + } + } + default { + if [eof $s] { + Log error "unexpected eof; client closed connection" + return [Done $s] + } else { + Log error "bad http protocol state: %s" $state + Error $s 400 + return [Done $s] + } + } + } +} + +proc uhttpd::Done {s} { + + # @c Close the connection socket and discard token + + close $s + unset [namespace current]::Httpd$s +} + +proc uhttpd::Respond {s} { + + # @c Respond to the query. + + variable Httpd + upvar \#0 [namespace current]::Httpd$s data + + if {[uplevel \#0 info proc $data(url)] == $data(url)} { + + # + # Service URL-procedure first + # + + if {[catch { + puts $s "HTTP/1.0 200 OK" + puts $s "Date: [Date]" + puts $s "Last-Modified: [Date]" + } err]} { + Log error "client closed connection prematurely: %s" $err + return [Done $s] + } + set data(sock) $s + if {[catch {$data(url) data} err]} { + Log error "%s: %s" $data(url) $err + } + + } else { + + # + # Service regular file path next. + # + + set mypath [Url2File $data(url)] + if {![catch {open $mypath} i]} { + if {[catch { + puts $s "HTTP/1.0 200 OK" + puts $s "Date: [Date]" + puts $s "Last-Modified: [Date [file mtime $mypath]]" + puts $s "Content-Type: [ContentType $mypath]" + puts $s "Content-Length: [file size $mypath]" + puts $s "" + fconfigure $s -translation binary -blocking 0 + fconfigure $i -translation binary + fcopy $i $s + close $i + } err]} { + Log error "client closed connection prematurely: %s" $err + } + } else { + Log error "%s: %s" $data(url) $i + Error $s 404 + } + } + + Done $s +} + +proc uhttpd::ContentType {path} { + + # @c Convert the file suffix into a mime type. + + variable MimeTypes + + set type "text/plain" + catch {set type $MimeTypes([file extension $path])} + + return $type +} + +proc uhttpd::Error {s code} { + + # @c Emit error page. + + variable Httpd + variable HttpCodes + variable ErrorPage + + upvar \#0 [namespace current]::Httpd$s data + + append data(url) "" + set msg \ + [format $ErrorPage \ + $code \ + $HttpCodes($code) \ + $HttpCodes($code) \ + $data(url) \ + $Httpd(-name) \ + $Httpd(-vers) \ + $Httpd(host) \ + $Httpd(port) \ + ] + if {[catch { + puts $s "HTTP/1.0 $code $HttpCodes($code)" + puts $s "Date: [Date]" + puts $s "Content-Length: [string length $msg]" + puts $s "" + puts $s $msg + } err]} { + Log error "client closed connection prematurely: %s" $err + } +} + +proc uhttpd::Date {{seconds 0}} { + + # @c Generate a date string in HTTP format. + + if {$seconds == 0} { + set seconds [clock seconds] + } + clock format $seconds -format {%a, %d %b %Y %T %Z} -gmt 1 +} + +proc uhttpd::Log {reason format args} { + + # @c Log an httpd transaction. + + set messg [eval format [list $format] $args] + set stamp [clock format [clock seconds] -format "%d/%b/%Y:%H:%M:%S"] + + puts stderr "\[$stamp\] $reason: $messg" +} + +proc uhttpd::Url2File {url} { + + # @c Convert a url into a pathname (this is probably not right) + + variable Httpd + + lappend pathlist $Httpd(-root) + set level 0 + + foreach part [split $url /] { + set part [CgiMap $part] + if [regexp {[:/]} $part] { + return "" + } + switch -- $part { + "." { } + ".." {incr level -1} + default {incr level} + } + if {$level <= 0} { + return "" + } + lappend pathlist $part + } + + set file [eval file join $pathlist] + + if {[file isdirectory $file]} { + return [file join $file $Httpd(-index)] + } else { + return $file + } +} + +proc uhttpd::CgiMap {data} { + + # @c Decode url-encoded strings + + regsub -all {\+} $data { } data + regsub -all {([][$\\])} $data {\\\1} data + regsub -all {%([0-9a-fA-F][0-9a-fA-F])} $data {[format %c 0x\1]} data + + return [subst $data] +} + +proc uhttpd::QueryMap {query} { + + # @c Decode url-encoded query into key/value pairs + + set res [list] + + regsub -all {[&=]} $query { } query + regsub -all { } $query { {} } query; # Othewise we lose empty values + + foreach {key val} $query { + lappend res [CgiMap $key] [CgiMap $val] + } + return $res +} + +proc /monitor {array} { + + upvar $array data ; # Holds the socket to remote client + + # + # Emit headers + # + + puts $data(sock) "HTTP/1.0 200 OK" + puts $data(sock) "Date: [uhttpd::Date]" + puts $data(sock) "Content-Type: text/html" + puts $data(sock) "" + + # + # Emit body + # + + puts $data(sock) [subst { + <html> + <body> + <h3>[clock format [clock seconds]]</h3> + }] + + after 1 ; # Simulate blocking call + + puts $data(sock) [subst { + </body> + </html> + }] +} + +# EOF $RCSfile: uhttpd.tcl,v $ +# Emacs Setup Variables +# Local Variables: +# mode: Tcl +# indent-tabs-mode: nil +# tcl-basic-offset: 4 +# End: + diff --git a/tcl8.6/pkgs/thread2.8.4/tcl/tpool/tpool.tcl b/tcl8.6/pkgs/thread2.8.4/tcl/tpool/tpool.tcl new file mode 100644 index 0000000..021e231 --- /dev/null +++ b/tcl8.6/pkgs/thread2.8.4/tcl/tpool/tpool.tcl @@ -0,0 +1,576 @@ +# +# tpool.tcl -- +# +# Tcl implementation of a threadpool paradigm in pure Tcl using +# the Tcl threading extension 2.5 (or higher). +# +# This file is for example purposes only. The efficient C-level +# threadpool implementation is already a part of the threading +# extension starting with 2.5 version. Both implementations have +# the same Tcl API so both can be used interchangeably. Goal of +# this implementation is to serve as an example of using the Tcl +# extension to implement some very common threading paradigms. +# +# Beware: with time, as improvements are made to the C-level +# implementation, this Tcl one might lag behind. +# Please consider this code as a working example only. +# +# +# +# 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. +# ----------------------------------------------------------------------------- + +package require Thread 2.5 +set thisScript [info script] + +namespace eval tpool { + + variable afterevent "" ; # Idle timer event for worker threads + variable result ; # Stores result from the worker thread + variable waiter ; # Waits for an idle worker thread + variable jobsdone ; # Accumulates results from worker threads + + # + # Create shared array with a single element. + # It is used for automatic pool handles creation. + # + + set ns [namespace current] + tsv::lock $ns { + if {[tsv::exists $ns count] == 0} { + tsv::set $ns count 0 + } + tsv::set $ns count -1 + } + variable thisScript [info script] +} + +# +# tpool::create -- +# +# Creates instance of a thread pool. +# +# Arguments: +# args Variable number of key/value arguments, as follows: +# +# -minworkers minimum # of worker threads (def:0) +# -maxworkers maximum # of worker threads (def:4) +# -idletime # of sec worker is idle before exiting (def:0 = never) +# -initcmd script used to initialize new worker thread +# -exitcmd script run at worker thread exit +# +# Side Effects: +# Might create many new threads if "-minworkers" option is > 0. +# +# Results: +# The id of the newly created thread pool. This id must be used +# in all other tpool::* commands. +# + +proc tpool::create {args} { + + variable thisScript + + # + # Get next threadpool handle and create the pool array. + # + + set usage "wrong \# args: should be \"[lindex [info level 1] 0]\ + ?-minworkers count? ?-maxworkers count?\ + ?-initcmd script? ?-exitcmd script?\ + ?-idletime seconds?\"" + + set ns [namespace current] + set tpid [namespace tail $ns][tsv::incr $ns count] + + tsv::lock $tpid { + tsv::set $tpid name $tpid + } + + # + # Setup default pool data. + # + + tsv::array set $tpid { + thrworkers "" + thrwaiters "" + jobcounter 0 + refcounter 0 + numworkers 0 + -minworkers 0 + -maxworkers 4 + -idletime 0 + -initcmd "" + -exitcmd "" + } + + tsv::set $tpid -initcmd "source $thisScript" + + # + # Override with user-supplied data + # + + if {[llength $args] % 2} { + error $usage + } + + foreach {arg val} $args { + switch -- $arg { + -minworkers - + -maxworkers {tsv::set $tpid $arg $val} + -idletime {tsv::set $tpid $arg [expr {$val*1000}]} + -initcmd {tsv::append $tpid $arg \n $val} + -exitcmd {tsv::append $tpid $arg \n $val} + default { + error $usage + } + } + } + + # + # Start initial (minimum) number of worker threads. + # + + for {set ii 0} {$ii < [tsv::set $tpid -minworkers]} {incr ii} { + Worker $tpid + } + + return $tpid +} + +# +# tpool::names -- +# +# Returns list of currently created threadpools +# +# Arguments: +# None. +# +# Side Effects: +# None. +# +# Results +# List of active threadpoool identifiers or empty if none found +# +# + +proc tpool::names {} { + tsv::names [namespace tail [namespace current]]* +} + +# +# tpool::post -- +# +# Submits the new job to the thread pool. The caller might pass +# the job in two modes: synchronous and asynchronous. +# For the synchronous mode, the pool implementation will retain +# the result of the passed script until the caller collects it +# using the "thread::get" command. +# For the asynchronous mode, the result of the script is ignored. +# +# Arguments: +# args Variable # of arguments with the following syntax: +# tpool::post ?-detached? tpid script +# +# -detached flag to turn the async operation (ignore result) +# tpid the id of the thread pool +# script script to pass to the worker thread for execution +# +# Side Effects: +# Depends on the passed script. +# +# Results: +# The id of the posted job. This id is used later on to collect +# result of the job and set local variables accordingly. +# For asynchronously posted jobs, the return result is ignored +# and this function returns empty result. +# + +proc tpool::post {args} { + + # + # Parse command arguments. + # + + set ns [namespace current] + set usage "wrong \# args: should be \"[lindex [info level 1] 0]\ + ?-detached? tpoolId script\"" + + if {[llength $args] == 2} { + set detached 0 + set tpid [lindex $args 0] + set cmd [lindex $args 1] + } elseif {[llength $args] == 3} { + if {[lindex $args 0] != "-detached"} { + error $usage + } + set detached 1 + set tpid [lindex $args 1] + set cmd [lindex $args 2] + } else { + error $usage + } + + # + # Find idle (or create new) worker thread. This is relatively + # a complex issue, since we must honour the limits about number + # of allowed worker threads imposed to us by the caller. + # + + set tid "" + + while {$tid == ""} { + tsv::lock $tpid { + set tid [tsv::lpop $tpid thrworkers] + if {$tid == "" || [catch {thread::preserve $tid}]} { + set tid "" + tsv::lpush $tpid thrwaiters [thread::id] end + if {[tsv::set $tpid numworkers]<[tsv::set $tpid -maxworkers]} { + Worker $tpid + } + } + } + if {$tid == ""} { + vwait ${ns}::waiter + } + } + + # + # Post the command to the worker thread + # + + if {$detached} { + set j "" + thread::send -async $tid [list ${ns}::Run $tpid 0 $cmd] + } else { + set j [tsv::incr $tpid jobcounter] + thread::send -async $tid [list ${ns}::Run $tpid $j $cmd] ${ns}::result + } + + variable jobsdone + set jobsdone($j) "" + + return $j +} + +# +# tpool::wait -- +# +# Waits for jobs sent with "thread::post" to finish. +# +# Arguments: +# tpid Name of the pool shared array. +# jobList List of job id's done. +# jobLeft List of jobs still pending. +# +# Side Effects: +# Might eventually enter the event loop while waiting +# for the job result to arrive from the worker thread. +# It ignores bogus job ids. +# +# Results: +# Result of the job. If the job resulted in error, it sets +# the global errorInfo and errorCode variables accordingly. +# + +proc tpool::wait {tpid jobList {jobLeft ""}} { + + variable result + variable jobsdone + + if {$jobLeft != ""} { + upvar $jobLeft jobleft + } + + set retlist "" + set jobleft "" + + foreach j $jobList { + if {[info exists jobsdone($j)] == 0} { + continue ; # Ignore (skip) bogus job ids + } + if {$jobsdone($j) != ""} { + lappend retlist $j + } else { + lappend jobleft $j + } + } + if {[llength $retlist] == 0 && [llength $jobList]} { + # + # No jobs found; wait for the first one to get ready. + # + set jobleft $jobList + while {1} { + vwait [namespace current]::result + set doneid [lindex $result 0] + set jobsdone($doneid) $result + if {[lsearch $jobList $doneid] >= 0} { + lappend retlist $doneid + set x [lsearch $jobleft $doneid] + set jobleft [lreplace $jobleft $x $x] + break + } + } + } + + return $retlist +} + +# +# tpool::get -- +# +# Waits for a job sent with "thread::post" to finish. +# +# Arguments: +# tpid Name of the pool shared array. +# jobid Id of the previously posted job. +# +# Side Effects: +# None. +# +# Results: +# Result of the job. If the job resulted in error, it sets +# the global errorInfo and errorCode variables accordingly. +# + +proc tpool::get {tpid jobid} { + + variable jobsdone + + if {[lindex $jobsdone($jobid) 1] != 0} { + eval error [lrange $jobsdone($jobid) 2 end] + } + + return [lindex $jobsdone($jobid) 2] +} + +# +# tpool::preserve -- +# +# Increments the reference counter of the threadpool, reserving it +# for the private usage.. +# +# Arguments: +# tpid Name of the pool shared array. +# +# Side Effects: +# None. +# +# Results: +# Current number of threadpool reservations. +# + +proc tpool::preserve {tpid} { + tsv::incr $tpid refcounter +} + +# +# tpool::release -- +# +# Decrements the reference counter of the threadpool, eventually +# tearing the pool down if this was the last reservation. +# +# Arguments: +# tpid Name of the pool shared array. +# +# Side Effects: +# If the number of reservations drops to zero or below +# the threadpool is teared down. +# +# Results: +# Current number of threadpool reservations. +# + +proc tpool::release {tpid} { + + tsv::lock $tpid { + if {[tsv::incr $tpid refcounter -1] <= 0} { + # Release all workers threads + foreach t [tsv::set $tpid thrworkers] { + thread::release -wait $t + } + tsv::unset $tpid ; # This is not an error; it works! + } + } +} + +# +# Private procedures, not a part of the threadpool API. +# + +# +# tpool::Worker -- +# +# Creates new worker thread. This procedure must be executed +# under the tsv lock. +# +# Arguments: +# tpid Name of the pool shared array. +# +# Side Effects: +# Depends on the thread initialization script. +# +# Results: +# None. +# + +proc tpool::Worker {tpid} { + + # + # Create new worker thread + # + + set tid [thread::create] + + thread::send $tid [tsv::set $tpid -initcmd] + thread::preserve $tid + + tsv::incr $tpid numworkers + tsv::lpush $tpid thrworkers $tid + + # + # Signalize waiter threads if any + # + + set waiter [tsv::lpop $tpid thrwaiters] + if {$waiter != ""} { + thread::send -async $waiter [subst { + set [namespace current]::waiter 1 + }] + } +} + +# +# tpool::Timer -- +# +# This procedure should be executed within the worker thread only. +# It registers the callback for terminating the idle thread. +# +# Arguments: +# tpid Name of the pool shared array. +# +# Side Effects: +# Thread may eventually exit. +# +# Results: +# None. +# + +proc tpool::Timer {tpid} { + + tsv::lock $tpid { + if {[tsv::set $tpid numworkers] > [tsv::set $tpid -minworkers]} { + + # + # We have more workers than needed, so kill this one. + # We first splice ourselves from the list of active + # workers, adjust the number of workers and release + # this thread, which may exit eventually. + # + + set x [tsv::lsearch $tpid thrworkers [thread::id]] + if {$x >= 0} { + tsv::lreplace $tpid thrworkers $x $x + tsv::incr $tpid numworkers -1 + set exitcmd [tsv::set $tpid -exitcmd] + if {$exitcmd != ""} { + catch {eval $exitcmd} + } + thread::release + } + } + } +} + +# +# tpool::Run -- +# +# This procedure should be executed within the worker thread only. +# It performs the actual command execution in the worker thread. +# +# Arguments: +# tpid Name of the pool shared array. +# jid The job id +# cmd The command to execute +# +# Side Effects: +# Many, depending of the passed command +# +# Results: +# List for passing the evaluation result and status back. +# + +proc tpool::Run {tpid jid cmd} { + + # + # Cancel the idle timer callback, if any. + # + + variable afterevent + if {$afterevent != ""} { + after cancel $afterevent + } + + # + # Evaluate passed command and build the result list. + # + + set code [catch {uplevel \#0 $cmd} ret] + if {$code == 0} { + set res [list $jid 0 $ret] + } else { + set res [list $jid $code $ret $::errorInfo $::errorCode] + } + + # + # Check to see if any caller is waiting to be serviced. + # If yes, kick it out of the waiting state. + # + + set ns [namespace current] + + tsv::lock $tpid { + tsv::lpush $tpid thrworkers [thread::id] + set waiter [tsv::lpop $tpid thrwaiters] + if {$waiter != ""} { + thread::send -async $waiter [subst { + set ${ns}::waiter 1 + }] + } + } + + # + # Release the thread. If this turns out to be + # the last refcount held, don't bother to do + # any more work, since thread will soon exit. + # + + if {[thread::release] <= 0} { + return $res + } + + # + # Register the idle timer again. + # + + if {[set idle [tsv::set $tpid -idletime]]} { + set afterevent [after $idle [subst { + ${ns}::Timer $tpid + }]] + } + + return $res +} + +# EOF $RCSfile: tpool.tcl,v $ + +# Emacs Setup Variables +# Local Variables: +# mode: Tcl +# indent-tabs-mode: nil +# tcl-basic-offset: 4 +# End: + diff --git a/tcl8.6/pkgs/thread2.8.4/tclconfig/README.txt b/tcl8.6/pkgs/thread2.8.4/tclconfig/README.txt new file mode 100644 index 0000000..59b5a3e --- /dev/null +++ b/tcl8.6/pkgs/thread2.8.4/tclconfig/README.txt @@ -0,0 +1,26 @@ +These files comprise the basic building blocks for a Tcl Extension +Architecture (TEA) extension. For more information on TEA see: + + http://www.tcl.tk/doc/tea/ + +This package is part of the Tcl project at SourceForge, and latest +sources should be available there: + + http://tcl.sourceforge.net/ + +This package is a freely available open source package. You can do +virtually anything you like with it, such as modifying it, redistributing +it, and selling it either in whole or in part. + +CONTENTS +======== +The following is a short description of the files you will find in +the sample extension. + +README.txt This file + +install-sh Program used for copying binaries and script files + to their install locations. + +tcl.m4 Collection of Tcl autoconf macros. Included by a package's + aclocal.m4 to define TEA_* macros. diff --git a/tcl8.6/pkgs/thread2.8.4/tclconfig/install-sh b/tcl8.6/pkgs/thread2.8.4/tclconfig/install-sh new file mode 100644 index 0000000..7c34c3f --- /dev/null +++ b/tcl8.6/pkgs/thread2.8.4/tclconfig/install-sh @@ -0,0 +1,528 @@ +#!/bin/sh +# install - install a program, script, or datafile + +scriptversion=2011-04-20.01; # UTC + +# This originates from X11R5 (mit/util/scripts/install.sh), which was +# later released in X11R6 (xc/config/util/install.sh) with the +# following copyright and license. +# +# Copyright (C) 1994 X Consortium +# +# Permission is hereby granted, free of charge, to any person obtaining a copy +# of this software and associated documentation files (the "Software"), to +# deal in the Software without restriction, including without limitation the +# rights to use, copy, modify, merge, publish, distribute, sublicense, and/or +# sell copies of the Software, and to permit persons to whom the Software is +# furnished to do so, subject to the following conditions: +# +# The above copyright notice and this permission notice shall be included in +# all copies or substantial portions of the Software. +# +# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +# X CONSORTIUM BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN +# AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNEC- +# TION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +# +# Except as contained in this notice, the name of the X Consortium shall not +# be used in advertising or otherwise to promote the sale, use or other deal- +# ings in this Software without prior written authorization from the X Consor- +# tium. +# +# +# FSF changes to this file are in the public domain. +# +# Calling this script install-sh is preferred over install.sh, to prevent +# `make' implicit rules from creating a file called install from it +# when there is no Makefile. +# +# This script is compatible with the BSD install script, but was written +# from scratch. + +nl=' +' +IFS=" "" $nl" + +# set DOITPROG to echo to test this script + +# Don't use :- since 4.3BSD and earlier shells don't like it. +doit=${DOITPROG-} +if test -z "$doit"; then + doit_exec=exec +else + doit_exec=$doit +fi + +# Put in absolute file names if you don't have them in your path; +# or use environment vars. + +chgrpprog=${CHGRPPROG-chgrp} +chmodprog=${CHMODPROG-chmod} +chownprog=${CHOWNPROG-chown} +cmpprog=${CMPPROG-cmp} +cpprog=${CPPROG-cp} +mkdirprog=${MKDIRPROG-mkdir} +mvprog=${MVPROG-mv} +rmprog=${RMPROG-rm} +stripprog=${STRIPPROG-strip} + +posix_glob='?' +initialize_posix_glob=' + test "$posix_glob" != "?" || { + if (set -f) 2>/dev/null; then + posix_glob= + else + posix_glob=: + fi + } +' + +posix_mkdir= + +# Desired mode of installed file. +mode=0755 + +chgrpcmd= +chmodcmd=$chmodprog +chowncmd= +mvcmd=$mvprog +rmcmd="$rmprog -f" +stripcmd= + +src= +dst= +dir_arg= +dst_arg= + +copy_on_change=false +no_target_directory= + +usage="\ +Usage: $0 [OPTION]... [-T] SRCFILE DSTFILE + or: $0 [OPTION]... SRCFILES... DIRECTORY + or: $0 [OPTION]... -t DIRECTORY SRCFILES... + or: $0 [OPTION]... -d DIRECTORIES... + +In the 1st form, copy SRCFILE to DSTFILE. +In the 2nd and 3rd, copy all SRCFILES to DIRECTORY. +In the 4th, create DIRECTORIES. + +Options: + --help display this help and exit. + --version display version info and exit. + + -c (ignored) + -C install only if different (preserve the last data modification time) + -d create directories instead of installing files. + -g GROUP $chgrpprog installed files to GROUP. + -m MODE $chmodprog installed files to MODE. + -o USER $chownprog installed files to USER. + -s $stripprog installed files. + -S $stripprog installed files. + -t DIRECTORY install into DIRECTORY. + -T report an error if DSTFILE is a directory. + +Environment variables override the default commands: + CHGRPPROG CHMODPROG CHOWNPROG CMPPROG CPPROG MKDIRPROG MVPROG + RMPROG STRIPPROG +" + +while test $# -ne 0; do + case $1 in + -c) ;; + + -C) copy_on_change=true;; + + -d) dir_arg=true;; + + -g) chgrpcmd="$chgrpprog $2" + shift;; + + --help) echo "$usage"; exit $?;; + + -m) mode=$2 + case $mode in + *' '* | *' '* | *' +'* | *'*'* | *'?'* | *'['*) + echo "$0: invalid mode: $mode" >&2 + exit 1;; + esac + shift;; + + -o) chowncmd="$chownprog $2" + shift;; + + -s) stripcmd=$stripprog;; + + -S) stripcmd="$stripprog $2" + shift;; + + -t) dst_arg=$2 + shift;; + + -T) no_target_directory=true;; + + --version) echo "$0 $scriptversion"; exit $?;; + + --) shift + break;; + + -*) echo "$0: invalid option: $1" >&2 + exit 1;; + + *) break;; + esac + shift +done + +if test $# -ne 0 && test -z "$dir_arg$dst_arg"; then + # When -d is used, all remaining arguments are directories to create. + # When -t is used, the destination is already specified. + # Otherwise, the last argument is the destination. Remove it from $@. + for arg + do + if test -n "$dst_arg"; then + # $@ is not empty: it contains at least $arg. + set fnord "$@" "$dst_arg" + shift # fnord + fi + shift # arg + dst_arg=$arg + done +fi + +if test $# -eq 0; then + if test -z "$dir_arg"; then + echo "$0: no input file specified." >&2 + exit 1 + fi + # It's OK to call `install-sh -d' without argument. + # This can happen when creating conditional directories. + exit 0 +fi + +if test -z "$dir_arg"; then + do_exit='(exit $ret); exit $ret' + trap "ret=129; $do_exit" 1 + trap "ret=130; $do_exit" 2 + trap "ret=141; $do_exit" 13 + trap "ret=143; $do_exit" 15 + + # Set umask so as not to create temps with too-generous modes. + # However, 'strip' requires both read and write access to temps. + case $mode in + # Optimize common cases. + *644) cp_umask=133;; + *755) cp_umask=22;; + + *[0-7]) + if test -z "$stripcmd"; then + u_plus_rw= + else + u_plus_rw='% 200' + fi + cp_umask=`expr '(' 777 - $mode % 1000 ')' $u_plus_rw`;; + *) + if test -z "$stripcmd"; then + u_plus_rw= + else + u_plus_rw=,u+rw + fi + cp_umask=$mode$u_plus_rw;; + esac +fi + +for src +do + # Protect names starting with `-'. + case $src in + -*) src=./$src;; + esac + + if test -n "$dir_arg"; then + dst=$src + dstdir=$dst + test -d "$dstdir" + dstdir_status=$? + else + + # Waiting for this to be detected by the "$cpprog $src $dsttmp" command + # might cause directories to be created, which would be especially bad + # if $src (and thus $dsttmp) contains '*'. + if test ! -f "$src" && test ! -d "$src"; then + echo "$0: $src does not exist." >&2 + exit 1 + fi + + if test -z "$dst_arg"; then + echo "$0: no destination specified." >&2 + exit 1 + fi + + dst=$dst_arg + # Protect names starting with `-'. + case $dst in + -*) dst=./$dst;; + esac + + # If destination is a directory, append the input filename; won't work + # if double slashes aren't ignored. + if test -d "$dst"; then + if test -n "$no_target_directory"; then + echo "$0: $dst_arg: Is a directory" >&2 + exit 1 + fi + dstdir=$dst + dst=$dstdir/`basename "$src"` + dstdir_status=0 + else + # Prefer dirname, but fall back on a substitute if dirname fails. + dstdir=` + (dirname "$dst") 2>/dev/null || + expr X"$dst" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$dst" : 'X\(//\)[^/]' \| \ + X"$dst" : 'X\(//\)$' \| \ + X"$dst" : 'X\(/\)' \| . 2>/dev/null || + echo X"$dst" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ + s//\1/ + q + } + /^X\(\/\/\)[^/].*/{ + s//\1/ + q + } + /^X\(\/\/\)$/{ + s//\1/ + q + } + /^X\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q' + ` + + test -d "$dstdir" + dstdir_status=$? + fi + fi + + obsolete_mkdir_used=false + + if test $dstdir_status != 0; then + case $posix_mkdir in + '') + # Create intermediate dirs using mode 755 as modified by the umask. + # This is like FreeBSD 'install' as of 1997-10-28. + umask=`umask` + case $stripcmd.$umask in + # Optimize common cases. + *[2367][2367]) mkdir_umask=$umask;; + .*0[02][02] | .[02][02] | .[02]) mkdir_umask=22;; + + *[0-7]) + mkdir_umask=`expr $umask + 22 \ + - $umask % 100 % 40 + $umask % 20 \ + - $umask % 10 % 4 + $umask % 2 + `;; + *) mkdir_umask=$umask,go-w;; + esac + + # With -d, create the new directory with the user-specified mode. + # Otherwise, rely on $mkdir_umask. + if test -n "$dir_arg"; then + mkdir_mode=-m$mode + else + mkdir_mode= + fi + + posix_mkdir=false + case $umask in + *[123567][0-7][0-7]) + # POSIX mkdir -p sets u+wx bits regardless of umask, which + # is incompatible with FreeBSD 'install' when (umask & 300) != 0. + ;; + *) + tmpdir=${TMPDIR-/tmp}/ins$RANDOM-$$ + trap 'ret=$?; rmdir "$tmpdir/d" "$tmpdir" 2>/dev/null; exit $ret' 0 + + if (umask $mkdir_umask && + exec $mkdirprog $mkdir_mode -p -- "$tmpdir/d") >/dev/null 2>&1 + then + if test -z "$dir_arg" || { + # Check for POSIX incompatibilities with -m. + # HP-UX 11.23 and IRIX 6.5 mkdir -m -p sets group- or + # other-writeable bit of parent directory when it shouldn't. + # FreeBSD 6.1 mkdir -m -p sets mode of existing directory. + ls_ld_tmpdir=`ls -ld "$tmpdir"` + case $ls_ld_tmpdir in + d????-?r-*) different_mode=700;; + d????-?--*) different_mode=755;; + *) false;; + esac && + $mkdirprog -m$different_mode -p -- "$tmpdir" && { + ls_ld_tmpdir_1=`ls -ld "$tmpdir"` + test "$ls_ld_tmpdir" = "$ls_ld_tmpdir_1" + } + } + then posix_mkdir=: + fi + rmdir "$tmpdir/d" "$tmpdir" + else + # Remove any dirs left behind by ancient mkdir implementations. + rmdir ./$mkdir_mode ./-p ./-- 2>/dev/null + fi + trap '' 0;; + esac;; + esac + + if + $posix_mkdir && ( + umask $mkdir_umask && + $doit_exec $mkdirprog $mkdir_mode -p -- "$dstdir" + ) + then : + else + + # The umask is ridiculous, or mkdir does not conform to POSIX, + # or it failed possibly due to a race condition. Create the + # directory the slow way, step by step, checking for races as we go. + + case $dstdir in + /*) prefix='/';; + -*) prefix='./';; + *) prefix='';; + esac + + eval "$initialize_posix_glob" + + oIFS=$IFS + IFS=/ + $posix_glob set -f + set fnord $dstdir + shift + $posix_glob set +f + IFS=$oIFS + + prefixes= + + for d + do + test -z "$d" && continue + + prefix=$prefix$d + if test -d "$prefix"; then + prefixes= + else + if $posix_mkdir; then + (umask=$mkdir_umask && + $doit_exec $mkdirprog $mkdir_mode -p -- "$dstdir") && break + # Don't fail if two instances are running concurrently. + test -d "$prefix" || exit 1 + else + case $prefix in + *\'*) qprefix=`echo "$prefix" | sed "s/'/'\\\\\\\\''/g"`;; + *) qprefix=$prefix;; + esac + prefixes="$prefixes '$qprefix'" + fi + fi + prefix=$prefix/ + done + + if test -n "$prefixes"; then + # Don't fail if two instances are running concurrently. + (umask $mkdir_umask && + eval "\$doit_exec \$mkdirprog $prefixes") || + test -d "$dstdir" || exit 1 + obsolete_mkdir_used=true + fi + fi + fi + + if test -n "$dir_arg"; then + { test -z "$chowncmd" || $doit $chowncmd "$dst"; } && + { test -z "$chgrpcmd" || $doit $chgrpcmd "$dst"; } && + { test "$obsolete_mkdir_used$chowncmd$chgrpcmd" = false || + test -z "$chmodcmd" || $doit $chmodcmd $mode "$dst"; } || exit 1 + else + + # Make a couple of temp file names in the proper directory. + dsttmp=$dstdir/_inst.$$_ + rmtmp=$dstdir/_rm.$$_ + + # Trap to clean up those temp files at exit. + trap 'ret=$?; rm -f "$dsttmp" "$rmtmp" && exit $ret' 0 + + # Copy the file name to the temp name. + (umask $cp_umask && $doit_exec $cpprog "$src" "$dsttmp") && + + # and set any options; do chmod last to preserve setuid bits. + # + # If any of these fail, we abort the whole thing. If we want to + # ignore errors from any of these, just make sure not to ignore + # errors from the above "$doit $cpprog $src $dsttmp" command. + # + { test -z "$chowncmd" || $doit $chowncmd "$dsttmp"; } && + { test -z "$chgrpcmd" || $doit $chgrpcmd "$dsttmp"; } && + { test -z "$stripcmd" || $doit $stripcmd "$dsttmp"; } && + { test -z "$chmodcmd" || $doit $chmodcmd $mode "$dsttmp"; } && + + # If -C, don't bother to copy if it wouldn't change the file. + if $copy_on_change && + old=`LC_ALL=C ls -dlL "$dst" 2>/dev/null` && + new=`LC_ALL=C ls -dlL "$dsttmp" 2>/dev/null` && + + eval "$initialize_posix_glob" && + $posix_glob set -f && + set X $old && old=:$2:$4:$5:$6 && + set X $new && new=:$2:$4:$5:$6 && + $posix_glob set +f && + + test "$old" = "$new" && + $cmpprog "$dst" "$dsttmp" >/dev/null 2>&1 + then + rm -f "$dsttmp" + else + # Rename the file to the real destination. + $doit $mvcmd -f "$dsttmp" "$dst" 2>/dev/null || + + # The rename failed, perhaps because mv can't rename something else + # to itself, or perhaps because mv is so ancient that it does not + # support -f. + { + # Now remove or move aside any old file at destination location. + # We try this two ways since rm can't unlink itself on some + # systems and the destination file might be busy for other + # reasons. In this case, the final cleanup might fail but the new + # file should still install successfully. + { + test ! -f "$dst" || + $doit $rmcmd -f "$dst" 2>/dev/null || + { $doit $mvcmd -f "$dst" "$rmtmp" 2>/dev/null && + { $doit $rmcmd -f "$rmtmp" 2>/dev/null; :; } + } || + { echo "$0: cannot unlink or rename $dst" >&2 + (exit 1); exit 1 + } + } && + + # Now rename the file to the real destination. + $doit $mvcmd "$dsttmp" "$dst" + } + fi || exit 1 + + trap '' 0 + fi +done + +# Local variables: +# eval: (add-hook 'write-file-hooks 'time-stamp) +# time-stamp-start: "scriptversion=" +# time-stamp-format: "%:y-%02m-%02d.%02H" +# time-stamp-time-zone: "UTC" +# time-stamp-end: "; # UTC" +# End: diff --git a/tcl8.6/pkgs/thread2.8.4/tclconfig/tcl.m4 b/tcl8.6/pkgs/thread2.8.4/tclconfig/tcl.m4 new file mode 100644 index 0000000..2ec82a2 --- /dev/null +++ b/tcl8.6/pkgs/thread2.8.4/tclconfig/tcl.m4 @@ -0,0 +1,4184 @@ +# tcl.m4 -- +# +# This file provides a set of autoconf macros to help TEA-enable +# a Tcl extension. +# +# Copyright (c) 1999-2000 Ajuba Solutions. +# Copyright (c) 2002-2005 ActiveState Corporation. +# +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. + +AC_PREREQ(2.57) + +# Possible values for key variables defined: +# +# TEA_WINDOWINGSYSTEM - win32 aqua x11 (mirrors 'tk windowingsystem') +# TEA_PLATFORM - windows unix +# TEA_TK_EXTENSION - True if this is a Tk extension +# + +#------------------------------------------------------------------------ +# TEA_PATH_TCLCONFIG -- +# +# Locate the tclConfig.sh file and perform a sanity check on +# the Tcl compile flags +# +# Arguments: +# none +# +# Results: +# +# Adds the following arguments to configure: +# --with-tcl=... +# +# Defines the following vars: +# TCL_BIN_DIR Full path to the directory containing +# the tclConfig.sh file +#------------------------------------------------------------------------ + +AC_DEFUN([TEA_PATH_TCLCONFIG], [ + dnl TEA specific: Make sure we are initialized + AC_REQUIRE([TEA_INIT]) + # + # Ok, lets find the tcl configuration + # First, look for one uninstalled. + # the alternative search directory is invoked by --with-tcl + # + + if test x"${no_tcl}" = x ; then + # we reset no_tcl in case something fails here + no_tcl=true + AC_ARG_WITH(tcl, + AC_HELP_STRING([--with-tcl], + [directory containing tcl configuration (tclConfig.sh)]), + with_tclconfig="${withval}") + AC_MSG_CHECKING([for Tcl configuration]) + AC_CACHE_VAL(ac_cv_c_tclconfig,[ + + # First check to see if --with-tcl was specified. + if test x"${with_tclconfig}" != x ; then + case "${with_tclconfig}" in + */tclConfig.sh ) + if test -f "${with_tclconfig}"; then + AC_MSG_WARN([--with-tcl argument should refer to directory containing tclConfig.sh, not to tclConfig.sh itself]) + with_tclconfig="`echo "${with_tclconfig}" | sed 's!/tclConfig\.sh$!!'`" + fi ;; + esac + if test -f "${with_tclconfig}/tclConfig.sh" ; then + ac_cv_c_tclconfig="`(cd "${with_tclconfig}"; pwd)`" + else + AC_MSG_ERROR([${with_tclconfig} directory doesn't contain tclConfig.sh]) + fi + fi + + # then check for a private Tcl installation + if test x"${ac_cv_c_tclconfig}" = x ; then + for i in \ + ../tcl \ + `ls -dr ../tcl[[8-9]].[[0-9]].[[0-9]]* 2>/dev/null` \ + `ls -dr ../tcl[[8-9]].[[0-9]] 2>/dev/null` \ + `ls -dr ../tcl[[8-9]].[[0-9]]* 2>/dev/null` \ + ../../tcl \ + `ls -dr ../../tcl[[8-9]].[[0-9]].[[0-9]]* 2>/dev/null` \ + `ls -dr ../../tcl[[8-9]].[[0-9]] 2>/dev/null` \ + `ls -dr ../../tcl[[8-9]].[[0-9]]* 2>/dev/null` \ + ../../../tcl \ + `ls -dr ../../../tcl[[8-9]].[[0-9]].[[0-9]]* 2>/dev/null` \ + `ls -dr ../../../tcl[[8-9]].[[0-9]] 2>/dev/null` \ + `ls -dr ../../../tcl[[8-9]].[[0-9]]* 2>/dev/null` ; do + if test "${TEA_PLATFORM}" = "windows" \ + -a -f "$i/win/tclConfig.sh" ; then + ac_cv_c_tclconfig="`(cd $i/win; pwd)`" + break + fi + if test -f "$i/unix/tclConfig.sh" ; then + ac_cv_c_tclconfig="`(cd $i/unix; pwd)`" + break + fi + done + fi + + # on Darwin, check in Framework installation locations + if test "`uname -s`" = "Darwin" -a x"${ac_cv_c_tclconfig}" = x ; then + for i in `ls -d ~/Library/Frameworks 2>/dev/null` \ + `ls -d /Library/Frameworks 2>/dev/null` \ + `ls -d /Network/Library/Frameworks 2>/dev/null` \ + `ls -d /System/Library/Frameworks 2>/dev/null` \ + `ls -d /Applications/Xcode.app/Contents/Developer/Platforms/MacOSX.platform/Developer/SDKs/MacOSX.sdk/Library/Frameworks/Tcl.framework 2>/dev/null` \ + `ls -d /Applications/Xcode.app/Contents/Developer/Platforms/MacOSX.platform/Developer/SDKs/MacOSX.sdk/Network/Library/Frameworks/Tcl.framework 2>/dev/null` \ + `ls -d /Applications/Xcode.app/Contents/Developer/Platforms/MacOSX.platform/Developer/SDKs/MacOSX.sdk/System/Library/Frameworks/Tcl.framework 2>/dev/null` \ + ; do + if test -f "$i/Tcl.framework/tclConfig.sh" ; then + ac_cv_c_tclconfig="`(cd $i/Tcl.framework; pwd)`" + break + fi + done + fi + + # TEA specific: on Windows, check in common installation locations + if test "${TEA_PLATFORM}" = "windows" \ + -a x"${ac_cv_c_tclconfig}" = x ; then + for i in `ls -d C:/Tcl/lib 2>/dev/null` \ + `ls -d C:/Progra~1/Tcl/lib 2>/dev/null` \ + ; do + if test -f "$i/tclConfig.sh" ; then + ac_cv_c_tclconfig="`(cd $i; pwd)`" + break + fi + done + fi + + # check in a few common install locations + if test x"${ac_cv_c_tclconfig}" = x ; then + for i in `ls -d ${libdir} 2>/dev/null` \ + `ls -d ${exec_prefix}/lib 2>/dev/null` \ + `ls -d ${prefix}/lib 2>/dev/null` \ + `ls -d /usr/local/lib 2>/dev/null` \ + `ls -d /usr/contrib/lib 2>/dev/null` \ + `ls -d /usr/pkg/lib 2>/dev/null` \ + `ls -d /usr/lib 2>/dev/null` \ + `ls -d /usr/lib64 2>/dev/null` \ + `ls -d /usr/lib/tcl8.6 2>/dev/null` \ + `ls -d /usr/lib/tcl8.5 2>/dev/null` \ + `ls -d /usr/local/lib/tcl8.6 2>/dev/null` \ + `ls -d /usr/local/lib/tcl8.5 2>/dev/null` \ + `ls -d /usr/local/lib/tcl/tcl8.6 2>/dev/null` \ + `ls -d /usr/local/lib/tcl/tcl8.5 2>/dev/null` \ + ; do + if test -f "$i/tclConfig.sh" ; then + ac_cv_c_tclconfig="`(cd $i; pwd)`" + break + fi + done + fi + + # check in a few other private locations + if test x"${ac_cv_c_tclconfig}" = x ; then + for i in \ + ${srcdir}/../tcl \ + `ls -dr ${srcdir}/../tcl[[8-9]].[[0-9]].[[0-9]]* 2>/dev/null` \ + `ls -dr ${srcdir}/../tcl[[8-9]].[[0-9]] 2>/dev/null` \ + `ls -dr ${srcdir}/../tcl[[8-9]].[[0-9]]* 2>/dev/null` ; do + if test "${TEA_PLATFORM}" = "windows" \ + -a -f "$i/win/tclConfig.sh" ; then + ac_cv_c_tclconfig="`(cd $i/win; pwd)`" + break + fi + if test -f "$i/unix/tclConfig.sh" ; then + ac_cv_c_tclconfig="`(cd $i/unix; pwd)`" + break + fi + done + fi + ]) + + if test x"${ac_cv_c_tclconfig}" = x ; then + TCL_BIN_DIR="# no Tcl configs found" + AC_MSG_ERROR([Can't find Tcl configuration definitions. Use --with-tcl to specify a directory containing tclConfig.sh]) + else + no_tcl= + TCL_BIN_DIR="${ac_cv_c_tclconfig}" + AC_MSG_RESULT([found ${TCL_BIN_DIR}/tclConfig.sh]) + fi + fi +]) + +#------------------------------------------------------------------------ +# TEA_PATH_TKCONFIG -- +# +# Locate the tkConfig.sh file +# +# Arguments: +# none +# +# Results: +# +# Adds the following arguments to configure: +# --with-tk=... +# +# Defines the following vars: +# TK_BIN_DIR Full path to the directory containing +# the tkConfig.sh file +#------------------------------------------------------------------------ + +AC_DEFUN([TEA_PATH_TKCONFIG], [ + # + # Ok, lets find the tk configuration + # First, look for one uninstalled. + # the alternative search directory is invoked by --with-tk + # + + if test x"${no_tk}" = x ; then + # we reset no_tk in case something fails here + no_tk=true + AC_ARG_WITH(tk, + AC_HELP_STRING([--with-tk], + [directory containing tk configuration (tkConfig.sh)]), + with_tkconfig="${withval}") + AC_MSG_CHECKING([for Tk configuration]) + AC_CACHE_VAL(ac_cv_c_tkconfig,[ + + # First check to see if --with-tkconfig was specified. + if test x"${with_tkconfig}" != x ; then + case "${with_tkconfig}" in + */tkConfig.sh ) + if test -f "${with_tkconfig}"; then + AC_MSG_WARN([--with-tk argument should refer to directory containing tkConfig.sh, not to tkConfig.sh itself]) + with_tkconfig="`echo "${with_tkconfig}" | sed 's!/tkConfig\.sh$!!'`" + fi ;; + esac + if test -f "${with_tkconfig}/tkConfig.sh" ; then + ac_cv_c_tkconfig="`(cd "${with_tkconfig}"; pwd)`" + else + AC_MSG_ERROR([${with_tkconfig} directory doesn't contain tkConfig.sh]) + fi + fi + + # then check for a private Tk library + if test x"${ac_cv_c_tkconfig}" = x ; then + for i in \ + ../tk \ + `ls -dr ../tk[[8-9]].[[0-9]].[[0-9]]* 2>/dev/null` \ + `ls -dr ../tk[[8-9]].[[0-9]] 2>/dev/null` \ + `ls -dr ../tk[[8-9]].[[0-9]]* 2>/dev/null` \ + ../../tk \ + `ls -dr ../../tk[[8-9]].[[0-9]].[[0-9]]* 2>/dev/null` \ + `ls -dr ../../tk[[8-9]].[[0-9]] 2>/dev/null` \ + `ls -dr ../../tk[[8-9]].[[0-9]]* 2>/dev/null` \ + ../../../tk \ + `ls -dr ../../../tk[[8-9]].[[0-9]].[[0-9]]* 2>/dev/null` \ + `ls -dr ../../../tk[[8-9]].[[0-9]] 2>/dev/null` \ + `ls -dr ../../../tk[[8-9]].[[0-9]]* 2>/dev/null` ; do + if test "${TEA_PLATFORM}" = "windows" \ + -a -f "$i/win/tkConfig.sh" ; then + ac_cv_c_tkconfig="`(cd $i/win; pwd)`" + break + fi + if test -f "$i/unix/tkConfig.sh" ; then + ac_cv_c_tkconfig="`(cd $i/unix; pwd)`" + break + fi + done + fi + + # on Darwin, check in Framework installation locations + if test "`uname -s`" = "Darwin" -a x"${ac_cv_c_tkconfig}" = x ; then + for i in `ls -d ~/Library/Frameworks 2>/dev/null` \ + `ls -d /Library/Frameworks 2>/dev/null` \ + `ls -d /Network/Library/Frameworks 2>/dev/null` \ + `ls -d /System/Library/Frameworks 2>/dev/null` \ + `ls -d /Applications/Xcode.app/Contents/Developer/Platforms/MacOSX.platform/Developer/SDKs/MacOSX.sdk/Library/Frameworks/Tcl.framework 2>/dev/null` \ + `ls -d /Applications/Xcode.app/Contents/Developer/Platforms/MacOSX.platform/Developer/SDKs/MacOSX.sdk/Network/Library/Frameworks/Tcl.framework 2>/dev/null` \ + `ls -d /Applications/Xcode.app/Contents/Developer/Platforms/MacOSX.platform/Developer/SDKs/MacOSX.sdk/System/Library/Frameworks/Tcl.framework 2>/dev/null` \ + ; do + if test -f "$i/Tk.framework/tkConfig.sh" ; then + ac_cv_c_tkconfig="`(cd $i/Tk.framework; pwd)`" + break + fi + done + fi + + # check in a few common install locations + if test x"${ac_cv_c_tkconfig}" = x ; then + for i in `ls -d ${libdir} 2>/dev/null` \ + `ls -d ${exec_prefix}/lib 2>/dev/null` \ + `ls -d ${prefix}/lib 2>/dev/null` \ + `ls -d /usr/local/lib 2>/dev/null` \ + `ls -d /usr/contrib/lib 2>/dev/null` \ + `ls -d /usr/pkg/lib 2>/dev/null` \ + `ls -d /usr/lib 2>/dev/null` \ + `ls -d /usr/lib64 2>/dev/null` \ + `ls -d /usr/lib/tk8.6 2>/dev/null` \ + `ls -d /usr/lib/tk8.5 2>/dev/null` \ + `ls -d /usr/local/lib/tk8.6 2>/dev/null` \ + `ls -d /usr/local/lib/tk8.5 2>/dev/null` \ + `ls -d /usr/local/lib/tcl/tk8.6 2>/dev/null` \ + `ls -d /usr/local/lib/tcl/tk8.5 2>/dev/null` \ + ; do + if test -f "$i/tkConfig.sh" ; then + ac_cv_c_tkconfig="`(cd $i; pwd)`" + break + fi + done + fi + + # TEA specific: on Windows, check in common installation locations + if test "${TEA_PLATFORM}" = "windows" \ + -a x"${ac_cv_c_tkconfig}" = x ; then + for i in `ls -d C:/Tcl/lib 2>/dev/null` \ + `ls -d C:/Progra~1/Tcl/lib 2>/dev/null` \ + ; do + if test -f "$i/tkConfig.sh" ; then + ac_cv_c_tkconfig="`(cd $i; pwd)`" + break + fi + done + fi + + # check in a few other private locations + if test x"${ac_cv_c_tkconfig}" = x ; then + for i in \ + ${srcdir}/../tk \ + `ls -dr ${srcdir}/../tk[[8-9]].[[0-9]].[[0-9]]* 2>/dev/null` \ + `ls -dr ${srcdir}/../tk[[8-9]].[[0-9]] 2>/dev/null` \ + `ls -dr ${srcdir}/../tk[[8-9]].[[0-9]]* 2>/dev/null` ; do + if test "${TEA_PLATFORM}" = "windows" \ + -a -f "$i/win/tkConfig.sh" ; then + ac_cv_c_tkconfig="`(cd $i/win; pwd)`" + break + fi + if test -f "$i/unix/tkConfig.sh" ; then + ac_cv_c_tkconfig="`(cd $i/unix; pwd)`" + break + fi + done + fi + ]) + + if test x"${ac_cv_c_tkconfig}" = x ; then + TK_BIN_DIR="# no Tk configs found" + AC_MSG_ERROR([Can't find Tk configuration definitions. Use --with-tk to specify a directory containing tkConfig.sh]) + else + no_tk= + TK_BIN_DIR="${ac_cv_c_tkconfig}" + AC_MSG_RESULT([found ${TK_BIN_DIR}/tkConfig.sh]) + fi + fi +]) + +#------------------------------------------------------------------------ +# TEA_LOAD_TCLCONFIG -- +# +# Load the tclConfig.sh file +# +# Arguments: +# +# Requires the following vars to be set: +# TCL_BIN_DIR +# +# Results: +# +# Substitutes the following vars: +# TCL_BIN_DIR +# TCL_SRC_DIR +# TCL_LIB_FILE +# TCL_ZIP_FILE +# TCL_ZIPFS_SUPPORT +#------------------------------------------------------------------------ + +AC_DEFUN([TEA_LOAD_TCLCONFIG], [ + AC_MSG_CHECKING([for existence of ${TCL_BIN_DIR}/tclConfig.sh]) + + if test -f "${TCL_BIN_DIR}/tclConfig.sh" ; then + AC_MSG_RESULT([loading]) + . "${TCL_BIN_DIR}/tclConfig.sh" + else + AC_MSG_RESULT([could not find ${TCL_BIN_DIR}/tclConfig.sh]) + fi + + # eval is required to do the TCL_DBGX substitution + eval "TCL_LIB_FILE=\"${TCL_LIB_FILE}\"" + eval "TCL_STUB_LIB_FILE=\"${TCL_STUB_LIB_FILE}\"" + + # If the TCL_BIN_DIR is the build directory (not the install directory), + # then set the common variable name to the value of the build variables. + # For example, the variable TCL_LIB_SPEC will be set to the value + # of TCL_BUILD_LIB_SPEC. An extension should make use of TCL_LIB_SPEC + # instead of TCL_BUILD_LIB_SPEC since it will work with both an + # installed and uninstalled version of Tcl. + if test -f "${TCL_BIN_DIR}/Makefile" ; then + TCL_LIB_SPEC="${TCL_BUILD_LIB_SPEC}" + TCL_STUB_LIB_SPEC="${TCL_BUILD_STUB_LIB_SPEC}" + TCL_STUB_LIB_PATH="${TCL_BUILD_STUB_LIB_PATH}" + elif test "`uname -s`" = "Darwin"; then + # If Tcl was built as a framework, attempt to use the libraries + # from the framework at the given location so that linking works + # against Tcl.framework installed in an arbitrary location. + case ${TCL_DEFS} in + *TCL_FRAMEWORK*) + if test -f "${TCL_BIN_DIR}/${TCL_LIB_FILE}"; then + for i in "`cd "${TCL_BIN_DIR}"; pwd`" \ + "`cd "${TCL_BIN_DIR}"/../..; pwd`"; do + if test "`basename "$i"`" = "${TCL_LIB_FILE}.framework"; then + TCL_LIB_SPEC="-F`dirname "$i" | sed -e 's/ /\\\\ /g'` -framework ${TCL_LIB_FILE}" + break + fi + done + fi + if test -f "${TCL_BIN_DIR}/${TCL_STUB_LIB_FILE}"; then + TCL_STUB_LIB_SPEC="-L`echo "${TCL_BIN_DIR}" | sed -e 's/ /\\\\ /g'` ${TCL_STUB_LIB_FLAG}" + TCL_STUB_LIB_PATH="${TCL_BIN_DIR}/${TCL_STUB_LIB_FILE}" + fi + ;; + esac + fi + + # eval is required to do the TCL_DBGX substitution + eval "TCL_LIB_FLAG=\"${TCL_LIB_FLAG}\"" + eval "TCL_LIB_SPEC=\"${TCL_LIB_SPEC}\"" + eval "TCL_STUB_LIB_FLAG=\"${TCL_STUB_LIB_FLAG}\"" + eval "TCL_STUB_LIB_SPEC=\"${TCL_STUB_LIB_SPEC}\"" + + AC_SUBST(TCL_VERSION) + AC_SUBST(TCL_PATCH_LEVEL) + AC_SUBST(TCL_BIN_DIR) + AC_SUBST(TCL_SRC_DIR) + + AC_SUBST(TCL_LIB_FILE) + AC_SUBST(TCL_LIB_FLAG) + AC_SUBST(TCL_LIB_SPEC) + + AC_SUBST(TCL_STUB_LIB_FILE) + AC_SUBST(TCL_STUB_LIB_FLAG) + AC_SUBST(TCL_STUB_LIB_SPEC) + + AC_MSG_CHECKING([platform]) + hold_cc=$CC; CC="$TCL_CC" + AC_TRY_COMPILE(,[ + #ifdef _WIN32 + #error win32 + #endif + ], [ + TEA_PLATFORM="unix" + CYGPATH=echo + ], [ + TEA_PLATFORM="windows" + AC_CHECK_PROG(CYGPATH, cygpath, cygpath -m, echo) ] + ) + CC=$hold_cc + AC_MSG_RESULT($TEA_PLATFORM) + + # The BUILD_$pkg is to define the correct extern storage class + # handling when making this package + AC_DEFINE_UNQUOTED(BUILD_${PACKAGE_NAME}, [], + [Building extension source?]) + # Do this here as we have fully defined TEA_PLATFORM now + if test "${TEA_PLATFORM}" = "windows" ; then + EXEEXT=".exe" + CLEANFILES="$CLEANFILES *.lib *.dll *.pdb *.exp" + fi + + # TEA specific: + AC_SUBST(CLEANFILES) + AC_SUBST(TCL_LIBS) + AC_SUBST(TCL_DEFS) + AC_SUBST(TCL_EXTRA_CFLAGS) + AC_SUBST(TCL_LD_FLAGS) + AC_SUBST(TCL_SHLIB_LD_LIBS) +]) + +#------------------------------------------------------------------------ +# TEA_LOAD_TKCONFIG -- +# +# Load the tkConfig.sh file +# +# Arguments: +# +# Requires the following vars to be set: +# TK_BIN_DIR +# +# Results: +# +# Sets the following vars that should be in tkConfig.sh: +# TK_BIN_DIR +#------------------------------------------------------------------------ + +AC_DEFUN([TEA_LOAD_TKCONFIG], [ + AC_MSG_CHECKING([for existence of ${TK_BIN_DIR}/tkConfig.sh]) + + if test -f "${TK_BIN_DIR}/tkConfig.sh" ; then + AC_MSG_RESULT([loading]) + . "${TK_BIN_DIR}/tkConfig.sh" + else + AC_MSG_RESULT([could not find ${TK_BIN_DIR}/tkConfig.sh]) + fi + + # eval is required to do the TK_DBGX substitution + eval "TK_LIB_FILE=\"${TK_LIB_FILE}\"" + eval "TK_STUB_LIB_FILE=\"${TK_STUB_LIB_FILE}\"" + + # If the TK_BIN_DIR is the build directory (not the install directory), + # then set the common variable name to the value of the build variables. + # For example, the variable TK_LIB_SPEC will be set to the value + # of TK_BUILD_LIB_SPEC. An extension should make use of TK_LIB_SPEC + # instead of TK_BUILD_LIB_SPEC since it will work with both an + # installed and uninstalled version of Tcl. + if test -f "${TK_BIN_DIR}/Makefile" ; then + TK_LIB_SPEC="${TK_BUILD_LIB_SPEC}" + TK_STUB_LIB_SPEC="${TK_BUILD_STUB_LIB_SPEC}" + TK_STUB_LIB_PATH="${TK_BUILD_STUB_LIB_PATH}" + elif test "`uname -s`" = "Darwin"; then + # If Tk was built as a framework, attempt to use the libraries + # from the framework at the given location so that linking works + # against Tk.framework installed in an arbitrary location. + case ${TK_DEFS} in + *TK_FRAMEWORK*) + if test -f "${TK_BIN_DIR}/${TK_LIB_FILE}"; then + for i in "`cd "${TK_BIN_DIR}"; pwd`" \ + "`cd "${TK_BIN_DIR}"/../..; pwd`"; do + if test "`basename "$i"`" = "${TK_LIB_FILE}.framework"; then + TK_LIB_SPEC="-F`dirname "$i" | sed -e 's/ /\\\\ /g'` -framework ${TK_LIB_FILE}" + break + fi + done + fi + if test -f "${TK_BIN_DIR}/${TK_STUB_LIB_FILE}"; then + TK_STUB_LIB_SPEC="-L` echo "${TK_BIN_DIR}" | sed -e 's/ /\\\\ /g'` ${TK_STUB_LIB_FLAG}" + TK_STUB_LIB_PATH="${TK_BIN_DIR}/${TK_STUB_LIB_FILE}" + fi + ;; + esac + fi + + # eval is required to do the TK_DBGX substitution + eval "TK_LIB_FLAG=\"${TK_LIB_FLAG}\"" + eval "TK_LIB_SPEC=\"${TK_LIB_SPEC}\"" + eval "TK_STUB_LIB_FLAG=\"${TK_STUB_LIB_FLAG}\"" + eval "TK_STUB_LIB_SPEC=\"${TK_STUB_LIB_SPEC}\"" + + # TEA specific: Ensure windowingsystem is defined + if test "${TEA_PLATFORM}" = "unix" ; then + case ${TK_DEFS} in + *MAC_OSX_TK*) + AC_DEFINE(MAC_OSX_TK, 1, [Are we building against Mac OS X TkAqua?]) + TEA_WINDOWINGSYSTEM="aqua" + ;; + *) + TEA_WINDOWINGSYSTEM="x11" + ;; + esac + elif test "${TEA_PLATFORM}" = "windows" ; then + TEA_WINDOWINGSYSTEM="win32" + fi + + AC_SUBST(TK_VERSION) + AC_SUBST(TK_BIN_DIR) + AC_SUBST(TK_SRC_DIR) + + AC_SUBST(TK_LIB_FILE) + AC_SUBST(TK_LIB_FLAG) + AC_SUBST(TK_LIB_SPEC) + + AC_SUBST(TK_STUB_LIB_FILE) + AC_SUBST(TK_STUB_LIB_FLAG) + AC_SUBST(TK_STUB_LIB_SPEC) + + # TEA specific: + AC_SUBST(TK_LIBS) + AC_SUBST(TK_XINCLUDES) +]) + +#------------------------------------------------------------------------ +# TEA_PROG_TCLSH +# Determine the fully qualified path name of the tclsh executable +# in the Tcl build directory or the tclsh installed in a bin +# directory. This macro will correctly determine the name +# of the tclsh executable even if tclsh has not yet been +# built in the build directory. The tclsh found is always +# associated with a tclConfig.sh file. This tclsh should be used +# only for running extension test cases. It should never be +# or generation of files (like pkgIndex.tcl) at build time. +# +# Arguments: +# none +# +# Results: +# Substitutes the following vars: +# TCLSH_PROG +#------------------------------------------------------------------------ + +AC_DEFUN([TEA_PROG_TCLSH], [ + AC_MSG_CHECKING([for tclsh]) + if test -f "${TCL_BIN_DIR}/Makefile" ; then + # tclConfig.sh is in Tcl build directory + if test "${TEA_PLATFORM}" = "windows"; then + if test -f "${TCL_BIN_DIR}/tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}${TCL_DBGX}${EXEEXT}" ; then + TCLSH_PROG="${TCL_BIN_DIR}/tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}${TCL_DBGX}${EXEEXT}" + elif test -f "${TCL_BIN_DIR}/tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}${TCL_DBGX}s${EXEEXT}" ; then + TCLSH_PROG="${TCL_BIN_DIR}/tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}${TCL_DBGX}s${EXEEXT}" + elif test -f "${TCL_BIN_DIR}/tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}${TCL_DBGX}t${EXEEXT}" ; then + TCLSH_PROG="${TCL_BIN_DIR}/tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}${TCL_DBGX}t${EXEEXT}" + elif test -f "${TCL_BIN_DIR}/tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}${TCL_DBGX}st${EXEEXT}" ; then + TCLSH_PROG="${TCL_BIN_DIR}/tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}${TCL_DBGX}st${EXEEXT}" + fi + else + TCLSH_PROG="${TCL_BIN_DIR}/tclsh" + fi + else + # tclConfig.sh is in install location + if test "${TEA_PLATFORM}" = "windows"; then + TCLSH_PROG="tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}${TCL_DBGX}${EXEEXT}" + else + TCLSH_PROG="tclsh${TCL_MAJOR_VERSION}.${TCL_MINOR_VERSION}${TCL_DBGX}" + fi + list="`ls -d ${TCL_BIN_DIR}/../bin 2>/dev/null` \ + `ls -d ${TCL_BIN_DIR}/.. 2>/dev/null` \ + `ls -d ${TCL_PREFIX}/bin 2>/dev/null`" + for i in $list ; do + if test -f "$i/${TCLSH_PROG}" ; then + REAL_TCL_BIN_DIR="`cd "$i"; pwd`/" + break + fi + done + TCLSH_PROG="${REAL_TCL_BIN_DIR}${TCLSH_PROG}" + fi + AC_MSG_RESULT([${TCLSH_PROG}]) + AC_SUBST(TCLSH_PROG) +]) + +#------------------------------------------------------------------------ +# TEA_PROG_WISH +# Determine the fully qualified path name of the wish executable +# in the Tk build directory or the wish installed in a bin +# directory. This macro will correctly determine the name +# of the wish executable even if wish has not yet been +# built in the build directory. The wish found is always +# associated with a tkConfig.sh file. This wish should be used +# only for running extension test cases. It should never be +# or generation of files (like pkgIndex.tcl) at build time. +# +# Arguments: +# none +# +# Results: +# Substitutes the following vars: +# WISH_PROG +#------------------------------------------------------------------------ + +AC_DEFUN([TEA_PROG_WISH], [ + AC_MSG_CHECKING([for wish]) + if test -f "${TK_BIN_DIR}/Makefile" ; then + # tkConfig.sh is in Tk build directory + if test "${TEA_PLATFORM}" = "windows"; then + if test -f "${TK_BIN_DIR}/wish${TK_MAJOR_VERSION}${TK_MINOR_VERSION}${TK_DBGX}${EXEEXT}" ; then + WISH_PROG="${TK_BIN_DIR}/wish${TK_MAJOR_VERSION}${TK_MINOR_VERSION}${TK_DBGX}${EXEEXT}" + elif test -f "${TK_BIN_DIR}/wish${TK_MAJOR_VERSION}${TK_MINOR_VERSION}${TK_DBGX}s${EXEEXT}" ; then + WISH_PROG="${TK_BIN_DIR}/wish${TK_MAJOR_VERSION}${TK_MINOR_VERSION}${TK_DBGX}$s{EXEEXT}" + elif test -f "${TK_BIN_DIR}/wish${TK_MAJOR_VERSION}${TK_MINOR_VERSION}${TK_DBGX}t${EXEEXT}" ; then + WISH_PROG="${TK_BIN_DIR}/wish${TK_MAJOR_VERSION}${TK_MINOR_VERSION}${TK_DBGX}t${EXEEXT}" + elif test -f "${TK_BIN_DIR}/wish${TK_MAJOR_VERSION}${TK_MINOR_VERSION}${TK_DBGX}st${EXEEXT}" ; then + WISH_PROG="${TK_BIN_DIR}/wish${TK_MAJOR_VERSION}${TK_MINOR_VERSION}${TK_DBGX}st${EXEEXT}" + fi + else + WISH_PROG="${TK_BIN_DIR}/wish" + fi + else + # tkConfig.sh is in install location + if test "${TEA_PLATFORM}" = "windows"; then + WISH_PROG="wish${TK_MAJOR_VERSION}${TK_MINOR_VERSION}${TK_DBGX}${EXEEXT}" + else + WISH_PROG="wish${TK_MAJOR_VERSION}.${TK_MINOR_VERSION}${TK_DBGX}" + fi + list="`ls -d ${TK_BIN_DIR}/../bin 2>/dev/null` \ + `ls -d ${TK_BIN_DIR}/.. 2>/dev/null` \ + `ls -d ${TK_PREFIX}/bin 2>/dev/null`" + for i in $list ; do + if test -f "$i/${WISH_PROG}" ; then + REAL_TK_BIN_DIR="`cd "$i"; pwd`/" + break + fi + done + WISH_PROG="${REAL_TK_BIN_DIR}${WISH_PROG}" + fi + AC_MSG_RESULT([${WISH_PROG}]) + AC_SUBST(WISH_PROG) +]) + +#------------------------------------------------------------------------ +# TEA_ENABLE_SHARED -- +# +# Allows the building of shared libraries +# +# Arguments: +# none +# +# Results: +# +# Adds the following arguments to configure: +# --enable-shared=yes|no +# --enable-stubs=yes|no +# +# Defines the following vars: +# STATIC_BUILD Used for building import/export libraries +# on Windows. +# +# Sets the following vars: +# SHARED_BUILD Value of 1 or 0 +# STUBS_BUILD Value if 1 or 0 +# USE_TCL_STUBS Value true: if SHARED_BUILD or --enable-stubs +# USE_TCLOO_STUBS Value true: if SHARED_BUILD or --enable-stubs +# USE_TK_STUBS Value true: if SHARED_BUILD or --enable-stubs +# AND TEA_WINDOWING_SYSTEM != "" +#------------------------------------------------------------------------ +AC_DEFUN([TEA_ENABLE_SHARED], [ + AC_MSG_CHECKING([how to build libraries]) + AC_ARG_ENABLE(shared, + AC_HELP_STRING([--enable-shared], + [build and link with shared libraries (default: on)]), + [shared_ok=$enableval], [shared_ok=yes]) + + if test "${enable_shared+set}" = set; then + enableval="$enable_shared" + shared_ok=$enableval + else + shared_ok=yes + fi + + AC_ARG_ENABLE(stubs, + AC_HELP_STRING([--enable-stubs], + [build and link with stub libraries. Always true for shared builds (default: on)]), + [stubs_ok=$enableval], [stubs_ok=yes]) + + if test "${enable_stubs+set}" = set; then + enableval="$enable_stubs" + stubs_ok=$enableval + else + stubs_ok=yes + fi + + # Stubs are always enabled for shared builds + if test "$shared_ok" = "yes" ; then + AC_MSG_RESULT([shared]) + SHARED_BUILD=1 + STUBS_BUILD=1 + else + AC_MSG_RESULT([static]) + SHARED_BUILD=0 + AC_DEFINE(STATIC_BUILD, 1, [This a static build]) + if test "$stubs_ok" = "yes" ; then + STUBS_BUILD=1 + else + STUBS_BUILD=0 + fi + fi + if test "${STUBS_BUILD}" = "1" ; then + AC_DEFINE(USE_TCL_STUBS, 1, [Use Tcl stubs]) + AC_DEFINE(USE_TCLOO_STUBS, 1, [Use TclOO stubs]) + if test "${TEA_WINDOWINGSYSTEM}" != ""; then + AC_DEFINE(USE_TK_STUBS, 1, [Use Tk stubs]) + fi + fi + + AC_SUBST(SHARED_BUILD) + AC_SUBST(STUBS_BUILD) +]) + +#------------------------------------------------------------------------ +# TEA_ENABLE_THREADS -- +# +# Specify if thread support should be enabled. If "yes" is specified +# as an arg (optional), threads are enabled by default, "no" means +# threads are disabled. "yes" is the default. +# +# TCL_THREADS is checked so that if you are compiling an extension +# against a threaded core, your extension must be compiled threaded +# as well. +# +# Note that it is legal to have a thread enabled extension run in a +# threaded or non-threaded Tcl core, but a non-threaded extension may +# only run in a non-threaded Tcl core. +# +# Arguments: +# none +# +# Results: +# +# Adds the following arguments to configure: +# --enable-threads +# +# Sets the following vars: +# THREADS_LIBS Thread library(s) +# +# Defines the following vars: +# TCL_THREADS +# _REENTRANT +# _THREAD_SAFE +#------------------------------------------------------------------------ + +AC_DEFUN([TEA_ENABLE_THREADS], [ + AC_ARG_ENABLE(threads, + AC_HELP_STRING([--enable-threads], + [build with threads (default: on)]), + [tcl_ok=$enableval], [tcl_ok=yes]) + + if test "${enable_threads+set}" = set; then + enableval="$enable_threads" + tcl_ok=$enableval + else + tcl_ok=yes + fi + + if test "$tcl_ok" = "yes" -o "${TCL_THREADS}" = 1; then + TCL_THREADS=1 + + if test "${TEA_PLATFORM}" != "windows" ; then + # We are always OK on Windows, so check what this platform wants: + + # USE_THREAD_ALLOC tells us to try the special thread-based + # allocator that significantly reduces lock contention + AC_DEFINE(USE_THREAD_ALLOC, 1, + [Do we want to use the threaded memory allocator?]) + AC_DEFINE(_REENTRANT, 1, [Do we want the reentrant OS API?]) + if test "`uname -s`" = "SunOS" ; then + AC_DEFINE(_POSIX_PTHREAD_SEMANTICS, 1, + [Do we really want to follow the standard? Yes we do!]) + fi + AC_DEFINE(_THREAD_SAFE, 1, [Do we want the thread-safe OS API?]) + AC_CHECK_LIB(pthread,pthread_mutex_init,tcl_ok=yes,tcl_ok=no) + if test "$tcl_ok" = "no"; then + # Check a little harder for __pthread_mutex_init in the same + # library, as some systems hide it there until pthread.h is + # defined. We could alternatively do an AC_TRY_COMPILE with + # pthread.h, but that will work with libpthread really doesn't + # exist, like AIX 4.2. [Bug: 4359] + AC_CHECK_LIB(pthread, __pthread_mutex_init, + tcl_ok=yes, tcl_ok=no) + fi + + if test "$tcl_ok" = "yes"; then + # The space is needed + THREADS_LIBS=" -lpthread" + else + AC_CHECK_LIB(pthreads, pthread_mutex_init, + tcl_ok=yes, tcl_ok=no) + if test "$tcl_ok" = "yes"; then + # The space is needed + THREADS_LIBS=" -lpthreads" + else + AC_CHECK_LIB(c, pthread_mutex_init, + tcl_ok=yes, tcl_ok=no) + if test "$tcl_ok" = "no"; then + AC_CHECK_LIB(c_r, pthread_mutex_init, + tcl_ok=yes, tcl_ok=no) + if test "$tcl_ok" = "yes"; then + # The space is needed + THREADS_LIBS=" -pthread" + else + TCL_THREADS=0 + AC_MSG_WARN([Do not know how to find pthread lib on your system - thread support disabled]) + fi + fi + fi + fi + fi + else + TCL_THREADS=0 + fi + # Do checking message here to not mess up interleaved configure output + AC_MSG_CHECKING([for building with threads]) + if test "${TCL_THREADS}" = 1; then + AC_DEFINE(TCL_THREADS, 1, [Are we building with threads enabled?]) + AC_MSG_RESULT([yes (default)]) + else + AC_MSG_RESULT([no]) + fi + # TCL_THREADS sanity checking. See if our request for building with + # threads is the same as the way Tcl was built. If not, warn the user. + case ${TCL_DEFS} in + *THREADS=1*) + if test "${TCL_THREADS}" = "0"; then + AC_MSG_WARN([ + Building ${PACKAGE_NAME} without threads enabled, but building against Tcl + that IS thread-enabled. It is recommended to use --enable-threads.]) + fi + ;; + *) + if test "${TCL_THREADS}" = "1"; then + AC_MSG_WARN([ + --enable-threads requested, but building against a Tcl that is NOT + thread-enabled. This is an OK configuration that will also run in + a thread-enabled core.]) + fi + ;; + esac + AC_SUBST(TCL_THREADS) +]) + +#------------------------------------------------------------------------ +# TEA_ENABLE_SYMBOLS -- +# +# Specify if debugging symbols should be used. +# Memory (TCL_MEM_DEBUG) debugging can also be enabled. +# +# Arguments: +# none +# +# TEA varies from core Tcl in that C|LDFLAGS_DEFAULT receives +# the value of C|LDFLAGS_OPTIMIZE|DEBUG already substituted. +# Requires the following vars to be set in the Makefile: +# CFLAGS_DEFAULT +# LDFLAGS_DEFAULT +# +# Results: +# +# Adds the following arguments to configure: +# --enable-symbols +# +# Defines the following vars: +# CFLAGS_DEFAULT Sets to $(CFLAGS_DEBUG) if true +# Sets to "$(CFLAGS_OPTIMIZE) -DNDEBUG" if false +# LDFLAGS_DEFAULT Sets to $(LDFLAGS_DEBUG) if true +# Sets to $(LDFLAGS_OPTIMIZE) if false +# DBGX Formerly used as debug library extension; +# always blank now. +#------------------------------------------------------------------------ + +AC_DEFUN([TEA_ENABLE_SYMBOLS], [ + dnl TEA specific: Make sure we are initialized + AC_REQUIRE([TEA_CONFIG_CFLAGS]) + AC_MSG_CHECKING([for build with symbols]) + AC_ARG_ENABLE(symbols, + AC_HELP_STRING([--enable-symbols], + [build with debugging symbols (default: off)]), + [tcl_ok=$enableval], [tcl_ok=no]) + DBGX="" + if test "$tcl_ok" = "no"; then + CFLAGS_DEFAULT="${CFLAGS_OPTIMIZE} -DNDEBUG" + LDFLAGS_DEFAULT="${LDFLAGS_OPTIMIZE}" + AC_MSG_RESULT([no]) + else + CFLAGS_DEFAULT="${CFLAGS_DEBUG}" + LDFLAGS_DEFAULT="${LDFLAGS_DEBUG}" + if test "$tcl_ok" = "yes"; then + AC_MSG_RESULT([yes (standard debugging)]) + fi + fi + # TEA specific: + if test "${TEA_PLATFORM}" != "windows" ; then + LDFLAGS_DEFAULT="${LDFLAGS}" + fi + AC_SUBST(CFLAGS_DEFAULT) + AC_SUBST(LDFLAGS_DEFAULT) + AC_SUBST(TCL_DBGX) + + if test "$tcl_ok" = "mem" -o "$tcl_ok" = "all"; then + AC_DEFINE(TCL_MEM_DEBUG, 1, [Is memory debugging enabled?]) + fi + + if test "$tcl_ok" != "yes" -a "$tcl_ok" != "no"; then + if test "$tcl_ok" = "all"; then + AC_MSG_RESULT([enabled symbols mem debugging]) + else + AC_MSG_RESULT([enabled $tcl_ok debugging]) + fi + fi +]) + +#------------------------------------------------------------------------ +# TEA_ENABLE_LANGINFO -- +# +# Allows use of modern nl_langinfo check for better l10n. +# This is only relevant for Unix. +# +# Arguments: +# none +# +# Results: +# +# Adds the following arguments to configure: +# --enable-langinfo=yes|no (default is yes) +# +# Defines the following vars: +# HAVE_LANGINFO Triggers use of nl_langinfo if defined. +#------------------------------------------------------------------------ + +AC_DEFUN([TEA_ENABLE_LANGINFO], [ + AC_ARG_ENABLE(langinfo, + AC_HELP_STRING([--enable-langinfo], + [use nl_langinfo if possible to determine encoding at startup, otherwise use old heuristic (default: on)]), + [langinfo_ok=$enableval], [langinfo_ok=yes]) + + HAVE_LANGINFO=0 + if test "$langinfo_ok" = "yes"; then + AC_CHECK_HEADER(langinfo.h,[langinfo_ok=yes],[langinfo_ok=no]) + fi + AC_MSG_CHECKING([whether to use nl_langinfo]) + if test "$langinfo_ok" = "yes"; then + AC_CACHE_VAL(tcl_cv_langinfo_h, [ + AC_TRY_COMPILE([#include <langinfo.h>], [nl_langinfo(CODESET);], + [tcl_cv_langinfo_h=yes],[tcl_cv_langinfo_h=no])]) + AC_MSG_RESULT([$tcl_cv_langinfo_h]) + if test $tcl_cv_langinfo_h = yes; then + AC_DEFINE(HAVE_LANGINFO, 1, [Do we have nl_langinfo()?]) + fi + else + AC_MSG_RESULT([$langinfo_ok]) + fi +]) + +#-------------------------------------------------------------------- +# TEA_CONFIG_SYSTEM +# +# Determine what the system is (some things cannot be easily checked +# on a feature-driven basis, alas). This can usually be done via the +# "uname" command. +# +# Arguments: +# none +# +# Results: +# Defines the following var: +# +# system - System/platform/version identification code. +#-------------------------------------------------------------------- + +AC_DEFUN([TEA_CONFIG_SYSTEM], [ + AC_CACHE_CHECK([system version], tcl_cv_sys_version, [ + # TEA specific: + if test "${TEA_PLATFORM}" = "windows" ; then + tcl_cv_sys_version=windows + else + tcl_cv_sys_version=`uname -s`-`uname -r` + if test "$?" -ne 0 ; then + AC_MSG_WARN([can't find uname command]) + tcl_cv_sys_version=unknown + else + if test "`uname -s`" = "AIX" ; then + tcl_cv_sys_version=AIX-`uname -v`.`uname -r` + fi + fi + fi + ]) + system=$tcl_cv_sys_version +]) + +#-------------------------------------------------------------------- +# TEA_CONFIG_CFLAGS +# +# Try to determine the proper flags to pass to the compiler +# for building shared libraries and other such nonsense. +# +# Arguments: +# none +# +# Results: +# +# Defines and substitutes the following vars: +# +# DL_OBJS, DL_LIBS - removed for TEA, only needed by core. +# LDFLAGS - Flags to pass to the compiler when linking object +# files into an executable application binary such +# as tclsh. +# LD_SEARCH_FLAGS-Flags to pass to ld, such as "-R /usr/local/tcl/lib", +# that tell the run-time dynamic linker where to look +# for shared libraries such as libtcl.so. Depends on +# the variable LIB_RUNTIME_DIR in the Makefile. Could +# be the same as CC_SEARCH_FLAGS if ${CC} is used to link. +# CC_SEARCH_FLAGS-Flags to pass to ${CC}, such as "-Wl,-rpath,/usr/local/tcl/lib", +# that tell the run-time dynamic linker where to look +# for shared libraries such as libtcl.so. Depends on +# the variable LIB_RUNTIME_DIR in the Makefile. +# SHLIB_CFLAGS - Flags to pass to cc when compiling the components +# of a shared library (may request position-independent +# code, among other things). +# SHLIB_LD - Base command to use for combining object files +# into a shared library. +# SHLIB_LD_LIBS - Dependent libraries for the linker to scan when +# creating shared libraries. This symbol typically +# goes at the end of the "ld" commands that build +# shared libraries. The value of the symbol defaults to +# "${LIBS}" if all of the dependent libraries should +# be specified when creating a shared library. If +# dependent libraries should not be specified (as on +# SunOS 4.x, where they cause the link to fail, or in +# general if Tcl and Tk aren't themselves shared +# libraries), then this symbol has an empty string +# as its value. +# SHLIB_SUFFIX - Suffix to use for the names of dynamically loadable +# extensions. An empty string means we don't know how +# to use shared libraries on this platform. +# LIB_SUFFIX - Specifies everything that comes after the "libfoo" +# in a static or shared library name, using the $PACKAGE_VERSION variable +# to put the version in the right place. This is used +# by platforms that need non-standard library names. +# Examples: ${PACKAGE_VERSION}.so.1.1 on NetBSD, since it needs +# to have a version after the .so, and ${PACKAGE_VERSION}.a +# on AIX, since a shared library needs to have +# a .a extension whereas shared objects for loadable +# extensions have a .so extension. Defaults to +# ${PACKAGE_VERSION}${SHLIB_SUFFIX}. +# CFLAGS_DEBUG - +# Flags used when running the compiler in debug mode +# CFLAGS_OPTIMIZE - +# Flags used when running the compiler in optimize mode +# CFLAGS - Additional CFLAGS added as necessary (usually 64-bit) +#-------------------------------------------------------------------- + +AC_DEFUN([TEA_CONFIG_CFLAGS], [ + dnl TEA specific: Make sure we are initialized + AC_REQUIRE([TEA_INIT]) + + # Step 0.a: Enable 64 bit support? + + AC_MSG_CHECKING([if 64bit support is requested]) + AC_ARG_ENABLE(64bit, + AC_HELP_STRING([--enable-64bit], + [enable 64bit support (default: off)]), + [do64bit=$enableval], [do64bit=no]) + AC_MSG_RESULT([$do64bit]) + + # Step 0.b: Enable Solaris 64 bit VIS support? + + AC_MSG_CHECKING([if 64bit Sparc VIS support is requested]) + AC_ARG_ENABLE(64bit-vis, + AC_HELP_STRING([--enable-64bit-vis], + [enable 64bit Sparc VIS support (default: off)]), + [do64bitVIS=$enableval], [do64bitVIS=no]) + AC_MSG_RESULT([$do64bitVIS]) + # Force 64bit on with VIS + AS_IF([test "$do64bitVIS" = "yes"], [do64bit=yes]) + + # Step 0.c: Check if visibility support is available. Do this here so + # that platform specific alternatives can be used below if this fails. + + AC_CACHE_CHECK([if compiler supports visibility "hidden"], + tcl_cv_cc_visibility_hidden, [ + hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -Werror" + AC_TRY_LINK([ + extern __attribute__((__visibility__("hidden"))) void f(void); + void f(void) {}], [f();], tcl_cv_cc_visibility_hidden=yes, + tcl_cv_cc_visibility_hidden=no) + CFLAGS=$hold_cflags]) + AS_IF([test $tcl_cv_cc_visibility_hidden = yes], [ + AC_DEFINE(MODULE_SCOPE, + [extern __attribute__((__visibility__("hidden")))], + [Compiler support for module scope symbols]) + AC_DEFINE(HAVE_HIDDEN, [1], [Compiler support for module scope symbols]) + ]) + + # Step 0.d: Disable -rpath support? + + AC_MSG_CHECKING([if rpath support is requested]) + AC_ARG_ENABLE(rpath, + AC_HELP_STRING([--disable-rpath], + [disable rpath support (default: on)]), + [doRpath=$enableval], [doRpath=yes]) + AC_MSG_RESULT([$doRpath]) + + # TEA specific: Cross-compiling options for Windows/CE builds? + + AS_IF([test "${TEA_PLATFORM}" = windows], [ + AC_MSG_CHECKING([if Windows/CE build is requested]) + AC_ARG_ENABLE(wince, + AC_HELP_STRING([--enable-wince], + [enable Win/CE support (where applicable)]), + [doWince=$enableval], [doWince=no]) + AC_MSG_RESULT([$doWince]) + ]) + + # Set the variable "system" to hold the name and version number + # for the system. + + TEA_CONFIG_SYSTEM + + # Require ranlib early so we can override it in special cases below. + + AC_REQUIRE([AC_PROG_RANLIB]) + + # Set configuration options based on system name and version. + # This is similar to Tcl's unix/tcl.m4 except that we've added a + # "windows" case and removed some core-only vars. + + do64bit_ok=no + # default to '{$LIBS}' and set to "" on per-platform necessary basis + SHLIB_LD_LIBS='${LIBS}' + # When ld needs options to work in 64-bit mode, put them in + # LDFLAGS_ARCH so they eventually end up in LDFLAGS even if [load] + # is disabled by the user. [Bug 1016796] + LDFLAGS_ARCH="" + UNSHARED_LIB_SUFFIX="" + # TEA specific: use PACKAGE_VERSION instead of VERSION + TCL_TRIM_DOTS='`echo ${PACKAGE_VERSION} | tr -d .`' + ECHO_VERSION='`echo ${PACKAGE_VERSION}`' + TCL_LIB_VERSIONS_OK=ok + CFLAGS_DEBUG=-g + AS_IF([test "$GCC" = yes], [ + CFLAGS_OPTIMIZE=-O2 + CFLAGS_WARNING="-Wall" + ], [ + CFLAGS_OPTIMIZE=-O + CFLAGS_WARNING="" + ]) + AC_CHECK_TOOL(AR, ar) + STLIB_LD='${AR} cr' + LD_LIBRARY_PATH_VAR="LD_LIBRARY_PATH" + AS_IF([test "x$SHLIB_VERSION" = x],[SHLIB_VERSION=""],[SHLIB_VERSION=".$SHLIB_VERSION"]) + case $system in + # TEA specific: + windows) + # This is a 2-stage check to make sure we have the 64-bit SDK + # We have to know where the SDK is installed. + # This magic is based on MS Platform SDK for Win2003 SP1 - hobbs + # MACHINE is IX86 for LINK, but this is used by the manifest, + # which requires x86|amd64|ia64. + MACHINE="X86" + if test "$do64bit" != "no" ; then + if test "x${MSSDK}x" = "xx" ; then + MSSDK="C:/Progra~1/Microsoft Platform SDK" + fi + MSSDK=`echo "$MSSDK" | sed -e 's!\\\!/!g'` + PATH64="" + case "$do64bit" in + amd64|x64|yes) + MACHINE="AMD64" ; # default to AMD64 64-bit build + PATH64="${MSSDK}/Bin/Win64/x86/AMD64" + ;; + ia64) + MACHINE="IA64" + PATH64="${MSSDK}/Bin/Win64" + ;; + esac + if test "$GCC" != "yes" -a ! -d "${PATH64}" ; then + AC_MSG_WARN([Could not find 64-bit $MACHINE SDK to enable 64bit mode]) + AC_MSG_WARN([Ensure latest Platform SDK is installed]) + do64bit="no" + else + AC_MSG_RESULT([ Using 64-bit $MACHINE mode]) + do64bit_ok="yes" + fi + fi + + if test "$doWince" != "no" ; then + if test "$do64bit" != "no" ; then + AC_MSG_ERROR([Windows/CE and 64-bit builds incompatible]) + fi + if test "$GCC" = "yes" ; then + AC_MSG_ERROR([Windows/CE and GCC builds incompatible]) + fi + TEA_PATH_CELIB + # Set defaults for common evc4/PPC2003 setup + # Currently Tcl requires 300+, possibly 420+ for sockets + CEVERSION=420; # could be 211 300 301 400 420 ... + TARGETCPU=ARMV4; # could be ARMV4 ARM MIPS SH3 X86 ... + ARCH=ARM; # could be ARM MIPS X86EM ... + PLATFORM="Pocket PC 2003"; # or "Pocket PC 2002" + if test "$doWince" != "yes"; then + # If !yes then the user specified something + # Reset ARCH to allow user to skip specifying it + ARCH= + eval `echo $doWince | awk -F, '{ \ + if (length([$]1)) { printf "CEVERSION=\"%s\"\n", [$]1; \ + if ([$]1 < 400) { printf "PLATFORM=\"Pocket PC 2002\"\n" } }; \ + if (length([$]2)) { printf "TARGETCPU=\"%s\"\n", toupper([$]2) }; \ + if (length([$]3)) { printf "ARCH=\"%s\"\n", toupper([$]3) }; \ + if (length([$]4)) { printf "PLATFORM=\"%s\"\n", [$]4 }; \ + }'` + if test "x${ARCH}" = "x" ; then + ARCH=$TARGETCPU; + fi + fi + OSVERSION=WCE$CEVERSION; + if test "x${WCEROOT}" = "x" ; then + WCEROOT="C:/Program Files/Microsoft eMbedded C++ 4.0" + if test ! -d "${WCEROOT}" ; then + WCEROOT="C:/Program Files/Microsoft eMbedded Tools" + fi + fi + if test "x${SDKROOT}" = "x" ; then + SDKROOT="C:/Program Files/Windows CE Tools" + if test ! -d "${SDKROOT}" ; then + SDKROOT="C:/Windows CE Tools" + fi + fi + WCEROOT=`echo "$WCEROOT" | sed -e 's!\\\!/!g'` + SDKROOT=`echo "$SDKROOT" | sed -e 's!\\\!/!g'` + if test ! -d "${SDKROOT}/${OSVERSION}/${PLATFORM}/Lib/${TARGETCPU}" \ + -o ! -d "${WCEROOT}/EVC/${OSVERSION}/bin"; then + AC_MSG_ERROR([could not find PocketPC SDK or target compiler to enable WinCE mode [$CEVERSION,$TARGETCPU,$ARCH,$PLATFORM]]) + doWince="no" + else + # We could PATH_NOSPACE these, but that's not important, + # as long as we quote them when used. + CEINCLUDE="${SDKROOT}/${OSVERSION}/${PLATFORM}/include" + if test -d "${CEINCLUDE}/${TARGETCPU}" ; then + CEINCLUDE="${CEINCLUDE}/${TARGETCPU}" + fi + CELIBPATH="${SDKROOT}/${OSVERSION}/${PLATFORM}/Lib/${TARGETCPU}" + fi + fi + + if test "$GCC" != "yes" ; then + if test "${SHARED_BUILD}" = "0" ; then + runtime=-MT + else + runtime=-MD + fi + case "x`echo \${VisualStudioVersion}`" in + x1[[4-9]]*) + lflags="${lflags} -nodefaultlib:libucrt.lib" + TEA_ADD_LIBS([ucrt.lib]) + ;; + *) + ;; + esac + + if test "$do64bit" != "no" ; then + # All this magic is necessary for the Win64 SDK RC1 - hobbs + CC="\"${PATH64}/cl.exe\"" + CFLAGS="${CFLAGS} -I\"${MSSDK}/Include\" -I\"${MSSDK}/Include/crt\" -I\"${MSSDK}/Include/crt/sys\"" + RC="\"${MSSDK}/bin/rc.exe\"" + lflags="${lflags} -nologo -MACHINE:${MACHINE} -LIBPATH:\"${MSSDK}/Lib/${MACHINE}\"" + LINKBIN="\"${PATH64}/link.exe\"" + CFLAGS_DEBUG="-nologo -Zi -Od -W3 ${runtime}d" + CFLAGS_OPTIMIZE="-nologo -O2 -W2 ${runtime}" + # Avoid 'unresolved external symbol __security_cookie' + # errors, c.f. http://support.microsoft.com/?id=894573 + TEA_ADD_LIBS([bufferoverflowU.lib]) + elif test "$doWince" != "no" ; then + CEBINROOT="${WCEROOT}/EVC/${OSVERSION}/bin" + if test "${TARGETCPU}" = "X86"; then + CC="\"${CEBINROOT}/cl.exe\"" + else + CC="\"${CEBINROOT}/cl${ARCH}.exe\"" + fi + CFLAGS="$CFLAGS -I\"${CELIB_DIR}/inc\" -I\"${CEINCLUDE}\"" + RC="\"${WCEROOT}/Common/EVC/bin/rc.exe\"" + arch=`echo ${ARCH} | awk '{print tolower([$]0)}'` + defs="${ARCH} _${ARCH}_ ${arch} PALM_SIZE _MT _WINDOWS" + if test "${SHARED_BUILD}" = "1" ; then + # Static CE builds require static celib as well + defs="${defs} _DLL" + fi + for i in $defs ; do + AC_DEFINE_UNQUOTED($i, 1, [WinCE def ]$i) + done + AC_DEFINE_UNQUOTED(_WIN32_WCE, $CEVERSION, [_WIN32_WCE version]) + AC_DEFINE_UNQUOTED(UNDER_CE, $CEVERSION, [UNDER_CE version]) + CFLAGS_DEBUG="-nologo -Zi -Od" + CFLAGS_OPTIMIZE="-nologo -Ox" + lversion=`echo ${CEVERSION} | sed -e 's/\(.\)\(..\)/\1\.\2/'` + lflags="${lflags} -MACHINE:${ARCH} -LIBPATH:\"${CELIBPATH}\" -subsystem:windowsce,${lversion} -nologo" + LINKBIN="\"${CEBINROOT}/link.exe\"" + AC_SUBST(CELIB_DIR) + else + RC="rc" + lflags="${lflags} -nologo" + LINKBIN="link" + CFLAGS_DEBUG="-nologo -Z7 -Od -W3 -WX ${runtime}d" + CFLAGS_OPTIMIZE="-nologo -O2 -W2 ${runtime}" + fi + fi + + if test "$GCC" = "yes"; then + # mingw gcc mode + AC_CHECK_TOOL(RC, windres) + CFLAGS_DEBUG="-g" + CFLAGS_OPTIMIZE="-O2 -fomit-frame-pointer" + SHLIB_LD='${CC} -shared' + UNSHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.a' + LDFLAGS_CONSOLE="-wl,--subsystem,console ${lflags}" + LDFLAGS_WINDOW="-wl,--subsystem,windows ${lflags}" + + AC_CACHE_CHECK(for cross-compile version of gcc, + ac_cv_cross, + AC_TRY_COMPILE([ + #ifdef _WIN32 + #error cross-compiler + #endif + ], [], + ac_cv_cross=yes, + ac_cv_cross=no) + ) + if test "$ac_cv_cross" = "yes"; then + case "$do64bit" in + amd64|x64|yes) + CC="x86_64-w64-mingw32-gcc" + LD="x86_64-w64-mingw32-ld" + AR="x86_64-w64-mingw32-ar" + RANLIB="x86_64-w64-mingw32-ranlib" + RC="x86_64-w64-mingw32-windres" + ;; + *) + CC="i686-w64-mingw32-gcc" + LD="i686-w64-mingw32-ld" + AR="i686-w64-mingw32-ar" + RANLIB="i686-w64-mingw32-ranlib" + RC="i686-w64-mingw32-windres" + ;; + esac + fi + + else + SHLIB_LD="${LINKBIN} -dll ${lflags}" + # link -lib only works when -lib is the first arg + STLIB_LD="${LINKBIN} -lib ${lflags}" + UNSHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.lib' + PATHTYPE=-w + # For information on what debugtype is most useful, see: + # http://msdn.microsoft.com/library/en-us/dnvc60/html/gendepdebug.asp + # and also + # http://msdn2.microsoft.com/en-us/library/y0zzbyt4%28VS.80%29.aspx + # This essentially turns it all on. + LDFLAGS_DEBUG="-debug -debugtype:cv" + LDFLAGS_OPTIMIZE="-release" + if test "$doWince" != "no" ; then + LDFLAGS_CONSOLE="-link ${lflags}" + LDFLAGS_WINDOW=${LDFLAGS_CONSOLE} + else + LDFLAGS_CONSOLE="-link -subsystem:console ${lflags}" + LDFLAGS_WINDOW="-link -subsystem:windows ${lflags}" + fi + fi + + SHLIB_SUFFIX=".dll" + SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.dll' + + TCL_LIB_VERSIONS_OK=nodots + ;; + AIX-*) + AS_IF([test "${TCL_THREADS}" = "1" -a "$GCC" != "yes"], [ + # AIX requires the _r compiler when gcc isn't being used + case "${CC}" in + *_r|*_r\ *) + # ok ... + ;; + *) + # Make sure only first arg gets _r + CC=`echo "$CC" | sed -e 's/^\([[^ ]]*\)/\1_r/'` + ;; + esac + AC_MSG_RESULT([Using $CC for compiling with threads]) + ]) + LIBS="$LIBS -lc" + SHLIB_CFLAGS="" + SHLIB_SUFFIX=".so" + + LD_LIBRARY_PATH_VAR="LIBPATH" + + # Check to enable 64-bit flags for compiler/linker + AS_IF([test "$do64bit" = yes], [ + AS_IF([test "$GCC" = yes], [ + AC_MSG_WARN([64bit mode not supported with GCC on $system]) + ], [ + do64bit_ok=yes + CFLAGS="$CFLAGS -q64" + LDFLAGS_ARCH="-q64" + RANLIB="${RANLIB} -X64" + AR="${AR} -X64" + SHLIB_LD_FLAGS="-b64" + ]) + ]) + + AS_IF([test "`uname -m`" = ia64], [ + # AIX-5 uses ELF style dynamic libraries on IA-64, but not PPC + SHLIB_LD="/usr/ccs/bin/ld -G -z text" + AS_IF([test "$GCC" = yes], [ + CC_SEARCH_FLAGS='-Wl,-R,${LIB_RUNTIME_DIR}' + ], [ + CC_SEARCH_FLAGS='-R${LIB_RUNTIME_DIR}' + ]) + LD_SEARCH_FLAGS='-R ${LIB_RUNTIME_DIR}' + ], [ + AS_IF([test "$GCC" = yes], [ + SHLIB_LD='${CC} -shared -Wl,-bexpall' + ], [ + SHLIB_LD="/bin/ld -bhalt:4 -bM:SRE -bexpall -H512 -T512 -bnoentry" + LDFLAGS="$LDFLAGS -brtl" + ]) + SHLIB_LD="${SHLIB_LD} ${SHLIB_LD_FLAGS}" + CC_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}' + LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} + ]) + ;; + BeOS*) + SHLIB_CFLAGS="-fPIC" + SHLIB_LD='${CC} -nostart' + SHLIB_SUFFIX=".so" + + #----------------------------------------------------------- + # Check for inet_ntoa in -lbind, for BeOS (which also needs + # -lsocket, even if the network functions are in -lnet which + # is always linked to, for compatibility. + #----------------------------------------------------------- + AC_CHECK_LIB(bind, inet_ntoa, [LIBS="$LIBS -lbind -lsocket"]) + ;; + BSD/OS-4.*) + SHLIB_CFLAGS="-export-dynamic -fPIC" + SHLIB_LD='${CC} -shared' + SHLIB_SUFFIX=".so" + LDFLAGS="$LDFLAGS -export-dynamic" + CC_SEARCH_FLAGS="" + LD_SEARCH_FLAGS="" + ;; + CYGWIN_*) + SHLIB_CFLAGS="" + SHLIB_LD='${CC} -shared' + SHLIB_LD_LIBS="${SHLIB_LD_LIBS} -Wl,--out-implib,\$[@].a" + SHLIB_SUFFIX=".dll" + EXEEXT=".exe" + do64bit_ok=yes + CC_SEARCH_FLAGS="" + LD_SEARCH_FLAGS="" + ;; + Haiku*) + LDFLAGS="$LDFLAGS -Wl,--export-dynamic" + SHLIB_CFLAGS="-fPIC" + SHLIB_SUFFIX=".so" + SHLIB_LD='${CC} ${CFLAGS} ${LDFLAGS} -shared' + AC_CHECK_LIB(network, inet_ntoa, [LIBS="$LIBS -lnetwork"]) + ;; + HP-UX-*.11.*) + # Use updated header definitions where possible + AC_DEFINE(_XOPEN_SOURCE_EXTENDED, 1, [Do we want to use the XOPEN network library?]) + # TEA specific: Needed by Tcl, but not most extensions + #AC_DEFINE(_XOPEN_SOURCE, 1, [Do we want to use the XOPEN network library?]) + #LIBS="$LIBS -lxnet" # Use the XOPEN network library + + AS_IF([test "`uname -m`" = ia64], [ + SHLIB_SUFFIX=".so" + # Use newer C++ library for C++ extensions + #if test "$GCC" != "yes" ; then + # CPPFLAGS="-AA" + #fi + ], [ + SHLIB_SUFFIX=".sl" + ]) + AC_CHECK_LIB(dld, shl_load, tcl_ok=yes, tcl_ok=no) + AS_IF([test "$tcl_ok" = yes], [ + LDFLAGS="$LDFLAGS -Wl,-E" + CC_SEARCH_FLAGS='-Wl,+s,+b,${LIB_RUNTIME_DIR}:.' + LD_SEARCH_FLAGS='+s +b ${LIB_RUNTIME_DIR}:.' + LD_LIBRARY_PATH_VAR="SHLIB_PATH" + ]) + AS_IF([test "$GCC" = yes], [ + SHLIB_LD='${CC} -shared' + LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} + ], [ + CFLAGS="$CFLAGS -z" + # Users may want PA-RISC 1.1/2.0 portable code - needs HP cc + #CFLAGS="$CFLAGS +DAportable" + SHLIB_CFLAGS="+z" + SHLIB_LD="ld -b" + ]) + + # Check to enable 64-bit flags for compiler/linker + AS_IF([test "$do64bit" = "yes"], [ + AS_IF([test "$GCC" = yes], [ + case `${CC} -dumpmachine` in + hppa64*) + # 64-bit gcc in use. Fix flags for GNU ld. + do64bit_ok=yes + SHLIB_LD='${CC} -shared' + AS_IF([test $doRpath = yes], [ + CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}']) + LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} + ;; + *) + AC_MSG_WARN([64bit mode not supported with GCC on $system]) + ;; + esac + ], [ + do64bit_ok=yes + CFLAGS="$CFLAGS +DD64" + LDFLAGS_ARCH="+DD64" + ]) + ]) ;; + IRIX-6.*) + SHLIB_CFLAGS="" + SHLIB_LD="ld -n32 -shared -rdata_shared" + SHLIB_SUFFIX=".so" + AS_IF([test $doRpath = yes], [ + CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' + LD_SEARCH_FLAGS='-rpath ${LIB_RUNTIME_DIR}']) + AS_IF([test "$GCC" = yes], [ + CFLAGS="$CFLAGS -mabi=n32" + LDFLAGS="$LDFLAGS -mabi=n32" + ], [ + case $system in + IRIX-6.3) + # Use to build 6.2 compatible binaries on 6.3. + CFLAGS="$CFLAGS -n32 -D_OLD_TERMIOS" + ;; + *) + CFLAGS="$CFLAGS -n32" + ;; + esac + LDFLAGS="$LDFLAGS -n32" + ]) + ;; + IRIX64-6.*) + SHLIB_CFLAGS="" + SHLIB_LD="ld -n32 -shared -rdata_shared" + SHLIB_SUFFIX=".so" + AS_IF([test $doRpath = yes], [ + CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' + LD_SEARCH_FLAGS='-rpath ${LIB_RUNTIME_DIR}']) + + # Check to enable 64-bit flags for compiler/linker + + AS_IF([test "$do64bit" = yes], [ + AS_IF([test "$GCC" = yes], [ + AC_MSG_WARN([64bit mode not supported by gcc]) + ], [ + do64bit_ok=yes + SHLIB_LD="ld -64 -shared -rdata_shared" + CFLAGS="$CFLAGS -64" + LDFLAGS_ARCH="-64" + ]) + ]) + ;; + Linux*|GNU*|NetBSD-Debian) + SHLIB_CFLAGS="-fPIC" + SHLIB_SUFFIX=".so" + + # TEA specific: + CFLAGS_OPTIMIZE="-O2 -fomit-frame-pointer" + + # TEA specific: use LDFLAGS_DEFAULT instead of LDFLAGS + SHLIB_LD='${CC} ${CFLAGS} ${LDFLAGS_DEFAULT} -shared' + LDFLAGS="$LDFLAGS -Wl,--export-dynamic" + AS_IF([test $doRpath = yes], [ + CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}']) + LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} + AS_IF([test "`uname -m`" = "alpha"], [CFLAGS="$CFLAGS -mieee"]) + AS_IF([test $do64bit = yes], [ + AC_CACHE_CHECK([if compiler accepts -m64 flag], tcl_cv_cc_m64, [ + hold_cflags=$CFLAGS + CFLAGS="$CFLAGS -m64" + AC_TRY_LINK(,, tcl_cv_cc_m64=yes, tcl_cv_cc_m64=no) + CFLAGS=$hold_cflags]) + AS_IF([test $tcl_cv_cc_m64 = yes], [ + CFLAGS="$CFLAGS -m64" + do64bit_ok=yes + ]) + ]) + + # The combo of gcc + glibc has a bug related to inlining of + # functions like strtod(). The -fno-builtin flag should address + # this problem but it does not work. The -fno-inline flag is kind + # of overkill but it works. Disable inlining only when one of the + # files in compat/*.c is being linked in. + + AS_IF([test x"${USE_COMPAT}" != x],[CFLAGS="$CFLAGS -fno-inline"]) + ;; + Lynx*) + SHLIB_CFLAGS="-fPIC" + SHLIB_SUFFIX=".so" + CFLAGS_OPTIMIZE=-02 + SHLIB_LD='${CC} -shared' + LD_FLAGS="-Wl,--export-dynamic" + AS_IF([test $doRpath = yes], [ + CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' + LD_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}']) + ;; + OpenBSD-*) + arch=`arch -s` + case "$arch" in + alpha|sparc64) + SHLIB_CFLAGS="-fPIC" + ;; + *) + SHLIB_CFLAGS="-fpic" + ;; + esac + SHLIB_LD='${CC} ${SHLIB_CFLAGS} -shared' + SHLIB_SUFFIX=".so" + AS_IF([test $doRpath = yes], [ + CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}']) + LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} + SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.so${SHLIB_VERSION}' + LDFLAGS="-Wl,-export-dynamic" + CFLAGS_OPTIMIZE="-O2" + AS_IF([test "${TCL_THREADS}" = "1"], [ + # On OpenBSD: Compile with -pthread + # Don't link with -lpthread + LIBS=`echo $LIBS | sed s/-lpthread//` + CFLAGS="$CFLAGS -pthread" + ]) + # OpenBSD doesn't do version numbers with dots. + UNSHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.a' + TCL_LIB_VERSIONS_OK=nodots + ;; + NetBSD-*) + # NetBSD has ELF and can use 'cc -shared' to build shared libs + SHLIB_CFLAGS="-fPIC" + SHLIB_LD='${CC} ${SHLIB_CFLAGS} -shared' + SHLIB_SUFFIX=".so" + LDFLAGS="$LDFLAGS -export-dynamic" + AS_IF([test $doRpath = yes], [ + CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}']) + LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} + AS_IF([test "${TCL_THREADS}" = "1"], [ + # The -pthread needs to go in the CFLAGS, not LIBS + LIBS=`echo $LIBS | sed s/-pthread//` + CFLAGS="$CFLAGS -pthread" + LDFLAGS="$LDFLAGS -pthread" + ]) + ;; + DragonFly-*|FreeBSD-*) + # This configuration from FreeBSD Ports. + SHLIB_CFLAGS="-fPIC" + SHLIB_LD="${CC} -shared" + SHLIB_LD_LIBS="${SHLIB_LD_LIBS} -Wl,-soname,\$[@]" + SHLIB_SUFFIX=".so" + LDFLAGS="" + AS_IF([test $doRpath = yes], [ + CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' + LD_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}']) + AS_IF([test "${TCL_THREADS}" = "1"], [ + # The -pthread needs to go in the LDFLAGS, not LIBS + LIBS=`echo $LIBS | sed s/-pthread//` + CFLAGS="$CFLAGS $PTHREAD_CFLAGS" + LDFLAGS="$LDFLAGS $PTHREAD_LIBS"]) + case $system in + FreeBSD-3.*) + # Version numbers are dot-stripped by system policy. + TCL_TRIM_DOTS=`echo ${PACKAGE_VERSION} | tr -d .` + UNSHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.a' + SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}\$\{DBGX\}.so.1' + TCL_LIB_VERSIONS_OK=nodots + ;; + esac + ;; + Darwin-*) + CFLAGS_OPTIMIZE="-Os" + SHLIB_CFLAGS="-fno-common" + # To avoid discrepancies between what headers configure sees during + # preprocessing tests and compiling tests, move any -isysroot and + # -mmacosx-version-min flags from CFLAGS to CPPFLAGS: + CPPFLAGS="${CPPFLAGS} `echo " ${CFLAGS}" | \ + awk 'BEGIN {FS=" +-";ORS=" "}; {for (i=2;i<=NF;i++) \ + if ([$]i~/^(isysroot|mmacosx-version-min)/) print "-"[$]i}'`" + CFLAGS="`echo " ${CFLAGS}" | \ + awk 'BEGIN {FS=" +-";ORS=" "}; {for (i=2;i<=NF;i++) \ + if (!([$]i~/^(isysroot|mmacosx-version-min)/)) print "-"[$]i}'`" + AS_IF([test $do64bit = yes], [ + case `arch` in + ppc) + AC_CACHE_CHECK([if compiler accepts -arch ppc64 flag], + tcl_cv_cc_arch_ppc64, [ + hold_cflags=$CFLAGS + CFLAGS="$CFLAGS -arch ppc64 -mpowerpc64 -mcpu=G5" + AC_TRY_LINK(,, tcl_cv_cc_arch_ppc64=yes, + tcl_cv_cc_arch_ppc64=no) + CFLAGS=$hold_cflags]) + AS_IF([test $tcl_cv_cc_arch_ppc64 = yes], [ + CFLAGS="$CFLAGS -arch ppc64 -mpowerpc64 -mcpu=G5" + do64bit_ok=yes + ]);; + i386) + AC_CACHE_CHECK([if compiler accepts -arch x86_64 flag], + tcl_cv_cc_arch_x86_64, [ + hold_cflags=$CFLAGS + CFLAGS="$CFLAGS -arch x86_64" + AC_TRY_LINK(,, tcl_cv_cc_arch_x86_64=yes, + tcl_cv_cc_arch_x86_64=no) + CFLAGS=$hold_cflags]) + AS_IF([test $tcl_cv_cc_arch_x86_64 = yes], [ + CFLAGS="$CFLAGS -arch x86_64" + do64bit_ok=yes + ]);; + *) + AC_MSG_WARN([Don't know how enable 64-bit on architecture `arch`]);; + esac + ], [ + # Check for combined 32-bit and 64-bit fat build + AS_IF([echo "$CFLAGS " |grep -E -q -- '-arch (ppc64|x86_64) ' \ + && echo "$CFLAGS " |grep -E -q -- '-arch (ppc|i386) '], [ + fat_32_64=yes]) + ]) + # TEA specific: use LDFLAGS_DEFAULT instead of LDFLAGS + SHLIB_LD='${CC} -dynamiclib ${CFLAGS} ${LDFLAGS_DEFAULT}' + AC_CACHE_CHECK([if ld accepts -single_module flag], tcl_cv_ld_single_module, [ + hold_ldflags=$LDFLAGS + LDFLAGS="$LDFLAGS -dynamiclib -Wl,-single_module" + AC_TRY_LINK(, [int i;], tcl_cv_ld_single_module=yes, tcl_cv_ld_single_module=no) + LDFLAGS=$hold_ldflags]) + AS_IF([test $tcl_cv_ld_single_module = yes], [ + SHLIB_LD="${SHLIB_LD} -Wl,-single_module" + ]) + # TEA specific: link shlib with current and compatibility version flags + vers=`echo ${PACKAGE_VERSION} | sed -e 's/^\([[0-9]]\{1,5\}\)\(\(\.[[0-9]]\{1,3\}\)\{0,2\}\).*$/\1\2/p' -e d` + SHLIB_LD="${SHLIB_LD} -current_version ${vers:-0} -compatibility_version ${vers:-0}" + SHLIB_SUFFIX=".dylib" + # Don't use -prebind when building for Mac OS X 10.4 or later only: + AS_IF([test "`echo "${MACOSX_DEPLOYMENT_TARGET}" | awk -F '10\\.' '{print int([$]2)}'`" -lt 4 -a \ + "`echo "${CPPFLAGS}" | awk -F '-mmacosx-version-min=10\\.' '{print int([$]2)}'`" -lt 4], [ + LDFLAGS="$LDFLAGS -prebind"]) + LDFLAGS="$LDFLAGS -headerpad_max_install_names" + AC_CACHE_CHECK([if ld accepts -search_paths_first flag], + tcl_cv_ld_search_paths_first, [ + hold_ldflags=$LDFLAGS + LDFLAGS="$LDFLAGS -Wl,-search_paths_first" + AC_TRY_LINK(, [int i;], tcl_cv_ld_search_paths_first=yes, + tcl_cv_ld_search_paths_first=no) + LDFLAGS=$hold_ldflags]) + AS_IF([test $tcl_cv_ld_search_paths_first = yes], [ + LDFLAGS="$LDFLAGS -Wl,-search_paths_first" + ]) + AS_IF([test "$tcl_cv_cc_visibility_hidden" != yes], [ + AC_DEFINE(MODULE_SCOPE, [__private_extern__], + [Compiler support for module scope symbols]) + tcl_cv_cc_visibility_hidden=yes + ]) + CC_SEARCH_FLAGS="" + LD_SEARCH_FLAGS="" + LD_LIBRARY_PATH_VAR="DYLD_LIBRARY_PATH" + # TEA specific: for combined 32 & 64 bit fat builds of Tk + # extensions, verify that 64-bit build is possible. + AS_IF([test "$fat_32_64" = yes && test -n "${TK_BIN_DIR}"], [ + AS_IF([test "${TEA_WINDOWINGSYSTEM}" = x11], [ + AC_CACHE_CHECK([for 64-bit X11], tcl_cv_lib_x11_64, [ + for v in CFLAGS CPPFLAGS LDFLAGS; do + eval 'hold_'$v'="$'$v'";'$v'="`echo "$'$v' "|sed -e "s/-arch ppc / /g" -e "s/-arch i386 / /g"`"' + done + CPPFLAGS="$CPPFLAGS -I/usr/X11R6/include" + LDFLAGS="$LDFLAGS -L/usr/X11R6/lib -lX11" + AC_TRY_LINK([#include <X11/Xlib.h>], [XrmInitialize();], + tcl_cv_lib_x11_64=yes, tcl_cv_lib_x11_64=no) + for v in CFLAGS CPPFLAGS LDFLAGS; do + eval $v'="$hold_'$v'"' + done]) + ]) + AS_IF([test "${TEA_WINDOWINGSYSTEM}" = aqua], [ + AC_CACHE_CHECK([for 64-bit Tk], tcl_cv_lib_tk_64, [ + for v in CFLAGS CPPFLAGS LDFLAGS; do + eval 'hold_'$v'="$'$v'";'$v'="`echo "$'$v' "|sed -e "s/-arch ppc / /g" -e "s/-arch i386 / /g"`"' + done + CPPFLAGS="$CPPFLAGS -DUSE_TCL_STUBS=1 -DUSE_TK_STUBS=1 ${TCL_INCLUDES} ${TK_INCLUDES}" + LDFLAGS="$LDFLAGS ${TCL_STUB_LIB_SPEC} ${TK_STUB_LIB_SPEC}" + AC_TRY_LINK([#include <tk.h>], [Tk_InitStubs(NULL, "", 0);], + tcl_cv_lib_tk_64=yes, tcl_cv_lib_tk_64=no) + for v in CFLAGS CPPFLAGS LDFLAGS; do + eval $v'="$hold_'$v'"' + done]) + ]) + # remove 64-bit arch flags from CFLAGS et al. if configuration + # does not support 64-bit. + AS_IF([test "$tcl_cv_lib_tk_64" = no -o "$tcl_cv_lib_x11_64" = no], [ + AC_MSG_NOTICE([Removing 64-bit architectures from compiler & linker flags]) + for v in CFLAGS CPPFLAGS LDFLAGS; do + eval $v'="`echo "$'$v' "|sed -e "s/-arch ppc64 / /g" -e "s/-arch x86_64 / /g"`"' + done]) + ]) + ;; + OS/390-*) + CFLAGS_OPTIMIZE="" # Optimizer is buggy + AC_DEFINE(_OE_SOCKETS, 1, # needed in sys/socket.h + [Should OS/390 do the right thing with sockets?]) + ;; + OSF1-V*) + # Digital OSF/1 + SHLIB_CFLAGS="" + AS_IF([test "$SHARED_BUILD" = 1], [ + SHLIB_LD='ld -shared -expect_unresolved "*"' + ], [ + SHLIB_LD='ld -non_shared -expect_unresolved "*"' + ]) + SHLIB_SUFFIX=".so" + AS_IF([test $doRpath = yes], [ + CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' + LD_SEARCH_FLAGS='-rpath ${LIB_RUNTIME_DIR}']) + AS_IF([test "$GCC" = yes], [CFLAGS="$CFLAGS -mieee"], [ + CFLAGS="$CFLAGS -DHAVE_TZSET -std1 -ieee"]) + # see pthread_intro(3) for pthread support on osf1, k.furukawa + AS_IF([test "${TCL_THREADS}" = 1], [ + CFLAGS="$CFLAGS -DHAVE_PTHREAD_ATTR_SETSTACKSIZE" + CFLAGS="$CFLAGS -DTCL_THREAD_STACK_MIN=PTHREAD_STACK_MIN*64" + LIBS=`echo $LIBS | sed s/-lpthreads//` + AS_IF([test "$GCC" = yes], [ + LIBS="$LIBS -lpthread -lmach -lexc" + ], [ + CFLAGS="$CFLAGS -pthread" + LDFLAGS="$LDFLAGS -pthread" + ]) + ]) + ;; + QNX-6*) + # QNX RTP + # This may work for all QNX, but it was only reported for v6. + SHLIB_CFLAGS="-fPIC" + SHLIB_LD="ld -Bshareable -x" + SHLIB_LD_LIBS="" + SHLIB_SUFFIX=".so" + CC_SEARCH_FLAGS="" + LD_SEARCH_FLAGS="" + ;; + SCO_SV-3.2*) + AS_IF([test "$GCC" = yes], [ + SHLIB_CFLAGS="-fPIC -melf" + LDFLAGS="$LDFLAGS -melf -Wl,-Bexport" + ], [ + SHLIB_CFLAGS="-Kpic -belf" + LDFLAGS="$LDFLAGS -belf -Wl,-Bexport" + ]) + SHLIB_LD="ld -G" + SHLIB_LD_LIBS="" + SHLIB_SUFFIX=".so" + CC_SEARCH_FLAGS="" + LD_SEARCH_FLAGS="" + ;; + SunOS-5.[[0-6]]) + # Careful to not let 5.10+ fall into this case + + # Note: If _REENTRANT isn't defined, then Solaris + # won't define thread-safe library routines. + + AC_DEFINE(_REENTRANT, 1, [Do we want the reentrant OS API?]) + AC_DEFINE(_POSIX_PTHREAD_SEMANTICS, 1, + [Do we really want to follow the standard? Yes we do!]) + + SHLIB_CFLAGS="-KPIC" + SHLIB_SUFFIX=".so" + AS_IF([test "$GCC" = yes], [ + SHLIB_LD='${CC} -shared' + CC_SEARCH_FLAGS='-Wl,-R,${LIB_RUNTIME_DIR}' + LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} + ], [ + SHLIB_LD="/usr/ccs/bin/ld -G -z text" + CC_SEARCH_FLAGS='-R ${LIB_RUNTIME_DIR}' + LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} + ]) + ;; + SunOS-5*) + # Note: If _REENTRANT isn't defined, then Solaris + # won't define thread-safe library routines. + + AC_DEFINE(_REENTRANT, 1, [Do we want the reentrant OS API?]) + AC_DEFINE(_POSIX_PTHREAD_SEMANTICS, 1, + [Do we really want to follow the standard? Yes we do!]) + + SHLIB_CFLAGS="-KPIC" + + # Check to enable 64-bit flags for compiler/linker + AS_IF([test "$do64bit" = yes], [ + arch=`isainfo` + AS_IF([test "$arch" = "sparcv9 sparc"], [ + AS_IF([test "$GCC" = yes], [ + AS_IF([test "`${CC} -dumpversion | awk -F. '{print [$]1}'`" -lt 3], [ + AC_MSG_WARN([64bit mode not supported with GCC < 3.2 on $system]) + ], [ + do64bit_ok=yes + CFLAGS="$CFLAGS -m64 -mcpu=v9" + LDFLAGS="$LDFLAGS -m64 -mcpu=v9" + SHLIB_CFLAGS="-fPIC" + ]) + ], [ + do64bit_ok=yes + AS_IF([test "$do64bitVIS" = yes], [ + CFLAGS="$CFLAGS -xarch=v9a" + LDFLAGS_ARCH="-xarch=v9a" + ], [ + CFLAGS="$CFLAGS -xarch=v9" + LDFLAGS_ARCH="-xarch=v9" + ]) + # Solaris 64 uses this as well + #LD_LIBRARY_PATH_VAR="LD_LIBRARY_PATH_64" + ]) + ], [AS_IF([test "$arch" = "amd64 i386"], [ + AS_IF([test "$GCC" = yes], [ + case $system in + SunOS-5.1[[1-9]]*|SunOS-5.[[2-9]][[0-9]]*) + do64bit_ok=yes + CFLAGS="$CFLAGS -m64" + LDFLAGS="$LDFLAGS -m64";; + *) + AC_MSG_WARN([64bit mode not supported with GCC on $system]);; + esac + ], [ + do64bit_ok=yes + case $system in + SunOS-5.1[[1-9]]*|SunOS-5.[[2-9]][[0-9]]*) + CFLAGS="$CFLAGS -m64" + LDFLAGS="$LDFLAGS -m64";; + *) + CFLAGS="$CFLAGS -xarch=amd64" + LDFLAGS="$LDFLAGS -xarch=amd64";; + esac + ]) + ], [AC_MSG_WARN([64bit mode not supported for $arch])])]) + ]) + + SHLIB_SUFFIX=".so" + AS_IF([test "$GCC" = yes], [ + SHLIB_LD='${CC} -shared' + CC_SEARCH_FLAGS='-Wl,-R,${LIB_RUNTIME_DIR}' + LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} + AS_IF([test "$do64bit_ok" = yes], [ + AS_IF([test "$arch" = "sparcv9 sparc"], [ + # We need to specify -static-libgcc or we need to + # add the path to the sparv9 libgcc. + # JH: static-libgcc is necessary for core Tcl, but may + # not be necessary for extensions. + SHLIB_LD="$SHLIB_LD -m64 -mcpu=v9 -static-libgcc" + # for finding sparcv9 libgcc, get the regular libgcc + # path, remove so name and append 'sparcv9' + #v9gcclibdir="`gcc -print-file-name=libgcc_s.so` | ..." + #CC_SEARCH_FLAGS="${CC_SEARCH_FLAGS},-R,$v9gcclibdir" + ], [AS_IF([test "$arch" = "amd64 i386"], [ + # JH: static-libgcc is necessary for core Tcl, but may + # not be necessary for extensions. + SHLIB_LD="$SHLIB_LD -m64 -static-libgcc" + ])]) + ]) + ], [ + case $system in + SunOS-5.[[1-9]][[0-9]]*) + # TEA specific: use LDFLAGS_DEFAULT instead of LDFLAGS + SHLIB_LD='${CC} -G -z text ${LDFLAGS_DEFAULT}';; + *) + SHLIB_LD='/usr/ccs/bin/ld -G -z text';; + esac + CC_SEARCH_FLAGS='-Wl,-R,${LIB_RUNTIME_DIR}' + LD_SEARCH_FLAGS='-R ${LIB_RUNTIME_DIR}' + ]) + ;; + UNIX_SV* | UnixWare-5*) + SHLIB_CFLAGS="-KPIC" + SHLIB_LD='${CC} -G' + SHLIB_LD_LIBS="" + SHLIB_SUFFIX=".so" + # Some UNIX_SV* systems (unixware 1.1.2 for example) have linkers + # that don't grok the -Bexport option. Test that it does. + AC_CACHE_CHECK([for ld accepts -Bexport flag], tcl_cv_ld_Bexport, [ + hold_ldflags=$LDFLAGS + LDFLAGS="$LDFLAGS -Wl,-Bexport" + AC_TRY_LINK(, [int i;], tcl_cv_ld_Bexport=yes, tcl_cv_ld_Bexport=no) + LDFLAGS=$hold_ldflags]) + AS_IF([test $tcl_cv_ld_Bexport = yes], [ + LDFLAGS="$LDFLAGS -Wl,-Bexport" + ]) + CC_SEARCH_FLAGS="" + LD_SEARCH_FLAGS="" + ;; + esac + + AS_IF([test "$do64bit" = yes -a "$do64bit_ok" = no], [ + AC_MSG_WARN([64bit support being disabled -- don't know magic for this platform]) + ]) + +dnl # Add any CPPFLAGS set in the environment to our CFLAGS, but delay doing so +dnl # until the end of configure, as configure's compile and link tests use +dnl # both CPPFLAGS and CFLAGS (unlike our compile and link) but configure's +dnl # preprocessing tests use only CPPFLAGS. + AC_CONFIG_COMMANDS_PRE([CFLAGS="${CFLAGS} ${CPPFLAGS}"; CPPFLAGS=""]) + + # Add in the arch flags late to ensure it wasn't removed. + # Not necessary in TEA, but this is aligned with core + LDFLAGS="$LDFLAGS $LDFLAGS_ARCH" + + # If we're running gcc, then change the C flags for compiling shared + # libraries to the right flags for gcc, instead of those for the + # standard manufacturer compiler. + + AS_IF([test "$GCC" = yes], [ + case $system in + AIX-*) ;; + BSD/OS*) ;; + CYGWIN_*|MINGW32_*|MINGW64_*) ;; + IRIX*) ;; + NetBSD-*|DragonFly-*|FreeBSD-*|OpenBSD-*) ;; + Darwin-*) ;; + SCO_SV-3.2*) ;; + windows) ;; + *) SHLIB_CFLAGS="-fPIC" ;; + esac]) + + AS_IF([test "$tcl_cv_cc_visibility_hidden" != yes], [ + AC_DEFINE(MODULE_SCOPE, [extern], + [No Compiler support for module scope symbols]) + ]) + + AS_IF([test "$SHARED_LIB_SUFFIX" = ""], [ + # TEA specific: use PACKAGE_VERSION instead of VERSION + SHARED_LIB_SUFFIX='${PACKAGE_VERSION}${SHLIB_SUFFIX}']) + AS_IF([test "$UNSHARED_LIB_SUFFIX" = ""], [ + # TEA specific: use PACKAGE_VERSION instead of VERSION + UNSHARED_LIB_SUFFIX='${PACKAGE_VERSION}.a']) + + if test "${GCC}" = "yes" -a ${SHLIB_SUFFIX} = ".dll"; then + AC_CACHE_CHECK(for SEH support in compiler, + tcl_cv_seh, + AC_TRY_RUN([ +#define WIN32_LEAN_AND_MEAN +#include <windows.h> +#undef WIN32_LEAN_AND_MEAN + + int main(int argc, char** argv) { + int a, b = 0; + __try { + a = 666 / b; + } + __except (EXCEPTION_EXECUTE_HANDLER) { + return 0; + } + return 1; + } + ], + tcl_cv_seh=yes, + tcl_cv_seh=no, + tcl_cv_seh=no) + ) + if test "$tcl_cv_seh" = "no" ; then + AC_DEFINE(HAVE_NO_SEH, 1, + [Defined when mingw does not support SEH]) + fi + + # + # Check to see if the excpt.h include file provided contains the + # definition for EXCEPTION_DISPOSITION; if not, which is the case + # with Cygwin's version as of 2002-04-10, define it to be int, + # sufficient for getting the current code to work. + # + AC_CACHE_CHECK(for EXCEPTION_DISPOSITION support in include files, + tcl_cv_eh_disposition, + AC_TRY_COMPILE([ +# define WIN32_LEAN_AND_MEAN +# include <windows.h> +# undef WIN32_LEAN_AND_MEAN + ],[ + EXCEPTION_DISPOSITION x; + ], + tcl_cv_eh_disposition=yes, + tcl_cv_eh_disposition=no) + ) + if test "$tcl_cv_eh_disposition" = "no" ; then + AC_DEFINE(EXCEPTION_DISPOSITION, int, + [Defined when cygwin/mingw does not support EXCEPTION DISPOSITION]) + fi + + # Check to see if winnt.h defines CHAR, SHORT, and LONG + # even if VOID has already been #defined. The win32api + # used by mingw and cygwin is known to do this. + + AC_CACHE_CHECK(for winnt.h that ignores VOID define, + tcl_cv_winnt_ignore_void, + AC_TRY_COMPILE([ +#define VOID void +#define WIN32_LEAN_AND_MEAN +#include <windows.h> +#undef WIN32_LEAN_AND_MEAN + ], [ + CHAR c; + SHORT s; + LONG l; + ], + tcl_cv_winnt_ignore_void=yes, + tcl_cv_winnt_ignore_void=no) + ) + if test "$tcl_cv_winnt_ignore_void" = "yes" ; then + AC_DEFINE(HAVE_WINNT_IGNORE_VOID, 1, + [Defined when cygwin/mingw ignores VOID define in winnt.h]) + fi + fi + + # See if the compiler supports casting to a union type. + # This is used to stop gcc from printing a compiler + # warning when initializing a union member. + + AC_CACHE_CHECK(for cast to union support, + tcl_cv_cast_to_union, + AC_TRY_COMPILE([], + [ + union foo { int i; double d; }; + union foo f = (union foo) (int) 0; + ], + tcl_cv_cast_to_union=yes, + tcl_cv_cast_to_union=no) + ) + if test "$tcl_cv_cast_to_union" = "yes"; then + AC_DEFINE(HAVE_CAST_TO_UNION, 1, + [Defined when compiler supports casting to union type.]) + fi + + AC_SUBST(CFLAGS_DEBUG) + AC_SUBST(CFLAGS_OPTIMIZE) + AC_SUBST(CFLAGS_WARNING) + + AC_SUBST(STLIB_LD) + AC_SUBST(SHLIB_LD) + + AC_SUBST(SHLIB_LD_LIBS) + AC_SUBST(SHLIB_CFLAGS) + + AC_SUBST(LD_LIBRARY_PATH_VAR) + + # These must be called after we do the basic CFLAGS checks and + # verify any possible 64-bit or similar switches are necessary + TEA_TCL_EARLY_FLAGS + TEA_TCL_64BIT_FLAGS +]) + +#-------------------------------------------------------------------- +# TEA_SERIAL_PORT +# +# Determine which interface to use to talk to the serial port. +# Note that #include lines must begin in leftmost column for +# some compilers to recognize them as preprocessor directives, +# and some build environments have stdin not pointing at a +# pseudo-terminal (usually /dev/null instead.) +# +# Arguments: +# none +# +# Results: +# +# Defines only one of the following vars: +# HAVE_SYS_MODEM_H +# USE_TERMIOS +# USE_TERMIO +# USE_SGTTY +#-------------------------------------------------------------------- + +AC_DEFUN([TEA_SERIAL_PORT], [ + AC_CHECK_HEADERS(sys/modem.h) + AC_CACHE_CHECK([termios vs. termio vs. sgtty], tcl_cv_api_serial, [ + AC_TRY_RUN([ +#include <termios.h> + +int main() { + struct termios t; + if (tcgetattr(0, &t) == 0) { + cfsetospeed(&t, 0); + t.c_cflag |= PARENB | PARODD | CSIZE | CSTOPB; + return 0; + } + return 1; +}], tcl_cv_api_serial=termios, tcl_cv_api_serial=no, tcl_cv_api_serial=no) + if test $tcl_cv_api_serial = no ; then + AC_TRY_RUN([ +#include <termio.h> + +int main() { + struct termio t; + if (ioctl(0, TCGETA, &t) == 0) { + t.c_cflag |= CBAUD | PARENB | PARODD | CSIZE | CSTOPB; + return 0; + } + return 1; +}], tcl_cv_api_serial=termio, tcl_cv_api_serial=no, tcl_cv_api_serial=no) + fi + if test $tcl_cv_api_serial = no ; then + AC_TRY_RUN([ +#include <sgtty.h> + +int main() { + struct sgttyb t; + if (ioctl(0, TIOCGETP, &t) == 0) { + t.sg_ospeed = 0; + t.sg_flags |= ODDP | EVENP | RAW; + return 0; + } + return 1; +}], tcl_cv_api_serial=sgtty, tcl_cv_api_serial=no, tcl_cv_api_serial=no) + fi + if test $tcl_cv_api_serial = no ; then + AC_TRY_RUN([ +#include <termios.h> +#include <errno.h> + +int main() { + struct termios t; + if (tcgetattr(0, &t) == 0 + || errno == ENOTTY || errno == ENXIO || errno == EINVAL) { + cfsetospeed(&t, 0); + t.c_cflag |= PARENB | PARODD | CSIZE | CSTOPB; + return 0; + } + return 1; +}], tcl_cv_api_serial=termios, tcl_cv_api_serial=no, tcl_cv_api_serial=no) + fi + if test $tcl_cv_api_serial = no; then + AC_TRY_RUN([ +#include <termio.h> +#include <errno.h> + +int main() { + struct termio t; + if (ioctl(0, TCGETA, &t) == 0 + || errno == ENOTTY || errno == ENXIO || errno == EINVAL) { + t.c_cflag |= CBAUD | PARENB | PARODD | CSIZE | CSTOPB; + return 0; + } + return 1; + }], tcl_cv_api_serial=termio, tcl_cv_api_serial=no, tcl_cv_api_serial=no) + fi + if test $tcl_cv_api_serial = no; then + AC_TRY_RUN([ +#include <sgtty.h> +#include <errno.h> + +int main() { + struct sgttyb t; + if (ioctl(0, TIOCGETP, &t) == 0 + || errno == ENOTTY || errno == ENXIO || errno == EINVAL) { + t.sg_ospeed = 0; + t.sg_flags |= ODDP | EVENP | RAW; + return 0; + } + return 1; +}], tcl_cv_api_serial=sgtty, tcl_cv_api_serial=none, tcl_cv_api_serial=none) + fi]) + case $tcl_cv_api_serial in + termios) AC_DEFINE(USE_TERMIOS, 1, [Use the termios API for serial lines]);; + termio) AC_DEFINE(USE_TERMIO, 1, [Use the termio API for serial lines]);; + sgtty) AC_DEFINE(USE_SGTTY, 1, [Use the sgtty API for serial lines]);; + esac +]) + +#-------------------------------------------------------------------- +# TEA_PATH_X +# +# Locate the X11 header files and the X11 library archive. Try +# the ac_path_x macro first, but if it doesn't find the X stuff +# (e.g. because there's no xmkmf program) then check through +# a list of possible directories. Under some conditions the +# autoconf macro will return an include directory that contains +# no include files, so double-check its result just to be safe. +# +# This should be called after TEA_CONFIG_CFLAGS as setting the +# LIBS line can confuse some configure macro magic. +# +# Arguments: +# none +# +# Results: +# +# Sets the following vars: +# XINCLUDES +# XLIBSW +# PKG_LIBS (appends to) +#-------------------------------------------------------------------- + +AC_DEFUN([TEA_PATH_X], [ + if test "${TEA_WINDOWINGSYSTEM}" = "x11" ; then + TEA_PATH_UNIX_X + fi +]) + +AC_DEFUN([TEA_PATH_UNIX_X], [ + AC_PATH_X + not_really_there="" + if test "$no_x" = ""; then + if test "$x_includes" = ""; then + AC_TRY_CPP([#include <X11/Xlib.h>], , not_really_there="yes") + else + if test ! -r $x_includes/X11/Xlib.h; then + not_really_there="yes" + fi + fi + fi + if test "$no_x" = "yes" -o "$not_really_there" = "yes"; then + AC_MSG_CHECKING([for X11 header files]) + found_xincludes="no" + AC_TRY_CPP([#include <X11/Xlib.h>], found_xincludes="yes", found_xincludes="no") + if test "$found_xincludes" = "no"; then + dirs="/usr/unsupported/include /usr/local/include /usr/X386/include /usr/X11R6/include /usr/X11R5/include /usr/include/X11R5 /usr/include/X11R4 /usr/openwin/include /usr/X11/include /usr/sww/include" + for i in $dirs ; do + if test -r $i/X11/Xlib.h; then + AC_MSG_RESULT([$i]) + XINCLUDES=" -I$i" + found_xincludes="yes" + break + fi + done + fi + else + if test "$x_includes" != ""; then + XINCLUDES="-I$x_includes" + found_xincludes="yes" + fi + fi + if test "$found_xincludes" = "no"; then + AC_MSG_RESULT([couldn't find any!]) + fi + + if test "$no_x" = yes; then + AC_MSG_CHECKING([for X11 libraries]) + XLIBSW=nope + dirs="/usr/unsupported/lib /usr/local/lib /usr/X386/lib /usr/X11R6/lib /usr/X11R5/lib /usr/lib/X11R5 /usr/lib/X11R4 /usr/openwin/lib /usr/X11/lib /usr/sww/X11/lib" + for i in $dirs ; do + if test -r $i/libX11.a -o -r $i/libX11.so -o -r $i/libX11.sl -o -r $i/libX11.dylib; then + AC_MSG_RESULT([$i]) + XLIBSW="-L$i -lX11" + x_libraries="$i" + break + fi + done + else + if test "$x_libraries" = ""; then + XLIBSW=-lX11 + else + XLIBSW="-L$x_libraries -lX11" + fi + fi + if test "$XLIBSW" = nope ; then + AC_CHECK_LIB(Xwindow, XCreateWindow, XLIBSW=-lXwindow) + fi + if test "$XLIBSW" = nope ; then + AC_MSG_RESULT([could not find any! Using -lX11.]) + XLIBSW=-lX11 + fi + # TEA specific: + if test x"${XLIBSW}" != x ; then + PKG_LIBS="${PKG_LIBS} ${XLIBSW}" + fi +]) + +#-------------------------------------------------------------------- +# TEA_BLOCKING_STYLE +# +# The statements below check for systems where POSIX-style +# non-blocking I/O (O_NONBLOCK) doesn't work or is unimplemented. +# On these systems (mostly older ones), use the old BSD-style +# FIONBIO approach instead. +# +# Arguments: +# none +# +# Results: +# +# Defines some of the following vars: +# HAVE_SYS_IOCTL_H +# HAVE_SYS_FILIO_H +# USE_FIONBIO +# O_NONBLOCK +#-------------------------------------------------------------------- + +AC_DEFUN([TEA_BLOCKING_STYLE], [ + AC_CHECK_HEADERS(sys/ioctl.h) + AC_CHECK_HEADERS(sys/filio.h) + TEA_CONFIG_SYSTEM + AC_MSG_CHECKING([FIONBIO vs. O_NONBLOCK for nonblocking I/O]) + case $system in + OSF*) + AC_DEFINE(USE_FIONBIO, 1, [Should we use FIONBIO?]) + AC_MSG_RESULT([FIONBIO]) + ;; + *) + AC_MSG_RESULT([O_NONBLOCK]) + ;; + esac +]) + +#-------------------------------------------------------------------- +# TEA_TIME_HANDLER +# +# Checks how the system deals with time.h, what time structures +# are used on the system, and what fields the structures have. +# +# Arguments: +# none +# +# Results: +# +# Defines some of the following vars: +# USE_DELTA_FOR_TZ +# HAVE_TM_GMTOFF +# HAVE_TM_TZADJ +# HAVE_TIMEZONE_VAR +#-------------------------------------------------------------------- + +AC_DEFUN([TEA_TIME_HANDLER], [ + AC_CHECK_HEADERS(sys/time.h) + AC_HEADER_TIME + AC_STRUCT_TIMEZONE + + AC_CHECK_FUNCS(gmtime_r localtime_r) + + AC_CACHE_CHECK([tm_tzadj in struct tm], tcl_cv_member_tm_tzadj, [ + AC_TRY_COMPILE([#include <time.h>], [struct tm tm; tm.tm_tzadj;], + tcl_cv_member_tm_tzadj=yes, tcl_cv_member_tm_tzadj=no)]) + if test $tcl_cv_member_tm_tzadj = yes ; then + AC_DEFINE(HAVE_TM_TZADJ, 1, [Should we use the tm_tzadj field of struct tm?]) + fi + + AC_CACHE_CHECK([tm_gmtoff in struct tm], tcl_cv_member_tm_gmtoff, [ + AC_TRY_COMPILE([#include <time.h>], [struct tm tm; tm.tm_gmtoff;], + tcl_cv_member_tm_gmtoff=yes, tcl_cv_member_tm_gmtoff=no)]) + if test $tcl_cv_member_tm_gmtoff = yes ; then + AC_DEFINE(HAVE_TM_GMTOFF, 1, [Should we use the tm_gmtoff field of struct tm?]) + fi + + # + # Its important to include time.h in this check, as some systems + # (like convex) have timezone functions, etc. + # + AC_CACHE_CHECK([long timezone variable], tcl_cv_timezone_long, [ + AC_TRY_COMPILE([#include <time.h>], + [extern long timezone; + timezone += 1; + exit (0);], + tcl_cv_timezone_long=yes, tcl_cv_timezone_long=no)]) + if test $tcl_cv_timezone_long = yes ; then + AC_DEFINE(HAVE_TIMEZONE_VAR, 1, [Should we use the global timezone variable?]) + else + # + # On some systems (eg IRIX 6.2), timezone is a time_t and not a long. + # + AC_CACHE_CHECK([time_t timezone variable], tcl_cv_timezone_time, [ + AC_TRY_COMPILE([#include <time.h>], + [extern time_t timezone; + timezone += 1; + exit (0);], + tcl_cv_timezone_time=yes, tcl_cv_timezone_time=no)]) + if test $tcl_cv_timezone_time = yes ; then + AC_DEFINE(HAVE_TIMEZONE_VAR, 1, [Should we use the global timezone variable?]) + fi + fi +]) + +#-------------------------------------------------------------------- +# TEA_BUGGY_STRTOD +# +# Under Solaris 2.4, strtod returns the wrong value for the +# terminating character under some conditions. Check for this +# and if the problem exists use a substitute procedure +# "fixstrtod" (provided by Tcl) that corrects the error. +# Also, on Compaq's Tru64 Unix 5.0, +# strtod(" ") returns 0.0 instead of a failure to convert. +# +# Arguments: +# none +# +# Results: +# +# Might defines some of the following vars: +# strtod (=fixstrtod) +#-------------------------------------------------------------------- + +AC_DEFUN([TEA_BUGGY_STRTOD], [ + AC_CHECK_FUNC(strtod, tcl_strtod=1, tcl_strtod=0) + if test "$tcl_strtod" = 1; then + AC_CACHE_CHECK([for Solaris2.4/Tru64 strtod bugs], tcl_cv_strtod_buggy,[ + AC_TRY_RUN([ + extern double strtod(); + int main() { + char *infString="Inf", *nanString="NaN", *spaceString=" "; + char *term; + double value; + value = strtod(infString, &term); + if ((term != infString) && (term[-1] == 0)) { + exit(1); + } + value = strtod(nanString, &term); + if ((term != nanString) && (term[-1] == 0)) { + exit(1); + } + value = strtod(spaceString, &term); + if (term == (spaceString+1)) { + exit(1); + } + exit(0); + }], tcl_cv_strtod_buggy=ok, tcl_cv_strtod_buggy=buggy, + tcl_cv_strtod_buggy=buggy)]) + if test "$tcl_cv_strtod_buggy" = buggy; then + AC_LIBOBJ([fixstrtod]) + USE_COMPAT=1 + AC_DEFINE(strtod, fixstrtod, [Do we want to use the strtod() in compat?]) + fi + fi +]) + +#-------------------------------------------------------------------- +# TEA_TCL_EARLY_FLAGS +# +# Check for what flags are needed to be passed so the correct OS +# features are available. +# +# Arguments: +# None +# +# Results: +# +# Might define the following vars: +# _ISOC99_SOURCE +# _LARGEFILE64_SOURCE +# _LARGEFILE_SOURCE64 +#-------------------------------------------------------------------- + +AC_DEFUN([TEA_TCL_EARLY_FLAG],[ + AC_CACHE_VAL([tcl_cv_flag_]translit($1,[A-Z],[a-z]), + AC_TRY_COMPILE([$2], $3, [tcl_cv_flag_]translit($1,[A-Z],[a-z])=no, + AC_TRY_COMPILE([[#define ]$1[ 1 +]$2], $3, + [tcl_cv_flag_]translit($1,[A-Z],[a-z])=yes, + [tcl_cv_flag_]translit($1,[A-Z],[a-z])=no))) + if test ["x${tcl_cv_flag_]translit($1,[A-Z],[a-z])[}" = "xyes"] ; then + AC_DEFINE($1, 1, [Add the ]$1[ flag when building]) + tcl_flags="$tcl_flags $1" + fi +]) + +AC_DEFUN([TEA_TCL_EARLY_FLAGS],[ + AC_MSG_CHECKING([for required early compiler flags]) + tcl_flags="" + TEA_TCL_EARLY_FLAG(_ISOC99_SOURCE,[#include <stdlib.h>], + [char *p = (char *)strtoll; char *q = (char *)strtoull;]) + TEA_TCL_EARLY_FLAG(_LARGEFILE64_SOURCE,[#include <sys/stat.h>], + [struct stat64 buf; int i = stat64("/", &buf);]) + TEA_TCL_EARLY_FLAG(_LARGEFILE_SOURCE64,[#include <sys/stat.h>], + [char *p = (char *)open64;]) + if test "x${tcl_flags}" = "x" ; then + AC_MSG_RESULT([none]) + else + AC_MSG_RESULT([${tcl_flags}]) + fi +]) + +#-------------------------------------------------------------------- +# TEA_TCL_64BIT_FLAGS +# +# Check for what is defined in the way of 64-bit features. +# +# Arguments: +# None +# +# Results: +# +# Might define the following vars: +# TCL_WIDE_INT_IS_LONG +# TCL_WIDE_INT_TYPE +# HAVE_STRUCT_DIRENT64 +# HAVE_STRUCT_STAT64 +# HAVE_TYPE_OFF64_T +#-------------------------------------------------------------------- + +AC_DEFUN([TEA_TCL_64BIT_FLAGS], [ + AC_MSG_CHECKING([for 64-bit integer type]) + AC_CACHE_VAL(tcl_cv_type_64bit,[ + tcl_cv_type_64bit=none + # See if the compiler knows natively about __int64 + AC_TRY_COMPILE(,[__int64 value = (__int64) 0;], + tcl_type_64bit=__int64, tcl_type_64bit="long long") + # See if we should use long anyway Note that we substitute in the + # type that is our current guess for a 64-bit type inside this check + # program, so it should be modified only carefully... + AC_TRY_COMPILE(,[switch (0) { + case 1: case (sizeof(]${tcl_type_64bit}[)==sizeof(long)): ; + }],tcl_cv_type_64bit=${tcl_type_64bit})]) + if test "${tcl_cv_type_64bit}" = none ; then + AC_DEFINE(TCL_WIDE_INT_IS_LONG, 1, [Are wide integers to be implemented with C 'long's?]) + AC_MSG_RESULT([using long]) + elif test "${tcl_cv_type_64bit}" = "__int64" \ + -a "${TEA_PLATFORM}" = "windows" ; then + # TEA specific: We actually want to use the default tcl.h checks in + # this case to handle both TCL_WIDE_INT_TYPE and TCL_LL_MODIFIER* + AC_MSG_RESULT([using Tcl header defaults]) + else + AC_DEFINE_UNQUOTED(TCL_WIDE_INT_TYPE,${tcl_cv_type_64bit}, + [What type should be used to define wide integers?]) + AC_MSG_RESULT([${tcl_cv_type_64bit}]) + + # Now check for auxiliary declarations + AC_CACHE_CHECK([for struct dirent64], tcl_cv_struct_dirent64,[ + AC_TRY_COMPILE([#include <sys/types.h> +#include <dirent.h>],[struct dirent64 p;], + tcl_cv_struct_dirent64=yes,tcl_cv_struct_dirent64=no)]) + if test "x${tcl_cv_struct_dirent64}" = "xyes" ; then + AC_DEFINE(HAVE_STRUCT_DIRENT64, 1, [Is 'struct dirent64' in <sys/types.h>?]) + fi + + AC_CACHE_CHECK([for struct stat64], tcl_cv_struct_stat64,[ + AC_TRY_COMPILE([#include <sys/stat.h>],[struct stat64 p; +], + tcl_cv_struct_stat64=yes,tcl_cv_struct_stat64=no)]) + if test "x${tcl_cv_struct_stat64}" = "xyes" ; then + AC_DEFINE(HAVE_STRUCT_STAT64, 1, [Is 'struct stat64' in <sys/stat.h>?]) + fi + + AC_CHECK_FUNCS(open64 lseek64) + AC_MSG_CHECKING([for off64_t]) + AC_CACHE_VAL(tcl_cv_type_off64_t,[ + AC_TRY_COMPILE([#include <sys/types.h>],[off64_t offset; +], + tcl_cv_type_off64_t=yes,tcl_cv_type_off64_t=no)]) + dnl Define HAVE_TYPE_OFF64_T only when the off64_t type and the + dnl functions lseek64 and open64 are defined. + if test "x${tcl_cv_type_off64_t}" = "xyes" && \ + test "x${ac_cv_func_lseek64}" = "xyes" && \ + test "x${ac_cv_func_open64}" = "xyes" ; then + AC_DEFINE(HAVE_TYPE_OFF64_T, 1, [Is off64_t in <sys/types.h>?]) + AC_MSG_RESULT([yes]) + else + AC_MSG_RESULT([no]) + fi + fi +]) + +## +## Here ends the standard Tcl configuration bits and starts the +## TEA specific functions +## + +#------------------------------------------------------------------------ +# TEA_INIT -- +# +# Init various Tcl Extension Architecture (TEA) variables. +# This should be the first called TEA_* macro. +# +# Arguments: +# none +# +# Results: +# +# Defines and substs the following vars: +# CYGPATH +# EXEEXT +# Defines only: +# TEA_VERSION +# TEA_INITED +# TEA_PLATFORM (windows or unix) +# +# "cygpath" is used on windows to generate native path names for include +# files. These variables should only be used with the compiler and linker +# since they generate native path names. +# +# EXEEXT +# Select the executable extension based on the host type. This +# is a lightweight replacement for AC_EXEEXT that doesn't require +# a compiler. +#------------------------------------------------------------------------ + +AC_DEFUN([TEA_INIT], [ + TEA_VERSION="3.13" + + AC_MSG_CHECKING([TEA configuration]) + if test x"${PACKAGE_NAME}" = x ; then + AC_MSG_ERROR([ +The PACKAGE_NAME variable must be defined by your TEA configure.ac]) + fi + AC_MSG_RESULT([ok (TEA ${TEA_VERSION})]) + + # If the user did not set CFLAGS, set it now to keep macros + # like AC_PROG_CC and AC_TRY_COMPILE from adding "-g -O2". + if test "${CFLAGS+set}" != "set" ; then + CFLAGS="" + fi + + case "`uname -s`" in + *win32*|*WIN32*|*MINGW32_*|*MINGW64_*) + AC_CHECK_PROG(CYGPATH, cygpath, cygpath -m, echo) + EXEEXT=".exe" + TEA_PLATFORM="windows" + ;; + *CYGWIN_*) + EXEEXT=".exe" + # CYGPATH and TEA_PLATFORM are determined later in LOAD_TCLCONFIG + ;; + *) + CYGPATH=echo + # Maybe we are cross-compiling.... + case ${host_alias} in + *mingw32*) + EXEEXT=".exe" + TEA_PLATFORM="windows" + ;; + *) + EXEEXT="" + TEA_PLATFORM="unix" + ;; + esac + ;; + esac + + # Check if exec_prefix is set. If not use fall back to prefix. + # Note when adjusted, so that TEA_PREFIX can correct for this. + # This is needed for recursive configures, since autoconf propagates + # $prefix, but not $exec_prefix (doh!). + if test x$exec_prefix = xNONE ; then + exec_prefix_default=yes + exec_prefix=$prefix + fi + + AC_MSG_NOTICE([configuring ${PACKAGE_NAME} ${PACKAGE_VERSION}]) + + AC_SUBST(EXEEXT) + AC_SUBST(CYGPATH) + + # This package name must be replaced statically for AC_SUBST to work + AC_SUBST(PKG_LIB_FILE) + # Substitute STUB_LIB_FILE in case package creates a stub library too. + AC_SUBST(PKG_STUB_LIB_FILE) + + # We AC_SUBST these here to ensure they are subst'ed, + # in case the user doesn't call TEA_ADD_... + AC_SUBST(PKG_STUB_SOURCES) + AC_SUBST(PKG_STUB_OBJECTS) + AC_SUBST(PKG_TCL_SOURCES) + AC_SUBST(PKG_HEADERS) + AC_SUBST(PKG_INCLUDES) + AC_SUBST(PKG_LIBS) + AC_SUBST(PKG_CFLAGS) + + # Configure the installer. + TEA_INSTALLER +]) + +#------------------------------------------------------------------------ +# TEA_ADD_SOURCES -- +# +# Specify one or more source files. Users should check for +# the right platform before adding to their list. +# It is not important to specify the directory, as long as it is +# in the generic, win or unix subdirectory of $(srcdir). +# +# Arguments: +# one or more file names +# +# Results: +# +# Defines and substs the following vars: +# PKG_SOURCES +# PKG_OBJECTS +#------------------------------------------------------------------------ +AC_DEFUN([TEA_ADD_SOURCES], [ + vars="$@" + for i in $vars; do + case $i in + [\$]*) + # allow $-var names + PKG_SOURCES="$PKG_SOURCES $i" + PKG_OBJECTS="$PKG_OBJECTS $i" + ;; + *) + # check for existence - allows for generic/win/unix VPATH + # To add more dirs here (like 'src'), you have to update VPATH + # in Makefile.in as well + if test ! -f "${srcdir}/$i" -a ! -f "${srcdir}/generic/$i" \ + -a ! -f "${srcdir}/win/$i" -a ! -f "${srcdir}/unix/$i" \ + -a ! -f "${srcdir}/macosx/$i" \ + ; then + AC_MSG_ERROR([could not find source file '$i']) + fi + PKG_SOURCES="$PKG_SOURCES $i" + # this assumes it is in a VPATH dir + i=`basename $i` + # handle user calling this before or after TEA_SETUP_COMPILER + if test x"${OBJEXT}" != x ; then + j="`echo $i | sed -e 's/\.[[^.]]*$//'`.${OBJEXT}" + else + j="`echo $i | sed -e 's/\.[[^.]]*$//'`.\${OBJEXT}" + fi + PKG_OBJECTS="$PKG_OBJECTS $j" + ;; + esac + done + AC_SUBST(PKG_SOURCES) + AC_SUBST(PKG_OBJECTS) +]) + +#------------------------------------------------------------------------ +# TEA_ADD_STUB_SOURCES -- +# +# Specify one or more source files. Users should check for +# the right platform before adding to their list. +# It is not important to specify the directory, as long as it is +# in the generic, win or unix subdirectory of $(srcdir). +# +# Arguments: +# one or more file names +# +# Results: +# +# Defines and substs the following vars: +# PKG_STUB_SOURCES +# PKG_STUB_OBJECTS +#------------------------------------------------------------------------ +AC_DEFUN([TEA_ADD_STUB_SOURCES], [ + vars="$@" + for i in $vars; do + # check for existence - allows for generic/win/unix VPATH + if test ! -f "${srcdir}/$i" -a ! -f "${srcdir}/generic/$i" \ + -a ! -f "${srcdir}/win/$i" -a ! -f "${srcdir}/unix/$i" \ + -a ! -f "${srcdir}/macosx/$i" \ + ; then + AC_MSG_ERROR([could not find stub source file '$i']) + fi + PKG_STUB_SOURCES="$PKG_STUB_SOURCES $i" + # this assumes it is in a VPATH dir + i=`basename $i` + # handle user calling this before or after TEA_SETUP_COMPILER + if test x"${OBJEXT}" != x ; then + j="`echo $i | sed -e 's/\.[[^.]]*$//'`.${OBJEXT}" + else + j="`echo $i | sed -e 's/\.[[^.]]*$//'`.\${OBJEXT}" + fi + PKG_STUB_OBJECTS="$PKG_STUB_OBJECTS $j" + done + AC_SUBST(PKG_STUB_SOURCES) + AC_SUBST(PKG_STUB_OBJECTS) +]) + +#------------------------------------------------------------------------ +# TEA_ADD_TCL_SOURCES -- +# +# Specify one or more Tcl source files. These should be platform +# independent runtime files. +# +# Arguments: +# one or more file names +# +# Results: +# +# Defines and substs the following vars: +# PKG_TCL_SOURCES +#------------------------------------------------------------------------ +AC_DEFUN([TEA_ADD_TCL_SOURCES], [ + vars="$@" + for i in $vars; do + # check for existence, be strict because it is installed + if test ! -f "${srcdir}/$i" ; then + AC_MSG_ERROR([could not find tcl source file '${srcdir}/$i']) + fi + PKG_TCL_SOURCES="$PKG_TCL_SOURCES $i" + done + AC_SUBST(PKG_TCL_SOURCES) +]) + +#------------------------------------------------------------------------ +# TEA_ADD_HEADERS -- +# +# Specify one or more source headers. Users should check for +# the right platform before adding to their list. +# +# Arguments: +# one or more file names +# +# Results: +# +# Defines and substs the following vars: +# PKG_HEADERS +#------------------------------------------------------------------------ +AC_DEFUN([TEA_ADD_HEADERS], [ + vars="$@" + for i in $vars; do + # check for existence, be strict because it is installed + if test ! -f "${srcdir}/$i" ; then + AC_MSG_ERROR([could not find header file '${srcdir}/$i']) + fi + PKG_HEADERS="$PKG_HEADERS $i" + done + AC_SUBST(PKG_HEADERS) +]) + +#------------------------------------------------------------------------ +# TEA_ADD_INCLUDES -- +# +# Specify one or more include dirs. Users should check for +# the right platform before adding to their list. +# +# Arguments: +# one or more file names +# +# Results: +# +# Defines and substs the following vars: +# PKG_INCLUDES +#------------------------------------------------------------------------ +AC_DEFUN([TEA_ADD_INCLUDES], [ + vars="$@" + for i in $vars; do + PKG_INCLUDES="$PKG_INCLUDES $i" + done + AC_SUBST(PKG_INCLUDES) +]) + +#------------------------------------------------------------------------ +# TEA_ADD_LIBS -- +# +# Specify one or more libraries. Users should check for +# the right platform before adding to their list. For Windows, +# libraries provided in "foo.lib" format will be converted to +# "-lfoo" when using GCC (mingw). +# +# Arguments: +# one or more file names +# +# Results: +# +# Defines and substs the following vars: +# PKG_LIBS +#------------------------------------------------------------------------ +AC_DEFUN([TEA_ADD_LIBS], [ + vars="$@" + for i in $vars; do + if test "${TEA_PLATFORM}" = "windows" -a "$GCC" = "yes" ; then + # Convert foo.lib to -lfoo for GCC. No-op if not *.lib + i=`echo "$i" | sed -e 's/^\([[^-]].*\)\.lib[$]/-l\1/i'` + fi + PKG_LIBS="$PKG_LIBS $i" + done + AC_SUBST(PKG_LIBS) +]) + +#------------------------------------------------------------------------ +# TEA_ADD_CFLAGS -- +# +# Specify one or more CFLAGS. Users should check for +# the right platform before adding to their list. +# +# Arguments: +# one or more file names +# +# Results: +# +# Defines and substs the following vars: +# PKG_CFLAGS +#------------------------------------------------------------------------ +AC_DEFUN([TEA_ADD_CFLAGS], [ + PKG_CFLAGS="$PKG_CFLAGS $@" + AC_SUBST(PKG_CFLAGS) +]) + +#------------------------------------------------------------------------ +# TEA_ADD_CLEANFILES -- +# +# Specify one or more CLEANFILES. +# +# Arguments: +# one or more file names to clean target +# +# Results: +# +# Appends to CLEANFILES, already defined for subst in LOAD_TCLCONFIG +#------------------------------------------------------------------------ +AC_DEFUN([TEA_ADD_CLEANFILES], [ + CLEANFILES="$CLEANFILES $@" +]) + +#------------------------------------------------------------------------ +# TEA_PREFIX -- +# +# Handle the --prefix=... option by defaulting to what Tcl gave +# +# Arguments: +# none +# +# Results: +# +# If --prefix or --exec-prefix was not specified, $prefix and +# $exec_prefix will be set to the values given to Tcl when it was +# configured. +#------------------------------------------------------------------------ +AC_DEFUN([TEA_PREFIX], [ + if test "${prefix}" = "NONE"; then + prefix_default=yes + if test x"${TCL_PREFIX}" != x; then + AC_MSG_NOTICE([--prefix defaulting to TCL_PREFIX ${TCL_PREFIX}]) + prefix=${TCL_PREFIX} + else + AC_MSG_NOTICE([--prefix defaulting to /usr/local]) + prefix=/usr/local + fi + fi + if test "${exec_prefix}" = "NONE" -a x"${prefix_default}" = x"yes" \ + -o x"${exec_prefix_default}" = x"yes" ; then + if test x"${TCL_EXEC_PREFIX}" != x; then + AC_MSG_NOTICE([--exec-prefix defaulting to TCL_EXEC_PREFIX ${TCL_EXEC_PREFIX}]) + exec_prefix=${TCL_EXEC_PREFIX} + else + AC_MSG_NOTICE([--exec-prefix defaulting to ${prefix}]) + exec_prefix=$prefix + fi + fi +]) + +#------------------------------------------------------------------------ +# TEA_SETUP_COMPILER_CC -- +# +# Do compiler checks the way we want. This is just a replacement +# for AC_PROG_CC in TEA configure.ac files to make them cleaner. +# +# Arguments: +# none +# +# Results: +# +# Sets up CC var and other standard bits we need to make executables. +#------------------------------------------------------------------------ +AC_DEFUN([TEA_SETUP_COMPILER_CC], [ + # Don't put any macros that use the compiler (e.g. AC_TRY_COMPILE) + # in this macro, they need to go into TEA_SETUP_COMPILER instead. + + AC_PROG_CC + AC_PROG_CPP + + #-------------------------------------------------------------------- + # Checks to see if the make program sets the $MAKE variable. + #-------------------------------------------------------------------- + + AC_PROG_MAKE_SET + + #-------------------------------------------------------------------- + # Find ranlib + #-------------------------------------------------------------------- + + AC_CHECK_TOOL(RANLIB, ranlib) + + #-------------------------------------------------------------------- + # Determines the correct binary file extension (.o, .obj, .exe etc.) + #-------------------------------------------------------------------- + + AC_OBJEXT + AC_EXEEXT +]) + +#------------------------------------------------------------------------ +# TEA_SETUP_COMPILER -- +# +# Do compiler checks that use the compiler. This must go after +# TEA_SETUP_COMPILER_CC, which does the actual compiler check. +# +# Arguments: +# none +# +# Results: +# +# Sets up CC var and other standard bits we need to make executables. +#------------------------------------------------------------------------ +AC_DEFUN([TEA_SETUP_COMPILER], [ + # Any macros that use the compiler (e.g. AC_TRY_COMPILE) have to go here. + AC_REQUIRE([TEA_SETUP_COMPILER_CC]) + + #------------------------------------------------------------------------ + # If we're using GCC, see if the compiler understands -pipe. If so, use it. + # It makes compiling go faster. (This is only a performance feature.) + #------------------------------------------------------------------------ + + if test -z "$no_pipe" -a -n "$GCC"; then + AC_CACHE_CHECK([if the compiler understands -pipe], + tcl_cv_cc_pipe, [ + hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -pipe" + AC_TRY_COMPILE(,, tcl_cv_cc_pipe=yes, tcl_cv_cc_pipe=no) + CFLAGS=$hold_cflags]) + if test $tcl_cv_cc_pipe = yes; then + CFLAGS="$CFLAGS -pipe" + fi + fi + + #-------------------------------------------------------------------- + # Common compiler flag setup + #-------------------------------------------------------------------- + + AC_C_BIGENDIAN +]) + +#------------------------------------------------------------------------ +# TEA_MAKE_LIB -- +# +# Generate a line that can be used to build a shared/unshared library +# in a platform independent manner. +# +# Arguments: +# none +# +# Requires: +# +# Results: +# +# Defines the following vars: +# CFLAGS - Done late here to note disturb other AC macros +# MAKE_LIB - Command to execute to build the Tcl library; +# differs depending on whether or not Tcl is being +# compiled as a shared library. +# MAKE_SHARED_LIB Makefile rule for building a shared library +# MAKE_STATIC_LIB Makefile rule for building a static library +# MAKE_STUB_LIB Makefile rule for building a stub library +# VC_MANIFEST_EMBED_DLL Makefile rule for embedded VC manifest in DLL +# VC_MANIFEST_EMBED_EXE Makefile rule for embedded VC manifest in EXE +#------------------------------------------------------------------------ + +AC_DEFUN([TEA_MAKE_LIB], [ + if test "${TEA_PLATFORM}" = "windows" -a "$GCC" != "yes"; then + MAKE_STATIC_LIB="\${STLIB_LD} -out:\[$]@ \$(PKG_OBJECTS)" + MAKE_SHARED_LIB="\${SHLIB_LD} \${SHLIB_LD_LIBS} \${LDFLAGS_DEFAULT} -out:\[$]@ \$(PKG_OBJECTS)" + AC_EGREP_CPP([manifest needed], [ +#if defined(_MSC_VER) && _MSC_VER >= 1400 +print("manifest needed") +#endif + ], [ + # Could do a CHECK_PROG for mt, but should always be with MSVC8+ + VC_MANIFEST_EMBED_DLL="if test -f \[$]@.manifest ; then mt.exe -nologo -manifest \[$]@.manifest -outputresource:\[$]@\;2 ; fi" + VC_MANIFEST_EMBED_EXE="if test -f \[$]@.manifest ; then mt.exe -nologo -manifest \[$]@.manifest -outputresource:\[$]@\;1 ; fi" + MAKE_SHARED_LIB="${MAKE_SHARED_LIB} ; ${VC_MANIFEST_EMBED_DLL}" + TEA_ADD_CLEANFILES([*.manifest]) + ]) + MAKE_STUB_LIB="\${STLIB_LD} -nodefaultlib -out:\[$]@ \$(PKG_STUB_OBJECTS)" + else + MAKE_STATIC_LIB="\${STLIB_LD} \[$]@ \$(PKG_OBJECTS)" + MAKE_SHARED_LIB="\${SHLIB_LD} -o \[$]@ \$(PKG_OBJECTS) \${SHLIB_LD_LIBS}" + MAKE_STUB_LIB="\${STLIB_LD} \[$]@ \$(PKG_STUB_OBJECTS)" + fi + + if test "${SHARED_BUILD}" = "1" ; then + MAKE_LIB="${MAKE_SHARED_LIB} " + else + MAKE_LIB="${MAKE_STATIC_LIB} " + fi + + #-------------------------------------------------------------------- + # Shared libraries and static libraries have different names. + # Use the double eval to make sure any variables in the suffix is + # substituted. (@@@ Might not be necessary anymore) + #-------------------------------------------------------------------- + + if test "${TEA_PLATFORM}" = "windows" ; then + if test "${SHARED_BUILD}" = "1" ; then + # We force the unresolved linking of symbols that are really in + # the private libraries of Tcl and Tk. + if test x"${TK_BIN_DIR}" != x ; then + SHLIB_LD_LIBS="${SHLIB_LD_LIBS} \"`${CYGPATH} ${TK_BIN_DIR}/${TK_STUB_LIB_FILE}`\"" + fi + SHLIB_LD_LIBS="${SHLIB_LD_LIBS} \"`${CYGPATH} ${TCL_BIN_DIR}/${TCL_STUB_LIB_FILE}`\"" + if test "$GCC" = "yes"; then + SHLIB_LD_LIBS="${SHLIB_LD_LIBS} -static-libgcc" + fi + eval eval "PKG_LIB_FILE=${PACKAGE_LIB_PREFIX}${PACKAGE_NAME}${SHARED_LIB_SUFFIX}" + else + eval eval "PKG_LIB_FILE=${PACKAGE_LIB_PREFIX}${PACKAGE_NAME}${UNSHARED_LIB_SUFFIX}" + if test "$GCC" = "yes"; then + PKG_LIB_FILE=lib${PKG_LIB_FILE} + fi + fi + # Some packages build their own stubs libraries + eval eval "PKG_STUB_LIB_FILE=${PACKAGE_LIB_PREFIX}${PACKAGE_NAME}stub${UNSHARED_LIB_SUFFIX}" + if test "$GCC" = "yes"; then + PKG_STUB_LIB_FILE=lib${PKG_STUB_LIB_FILE} + fi + # These aren't needed on Windows (either MSVC or gcc) + RANLIB=: + RANLIB_STUB=: + else + RANLIB_STUB="${RANLIB}" + if test "${SHARED_BUILD}" = "1" ; then + SHLIB_LD_LIBS="${SHLIB_LD_LIBS} ${TCL_STUB_LIB_SPEC}" + if test x"${TK_BIN_DIR}" != x ; then + SHLIB_LD_LIBS="${SHLIB_LD_LIBS} ${TK_STUB_LIB_SPEC}" + fi + eval eval "PKG_LIB_FILE=lib${PACKAGE_LIB_PREFIX}${PACKAGE_NAME}${SHARED_LIB_SUFFIX}" + RANLIB=: + else + eval eval "PKG_LIB_FILE=lib${PACKAGE_LIB_PREFIX}${PACKAGE_NAME}${UNSHARED_LIB_SUFFIX}" + fi + # Some packages build their own stubs libraries + eval eval "PKG_STUB_LIB_FILE=lib${PACKAGE_LIB_PREFIX}${PACKAGE_NAME}stub${UNSHARED_LIB_SUFFIX}" + fi + + # These are escaped so that only CFLAGS is picked up at configure time. + # The other values will be substituted at make time. + CFLAGS="${CFLAGS} \${CFLAGS_DEFAULT} \${CFLAGS_WARNING}" + if test "${SHARED_BUILD}" = "1" ; then + CFLAGS="${CFLAGS} \${SHLIB_CFLAGS}" + fi + + AC_SUBST(MAKE_LIB) + AC_SUBST(MAKE_SHARED_LIB) + AC_SUBST(MAKE_STATIC_LIB) + AC_SUBST(MAKE_STUB_LIB) + AC_SUBST(RANLIB_STUB) + AC_SUBST(VC_MANIFEST_EMBED_DLL) + AC_SUBST(VC_MANIFEST_EMBED_EXE) +]) + +#------------------------------------------------------------------------ +# TEA_LIB_SPEC -- +# +# Compute the name of an existing object library located in libdir +# from the given base name and produce the appropriate linker flags. +# +# Arguments: +# basename The base name of the library without version +# numbers, extensions, or "lib" prefixes. +# extra_dir Extra directory in which to search for the +# library. This location is used first, then +# $prefix/$exec-prefix, then some defaults. +# +# Requires: +# TEA_INIT and TEA_PREFIX must be called first. +# +# Results: +# +# Defines the following vars: +# ${basename}_LIB_NAME The computed library name. +# ${basename}_LIB_SPEC The computed linker flags. +#------------------------------------------------------------------------ + +AC_DEFUN([TEA_LIB_SPEC], [ + AC_MSG_CHECKING([for $1 library]) + + # Look in exec-prefix for the library (defined by TEA_PREFIX). + + tea_lib_name_dir="${exec_prefix}/lib" + + # Or in a user-specified location. + + if test x"$2" != x ; then + tea_extra_lib_dir=$2 + else + tea_extra_lib_dir=NONE + fi + + for i in \ + `ls -dr ${tea_extra_lib_dir}/$1[[0-9]]*.lib 2>/dev/null ` \ + `ls -dr ${tea_extra_lib_dir}/lib$1[[0-9]]* 2>/dev/null ` \ + `ls -dr ${tea_lib_name_dir}/$1[[0-9]]*.lib 2>/dev/null ` \ + `ls -dr ${tea_lib_name_dir}/lib$1[[0-9]]* 2>/dev/null ` \ + `ls -dr /usr/lib/$1[[0-9]]*.lib 2>/dev/null ` \ + `ls -dr /usr/lib/lib$1[[0-9]]* 2>/dev/null ` \ + `ls -dr /usr/lib64/$1[[0-9]]*.lib 2>/dev/null ` \ + `ls -dr /usr/lib64/lib$1[[0-9]]* 2>/dev/null ` \ + `ls -dr /usr/local/lib/$1[[0-9]]*.lib 2>/dev/null ` \ + `ls -dr /usr/local/lib/lib$1[[0-9]]* 2>/dev/null ` ; do + if test -f "$i" ; then + tea_lib_name_dir=`dirname $i` + $1_LIB_NAME=`basename $i` + $1_LIB_PATH_NAME=$i + break + fi + done + + if test "${TEA_PLATFORM}" = "windows"; then + $1_LIB_SPEC=\"`${CYGPATH} ${$1_LIB_PATH_NAME} 2>/dev/null`\" + else + # Strip off the leading "lib" and trailing ".a" or ".so" + + tea_lib_name_lib=`echo ${$1_LIB_NAME}|sed -e 's/^lib//' -e 's/\.[[^.]]*$//' -e 's/\.so.*//'` + $1_LIB_SPEC="-L${tea_lib_name_dir} -l${tea_lib_name_lib}" + fi + + if test "x${$1_LIB_NAME}" = x ; then + AC_MSG_ERROR([not found]) + else + AC_MSG_RESULT([${$1_LIB_SPEC}]) + fi +]) + +#------------------------------------------------------------------------ +# TEA_PRIVATE_TCL_HEADERS -- +# +# Locate the private Tcl include files +# +# Arguments: +# +# Requires: +# TCL_SRC_DIR Assumes that TEA_LOAD_TCLCONFIG has +# already been called. +# +# Results: +# +# Substitutes the following vars: +# TCL_TOP_DIR_NATIVE +# TCL_INCLUDES +#------------------------------------------------------------------------ + +AC_DEFUN([TEA_PRIVATE_TCL_HEADERS], [ + # Allow for --with-tclinclude to take effect and define ${ac_cv_c_tclh} + AC_REQUIRE([TEA_PUBLIC_TCL_HEADERS]) + AC_MSG_CHECKING([for Tcl private include files]) + + TCL_SRC_DIR_NATIVE=`${CYGPATH} ${TCL_SRC_DIR}` + TCL_TOP_DIR_NATIVE=\"${TCL_SRC_DIR_NATIVE}\" + + # Check to see if tcl<Plat>Port.h isn't already with the public headers + # Don't look for tclInt.h because that resides with tcl.h in the core + # sources, but the <plat>Port headers are in a different directory + if test "${TEA_PLATFORM}" = "windows" -a \ + -f "${ac_cv_c_tclh}/tclWinPort.h"; then + result="private headers found with public headers" + elif test "${TEA_PLATFORM}" = "unix" -a \ + -f "${ac_cv_c_tclh}/tclUnixPort.h"; then + result="private headers found with public headers" + else + TCL_GENERIC_DIR_NATIVE=\"${TCL_SRC_DIR_NATIVE}/generic\" + if test "${TEA_PLATFORM}" = "windows"; then + TCL_PLATFORM_DIR_NATIVE=\"${TCL_SRC_DIR_NATIVE}/win\" + else + TCL_PLATFORM_DIR_NATIVE=\"${TCL_SRC_DIR_NATIVE}/unix\" + fi + # Overwrite the previous TCL_INCLUDES as this should capture both + # public and private headers in the same set. + # We want to ensure these are substituted so as not to require + # any *_NATIVE vars be defined in the Makefile + TCL_INCLUDES="-I${TCL_GENERIC_DIR_NATIVE} -I${TCL_PLATFORM_DIR_NATIVE}" + if test "`uname -s`" = "Darwin"; then + # If Tcl was built as a framework, attempt to use + # the framework's Headers and PrivateHeaders directories + case ${TCL_DEFS} in + *TCL_FRAMEWORK*) + if test -d "${TCL_BIN_DIR}/Headers" -a \ + -d "${TCL_BIN_DIR}/PrivateHeaders"; then + TCL_INCLUDES="-I\"${TCL_BIN_DIR}/Headers\" -I\"${TCL_BIN_DIR}/PrivateHeaders\" ${TCL_INCLUDES}" + else + TCL_INCLUDES="${TCL_INCLUDES} ${TCL_INCLUDE_SPEC} `echo "${TCL_INCLUDE_SPEC}" | sed -e 's/Headers/PrivateHeaders/'`" + fi + ;; + esac + result="Using ${TCL_INCLUDES}" + else + if test ! -f "${TCL_SRC_DIR}/generic/tclInt.h" ; then + AC_MSG_ERROR([Cannot find private header tclInt.h in ${TCL_SRC_DIR}]) + fi + result="Using srcdir found in tclConfig.sh: ${TCL_SRC_DIR}" + fi + fi + + AC_SUBST(TCL_TOP_DIR_NATIVE) + + AC_SUBST(TCL_INCLUDES) + AC_MSG_RESULT([${result}]) +]) + +#------------------------------------------------------------------------ +# TEA_PUBLIC_TCL_HEADERS -- +# +# Locate the installed public Tcl header files +# +# Arguments: +# None. +# +# Requires: +# CYGPATH must be set +# +# Results: +# +# Adds a --with-tclinclude switch to configure. +# Result is cached. +# +# Substitutes the following vars: +# TCL_INCLUDES +#------------------------------------------------------------------------ + +AC_DEFUN([TEA_PUBLIC_TCL_HEADERS], [ + AC_MSG_CHECKING([for Tcl public headers]) + + AC_ARG_WITH(tclinclude, [ --with-tclinclude directory containing the public Tcl header files], with_tclinclude=${withval}) + + AC_CACHE_VAL(ac_cv_c_tclh, [ + # Use the value from --with-tclinclude, if it was given + + if test x"${with_tclinclude}" != x ; then + if test -f "${with_tclinclude}/tcl.h" ; then + ac_cv_c_tclh=${with_tclinclude} + else + AC_MSG_ERROR([${with_tclinclude} directory does not contain tcl.h]) + fi + else + list="" + if test "`uname -s`" = "Darwin"; then + # If Tcl was built as a framework, attempt to use + # the framework's Headers directory + case ${TCL_DEFS} in + *TCL_FRAMEWORK*) + list="`ls -d ${TCL_BIN_DIR}/Headers 2>/dev/null`" + ;; + esac + fi + + # Look in the source dir only if Tcl is not installed, + # and in that situation, look there before installed locations. + if test -f "${TCL_BIN_DIR}/Makefile" ; then + list="$list `ls -d ${TCL_SRC_DIR}/generic 2>/dev/null`" + fi + + # Check order: pkg --prefix location, Tcl's --prefix location, + # relative to directory of tclConfig.sh. + + eval "temp_includedir=${includedir}" + list="$list \ + `ls -d ${temp_includedir} 2>/dev/null` \ + `ls -d ${TCL_PREFIX}/include 2>/dev/null` \ + `ls -d ${TCL_BIN_DIR}/../include 2>/dev/null`" + if test "${TEA_PLATFORM}" != "windows" -o "$GCC" = "yes"; then + list="$list /usr/local/include /usr/include" + if test x"${TCL_INCLUDE_SPEC}" != x ; then + d=`echo "${TCL_INCLUDE_SPEC}" | sed -e 's/^-I//'` + list="$list `ls -d ${d} 2>/dev/null`" + fi + fi + for i in $list ; do + if test -f "$i/tcl.h" ; then + ac_cv_c_tclh=$i + break + fi + done + fi + ]) + + # Print a message based on how we determined the include path + + if test x"${ac_cv_c_tclh}" = x ; then + AC_MSG_ERROR([tcl.h not found. Please specify its location with --with-tclinclude]) + else + AC_MSG_RESULT([${ac_cv_c_tclh}]) + fi + + # Convert to a native path and substitute into the output files. + + INCLUDE_DIR_NATIVE=`${CYGPATH} ${ac_cv_c_tclh}` + + TCL_INCLUDES=-I\"${INCLUDE_DIR_NATIVE}\" + + AC_SUBST(TCL_INCLUDES) +]) + +#------------------------------------------------------------------------ +# TEA_PRIVATE_TK_HEADERS -- +# +# Locate the private Tk include files +# +# Arguments: +# +# Requires: +# TK_SRC_DIR Assumes that TEA_LOAD_TKCONFIG has +# already been called. +# +# Results: +# +# Substitutes the following vars: +# TK_INCLUDES +#------------------------------------------------------------------------ + +AC_DEFUN([TEA_PRIVATE_TK_HEADERS], [ + # Allow for --with-tkinclude to take effect and define ${ac_cv_c_tkh} + AC_REQUIRE([TEA_PUBLIC_TK_HEADERS]) + AC_MSG_CHECKING([for Tk private include files]) + + TK_SRC_DIR_NATIVE=`${CYGPATH} ${TK_SRC_DIR}` + TK_TOP_DIR_NATIVE=\"${TK_SRC_DIR_NATIVE}\" + + # Check to see if tk<Plat>Port.h isn't already with the public headers + # Don't look for tkInt.h because that resides with tk.h in the core + # sources, but the <plat>Port headers are in a different directory + if test "${TEA_PLATFORM}" = "windows" -a \ + -f "${ac_cv_c_tkh}/tkWinPort.h"; then + result="private headers found with public headers" + elif test "${TEA_PLATFORM}" = "unix" -a \ + -f "${ac_cv_c_tkh}/tkUnixPort.h"; then + result="private headers found with public headers" + else + TK_GENERIC_DIR_NATIVE=\"${TK_SRC_DIR_NATIVE}/generic\" + TK_XLIB_DIR_NATIVE=\"${TK_SRC_DIR_NATIVE}/xlib\" + if test "${TEA_PLATFORM}" = "windows"; then + TK_PLATFORM_DIR_NATIVE=\"${TK_SRC_DIR_NATIVE}/win\" + else + TK_PLATFORM_DIR_NATIVE=\"${TK_SRC_DIR_NATIVE}/unix\" + fi + # Overwrite the previous TK_INCLUDES as this should capture both + # public and private headers in the same set. + # We want to ensure these are substituted so as not to require + # any *_NATIVE vars be defined in the Makefile + TK_INCLUDES="-I${TK_GENERIC_DIR_NATIVE} -I${TK_PLATFORM_DIR_NATIVE}" + # Detect and add ttk subdir + if test -d "${TK_SRC_DIR}/generic/ttk"; then + TK_INCLUDES="${TK_INCLUDES} -I\"${TK_SRC_DIR_NATIVE}/generic/ttk\"" + fi + if test "${TEA_WINDOWINGSYSTEM}" != "x11"; then + TK_INCLUDES="${TK_INCLUDES} -I\"${TK_XLIB_DIR_NATIVE}\"" + fi + if test "${TEA_WINDOWINGSYSTEM}" = "aqua"; then + TK_INCLUDES="${TK_INCLUDES} -I\"${TK_SRC_DIR_NATIVE}/macosx\"" + fi + if test "`uname -s`" = "Darwin"; then + # If Tk was built as a framework, attempt to use + # the framework's Headers and PrivateHeaders directories + case ${TK_DEFS} in + *TK_FRAMEWORK*) + if test -d "${TK_BIN_DIR}/Headers" -a \ + -d "${TK_BIN_DIR}/PrivateHeaders"; then + TK_INCLUDES="-I\"${TK_BIN_DIR}/Headers\" -I\"${TK_BIN_DIR}/PrivateHeaders\" ${TK_INCLUDES}" + else + TK_INCLUDES="${TK_INCLUDES} ${TK_INCLUDE_SPEC} `echo "${TK_INCLUDE_SPEC}" | sed -e 's/Headers/PrivateHeaders/'`" + fi + ;; + esac + result="Using ${TK_INCLUDES}" + else + if test ! -f "${TK_SRC_DIR}/generic/tkInt.h" ; then + AC_MSG_ERROR([Cannot find private header tkInt.h in ${TK_SRC_DIR}]) + fi + result="Using srcdir found in tkConfig.sh: ${TK_SRC_DIR}" + fi + fi + + AC_SUBST(TK_TOP_DIR_NATIVE) + AC_SUBST(TK_XLIB_DIR_NATIVE) + + AC_SUBST(TK_INCLUDES) + AC_MSG_RESULT([${result}]) +]) + +#------------------------------------------------------------------------ +# TEA_PUBLIC_TK_HEADERS -- +# +# Locate the installed public Tk header files +# +# Arguments: +# None. +# +# Requires: +# CYGPATH must be set +# +# Results: +# +# Adds a --with-tkinclude switch to configure. +# Result is cached. +# +# Substitutes the following vars: +# TK_INCLUDES +#------------------------------------------------------------------------ + +AC_DEFUN([TEA_PUBLIC_TK_HEADERS], [ + AC_MSG_CHECKING([for Tk public headers]) + + AC_ARG_WITH(tkinclude, [ --with-tkinclude directory containing the public Tk header files], with_tkinclude=${withval}) + + AC_CACHE_VAL(ac_cv_c_tkh, [ + # Use the value from --with-tkinclude, if it was given + + if test x"${with_tkinclude}" != x ; then + if test -f "${with_tkinclude}/tk.h" ; then + ac_cv_c_tkh=${with_tkinclude} + else + AC_MSG_ERROR([${with_tkinclude} directory does not contain tk.h]) + fi + else + list="" + if test "`uname -s`" = "Darwin"; then + # If Tk was built as a framework, attempt to use + # the framework's Headers directory. + case ${TK_DEFS} in + *TK_FRAMEWORK*) + list="`ls -d ${TK_BIN_DIR}/Headers 2>/dev/null`" + ;; + esac + fi + + # Look in the source dir only if Tk is not installed, + # and in that situation, look there before installed locations. + if test -f "${TK_BIN_DIR}/Makefile" ; then + list="$list `ls -d ${TK_SRC_DIR}/generic 2>/dev/null`" + fi + + # Check order: pkg --prefix location, Tk's --prefix location, + # relative to directory of tkConfig.sh, Tcl's --prefix location, + # relative to directory of tclConfig.sh. + + eval "temp_includedir=${includedir}" + list="$list \ + `ls -d ${temp_includedir} 2>/dev/null` \ + `ls -d ${TK_PREFIX}/include 2>/dev/null` \ + `ls -d ${TK_BIN_DIR}/../include 2>/dev/null` \ + `ls -d ${TCL_PREFIX}/include 2>/dev/null` \ + `ls -d ${TCL_BIN_DIR}/../include 2>/dev/null`" + if test "${TEA_PLATFORM}" != "windows" -o "$GCC" = "yes"; then + list="$list /usr/local/include /usr/include" + if test x"${TK_INCLUDE_SPEC}" != x ; then + d=`echo "${TK_INCLUDE_SPEC}" | sed -e 's/^-I//'` + list="$list `ls -d ${d} 2>/dev/null`" + fi + fi + for i in $list ; do + if test -f "$i/tk.h" ; then + ac_cv_c_tkh=$i + break + fi + done + fi + ]) + + # Print a message based on how we determined the include path + + if test x"${ac_cv_c_tkh}" = x ; then + AC_MSG_ERROR([tk.h not found. Please specify its location with --with-tkinclude]) + else + AC_MSG_RESULT([${ac_cv_c_tkh}]) + fi + + # Convert to a native path and substitute into the output files. + + INCLUDE_DIR_NATIVE=`${CYGPATH} ${ac_cv_c_tkh}` + + TK_INCLUDES=-I\"${INCLUDE_DIR_NATIVE}\" + + AC_SUBST(TK_INCLUDES) + + if test "${TEA_WINDOWINGSYSTEM}" != "x11"; then + # On Windows and Aqua, we need the X compat headers + AC_MSG_CHECKING([for X11 header files]) + if test ! -r "${INCLUDE_DIR_NATIVE}/X11/Xlib.h"; then + INCLUDE_DIR_NATIVE="`${CYGPATH} ${TK_SRC_DIR}/xlib`" + TK_XINCLUDES=-I\"${INCLUDE_DIR_NATIVE}\" + AC_SUBST(TK_XINCLUDES) + fi + AC_MSG_RESULT([${INCLUDE_DIR_NATIVE}]) + fi +]) + +#------------------------------------------------------------------------ +# TEA_PATH_CONFIG -- +# +# Locate the ${1}Config.sh file and perform a sanity check on +# the ${1} compile flags. These are used by packages like +# [incr Tk] that load *Config.sh files from more than Tcl and Tk. +# +# Arguments: +# none +# +# Results: +# +# Adds the following arguments to configure: +# --with-$1=... +# +# Defines the following vars: +# $1_BIN_DIR Full path to the directory containing +# the $1Config.sh file +#------------------------------------------------------------------------ + +AC_DEFUN([TEA_PATH_CONFIG], [ + # + # Ok, lets find the $1 configuration + # First, look for one uninstalled. + # the alternative search directory is invoked by --with-$1 + # + + if test x"${no_$1}" = x ; then + # we reset no_$1 in case something fails here + no_$1=true + AC_ARG_WITH($1, [ --with-$1 directory containing $1 configuration ($1Config.sh)], with_$1config=${withval}) + AC_MSG_CHECKING([for $1 configuration]) + AC_CACHE_VAL(ac_cv_c_$1config,[ + + # First check to see if --with-$1 was specified. + if test x"${with_$1config}" != x ; then + case ${with_$1config} in + */$1Config.sh ) + if test -f ${with_$1config}; then + AC_MSG_WARN([--with-$1 argument should refer to directory containing $1Config.sh, not to $1Config.sh itself]) + with_$1config=`echo ${with_$1config} | sed 's!/$1Config\.sh$!!'` + fi;; + esac + if test -f "${with_$1config}/$1Config.sh" ; then + ac_cv_c_$1config=`(cd ${with_$1config}; pwd)` + else + AC_MSG_ERROR([${with_$1config} directory doesn't contain $1Config.sh]) + fi + fi + + # then check for a private $1 installation + if test x"${ac_cv_c_$1config}" = x ; then + for i in \ + ../$1 \ + `ls -dr ../$1*[[0-9]].[[0-9]]*.[[0-9]]* 2>/dev/null` \ + `ls -dr ../$1*[[0-9]].[[0-9]][[0-9]] 2>/dev/null` \ + `ls -dr ../$1*[[0-9]].[[0-9]] 2>/dev/null` \ + `ls -dr ../$1*[[0-9]].[[0-9]]* 2>/dev/null` \ + ../../$1 \ + `ls -dr ../../$1*[[0-9]].[[0-9]]*.[[0-9]]* 2>/dev/null` \ + `ls -dr ../../$1*[[0-9]].[[0-9]][[0-9]] 2>/dev/null` \ + `ls -dr ../../$1*[[0-9]].[[0-9]] 2>/dev/null` \ + `ls -dr ../../$1*[[0-9]].[[0-9]]* 2>/dev/null` \ + ../../../$1 \ + `ls -dr ../../../$1*[[0-9]].[[0-9]]*.[[0-9]]* 2>/dev/null` \ + `ls -dr ../../../$1*[[0-9]].[[0-9]][[0-9]] 2>/dev/null` \ + `ls -dr ../../../$1*[[0-9]].[[0-9]] 2>/dev/null` \ + `ls -dr ../../../$1*[[0-9]].[[0-9]]* 2>/dev/null` \ + ${srcdir}/../$1 \ + `ls -dr ${srcdir}/../$1*[[0-9]].[[0-9]]*.[[0-9]]* 2>/dev/null` \ + `ls -dr ${srcdir}/../$1*[[0-9]].[[0-9]][[0-9]] 2>/dev/null` \ + `ls -dr ${srcdir}/../$1*[[0-9]].[[0-9]] 2>/dev/null` \ + `ls -dr ${srcdir}/../$1*[[0-9]].[[0-9]]* 2>/dev/null` \ + ; do + if test -f "$i/$1Config.sh" ; then + ac_cv_c_$1config=`(cd $i; pwd)` + break + fi + if test -f "$i/unix/$1Config.sh" ; then + ac_cv_c_$1config=`(cd $i/unix; pwd)` + break + fi + done + fi + + # check in a few common install locations + if test x"${ac_cv_c_$1config}" = x ; then + for i in `ls -d ${libdir} 2>/dev/null` \ + `ls -d ${exec_prefix}/lib 2>/dev/null` \ + `ls -d ${prefix}/lib 2>/dev/null` \ + `ls -d /usr/local/lib 2>/dev/null` \ + `ls -d /usr/contrib/lib 2>/dev/null` \ + `ls -d /usr/pkg/lib 2>/dev/null` \ + `ls -d /usr/lib 2>/dev/null` \ + `ls -d /usr/lib64 2>/dev/null` \ + ; do + if test -f "$i/$1Config.sh" ; then + ac_cv_c_$1config=`(cd $i; pwd)` + break + fi + done + fi + ]) + + if test x"${ac_cv_c_$1config}" = x ; then + $1_BIN_DIR="# no $1 configs found" + AC_MSG_WARN([Cannot find $1 configuration definitions]) + exit 0 + else + no_$1= + $1_BIN_DIR=${ac_cv_c_$1config} + AC_MSG_RESULT([found $$1_BIN_DIR/$1Config.sh]) + fi + fi +]) + +#------------------------------------------------------------------------ +# TEA_LOAD_CONFIG -- +# +# Load the $1Config.sh file +# +# Arguments: +# +# Requires the following vars to be set: +# $1_BIN_DIR +# +# Results: +# +# Substitutes the following vars: +# $1_SRC_DIR +# $1_LIB_FILE +# $1_LIB_SPEC +#------------------------------------------------------------------------ + +AC_DEFUN([TEA_LOAD_CONFIG], [ + AC_MSG_CHECKING([for existence of ${$1_BIN_DIR}/$1Config.sh]) + + if test -f "${$1_BIN_DIR}/$1Config.sh" ; then + AC_MSG_RESULT([loading]) + . "${$1_BIN_DIR}/$1Config.sh" + else + AC_MSG_RESULT([file not found]) + fi + + # + # If the $1_BIN_DIR is the build directory (not the install directory), + # then set the common variable name to the value of the build variables. + # For example, the variable $1_LIB_SPEC will be set to the value + # of $1_BUILD_LIB_SPEC. An extension should make use of $1_LIB_SPEC + # instead of $1_BUILD_LIB_SPEC since it will work with both an + # installed and uninstalled version of Tcl. + # + + if test -f "${$1_BIN_DIR}/Makefile" ; then + AC_MSG_WARN([Found Makefile - using build library specs for $1]) + $1_LIB_SPEC=${$1_BUILD_LIB_SPEC} + $1_STUB_LIB_SPEC=${$1_BUILD_STUB_LIB_SPEC} + $1_STUB_LIB_PATH=${$1_BUILD_STUB_LIB_PATH} + $1_INCLUDE_SPEC=${$1_BUILD_INCLUDE_SPEC} + $1_LIBRARY_PATH=${$1_LIBRARY_PATH} + fi + + AC_SUBST($1_VERSION) + AC_SUBST($1_BIN_DIR) + AC_SUBST($1_SRC_DIR) + + AC_SUBST($1_LIB_FILE) + AC_SUBST($1_LIB_SPEC) + + AC_SUBST($1_STUB_LIB_FILE) + AC_SUBST($1_STUB_LIB_SPEC) + AC_SUBST($1_STUB_LIB_PATH) + + # Allow the caller to prevent this auto-check by specifying any 2nd arg + AS_IF([test "x$2" = x], [ + # Check both upper and lower-case variants + # If a dev wanted non-stubs libs, this function could take an option + # to not use _STUB in the paths below + AS_IF([test "x${$1_STUB_LIB_SPEC}" = x], + [TEA_LOAD_CONFIG_LIB(translit($1,[a-z],[A-Z])_STUB)], + [TEA_LOAD_CONFIG_LIB($1_STUB)]) + ]) +]) + +#------------------------------------------------------------------------ +# TEA_LOAD_CONFIG_LIB -- +# +# Helper function to load correct library from another extension's +# ${PACKAGE}Config.sh. +# +# Results: +# Adds to LIBS the appropriate extension library +#------------------------------------------------------------------------ +AC_DEFUN([TEA_LOAD_CONFIG_LIB], [ + AC_MSG_CHECKING([For $1 library for LIBS]) + # This simplifies the use of stub libraries by automatically adding + # the stub lib to your path. Normally this would add to SHLIB_LD_LIBS, + # but this is called before CONFIG_CFLAGS. More importantly, this adds + # to PKG_LIBS, which becomes LIBS, and that is only used by SHLIB_LD. + if test "x${$1_LIB_SPEC}" != "x" ; then + if test "${TEA_PLATFORM}" = "windows" -a "$GCC" != "yes" ; then + TEA_ADD_LIBS([\"`${CYGPATH} ${$1_LIB_PATH}`\"]) + AC_MSG_RESULT([using $1_LIB_PATH ${$1_LIB_PATH}]) + else + TEA_ADD_LIBS([${$1_LIB_SPEC}]) + AC_MSG_RESULT([using $1_LIB_SPEC ${$1_LIB_SPEC}]) + fi + else + AC_MSG_RESULT([file not found]) + fi +]) + +#------------------------------------------------------------------------ +# TEA_EXPORT_CONFIG -- +# +# Define the data to insert into the ${PACKAGE}Config.sh file +# +# Arguments: +# +# Requires the following vars to be set: +# $1 +# +# Results: +# Substitutes the following vars: +#------------------------------------------------------------------------ + +AC_DEFUN([TEA_EXPORT_CONFIG], [ + #-------------------------------------------------------------------- + # These are for $1Config.sh + #-------------------------------------------------------------------- + + # pkglibdir must be a fully qualified path and (not ${exec_prefix}/lib) + eval pkglibdir="[$]{libdir}/$1${PACKAGE_VERSION}" + if test "${TCL_LIB_VERSIONS_OK}" = "ok"; then + eval $1_LIB_FLAG="-l$1${PACKAGE_VERSION}${DBGX}" + eval $1_STUB_LIB_FLAG="-l$1stub${PACKAGE_VERSION}${DBGX}" + else + eval $1_LIB_FLAG="-l$1`echo ${PACKAGE_VERSION} | tr -d .`${DBGX}" + eval $1_STUB_LIB_FLAG="-l$1stub`echo ${PACKAGE_VERSION} | tr -d .`${DBGX}" + fi + $1_BUILD_LIB_SPEC="-L`$CYGPATH $(pwd)` ${$1_LIB_FLAG}" + $1_LIB_SPEC="-L`$CYGPATH ${pkglibdir}` ${$1_LIB_FLAG}" + $1_BUILD_STUB_LIB_SPEC="-L`$CYGPATH $(pwd)` [$]{$1_STUB_LIB_FLAG}" + $1_STUB_LIB_SPEC="-L`$CYGPATH ${pkglibdir}` [$]{$1_STUB_LIB_FLAG}" + $1_BUILD_STUB_LIB_PATH="`$CYGPATH $(pwd)`/[$]{PKG_STUB_LIB_FILE}" + $1_STUB_LIB_PATH="`$CYGPATH ${pkglibdir}`/[$]{PKG_STUB_LIB_FILE}" + + AC_SUBST($1_BUILD_LIB_SPEC) + AC_SUBST($1_LIB_SPEC) + AC_SUBST($1_BUILD_STUB_LIB_SPEC) + AC_SUBST($1_STUB_LIB_SPEC) + AC_SUBST($1_BUILD_STUB_LIB_PATH) + AC_SUBST($1_STUB_LIB_PATH) + + AC_SUBST(MAJOR_VERSION) + AC_SUBST(MINOR_VERSION) + AC_SUBST(PATCHLEVEL) +]) + + +#------------------------------------------------------------------------ +# TEA_PATH_CELIB -- +# +# Locate Keuchel's celib emulation layer for targeting Win/CE +# +# Arguments: +# none +# +# Results: +# +# Adds the following arguments to configure: +# --with-celib=... +# +# Defines the following vars: +# CELIB_DIR Full path to the directory containing +# the include and platform lib files +#------------------------------------------------------------------------ + +AC_DEFUN([TEA_PATH_CELIB], [ + # First, look for one uninstalled. + # the alternative search directory is invoked by --with-celib + + if test x"${no_celib}" = x ; then + # we reset no_celib in case something fails here + no_celib=true + AC_ARG_WITH(celib,[ --with-celib=DIR use Windows/CE support library from DIR], with_celibconfig=${withval}) + AC_MSG_CHECKING([for Windows/CE celib directory]) + AC_CACHE_VAL(ac_cv_c_celibconfig,[ + # First check to see if --with-celibconfig was specified. + if test x"${with_celibconfig}" != x ; then + if test -d "${with_celibconfig}/inc" ; then + ac_cv_c_celibconfig=`(cd ${with_celibconfig}; pwd)` + else + AC_MSG_ERROR([${with_celibconfig} directory doesn't contain inc directory]) + fi + fi + + # then check for a celib library + if test x"${ac_cv_c_celibconfig}" = x ; then + for i in \ + ../celib-palm-3.0 \ + ../celib \ + ../../celib-palm-3.0 \ + ../../celib \ + `ls -dr ../celib-*3.[[0-9]]* 2>/dev/null` \ + ${srcdir}/../celib-palm-3.0 \ + ${srcdir}/../celib \ + `ls -dr ${srcdir}/../celib-*3.[[0-9]]* 2>/dev/null` \ + ; do + if test -d "$i/inc" ; then + ac_cv_c_celibconfig=`(cd $i; pwd)` + break + fi + done + fi + ]) + if test x"${ac_cv_c_celibconfig}" = x ; then + AC_MSG_ERROR([Cannot find celib support library directory]) + else + no_celib= + CELIB_DIR=${ac_cv_c_celibconfig} + CELIB_DIR=`echo "$CELIB_DIR" | sed -e 's!\\\!/!g'` + AC_MSG_RESULT([found $CELIB_DIR]) + fi + fi +]) + +#------------------------------------------------------------------------ +# TEA_INSTALLER -- +# +# Configure the installer. +# +# Arguments: +# none +# +# Results: +# Substitutes the following vars: +# INSTALL +# INSTALL_DATA_DIR +# INSTALL_DATA +# INSTALL_PROGRAM +# INSTALL_SCRIPT +# INSTALL_LIBRARY +#------------------------------------------------------------------------ + +AC_DEFUN([TEA_INSTALLER], [ + INSTALL='$(SHELL) $(srcdir)/tclconfig/install-sh -c' + INSTALL_DATA_DIR='${INSTALL} -d -m 755' + INSTALL_DATA='${INSTALL} -m 644' + INSTALL_PROGRAM='${INSTALL} -m 755' + INSTALL_SCRIPT='${INSTALL} -m 755' + + TEA_CONFIG_SYSTEM + case $system in + HP-UX-*) INSTALL_LIBRARY='${INSTALL} -m 755' ;; + *) INSTALL_LIBRARY='${INSTALL} -m 644' ;; + esac + + AC_SUBST(INSTALL) + AC_SUBST(INSTALL_DATA_DIR) + AC_SUBST(INSTALL_DATA) + AC_SUBST(INSTALL_PROGRAM) + AC_SUBST(INSTALL_SCRIPT) + AC_SUBST(INSTALL_LIBRARY) +]) + +### +# Tip 430 - ZipFS Modifications +### +#------------------------------------------------------------------------ +# SC_ZIPFS_SUPPORT +# Locate a zip encoder installed on the system path, or none. +# +# Arguments: +# none +# +# Results: +# Substitutes the following vars: +# TCL_ZIP_FILE +# TCL_ZIPFS_SUPPORT +# TCL_ZIPFS_FLAG +# ZIP_PROG +#------------------------------------------------------------------------ + +#------------------------------------------------------------------------ +# SC_PROG_ZIP +# Locate a zip encoder installed on the system path, or none. +# +# Arguments: +# none +# +# Results: +# Substitutes the following vars: +# ZIP_PROG +# ZIP_PROG_OPTIONS +# ZIP_PROG_VFSSEARCH +# ZIP_INSTALL_OBJS +#------------------------------------------------------------------------ +AC_DEFUN([TEA_ZIPFS_SUPPORT], [ + AC_MSG_CHECKING([for zipfs support]) + ZIP_PROG="" + ZIP_PROG_OPTIONS="" + ZIP_PROG_VFSSEARCH="" + INSTALL_MSGS="" + # If our native tclsh processes the "install" command line option + # we can use it to mint zip files + AS_IF([$TCLSH_PROG install],[ + ZIP_PROG=${TCLSH_PROG} + ZIP_PROG_OPTIONS="install mkzip" + ZIP_PROG_VFSSEARCH="." + AC_MSG_RESULT([Can use Native Tclsh for Zip encoding]) + ]) + if test "x$ZIP_PROG" = "x" ; then + AC_CACHE_VAL(ac_cv_path_zip, [ + search_path=`echo ${PATH} | sed -e 's/:/ /g'` + for dir in $search_path ; do + for j in `ls -r $dir/zip 2> /dev/null` \ + `ls -r $dir/zip 2> /dev/null` ; do + if test x"$ac_cv_path_zip" = x ; then + if test -f "$j" ; then + ac_cv_path_zip=$j + break + fi + fi + done + done + ]) + if test -f "$ac_cv_path_zip" ; then + ZIP_PROG="$ac_cv_path_zip " + AC_MSG_RESULT([$ZIP_PROG]) + ZIP_PROG_OPTIONS="-rq" + ZIP_PROG_VFSSEARCH="." + AC_MSG_RESULT([Found INFO Zip in environment]) + # Use standard arguments for zip + fi + fi + if test "x$ZIP_PROG" = "x" ; then + # It is not an error if an installed version of Zip can't be located. + ZIP_PROG="" + ZIP_PROG_OPTIONS="" + ZIP_PROG_VFSSEARCH="" + TCL_ZIPFS_SUPPORT=0 + TCL_ZIPFS_FLAG= + else + # ZIPFS Support + eval "TCL_ZIP_FILE=\"${TCL_ZIP_FILE}\"" + if test ${TCL_ZIP_FILE} = "" ; then + TCL_ZIPFS_SUPPORT=0 + TCL_ZIPFS_FLAG= + INSTALL_LIBRARIES=install-libraries + INSTALL_MSGS=install-msgs + else + if test ${SHARED_BUILD} = 1 ; then + TCL_ZIPFS_SUPPORT=1 + INSTALL_LIBRARIES=install-libraries-zipfs-shared + else + TCL_ZIPFS_SUPPORT=2 + INSTALL_LIBRARIES=install-libraries-zipfs-static + fi + TCL_ZIPFS_FLAG=-DTCL_ZIPFS_SUPPORT + fi + fi + + AC_SUBST(TCL_ZIP_FILE) + AC_SUBST(TCL_ZIPFS_SUPPORT) + AC_SUBST(TCL_ZIPFS_FLAG) + AC_SUBST(ZIP_PROG) + AC_SUBST(ZIP_PROG_OPTIONS) + AC_SUBST(ZIP_PROG_VFSSEARCH) + AC_SUBST(INSTALL_LIBRARIES) + AC_SUBST(INSTALL_MSGS) +]) + +# Local Variables: +# mode: autoconf +# End: diff --git a/tcl8.6/pkgs/thread2.8.4/tests/French.txt b/tcl8.6/pkgs/thread2.8.4/tests/French.txt new file mode 100644 index 0000000..ccbbab7 --- /dev/null +++ b/tcl8.6/pkgs/thread2.8.4/tests/French.txt @@ -0,0 +1,3257 @@ +########################################################################### +#Copyright 1999 The Internet Dictionary Project/Tyler Chambers +#http://www.june29.com/IDP/ +#This file is free to use and modify. Thank you for using the IDP. +# +#Approximately 1340 entries. 9/21/97 +#Approximately 1884 entries. 1/7/98 +#Appriximately 2160 entries. 3/8/98 +#Approximately 3040 entries. 8/18/98 +#Approximately 3250 entries. 2/19/99 +########################################################################### +a un(e): ~ book = un livre. 2.(instead of number one) ~ year ago; il y a un an[Article] +a un, une[Pronoun] +aardvark orycte/rope[Noun] +aardvark adverbe[Adverb] +aardvarks tamanoirs +aback etre deconcerte[Verb] +aback to be taken ~ : etre deconcerte,interdit[Adverb] +aback to be taken ~ :etre stupefait(e)[Adjective] +abacterial non-bacte/rien[Adjective] +abacus abaque,boulier (compteur)[Noun] +abacus abaque[Noun] +abacus boulier,compteur[Noun] +abacuses abaques, bouliers +abacuses abaques[Noun] +abacuses bouliers, compteurs[Noun] +abaft sur l'arrie\re, vers l'arrie\re[Adverb] +abalone ormeau[Noun] +abalones ormeaux[Noun] +abandon abandon, laisser-aller[Noun] +abandon abandonner[Verb] +abandoned abandonne/[Adjective] +abandoned abandonnes[Adjective] +abandoned de/vergonde/[Adjective] +abandonee abandoned, forsaken[Adjective] +abandoner abandoneur[Adjective] +abandoning abandonnant[Verb] +abandonment abandon[Noun] +abandonment abandonnement[Noun] +abandonments abandons[Noun] +abandons abandonnes[Verb] +abase abaisser, humilier[Verb] +abased humilie/ +abasement abaissement, humiliation[Noun] +abasements abaissement[Noun] +abases mortifie, humilie, rabaisse[Verb] +abash confondre, de/concerter[Verb] +abashed confus(e), embarrasse(e)[Adjective] +abashed deconcerte, confus, gene[Adjective] +abasing humiliant[Adjective] +abate diminuer[Verb] +abate s'apaiser, se calmer[Verb] +abated a diminue/[Verb] +abatement diminution[Noun] +abatement la suppression[Noun] +abatements coupures +abates se calme, s'apaise[Verb] +abating faiblant[Adjective] +abating faiblant[Adjective] +abattoir abattoir[Noun] +abbe abbe/[Noun] +abberations aberrations[Noun] +abbey abbaye (f)[Noun] +abbey une abbaye[Noun] +abbeys abbayes[Noun] +abbot abbe ( d'un monastere)[Noun] +abbot abbe/ +abbot abbe/[Noun] +abbot pere superieur[Noun] +abbot abbe/[Noun] +abbots abbe/s[Noun] +abbreviate abbre/ger[Verb] +abbreviate abre/ger[Verb] +abbreviated abbre/gé[Verb] +abbreviates s'abre\ge[Verb] +abbreviating abre/geant[Verb] +abbreviation abbre/viation[Noun] +abbreviation abre/viation[Noun] +abbreviation abreviation (f)[Noun] +abbreviations abbre/viations[Noun] +abbreviations abre/viations[Noun] +abbreviator abre/viateur[Noun] +abdicable abdiquable[Adjective] +abdicate abdiquer[Verb] +abdicate renoncer[Verb] +abdicated abdique/[Adjective] +abdication abdication[Verb] +abdicator abdicateur[Adjective] +abdomen abdomen (m)[Noun] +abdomen abdomen[Noun] +abdomens abdomens[Noun] +abdominal abdominal[Adjective] +abdominally abdominalement[Adverb] +abduct enlever[Verb] +abducted enlevé[Verb] +abducting enlevant[Verb] +abduction enlèvement[Noun] +abductions enlèvements[Noun] +abductor adducteur[Adjective] +abductors adducteur[Adjective] +abducts detourner[Verb] +abeam par le travers[Adverb] +abecedarian abécédaire[Noun] +abed au lit[Noun] +aberrance aberration (f)[Noun] +aberrant aberrant, egare[Adjective] +aberrantly de fac,on aberrante[Adverb] +aberration aberration[Noun] +aberration anomalie (f)[Noun] +aberrations erreurs +abet encourager (au crime)[Verb] +abetment encouragement[Noun] +abets secourirs +abetted encouragea, soutient[Verb] +abetter complice[Noun] +abetting provoquant[Adjective] +abettor aide, complice[Noun] +abeyance in ~ (law): en desuetude; (matter) en suspens[Noun] +abeyant en attente[Adjective] +abhor avoir horreur de[Verb] +abhorred abhorrait or abhorre/, de/testait or de/teste/[Verb] +abhorrence aversion extreme, horreur[Noun] +abhorrent odieux +abhorrently de fac,on odieuse[Adverb] +abhorring abhorrant[Adjective] +abhors abhorrer[Verb] +abide i can't ~ it/him : je ne peut pas le souffrir <or> supporter; to ~ by : observer, respecter[Verb] +abided souffri[Adjective] +abides tole\re, demeure, subsiste[Verb] +abiding constant, e/ternel[Adjective] +abilities talents[Noun] +ability compe/tence +ability competence (f); capacite (f); (skill) talent (m)[Noun] +abiotic abiotique[Adjective] +abject (poverty) sordid; (apology) plat(e)[Adjective] +abjection abjection(f)[Noun] +abjectly avec servilite/[Adjective] +abjuration renoncement, apostasie (rel)[Noun] +abjure abjurer[Verb] +abjurer personne qui abjure +ablation ablation +ablative ablatif[Adjective] +ablaze en feu +ablaze en feu, en flammes[Adjective] +able compe/tent(e) +able competent(e); to be ~ to do sth : pouvoir faire qch, etre capable de faire qch[Adjective] +able capable -to be able to e^tre capable de , pouvoir +able to be ~: pouvoir[Verb] +abler plus compétent(e)[Adjective] +ablest le plus compe/tent[Adjective] +abloom en fleur +ablution ablution[Noun] +ablutions ablutions[Noun] +ably de fac,on compe/tente, habilement[Adjective] +abnegate Renouncer à [Verb] +abnegates renie, re/pudie, rejette[Verb] +abnegation abne/gation[Noun] +abnormal abnormal(e)[Adjective] +abnormal anormal(e)[Adjective] +abnormal anormal +abnormalities anomalies, difformite/s[Noun] +abnormality anomalie, malformation[Noun] +abnormally anormalement[Adverb] +aboard a\ bord +abode of no fixed ~ :sans domicile fixe[Noun] +abodes demeures, domiciles[Noun] +aboil en train de bouillir[Verb] +abolish abolir[Verb] +abolish abroger, supprimer[Verb] +abolishable qui peut e^tre aboli +abolished aboli(es)[Verb] +abolisher suppresseur[Adjective] +abolishes abolit, abroge, supprime +abolishment suppression, abolition, abrogation[Noun] +abolition abolition +abolition suppression[Noun] +abolitionism abolitionnisme[Noun] +abolitionist abolitionniste[Adjective] +abolitionists abolitionnistes, antiesclavagistes (hist)[Noun] +abominable abominable[Adjective] +abominably abominablement, odieusement[Adverb] +abominate abhorrer, exe/crer, abominer[Verb] +abomination abomination[Noun] +abominations abominations[Noun] +aboriginal aborige\ne[Noun] +aboriginally aboriginalement[Adverb] +aborigine aborigene m/f[Noun] +aborigines aborigines[Noun] +abort faire avorter[Verb] +aborted avorté[Verb] +aborter avorteur/ avorteuse / faiseuse d'anges[Noun] +aborting discontinuant[Adjective] +abortion avortement +abortion avortement (m)[Noun] +abortionist avorteur[Noun] +abortionists avorteurs +abortions avortements[Noun] +abortive manque(e)[Adjective] +abortively en vain[Verb] +aborts avorte, e/choue, abandonne[Verb] +abound abonder +abounding abondant[Adjective] +about (approximatly)environ, a peu pres[Adjective] +above au-dessus[Adjective] +aboveboard re/gulier, correct[Adjective] +aboveground au-dessus du sol, a\ la surface[Adjective] +abovementioned ci-haut mentionné +abovementioned mentionné ci-dessus[Adjective] +abracadabra abracadabra[Verb] +abradable qui peut s'e/rafler, qui peut s'e/roder[Adjective] +abrade user en frottant, e/roder[Verb] +abrasion frottement, e/corchure, abrasion[Noun] +abrasions écorchures, égratignures[Noun] +abrasive abrasif(ive)[Adjective] +abrasives abrasifs[Noun] +abreast de front[Adjective] +abridge abreger[Verb] +abridged abre/ge/[Verb] +abridgement re/sume/[Noun] +abridging raccourc,ant[Adjective] +abroad a\ l'e/tranger, au loin[Adverb] +abrogate abroger[Verb] +abrogated abroge/, aboli[Verb] +abrogation abrogation[Noun] +abrupt abrupte[Adjective] +abruptly brusquement[Adjective] +abruptness abrupte[Noun] +abscess abcès[Noun] +abscesses abce\s[Noun] +abscond s'enfuir[Verb] +absconded s'enfuir (from, de)[Verb] +absence absence[Noun] +absences absences[Noun] +absent absent[Adjective] +absentee absentee[Noun] +absenteeism absente/isme[Noun] +absentees absentees[Noun] +absently distraitement[Adverb] +absentminded distrait[Adjective] +absentmindedly d'un air distrait[Adverb] +absentmindedly distraitement[Adverb] +absentmindedness distraction[Noun] +absinth absinthe[Noun] +absinthe absinthe[Noun] +absolute absolu[Adjective] +absolutely absolument[Adverb] +absolution absolution[Noun] +absolutism absolutisme[Noun] +absolve absoudre[Verb] +absolved exone/re/[Adjective] +absolving exon/erant[Adjective] +absorb absorber, retenir, assimiler[Verb] +absorbability absorbabilite/[Adjective] +absorbable absorbable[Adjective] +absorbant absorbant[Adjective] +absorbed absorb/e[Adjective] +absorbent absorbant(e)[Adjective] +absorbing absorbant[Adjective] +absorption absorbtion[Noun] +abstain abstenir[Verb] +abstained absteni[Adjective] +abstemious frugal(e), sobre[Adjective] +abstention abstention[Noun] +abstentions abstentions[Noun] +abstinence abstinence[Noun] +abstinent sobre[Adjective] +abstinently sobrement[Adverb] +abstract abstrait[Adjective] +abstract résumé, abrégé[Noun] +abstraction distraction, abstraction[Noun] +abstruse abstrus(e)[Adjective] +absurd absurde[Adjective] +absurdism absurdisme[Noun] +absurdist absurdiste[Noun] +absurdities absurdite/s[Noun] +absurdity absurdite/[Noun] +abundance abondance[Noun] +abundant abondant[Adjective] +abundantly abondamment[Adjective] +abuse abus[Noun] +abused abuse/[Verb] +abused insulter[Verb] +abusive abusif[Adjective] +abusively abusivement[Adverb] +abut etre contigu(ë) à [Verb] +abuzz bourdonnant[Adjective] +abysmal épouvantable, abominable[Noun] +abysmally abominablement[Adverb] +abyss abysse[Noun] +abyss abi^me[Noun] +abysses abysses[Noun] +abysses abi^mes[Noun] +acacia acacia[Noun] +academic académique[Adjective] +academical acade/mique[Adjective] +academically acade/miquement[Adverb] +academician acade/micien[Noun] +academies academies[Noun] +academism academisme[Noun] +academy académie[Noun] +acanthus acanthe[Noun] +acanthuses acanthes[Noun] +accede acce/der[Verb] +accede consentir[Verb] +accelerate acce/le/rer[Verb] +accelerated accéléré[Adjective] +acceleration acce/le/ration[Noun] +accelerations acce/le/rations[Noun] +accelerator acce/le/rateur[Noun] +accelerators acce/le/rateurs[Noun] +accelerometer acce/le/rome\tre[Noun] +accelerometers acce/le/rome\tres[Noun] +accent accent[Noun] +accented accente/[Verb] +accented accentue/ +accents accents[Noun] +accentual accentuelle[Adjective] +accentually accentuellement[Adverb] +accentuate accentuer[Verb] +accentuated accentue/[Adjective] +accentuation accentuation[Noun] +accept accepter[Verb] +acceptability acceptabilite/[Noun] +acceptable acceptable[Adjective] +acceptably convenablement[Adverb] +acceptance acceptation[Noun] +accepted accepte/[Verb] +accepter accepteur[Noun] +acceptor accepteur[Noun] +access acce\s, acce/der (verb)[Noun] +accessed accesse/[Verb] +accessibility accessibilite/[Noun] +accessible accessible[Adjective] +accession accession[Noun] +accessorial accessoire[Adjective] +accessories accessoires[Noun] +accessorize accessoriser[Verb] +accessors accesseurs[Noun] +accessory accessoire[Noun] +accident accident[Noun] +accidental accidentel[Adjective] +accidentalism accidentalisme[Noun] +accidentalist accidentaliste[Noun] +accidentally accidentellement[Adverb] +accidently accidentalement[Adverb] +accidents accidents[Noun] +acclaim acclamer[Verb] +acclamation acclamation[Noun] +acclimate acclimater[Verb] +acclimated acclimate/[Adjective] +acclimatize acclimater[Verb] +accolade accolade[Noun] +accolades accolades[Noun] +accommodate accomoder[Verb] +accommodated accommode/[Verb] +accommodating obligeant(e)[Adjective] +accommodation accomodation[Noun] +accommodations accommodations[Noun] +accompanied accompagne/[Adjective] +accompanier accompagneur[Noun] +accompanies accompanies[Verb] +accompaniment accompagnement[Noun] +accompaniments accompagnements[Noun] +accompanist accompaniste[Noun] +accompanists accompanistes[Noun] +accompany accompagner, accompagner qqn (à )[Verb] +accompanyist accompagnateur[Noun] +accompanyists accompagnateurs[Noun] +accomplice complice[Noun] +accomplices complices[Noun] +accomplish accomplir[Verb] +accomplished accompli(e)[Adjective] +accomplishment accomplissement[Noun] +accomplishments accomplissements[Noun] +accord accord[Noun] +accordance in accordance with : en conformite/ avec +accorder accordeur[Noun] +accorders accordeurs[Noun] +accordion accorde/on[Noun] +accordionist accordionist accordioniste[Noun] +accordionists accordionists accordionistes[Noun] +accordions accorde/ons[Noun] +accords accords[Noun] +accost accoster[Verb] +account compte[Noun] +accountability responsibilité[Noun] +accountable responsable[Adjective] +accountant comptable[Noun] +accounting comptabilité +accouterment accoutrement[Noun] +accredited accredite/[Verb] +accrued accrue/[Verb] +accruement accruement[Noun] +accumulated accumule/[Verb] +acetaminophen ace/taminophe\n[Noun] +acetify acetifie/[Verb] +acetone acetone[Noun] +acid acide[Noun] +acidic acidique[Adjective] +admission aveu[Adverb] +allergen allergene +allergen allergene[Noun] +allergic alergique[Adjective] +allergies allergies +allergies allergies[Noun] +allergy allergie +allergy allergie[Noun] +alleviate apaiser, soulager[Verb] +alleviated apaise/, apaise/e[Adjective] +alley ruelle, alle/e +alley ruelle, allée[Noun] +alleys ruelles, alle/es +alleys ruelles, alle/es[Noun] +alliance alliance +alliance alliance[Noun] +alliances alliances +alliances alliances[Noun] +allied allie/, allie/e +allied allie/, allie/e[Adjective] +alligator alligator +alligator alligator[Noun] +alligators alligators +alligators alligators[Noun] +alliteration allite/ration +alliteration allite/ration[Noun] +alliterations allite/rations +alliterations allite/rations[Noun] +allocate attribuer[Verb] +allocated attibue/, attribue/e[Adjective] +allocation attribution +allocation attribution[Noun] +allocations attibutions +allocations attributions[Noun] +allocution allocution +allocution attribution[Noun] +allocution allocution[Noun] +allot assigner[Verb] +allow autoriser, permettre[Verb] +allowable admissible[Adjective] +allowance indemnité[Noun] +allowed autorise/, autorise/e[Adjective] +alloy alliage[Noun] +alphabet alphabet[Noun] +alphabetic alphabetique[Adjective] +alphabetical alphabetique[Adjective] +alphabetically alphabetiquement[Adverb] +alphabetization alphabetisation[Noun] +alphabetizations alphabetisations[Noun] +alphabetize alphabetiser[Verb] +alphabetized alphabetise[Adjective] +alphabetizing alphabetizer[Verb] +alphabets alphabets[Noun] +alphamerical alphanumerique[Adjective] +alphanumeric alphanumerique[Noun] +alphanumerical alphanumerique[Adjective] +alphanumerically alphanumeriquement[Adverb] +alphanumerics alphanumerique[Adverb] +alpine alpin[Adjective] +alpinism alpinisme[Noun] +alpinist alpiniste[Noun] +already deja[Conjunction] +also aussi[Conjunction] +altercation altercation[Noun] +altercations altercations[Noun] +alternate alterner[Verb] +alternated alterne[Adjective] +alternately alternativement[Adverb] +among parmi, entre[Preposition] +amoral amoral[Adjective] +amorous amoureux[Adjective] +amorously amoureusement, avec amour[Adverb] +amorphous amorphe[Adjective] +amount s'elever. monter[Verb] +amount somme, quantite, importance[Noun] +amp ampere ; amplifier[Noun] +ampere ampere[Noun] +ampersand et commercial ; esperluette[Noun] +amphetamine amphetamine[Noun] +and et[Preposition] +anyway En tout cas, de toute facon[Adverb] +anywhere n'importe ou ; partout[Adverb] +aorta aorte[Noun] +apace rapidement[Adverb] +apart a part, separe[Adjective] +apartheid apartheid[Noun] +apartment apartement, chambre[Noun] +apathetic apathique[Adjective] +apathy apathie, indifference[Noun] +ape singe[Noun] +ape singer[Verb] +aperitif aperitif[Noun] +aperture ouverture[Noun] +apex sommet[Noun] +aphid aphis; puceron[Noun] +arrive arrivant[Verb] +aspen abedul +audit audit[Noun] +auditorium auditorium[Noun] +auditoriums auditoriums[Noun] +audits audits[Verb] +available disponible +babble bavard[Verb] +babbler bavardent +babies be/be/s[Noun] +baboon babouin +baby be/be/[Noun] +baccalaureate baccalaure/at[Noun] +baccarat baccarat[Noun] +bachelor ce/libataire[Noun] +bachelors ce/le/bataires[Noun] +bacilli bacilles (noun masculine)[Noun] +bacillus bacille (noun masculine)[Noun] +back en arriere, en retour +backache douler de dos +backbite calumnier +backbone e/pine[Noun] +background arriere-plan +backgrounds arriere-plans +backside derrie\re[Noun] +backslide re/gresser[Verb] +backup (computer) sauvegarde (feminine)[Noun] +backward en arrie\re[Preposition] +bacon lard +bacteria bactérie +bad mauvais, torve +badge insigne +badged insignée +badgers blaireaux +badinage badinage +bag sac[Noun] +bagatelle bagatelle +bagatelles bagatelles +baggage effets, colis +bags fouilles, étuis, sacs +baguette baguette +bah bannir[Verb] +bail caution +bairn enfant (e/cossais)[Noun] +bait leurre, eche +bake faire cuire[Verb] +baker boulanger +bakeries boulangeries +bakers boulangers +bakery boulangerie +bakeshop boulangerie[Noun] +balance balance, équilibrer +balconies balcons +balcony balcon +bald chauve, à ras +baldhead chauve[Adjective] +baldly ouvertement[Adverb] +baldness calvitie[Noun] +bale ballot +baleen baleine +balk déjouer[Verb] +ball bal (dance), ballon (like for games) +ballad ballade +ballade ballade +ballads ballades +ballast ballast, lest +ballet ballet +balletic balletique +balloon ballon, aérostat +ballot ballot +balls bals[Noun] +ballyhoo publicite/[Noun] +balm baume[Noun] +bamboo enfant (italien)[Noun] +bamboozle tricher[Verb] +banana banane +bananas bananes +band bande, chapelle +bandage bandage +bandeau bandeau +bandit brigand, forban, bandit +bandits brigands, forbans, bandits +bandleader chef d'orchestre[Noun] +bandmaster chef d'orchestre[Noun] +bane poison[Noun] +banished banni[Adjective] +barb barbe[Noun] +barbarian barbare[Noun] +barbarians barbares[Noun] +barbarism barbarisme[Noun] +barber barbier[Noun] +barmaid serveuse[Noun] +barman serveur[Noun] +barracks casernes[Noun] +beach plage[Noun] +bear ours[Noun] +bear supporter[Verb] +bed lit[Noun] +bedroom chambre (a coucher)[Noun] +believe croire[Verb] +betray trahir[Verb] +bibliographic bibliographique[Adjective] +bibliographies bibliographies[Noun] +bibliography bibliographie[Noun] +blackberry zarzamorra[Noun] +bonjour hello +book livre (m) +boomerang boomerang (m) +boxer (~ shorts) caleçon[Noun] +boy garc,on[Noun] +boys garc,ons[Noun] +brain cerveaux[Noun] +brood rimuginare, covare[Verb] +broom balai +broth bouillon +build construire[Verb] +building ba^timent[Noun] +bye bon voyage, ciao[Preposition] +cab taxi[Noun] +cabal cabale[Noun] +cabala cabale[Noun] +cabalism cabalisme[Noun] +cabalist cabaliste[Noun] +cabalistic cabalistique[Adjective] +caballero cavalier[Noun] +cabaret cabaret[Noun] +cabbage chou[Noun] +cabbages choux[Noun] +cabdriver chauffeur de taxi[Noun] +cabin cabane[Noun] +cabinet cabinet[Noun] +cabinetmaker e/be/niste[Noun] +cabinetmakers e/be/nistes[Noun] +cabinets cabinets[Noun] +cabins cabanes,(ships)cabines[Noun] +cable ca^ble[Noun] +cabled cablé[Adjective] +cablegram ca^blogramme[Noun] +cablegrams ca^blogrammes[Noun] +cables ca^bles[Noun] +cabling cablage[Noun] +cabman cocher de fiacre[Noun] +caboose caboose[Noun] +cabotage cabotage[Noun] +cabriolet cabriolet[Noun] +cabs taxis[Noun] +cacao cacao[Noun] +cacciatore chasseur[Noun] +cachalot cachalot[Noun] +cache cachette[Noun] +cachepot cachepot[Noun] +caches cachettes[Noun] +cackle caquet[Noun] +cackled caquete/[Verb] +cackles caquets[Noun] +cackling caquetant[Verb] +cacophony cacophonie[Noun] +cacti cactus(plural)[Noun] +cactus cactus (singular)[Noun] +cad mufle[Noun] +cadaver cadavre +cadaverous terreux,[Adjective] +caddies boi^tes a\ the/[Noun] +caddy boii^te a\ the/[Noun] +cadence cadence[Noun] +cadet cadet, younger son[Noun] +cadetship brevet de cadet[Noun] +cadge mendier[Verb] +cadger mendiant[Noun] +cafe cafe/-restaurant[Noun] +cafes cafe/-restaurants[Noun] +cafeteria cafe/taria[Noun] +cafeterias cafe/tarias[Noun] +caffeine cafe/ine[Verb] +caftan caftan[Noun] +cage cage[Noun] +cages cages[Noun] +cahier copy book[Noun] +cairn cairn[Noun] +cairns cairns[Noun] +caitiff la^che[Adjective] +cajole cajoler[Verb] +cajoler cajoleur[Noun] +cajolery cajolerie[Noun] +cake gâteau[Noun] +cake ga^teau[Noun] +calcium calcium[Noun] +calculate calculer[Verb] +calculated calculé +calibrate calibrer[Verb] +calibrated calibré[Adjective] +calibration calibration[Noun] +car voiture[Noun] +carbonization carbonisation[Noun] +carbonize carboniser[Verb] +carbonized carbonise[Adjective] +carbonless sans carbone[Adjective] +carburetor carburateur[Noun] +carburetors carburateurs[Noun] +carburization carburation[Noun] +carburize carburer[Verb] +card carte[Noun] +cardamom cardamone[Noun] +cardiac cardiaque[Adjective] +cardigan cardigan[Noun] +cardioid cardioide[Noun] +cardioids cardioides[Noun] +care attention[Noun] +care care[Noun] +cared attentionne[Adjective] +career cariere[Noun] +careful attentionne[Adjective] +carefully avec attention[Adjective] +cat le chat[Noun] +cell cellule[Noun] +cellular cellulaire[Adjective] +chance hasard +cherries les cerises[Noun] +church e/glise[Noun] +churches e/glises[Noun] +cloak manteau[Noun] +cloaks manteaux[Noun] +clock horloge[Noun] +clockmaker horloger[Noun] +clockwise dans le sens des aigu.illes d'une montre +cloister cloitre[Noun] +clone clone[Noun] +cloud le nuage +c'mon ben voyons +coal charbon (masc.)[Noun] +computer ordinateur[Noun] +computers ordinateurs[Noun] +comrades amis[Noun] +concealed e/touffe/ +conjuring escamotage[Verb] +contemplate contempler[Verb] +contemplate envisager[Verb] +contemplate pre/voir[Verb] +contemplates envisage[Verb] +contemplation contemplation[Noun] +contemplation me/ditation[Noun] +contemplation recueillement[Noun] +contemplations contemplations[Noun] +contemplations me/ditations[Noun] +contemplative contemplatif[Adjective] +contemporaneous contemporain[Adjective] +contemporaneously en me^me temps que [Adverb] +contemporaries contemporains[Noun] +contemporaries de la me^me ge/ne/ration[Adjective] +contemporary contemporain[Adjective] +contemporary de la me^me ge/ne/ration[Adjective] +contempt de/dain[Noun] +contempt me/pris[Noun] +contemptible indigne[Adjective] +contemptible me/prisable[Adjective] +contemptibly avec me/pris[Adverb] +contemptuous de me/pris[Adjective] +contemptuous me/prisant[Adjective] +contemptuously avec de/dain[Adverb] +contemptuously avec me/pris[Adverb] +contend combattre[Verb] +contend disputer[Verb] +contend lutter[Verb] +contender candidat[Noun] +contender challenger[Noun] +contender concurrent[Noun] +contenders candidats[Noun] +contenders challengers[Noun] +contenders concurrents[Noun] +contending concurrents[Adjective] +contending oppose/es[Adjective] +contends dispute[Verb] +contends lutte[Verb] +content contenter[Verb] +content satisfaire[Verb] +content satisfait[Adjective] +contented content[Adjective] +contented satisfait[Adjective] +contentedly avec contentement[Adverb] +contentedness contentement[Noun] +contention dispute[Noun] +contention e/mulation[Noun] +contention lutte[Noun] +contentions disputes[Noun] +contentions e/mulations[Noun] +contentions luttes[Noun] +contentious contentieux[Adjective] +contentious querelleur[Adjective] +contentment contentement[Noun] +contents contenu[Noun] +contents table de matie\res[Noun] +contest combat[Noun] +contest concours[Noun] +contest contester[Verb] +contestant combattant[Noun] +contestant concurrent[Noun] +cot lit d'enfant[Noun] +coterie coterie[Noun] +cotillion cotillon[Noun] +cotillon cotillon[Noun] +cottage chaumie\re[Noun] +cottager paysan[Noun] +couch couche[Noun] +cough tousser[Verb] +coughs toux[Noun] +count compter[Verb] +countenance visage[Noun] +counteract neutraliser[Verb] +counterbalance contrepoids[Noun] +counterfeit contrefait[Adjective] +countermand contremander[Verb] +countermarch contremarche[Noun] +counterplot contre-ruse[Noun] +counterpoint contrepoint[Noun] +counterpoise contre-balancer[Verb] +counterweight contrepoids[Noun] +countess comtesse[Noun] +countless innombrable[Adjective] +country pays[Verb] +countryman concitoyen[Noun] +countrywide concitoyenne +county comte/[Noun] +couple couple[Noun] +couplet distique[Noun] +coupon coupon[Noun] +courage courage[Noun] +courageous courageux[Adjective] +courageously cougrageusement[Adjective] +courier courrier[Noun] +course cours[Noun] +courser coursier[Noun] +court cour[Noun] +courteous courtois[Adjective] +courteously courtoisement[Adverb] +courteousness courtoisie[Noun] +courtesy courtoisie +courthouse palais de justice[Noun] +courtier courtisan[Noun] +courtliness e/le/gance[Adjective] +courtly e/le/gant[Adjective] +courtmartial conseil de guerre[Noun] +courtroom salle d'audience[Noun] +courtship cour[Noun] +cousin cousin[Noun] +cove anse[Noun] +covenant convention[Noun] +cover couvrir[Verb] +covert cache/[Adjective] +covet covoiter[Adjective] +covetous avide[Adjective] +covetously avidement[Adjective] +cow la moo cowetta[Noun] +cow la vache[Noun] +coward la^che[Noun] +cowardice la^chete/ +cowardly la^che[Adjective] +cower se blottir[Verb] +cowherd vacher[Noun] +cowl capuchon[Noun] +coxcomb petit-mai^tre[Noun] +coy farouche[Adjective] +coyly modestement[Adverb] +coyness re/serve[Noun] +coyote coyote[Noun] +cozily confortablement[Adverb] +cozy confortable +crab cancre[Noun] +crabapple pomme sauvage[Noun] +crabbed maussade[Adjective] +crack fente[Noun] +cracker pe/tard[Noun] +crackle craqueter[Verb] +cradle berceau[Noun] +craft fourberie[Noun] +craftily astucieusement[Adverb] +crag rocher escarpe/[Noun] +cram fourrer[Verb] +cramp crampe[Noun] +cranberry airelle coussinette[Noun] +crane grue[Noun] +cranium cra^ne[Noun] +crank manivelle[Noun] +crankiness humeur difficile[Noun] +cranky d'humeur difficile[Adjective] +crape cre^pe[Noun] +crash retentir[Verb] +crate caisse a\ claire-voie[Noun] +crater crate\re[Noun] +crave de/sirer ardemment[Verb] +craven poltron[Adjective] +crawl ramper[Verb] +crayfish e/crevisse[Noun] +crayon pastel[Noun] +craze manie[Noun] +crazily follement[Adverb] +crazy fou[Adjective] +creak grincer[Verb] +cream cr\eme[Noun] +creamy cre/meux[Adjective] +crease plisser[Verb] +create cre/er[Verb] +creation cre/ation +creator cre/ateur[Noun] +creature cre/ature[Noun] +credence croyance[Noun] +credential certificat[Noun] +credit cre/dit[Noun] +creditable estimable +creditably honourablement[Adverb] +creditor cre/ancier[Noun] +credo crois[Verb] +credulity cre/dulite/[Noun] +credulous cr/edule[Adjective] +credulously cr/edulement[Adverb] +creed credo[Noun] +creek crique[Noun] +creep ramper[Verb] +creeps chair de poule[Noun] +cremate incin/erer[Verb] +cut couper[Verb] +cute mignon, charmant, adorable[Adjective] +cute mignonne[Adjective] +cuteness gentillesse, charme[Noun] +cutoffs limite, seuil[Noun] +cutout forme a\ de/couper[Noun] +cuts e/conomies, re/duction de budget[Noun] +cutter couteau (de de/coupage)[Noun] +cutting d/ecoupe, de/coupage[Noun] +cyanate cyanante[Noun] +cyanide cyanure[Noun] +cybernetic cyberne/tique[Adjective] +cybernetician cyberne/ticien[Noun] +cybernetics cyberne/tique[Noun] +cycle cycle[Noun] +cyclic cyclique[Adjective] +cyclical cyclique[Adjective] +cyclist cycliste[Noun] +cyclists cyclistes[Noun] +cycloid cycloi.de[Noun] +cycloidal cycloi.dal[Adjective] +cyclone cyclone[Noun] +cyclonic cyclonique[Adjective] +cyclopean cyclope/en[Adjective] +cyclotron cyclotron[Noun] +cylinder cylindre[Noun] +dad papa[Noun] +daddies papas[Noun] +daddy papa[Noun] +dads papas[Noun] +daffy barjot[Adjective] +daft barje[Adjective] +dagger dague (une)[Noun] +dahlia dahlia[Noun] +dahlias dahlias[Noun] +daily quotidien +daintier plus délicat +dainty délicat +dairy laitier +dalmatian dalmatien[Adjective] +dalmatians dalmatiens[Noun] +dam barrage[Noun] +damage abimer[Verb] +damage de/ga^t[Noun] +damage endommagement +damage endommager[Verb] +damaged endommage/[Adjective] +damaged endommagé[Adjective] +damager endommageur +damagers endommageurs +damages de/ga^ts[Noun] +damaging endommageant +dame dame +dammit merde alors +damnation damnation[Noun] +damned damne/[Adjective] +damp humide[Adjective] +dampen humidifier[Verb] +dampened humidifie/ +dampness humidite/[Noun] +dams barrages[Noun] +dance danse +dancer danceur +dancers danceurs +dancing danser[Verb] +dandelion pissenlit +dandelions pissenlits +dandies dandys[Noun] +dandruff pelicule[Noun] +danger danger[Noun] +dangerous dangereux[Adjective] +d'art d'art +day jour[Noun] +daybreak aube[Noun] +daylight lumiere du jour[Noun] +days jours[Noun] +deactivate de/sactiver[Verb] +deactivation de/sactivation[Noun] +dead mort[Adjective] +deaf sourd[Adjective] +deaths morts +deep profond[Adjective] +density densite/[Noun] +deserve meriter[Verb] +d'etat d'état +d'etre d'être +device pe/riph/erique[Noun] +device pe/riphe/rique[Noun] +dictated dicté[Verb] +dictates dicte[Verb] +dictation dictée[Noun] +dictations dictées[Noun] +dictionaries dictionnaires[Noun] +dictionary dictionnaire[Noun] +did a fait[Verb] +die mourir[Verb] +died mort[Verb] +diesel diesel[Noun] +diet diète[Noun] +dietetically diététiquement[Adverb] +diets diètes[Noun] +different différent[Adjective] +difficulties difficultés[Noun] +difficulty difficulté[Noun] +dig creuser[Verb] +digested digéré[Verb] +dignitaries dignitaires[Noun] +dignities dignités[Noun] +dignity dignité[Noun] +dilate dilater[Verb] +dilated dilaté[Verb] +doctor docteur[Noun] +document document[Noun] +d'oeuvre d'oeuvre +dog chien/ne[Noun] +doggie chien/ne[Noun] +dogs chiens[Noun] +drink boire[Verb] +drinks boissons[Noun] +drive conduire[Verb] +driver conducteur[Noun] +drizzle bruiner[Verb] +dry se/cher[Verb] +duck canard[Noun] +each chaque +eagle aigle[Noun] +eagles aigles[Noun] +eaglet aiglon[Noun] +ear oreille[Noun] +earache mal d'oreille[Noun] +eardrum tympan[Noun] +eardrums tympans[Noun] +earlobe lobe d'oreille[Noun] +early to^t[Adjective] +earn gagner[Verb] +earning gagner[Verb] +earphones e/couteurs[Noun] +earring boucle d'oreille[Noun] +earrings boucles d'oreille[Noun] +ears oreilles[Noun] +earth terre[Noun] +earthquake tremblement de terre[Noun] +earthquakes tremblements de terre[Noun] +earths terres[Noun] +earthworm ver de terre[Noun] +earthworms vers de terre[Noun] +earwax serumen[Noun] +ease facilite/[Noun] +easel chevalet[Noun] +easier plus facile[Adjective] +easiest le plus facile[Adjective] +easily facilement[Adverb] +easiness facilite/[Noun] +east est[Noun] +easter Pa^ques[Noun] +easy facile[Adjective] +eat manger[Verb] +eatable comestible[Adjective] +eats manger[Verb] +ebony e/be\ne[Noun] +eccentric excentrique[Adjective] +eccentricity excentricite/[Noun] +ecclesiastic eccle/siastique[Noun] +echo e/cho[Noun] +eclipse e/clipse[Noun] +ecologic e/cologique[Adjective] +ecologist e/cologiste[Noun] +ecology e/cologie[Noun] +economics econom'ica[Noun] +ecru e/cru[Adjective] +eight huit[Adverb] +eighteen dix-huit[Adverb] +eighteenth dix-huitie\me[Adjective] +eightfold huit fois[Adverb] +eighth huitie\me[Adjective] +eighties les anne/es quatre-vingt (f)[Noun] +eightieth quatre-vingtie\me[Adjective] +eighty quatre-vingt[Adverb] +eightyfold quatre-vingt fois[Adverb] +einsteinium einsteinium (m)[Noun] +either soit[Adverb] +ejaculate e/jaculer[Verb] +ejaculated e/jacule/[Adjective] +ejaculates e/jacule[Verb] +ejaculating e/jaculant[Adjective] +ejaculation e/jaculation (f)[Noun] +ejaculations e/jaculations (f)[Noun] +ejaculatory e/jaculatoire[Adjective] +eject e/jecter[Verb] +ejectable e/jectable[Adjective] +ejecting e/jectant[Verb] +ejection e/jection (f)[Noun] +ejector e/jecteur (m)[Noun] +ejectors e/jecteurs (m)[Noun] +elaborate e/laborer[Verb] +elaborated e/labore/ (m), e/labore/e (f)[Adjective] +elaborates e/labore[Verb] +elaborating e/laborant[Adjective] +elaboration e/laboration (f)[Noun] +elaborations e/laborations (f)[Noun] +elevator ascenseur[Noun] +eleven onze[Adjective] +eleventh onzie\me[Noun] +eliminate e/liminer[Verb] +end fin[Noun] +environment ambiente[Noun] +environmental ambiental[Adjective] +envoy enviado[Noun] +envy envidia[Noun] +envy envidiar[Verb] +escalator escalier roulant[Noun] +establish constater[Verb] +event occasion[Noun] +eventual final[Adjective] +eventually finallement[Adverb] +ever toujours[Adverb] +evergreen permanent[Adjective] +everlasting permanent[Adjective] +every chaque[Pronoun] +everywhere partout[Conjunction] +eviction mise a` l' e'cart[Noun] +evidence preuve[Noun] +exclaim s'exclaimer[Verb] +fable fable[Noun] +fables fables[Noun] +fabric tissu[Noun] +fabricant fabricant[Noun] +fabricate fabriquer[Verb] +fabricated fabrique/[Pronoun] +fabricates fabrique[Verb] +fabricating fabriquant[Verb] +fabrication invention(s), fabulation; fait, forge(e) de toutes pieces[Noun] +fabrications fabrications[Noun] +fabricator fabricant[Noun] +fabricators fabricants[Noun] +fabrics tissus[Noun] +fabulist fabuliste (m)[Noun] +fabulous fabuleux(euse); formidable[Adjective] +facade fac,ade[Noun] +facades fac,ades[Noun] +face visage, figure; expression; (of clock) cadran; (of building) facade[Noun] +faceless sans face[Noun] +faceplate face avant (f),panneau avant (m)[Noun] +facet facette[Noun] +facetious facétieux[Adjective] +facetious plaisant[Adjective] +facetiously facétieusement[Adverb] +facial facial[Adjective] +facies facie\s (m)[Noun] +facile facile[Adjective] +facilitate faciliter[Verb] +facilitated facilite/[Pronoun] +facilitates facilite[Verb] +facilitating facilitant[Verb] +facilities instalations[Noun] +facility usine (f), e/tablissement (m)[Noun] +facing face a, en face de[Preposition] +facsimile (document) telecopie; (machine) telecopieur[Noun] +fact fait[Noun] +faction faction[Noun] +factor facteur[Noun] +factorial factoriel +factorials factorielles (f)[Noun] +factories usines (f)[Noun] +factorization factorisation[Noun] +factorizations factorisations[Noun] +factorize factoriser[Verb] +factorized factorisé[Adjective] +factors facteurs (m)[Noun] +factory usine (m) +facts faits[Noun] +factual factuel (m),factuelle (f)[Adjective] +facultative facultatif[Adjective] +facultatively facultativement[Adverb] +faculties faculte/s (f)[Noun] +faculty faculté +fad affaiblir, atte/nuer[Verb] +fade se faner[Verb] +faded affaibli, atte/nue/[Adjective] +fader atte/nuateur (m)[Noun] +faders atte/nuateurs (m)[Noun] +fading affaiblissement (m), atte/nuation (f)[Noun] +faery fe/e[Noun] +faience fai.ence +fail échouer[Verb] +faint s'e/vanouir[Verb] +faintly faiblement[Adverb] +fair juste[Adjective] +fairly e/quitablement[Adverb] +fairy fe/e[Noun] +faith foi[Noun] +faithful fide\le[Adjective] +faithfully fide\lement[Adverb] +fashion mode[Noun] +fashionable a\ la mode[Adjective] +fast rapide[Adjective] +fasten attacher[Verb] +fastener fermeture[Noun] +fastidious exigeant[Adjective] +fat gros[Adjective] +fatal mortel[Adjective] +fatalism fatalisme[Noun] +fatality victime[Noun] +fatally mortellement[Adverb] +fate destin[Noun] +fish poisson[Noun] +fishable pêchable[Adverb] +fishbowl bôl à poisson[Noun] +fished pêché[Verb] +fisher pêcheur[Noun] +fisheries poissonneries[Noun] +fisherman pêcheur[Noun] +fishermen pêcheurs[Noun] +fishers pêcheurs[Noun] +fishery poissonnerie[Noun] +fishes poissons[Noun] +fishing à la pêche +fishtail queue-de-poisson[Noun] +fission fision[Noun] +fissionable fisionable[Adverb] +fissure fissure[Noun] +fist poing[Noun] +fisted poingé[Verb] +fistful poingée[Noun] +five cinq[Adverb] +fivefold cinq fois[Adverb] +fix re/parer[Verb] +fixation fixation (f)[Noun] +fixations fixations (f)[Noun] +fixity fixite/ (f)[Noun] +fixture support (m)[Noun] +fixtures supports (m)[Noun] +fjord fjord (m)[Noun] +fjords fjords (m)[Noun] +flight le vol[Noun] +floppy disquette[Noun] +fluently couramment[Adverb] +foot pied[Noun] +football football[Noun] +forget oublier[Verb] +forgetful oublieux[Adjective] +forgetfulness manque de me/moire[Noun] +forgivable excusable[Adjective] +forgivably de fac,on excusable[Adverb] +forgive pardonner[Verb] +forgiveness pardon[Noun] +forgives pardonne[Verb] +forgiving indulgent[Adjective] +forgo renoncer \a[Verb] +forgoes renonce \a[Verb] +forgotten oublie/[Adjective] +forlorn de/laisse/[Adjective] +formaldehyde formalde/hyde +four quatre[Adverb] +fox renard (m)[Noun] +fractal fractale (f)[Noun] +fractals fractales (f)[Noun] +fraction fraction (f)[Noun] +fractionate fractionner[Verb] +fraternal fraternel[Adjective] +fraternize fraterniser[Verb] +friend ami[Noun] +friendship Amitie[Noun] +fringe frange[Noun] +frog grenouille[Noun] +frogs grenouilles[Noun] +from de +front devant[Preposition] +fucked foutu[Adjective] +fudge sucre a` la cre`me[Noun] +fugue fugue[Noun] +fulgurant fulgurant[Adjective] +funk frouse[Noun] +funniest le plus amusant[Adjective] +funny amusant[Adjective] +gab bavarde[Verb] +gabardine gabardine[Noun] +gabber comme\re[Noun] +gabbing bavarder[Verb] +gaberdine une gabardine[Noun] +gadget un gadget[Noun] +gaiety la gaieté[Noun] +gaily gaiement[Adverb] +gain le gain[Noun] +gained gagne/[Verb] +gaining gagnant[Verb] +gala un gala[Noun] +galactic galactique[Adjective] +galaxies galaxies[Noun] +galaxy une galaxie[Noun] +gallant gallant[Adjective] +gallantly gallamment[Adverb] +gallantry la gallantrie[Noun] +galleries galleries[Noun] +gallery gallerie[Noun] +gallon un gallon[Noun] +gallop galloper[Verb] +galloped gallope/[Verb] +galloping gallopant[Verb] +galvanic galvanique[Adjective] +galvanism le galvanisme[Noun] +galvanize galvaniser[Verb] +galvanized galvanise/[Verb] +game un jeu[Noun] +games joues[Noun] +garlic ail[Noun] +gas essence[Noun] +gasoline essence[Noun] +ghostwriter négre[Noun] +gift cadeau[Noun] +gifts cadeaux[Noun] +go aller[Verb] +goal objectif[Noun] +goals buts +goat oie +god dieu +goddess de/esse +goddesses de/esses +godfather parrain[Noun] +golf golf +golfer geolfeur +golfers golfeurs +golfs golfs +good bon;bien +good bien +goodbye au revoir +goodnight bon nuit +gopher gopher[Noun] +gospel evangile[Noun] +gown la robe +grab saisir (an object)[Verb] +gradient pente (math.)[Noun] +gradually graduellement[Adverb] +grammar grammaire (f)[Noun] +grape le raisin[Noun] +grapefruit le pamplemousse[Noun] +habilitated habilite/[Verb] +habilitation habilitation[Noun] +habit coutume[Noun] +habitant habitant[Noun] +habitants habitants[Noun] +habitat habitat[Noun] +habitation demeure[Noun] +habitual usuel[Adjective] +had se faire avoir +hand main[Noun] +head tete +heats series[Noun] +heaven paradis[Noun] +heavy lourd[Adjective] +hectare hectare +hectares hectares +hectoliter hectolitre +hedge haie +hedgehog he/risson[Noun] +heed suivre[Verb] +heel talon +heeler guerisseur +heels talons +height hauteur +heir he/ritier +held tenu[Adjective] +helices helices[Noun] +hell enfer[Noun] +hello bonjour[Noun] +helm barre[Noun] +helmet casque[Noun] +help aide[Noun] +hemp chanvre[Noun] +hen poule[Noun] +herd troupeau[Noun] +here ic,i[Noun] +heron huron[Noun] +hips flancs[Noun] +hit frapper[Verb] +hockey hockey[Noun] +hogwash non sense[Noun] +holidayer vacancier[Noun] +holidays vacances +home maison[Noun] +homeless sans-abri[Noun] +homes maisons[Noun] +house maison[Noun] +ice glace[Noun] +instancing instanciation[Noun] +internship stage professionnel en entreprise ou ailleurs +jab planter[Verb] +jabber baragouiner[Verb] +jabberwocky (playing card) valet[Noun] +jabberwocky Jaseroque, Bredoulocheux, Berdouilleux, Jabberwocheux[Noun] +jack criq[Noun] +jack valet[Noun] +jackal chacal[Noun] +jackals chacaux[Noun] +jackass a^ne[Noun] +jackdaw choucas (m)[Noun] +jacket blouson[Noun] +jacket veste[Noun] +jackhammer marteau piqueur[Noun] +jackknife canif[Noun] +jackpot gros lot[Noun] +jade jade[Noun] +jaded brime/e(e)[Adjective] +jag bombe, noce[Noun] +jagged e'bre'che[Verb] +jail emprisonner[Verb] +jail prison +jailbreak evasion[Noun] +jailed emprisonne/[Adjective] +jailer geo^lier[Noun] +jailing incarce/ration[Noun] +jailor geo^lier[Noun] +jails prisons[Noun] +jalopy guimbarde[Noun] +jam confiture[Noun] +jam enfoncer[Verb] +jamb jambage[Noun] +jammed coince/[Adjective] +jammed enraye/[Adjective] +jangle (bells) faire retenir[Verb] +janitor agent d'entretien[Noun] +janitor concierge[Noun] +jar bocal[Noun] +jar pot[Noun] +jar secousse[Noun] +jargon jargon (m)[Noun] +jasmine jasmin[Noun] +jaundice jaunisse[Noun] +jaunt balade[Noun] +jaunty désinvolte[Adjective] +jaunty insouciant(e)[Adjective] +javelin javelot[Noun] +jaw ma^choir[Noun] +jaws ma^choires[Noun] +jay geai (m)[Noun] +jazz jazz (m)[Noun] +jazzy voyant(e)[Adjective] +jealous jaloux, jalouse[Adjective] +jealousy jalousie[Noun] +jeer conspuer[Verb] +jeer huer[Verb] +jelly gele/e[Noun] +jellyfish meduse[Noun] +jeopardize compromettre[Verb] +jeopardize mettre en danger[Verb] +jerk abruti[Noun] +jerk bousculer[Verb] +jerry boche[Noun] +jersey (cloth) jersey[Noun] +jersey pull (m)[Noun] +jest plaisanterie (f)[Noun] +jester bouffon[Noun] +jester fou[Noun] +jet gicleur[Noun] +jet re/acteur[Noun] +jettison jeter, larguer[Verb] +jetty jete/e[Noun] +jewel joyau[Noun] +jeweler bijoutier[Noun] +jewelery bijouterie[Noun] +jewelry bijouterie[Noun] +jewels joyaux[Noun] +jib (of crane) flèche (f)[Noun] +jib (sail) foc (m)[Noun] +jiffy (in a ~) en un clin d'oeil +jig gigue (f)[Noun] +jigsaw (puzzle) puzzle (m)[Noun] +jihad lutte, combat (Islam)[Noun] +jilt laisser tomber[Verb] +jingle (bell) tinter[Verb] +jingle (song) jingle (m), indicatif (m)[Noun] +jingle (sound) cliquetis (m)[Noun] +jinx poisse (f)[Noun] +jitters trac[Noun] +job boulot (colloq.)[Noun] +job emploi (m)[Noun] +job turbin (slang)[Noun] +jobless au chômage[Adjective] +jockey jockey (m)[Noun] +jocular enjoué(e), jovial(e)[Adjective] +jocund gai[Adjective] +jodhpur jodhpur (m)[Noun] +jog faire du jogging[Verb] +jogging jogging (m)[Noun] +join (re)joindre[Verb] +join raccord (m)[Noun] +joinable joignable[Adverb] +joined (re)joint[Adjective] +joiner menuisier (m)[Noun] +joinery menuiserie (f)[Noun] +joint (drugs) joint (m)[Noun] +joint articulation[Noun] +joint jointure[Noun] +jointly conjointement[Adverb] +joke blague (colloq.)[Noun] +joke plaisanterie[Noun] +joked plaisanta (pass.simp.,3rd sing[Verb] +joker (playing card) joker (m)[Noun] +jokingly en plaisantant[Adverb] +jokingly pour rire[Adverb] +jolly jovial(e), enjoué(e)[Adjective] +jolt secousse[Noun] +jolt soubresaut (m)[Noun] +jonquils jonquilles[Noun] +jostle bousculer[Verb] +jot (~ down) noter[Verb] +jot (of truth) grain(m), brin(m) +journal (diary) journal (m)[Noun] +journal (magazine) revue (f) +journalism journalisme (m) +journalist journaliste[Noun] +journalists journalistes[Noun] +journey periple[Noun] +journey voyage[Noun] +jovial jovial(e)[Adjective] +jovially jovialement[Adverb] +joy joie[Noun] +joyful joyeux[Adjective] +joyfully joyeusement[Adverb] +joyless sans joie[Adverb] +joyously joyeusement[Adverb] +jubilant débordant(e) de joie[Adjective] +jubilee jubilé (m)[Noun] +judge juge[Noun] +judge juger[Verb] +judged juge/[Adjective] +judgement jugement[Noun] +judicial judiciaire[Adjective] +judiciary magistrature (f)[Noun] +judo judo (m)[Noun] +jug broc[Noun] +jug pichet[Noun] +jug pot (m)[Noun] +juggernaut poids (m) lourd[Noun] +juggle jongler[Verb] +juggler jongleur (m), jongleusse (f)[Noun] +jugular jugulaire[Adjective] +juice jus[Noun] +juiceless sans jus +juicier plus juteux +juiciest le plus juteux +juicy juteux, juteuse +jukebox juke-box (m)[Noun] +jumble mélange (m)[Noun] +jumbo géant(e)[Adjective] +jump sauter (inf.)[Verb] +jumped sauta (pass.simp., 3rd sing.)[Verb] +jumper robe (f) chasuble[Noun] +jumpy nerveux(euse)[Adjective] +junction (rail) embranchement (m)[Noun] +junction jonction[Noun] +jungle jungle (f)[Noun] +junior junior +juniper genie\vre[Noun] +junk bric-à -brac (m)[Noun] +junk camelotte (colloq.)[Noun] +junk des ordures[Noun] +junk du toc (colloq.)[Noun] +junkers casseurs (colloq.)[Noun] +junkers chiffonniers[Noun] +junkie accro (colloq.)[Noun] +junkie drogué(e)[Noun] +junkyard une casse (automobile)[Noun] +juridic juridique[Adjective] +jurisdiction juridiction[Noun] +jurist juriste[Noun] +juror jure/[Noun] +jurors jure/s[Noun] +jury jury (m)[Noun] +just juste +justice justice (f)[Noun] +justified justifie/(e)[Adjective] +justify justifier[Verb] +justly justement[Adverb] +jut (~ out) avancer[Verb] +juvenile puéril(e)[Adjective] +juxtapose juxtaposer[Verb] +kale chou[Noun] +kaleidescope kale/idoscope[Noun] +kaleidoscope kale/idoscope[Noun] +kangaroo kangourou[Noun] +karat carat (m)[Noun] +karate karaté (m)[Noun] +kayak kayak (m)[Noun] +kebab brochette[Noun] +keel la quille (naut.)[Noun] +keep garder (inf.)[Verb] +keeps toujours[Noun] +keepsake souvenir (m)[Noun] +keg caisson (liq.)[Noun] +keg tonnelet (m), baril (m)[Noun] +kennel niche (f)[Noun] +kennel un chenil[Noun] +kerchief un foulard[Noun] +kernel amande (f)[Noun] +kernel noyau[Noun] +kernel trognon (fruit)[Noun] +kerosene kérosène (m)[Noun] +ketchup ketchup (m)[Noun] +kettle une bouilloire[Noun] +key (map) légende +key une cle/, or clef[Noun] +key une touche (keyboard)[Noun] +keyboard un clavier[Noun] +keyhole le trou de (la) serrure[Noun] +keying taper (typewriter) (inf.)[Verb] +keynote note (f) dominante[Noun] +keypad (keyboard) pavé (m) numérique[Noun] +keypad un clavier (adding machine)[Noun] +khaki kaki[Adjective] +kick (~ out) vider[Verb] +kick donner (inf.) un coup de pied[Verb] +kickback un retour de manivelle[Noun] +kicked frappe/ du pied[Adjective] +kicker qui donne des coups de pied[Noun] +kickoff le depart synchronise/[Noun] +kicks s'amuser +kid un chevreau, une chevrette[Noun] +kid un(e) gosse (colloq.)[Noun] +kid un(e) mioche (colloq.)[Noun] +kiddies les gamins[Noun] +kiddies les gosses[Noun] +kiddies les mioches (colloq.)[Noun] +kidnap enlever (inf.)[Verb] +kidnap kidnapper[Verb] +kidnaped enleve/ (past.part.)[Adjective] +kidnaper enlèvement (m)[Noun] +kidnaper un ravisseur[Noun] +kidnapers les|des ravisseurs[Noun] +kidnaping un enle\vement[Noun] +kidnapped enleve/[Verb] +kidnapper un ravisseur[Noun] +kidnappers les|des ravisseurs[Noun] +kidnapping un enle\vement[Noun] +kidnappings des enle\vements[Noun] +kidney le rein[Noun] +kidneys les|des reins[Noun] +kidneys les rognons (cooking)[Noun] +kids les|des gamins[Noun] +kids les|des gosses[Noun] +kill (fig.) mettre fin à [Verb] +kill tuer[Verb] +killer meurtrier (m),meutrière (f)[Noun] +killer un tueur[Noun] +killers des tueurs[Noun] +killing meutre (m)[Noun] +killing une tuerie[Noun] +killings des tueries[Noun] +killjoy rabat-joie (m)[Noun] +kiln four (m)[Noun] +kiln un fourneau[Noun] +kilo kilo (m)[Noun] +kilobytes kilo-octet (m)[Noun] +kilogram kilogramme (abbr. kg)[Noun] +kilohertz kilo-hertz (m)[Noun] +kiloliter un kilolitre (abbr. kl)[Noun] +kilometer un kilome\tre (abbr. km) +kilowatt kilowatt (m)[Noun] +kilt kilt (m)[Noun] +kin aparente/ (a\...)[Adjective] +kind aimable[Adjective] +kind doux (de caracte\re)[Noun] +kind gentil(le)[Adjective] +kindergarten (le) jardin d'enfants[Noun] +kindergarten (une) cre^che pour enfants[Noun] +kindergarten (une) garderie (d'enfants)[Noun] +kindergarten e/cole maternelle[Noun] +kindhearted bon (de caracte\re, de coeur)[Noun] +kindhearted tendre de coeur[Adjective] +kindheartedness (la) tendresse de coeur[Noun] +kindle (feeling) susciter[Verb] +kindle (fire) allumer[Verb] +kindlessly froidement[Adverb] +kindlessly sans coeur[Adverb] +kindliness (la) douceur[Noun] +kindliness (la) gentillesse[Noun] +kindly avec douceur[Adverb] +kindly bienveillant(e)[Adverb] +kindly doucement[Adverb] +kindly gentiment[Adverb] +kindness (la) douceur de coeur[Noun] +kindness (la) gentillesse[Noun] +kindred aparente/[Adjective] +kindred semblable, similaire[Adjective] +kinds des espe\ces[Noun] +kinds des sortes (de...)[Noun] +king (le) roi[Noun] +kingdom (animals/plants) règne (m)[Noun] +kingdom (le) royaume[Noun] +kingdoms royaumes[Noun] +kingfisher (un) martin pe^cheur (bird)[Noun] +kingly royal[Adjective] +kings (les) rois[Noun] +kinky vicieux(ieuse)[Adjective] +kiosk kiosque[Noun] +kipper hereng (m) fumé[Noun] +kiss baiser[Verb] +kiss baiser[Noun] +kiss bisou[Noun] +kiss embrasser[Verb] +kisses baisers[Noun] +kisses bisous[Noun] +kit (set) trousse (f)[Noun] +kit (to be assembled) kit (m)[Noun] +kitchen cuisine[Noun] +kitchenette cuisinette[Noun] +kitchens cuisines +kitchenware (la) batterie de cuisine[Noun] +kitchenware (les) ustensiles de cuisine[Noun] +kite (un) cerf-volant[Noun] +kith (~ and kin) parents et amis +kiting jouer avec un cerf-volant[Verb] +kitten chaton[Noun] +kittens chatons[Noun] +kitty (shared fund) cagnotte (f)[Noun] +kiwi (bird) kiwi (m), aptéryx[Noun] +kiwi (fruit) kiwi (m)[Noun] +kleenex (un) mouchoir en papier[Noun] +kleenex TM, (R), etc. papier-mouchoir[Noun] +kleptomania (la) kleptomanie[Noun] +kleptomaniac un(e) kleptomane[Noun] +knack _ _ _ _ = avoir la main pour..[Noun] +knack to have the _ = avoir le chic[Noun] +knapsack (un) sac-a\-dos[Noun] +knead pe/trir[Verb] +kneadable pe/trissable[Adjective] +kneader pe/trisseur[Noun] +knee le genou[Noun] +kneecap la rotule[Noun] +kneel mettre à genoux[Verb] +kneel s'agenouiller (inf.reflx.)[Verb] +kneeling a\ genoux[Adverb] +kneeling s'agenouillant[Verb] +kneepad (un) prote\ge-genou[Noun] +knelt s'agenouilla (pass.simp.)[Verb] +knelt se mis(e) a\ genoux (pass.simp[Verb] +knickers pantalon de golf (m)[Noun] +knickknack (un) bibelot[Noun] +knickknack (une) babiole[Noun] +knife (un) canif[Noun] +knife (un) couteau[Noun] +knifes des couteaux[Noun] +knifing une blessure au couteau[Noun] +knight (chess) cavalier (m)[Noun] +knight (un) chevalier[Noun] +knighted e^tre sacre/ chevalier[Adjective] +knighthood la chevalerie[Noun] +knightly chevalier[Adjective] +knights des chevaliers[Noun] +knit (bones) se souder[Verb] +knit froncer les sourcils[Verb] +knit tricotter (inf.)[Verb] +knitted tricotte/ (past.part.)[Adjective] +knitting le tricot[Noun] +knitwear le tricot[Noun] +knives des couteaux[Noun] +knob (la) poigne/e[Noun] +knob (un) bouton (de commande)[Noun] +knobby noueux, noueuse[Adjective] +knobs (les) boutons (de commande)[Noun] +knock frapper (inf.)[Verb] +knock tapoter[Verb] +knockdown démolir[Verb] +knockout knock-out (m)[Noun] +knot (un) noeud[Noun] +knots des noeuds[Noun] +knotted noue/ (past.part.)[Adjective] +knotty épineux(euse)[Adjective] +knotty noueux[Adjective] +know savoir (inf.)[Verb] +knower celui|celle qui a le savoir[Noun] +knowhow le savoir-faire[Noun] +knowhow technique (f)[Noun] +knowing entendu(e)[Adjective] +knowingly en connaissance de cause[Adverb] +knowingly sciemment[Adverb] +knowledge la connaissance[Noun] +knowledge le savoir[Noun] +knowledgeable bien informé(e)[Adjective] +known connu (past.part.)[Verb] +knows (il|elle) sait[Verb] +knuckle (meat) jarret (m) +knuckle (une) phalange[Noun] +knucklebone (une) phalange[Noun] +knuckles (un) poing ame/ricain[Noun] +knuckles les phalanges[Noun] +koala koala (m)[Noun] +kosher cache\re[Adjective] +kosher kasher[Adjective] +kraut (la) choucroute[Noun] +kraut (un) boche (slang)[Noun] +krauts les chleus (slang.)[Noun] +kudzu lierre du Japon[Noun] +lab labo[Noun] +labor travail (m)[Noun] +laborer l'ouevrier[Noun] +laborer l'ouvrier[Noun] +laborers les ouevriers[Noun] +laborers les ouvriers[Noun] +laborious laborieux (m), laborieuse (f)[Noun] +labyrinth labyrinthe (m)[Noun] +lace dentelle (f)[Noun] +laceration lace/ration (f)[Noun] +lacerations lace/rations (f)[Noun] +lack manque[Noun] +lackadaisical nonchalant[Adjective] +lackey laquais[Noun] +lacking simplet[Adjective] +lackluster terne[Adjective] +laconic laconique[Adjective] +laconically laconiquement[Adjective] +lacquer (for wood) vernis (m)[Noun] +lacquer laque[Noun] +lad garcon[Noun] +ladies Mesdames[Noun] +lady dame[Noun] +ladybird coccinelle[Noun] +ladybug coccinelle[Noun] +lake lac[Noun] +lakes lacs[Noun] +lamb veau[Noun] +lambs veaux[Noun] +laminated laminé[Verb] +laminates lamine[Verb] +lamp lampe[Noun] +language langue[Noun] +laugh rire[Verb] +leather cuir[Noun] +leave laisser[Verb] +lectern lutrin[Noun] +lecture confe/rence[Noun] +lecturer confe/rencier[Noun] +ledge rebord[Noun] +ledger registre[Noun] +lee co^te/[Noun] +leg jambe[Noun] +legal legal[Adjective] +legality legalite[Noun] +legalize legaliser[Noun] +legally legalement[Adverb] +legate leguer[Verb] +legation legation[Noun] +legend legende[Noun] +legendary lengendaire[Adjective] +legion legion[Verb] +letter additive[] +letter ethnic[] +letter neighbor[] +like aimer[Verb] +live vivre[Verb] +love aime +love amour[Noun] +lover amant[Noun] +luck chance[Noun] +lunch le de/jeuner[Noun] +ma maman[Noun] +ma Mère[Noun] +ma'am M'dame[Noun] +ma'am madame[Noun] +ma'am mademoiselle[Noun] +macabre lugubre[Adjective] +macabre macabre[Adjective] +macabrely macabrement[Adverb] +macadam bitume[Noun] +macadam macadam[Noun] +macadamize goudronner[Verb] +macadamize macadamiser[Verb] +macadamized goudronné[Verb] +macadamized macadamise/[Adjective] +macadamizes goudronnes[Verb] +macadamizes macadamise[Verb] +macadamizing goudronnant[Verb] +macaque macaque[Noun] +macaque macaque[Noun] +macaroni macaroni[Noun] +macaronies macaronis[Noun] +macaroon macaron[Noun] +macaw l'ara[Noun] +mace sceptre[Noun] +macerate mace'rer[Verb] +macerate maçérer[Verb] +macerated macere'[Adjective] +maceration mace'ration[Noun] +macerations mace'rations[Noun] +maces masse[Noun] +machete machette[Noun] +machination machination[Noun] +machine machine[Noun] +machined machine/[Adjective] +machineries machinerie +machinery machinerie[Noun] +machines machines[Noun] +machinist machiniste[Noun] +machinists machinistes[Noun] +machismo machisme[Noun] +macho macho[Adjective] +macrocephalic macroce'phale[Adjective] +macrocosm macrocosme[Noun] +macroeconomics macroeconomie[Noun] +macroevolution macroe'volution[Noun] +macroevolutionary macroe'volutionnaire[Adjective] +macroinstruction macroinstruction +macromolecular macromole'culaire[Adjective] +macromolecule macromole'cule[Noun] +macromolecules macromole'cules[Noun] +macropathological macropathologique[Adjective] +macropathology macropathologie[Noun] +macrophage macrophage[Noun] +macrophages macrophages[Noun] +macrophagic macrophage[Adjective] +macroprocessor macroprocesseur[Noun] +macroscopic macroscopic[Adjective] +macrosimulation macrosimulation[Noun] +macrostructure macrostructure[Noun] +maculate maculer[Verb] +maculated macule'[Adjective] +maculates macule[Verb] +maculation maculation[Noun] +maculations maculations[Noun] +mad fache'[Adjective] +mad fou, folle[Adjective] +madam madame[Noun] +madams mesdames[Noun] +maddened rendu fou[Adjective] +made a fait[Verb] +made j'adore[Verb] +mademoiselle mademoiselle[Noun] +mademoiselles mesdemoiselles[Noun] +maestro maestro[Noun] +mafioso mafieux[Noun] +magazine magazine[Noun] +magic magique[Adjective] +magician magicien[Noun] +magicians magiciens[Noun] +magistral magistral[Adjective] +magistrally magistralement[Adverb] +magistrature magistrature[Noun] +magma magma[Noun] +me moi[Pronoun] +mead le hydromel[Noun] +meadow le pre/[Noun] +meadow pre/[Noun] +meadowland les prairies[Noun] +meadows pre/s[Noun] +meager maigre[Adjective] +meagerly maigrement[Adverb] +meagre maigre[Adjective] +meal repas[Noun] +meals repas[Noun] +mealtime heure du repas[Noun] +mean moyenne[Noun] +meander me/andre[Noun] +meaningless insense/[Adjective] +meanings significations[Noun] +means moyen[Noun] +meanwhile entretemps[Adverb] +measurable mesurable[Adjective] +meat viande[Noun] +meatball boulette de viande[Noun] +meatballs boulettes de viande[Noun] +mechanical me/canique[Adjective] +mechanician me/canicien[Noun] +mechanism me/canisme[Noun] +mechanisms me/canismes[Noun] +medal me/daille[Noun] +medallion me/daillon[Noun] +medallions me/daillons[Noun] +mediatrice me/diatrice[Noun] +mediatrix me/diatrice[Noun] +medic me/decin[Noun] +medical me/dical[Adjective] +medically me/dicalement[Conjunction] +medicament me/dicament[Noun] +medicaments me/dicaments[Noun] +medicinal me/dicinal[Adjective] +medicine me/decine[Noun] +medicines me/decines[Noun] +medico medico[Adjective] +medicolegal me/dicole/gal[Adjective] +medics me/decins[Noun] +medieval me/die/val[Adjective] +medievalist me/die/valiste[Noun] +medievalists me/die/valistes[Noun] +mediocre me/diocre[Adjective] +mediocrities me/diocrite/s[Noun] +mediocrity me/diocrite/[Noun] +meditate me/diter[Verb] +meditates me/dite[Verb] +meditation me/ditation[Noun] +meditations me/ditations[Noun] +meditative me/ditatif[Adjective] +meditatively d'un air me/ditatif[Adjective] +medium me/dium[Noun] +medlar ne\fle[Noun] +medley me/lange[Noun] +medleys me/langes[Noun] +medulla me/dulle[Noun] +medusae me/duses[Noun] +meek doux[Adjective] +meekly avec soumission[Adjective] +meekness soumission[Noun] +meerschaum pipe en e/cume de mer[Noun] +megabyte me/ga-octet[Noun] +megabytes me/ga-octets[Noun] +megacycle me/gacycle[Noun] +megahertz me/gahertz[Noun] +megalith me/galithe[Noun] +megalithic me/galitic[Adjective] +megalomania me/galomanie[Noun] +megalomaniac me/galomane[Noun] +megalomaniacal me/galomane[Adjective] +megaphone me/gaphone[Noun] +melancholia me/lancolie[Noun] +melancholic me/lancolique[Adjective] +melange me/lange[Noun] +melodic me/lodique[Adjective] +melodies me/lodies[Noun] +melodious me/lodieux[Adjective] +melodrama me/lodrame[Noun] +melodramas me/lodrames[Noun] +melodramatic me/lodramatique[Adjective] +melody me/lodie[Noun] +melon melon[Noun] +melons melons[Noun] +melted fondu[Pronoun] +member membre[Noun] +members membres[Noun] +membrane membrane[Noun] +membranes membranes[Noun] +membranous membraneux[Adjective] +memoir me/moire[Noun] +memoirs me/moires[Noun] +memorable me/morable[Adjective] +memories souvenirs[Noun] +memorize me/moriser[Verb] +memorized me/morise/[Pronoun] +memory me/moire, souvenir[Noun] +men hommes[Noun] +menace menace[Noun] +menaced menace/[Adjective] +menagerie me/nagerie[Noun] +menageries me/nageries[Noun] +menhir menhir[Noun] +meningitis me/ningite[Noun] +meniscus me/nisque[Noun] +menopause me/nopause[Noun] +menstrual menstruel[Adjective] +menstruation menstruation[Noun] +menstruations menstruations[Noun] +mental mental[Adjective] +mentality mentalite/[Noun] +menthol menthol[Noun] +mention mentionner[Verb] +menu menu[Noun] +meow miauler[Verb] +meowing miauleur[Adjective] +meows miaule[Verb] +mephitic me/phitique[Adjective] +mercantile mercantile[Adjective] +mercantilism mercantilisme[Noun] +mercenaries mercenaires[Noun] +mercenary mercenaire[Noun] +merchant marchand[Noun] +merchants marchands[Noun] +mercury mercure[Noun] +mercy pitie/[Noun] +meridian me/ridien[Noun] +meridians me/ridiens[Noun] +meridional me/ridional[Adjective] +merino me/rino[Noun] +merit me/rite[Noun] +meritocracy me/ritocratie[Noun] +merits me/rites[Noun] +mermaid sire\ne[Noun] +mermaids sire\nes[Noun] +merry joyeux[Adjective] +message message[Noun] +messages messages[Noun] +messiahs messie[Noun] +messianic messianique[Adjective] +moan gémir[Verb] +moaned gémit[Verb] +moaning gémissant[Verb] +moans gémissements +moat fossé[Noun] +moats fosséa[Noun] +mob foule[Noun] +mock ridiculiser[Verb] +mocked ridiculisé[Verb] +mockery moquerie[Noun] +modal modal[Adjective] +moon lune[Noun] +moonlight clair de lune +moons lunes +moose orignal +naive naif, naive[Adjective] +naively naivement[Adverb] +naked nu[Noun] +name prenom(persons), nom (things)[Noun] +named nomme[Adjective] +nameless sans nom[Adjective] +namely nomement [Adverb] +namely nommement[Adverb] +names prenoms, noms (see name)[Noun] +national national/e[Adjective] +nationalism nationalisme[Noun] +nationalist nationaliste[Adjective] +native habitant/e du pays[Noun] +natural naturel (le)[Adjective] +naturalize naturaliser[Verb] +naturally naturellement[Adverb] +neap mortes-eaux[Noun] +near proche[Adjective] +nearby près[Adverb] +nearer plus proche[Adjective] +neglect abandonner[Verb] +neighbor voisin[Noun] +neighbors voisins[Noun] +network réseau +networked réseauté +networks réseaux +nine neuf[Adjective] +nineteen dix-neuf[Adverb] +nineteenth dix-neuvie\me[Adjective] +nineties les anne/es quatre-vingt-dix[Noun] +ninetieth quatre-vingt-dixie\me[Adjective] +ninety quatre-vingt-dix[Adverb] +ninetyfold quatre-vingt-dix fois[Adverb] +ninth neuvie\me[Adjective] +niobium niobium (m)[Noun] +nip te/ton (m)[Noun] +nipple te/ton[Noun] +nipples te/tons[Noun] +nips te/tons (m)[Noun] +nirvana nirvana[Noun] +nitrate nitrate[Noun] +nitrated nitrate/[Noun] +nitrates nitrates[Noun] +nitrating nitratant[Adverb] +nitration nitratation[Noun] +nitrations nitratations[Noun] +nitric nitrique[Adjective] +nitride nitrate (m)[Noun] +nitrogen azote[Noun] +nitroglycerin nitroglyce/rine[Noun] +nitroglycerine nitroglyce/rine[Noun] +noble noble[Noun] +nobleman noble[Noun] +noblemen nobles[Noun] +nobleness noblesse[Noun] +nobody personne[Pronoun] +noctambulism noctambulisme[Noun] +noctambulist noctambule[Noun] +nocturn noctune +nocturnally de nuit[Noun] +now maintenant[Adverb] +nowadays de nos jours, aujourd'hui[Adverb] +noway pas question, pas du tout[Adverb] +noway pas question, pas du tout[Adverb] +oaf nigaud[Noun] +oafish stupide[Adjective] +oafishness sottise[Noun] +oak che^ne[Noun] +oar rame[Noun] +oarsman rameur[Noun] +oasis oasis[Noun] +oat avoine[Noun] +oath serment[Noun] +oatmeal farine d'avoine[Noun] +obdurate inve/te/re/[Adjective] +obedience obe/issance[Noun] +obedient soumis[Adjective] +obelisk obe/lisque[Noun] +obese obe\se[Adjective] +obesity obe/site/[Noun] +ocean ocean[Noun] +one un[Noun] +orange orange[Noun] +oranges oranges[Noun] +orbit orbite[Noun] +orbital orbital[Adjective] +orbits orbites[Noun] +orchestra orchestre[Noun] +orchestral orchestral[Adjective] +orchestras orchestres[Noun] +orchestrated orchestré[Adjective] +order commande[Noun] +ordered ordonné[Adjective] +organism organisme[Noun] +organisms organismes[Noun] +organist organiste[Noun] +organists organistes[Noun] +organization organisation[Noun] +organizations organisations[Noun] +organize organiser[Verb] +organized organisé[Adjective] +organs organes[Noun] +orgasm orgasme[Noun] +orgasms orgasmes[Noun] +orgies orgies[Noun] +orgy orgie[Noun] +orient orient[Noun] +orientable orientable[Adjective] +oriental oriental[Adjective] +orientation orientation[Noun] +orientations orientations[Noun] +oriented orienté[Adjective] +orients orients[Noun] +orifice orifice[Noun] +orifices orifices[Noun] +orificial orifique[Adjective] +origin origine[Noun] +original original[Adjective] +originality originalité[Adjective] +originally originalement[Adverb] +originals originaux[Adjective] +origins origines[Noun] +ornamental ornemental[Adjective] +ornithology ornithologie[Noun] +orthodox orthodoxe[Adjective] +orthodoxes orthodoxes[Adjective] +orthogonal orthogonal[Adjective] +pace rhytme[Noun] +pace vitesse[Noun] +pacemaker stimulateur cardiaque (m), pacemaker (m)[Noun] +pachyderm pachyde\rme[Noun] +pacific pacifique[Noun] +pacifically pacifiquement[Adverb] +pacification pacification(f)[Noun] +pacifications pacificateur / -trice [Noun] +pacificist pacifiste[Noun] +pacifier tétine (f), sucette (f) +pacifism pacifisme[Noun] +pacifist pacifiste[Noun] +pacify apaiser[Verb] +pacify pacifier[Verb] +package 2)paquet(m);3)ballot(m)[Noun] +package emballage[Noun] +packaged emballeE[Adverb] +packaged paquet (m)[Noun] +packed (~ with) bourré(e) de +packet 1) paquet (m) ;2)ballot(m)[Noun] +packing emballage (m)[Noun] +pact pacte, contrat[Noun] +pacts pcates, contrats[Noun] +pad coussinet, tampon[Noun] +padding rembourrage, remplissage[Noun] +paddle pagaie, palette[Noun] +paddock enclos, paddock[Noun] +padlock cadenas[Noun] +padlock cadenasser[Verb] +padrone patron /nne[Noun] +paella paella[Noun] +pagan pai.en/i.enne) +pagan payen /nne[Noun] +pagans païen(ne)s[Noun] +pageant spectacle[Noun] +pageantry apparat[Noun] +paid payé(e)[Adjective] +pail seau[Noun] +pain douleur[Noun] +pained peiné(e)[Adjective] +painful douleureux[Adjective] +painful pénible[Adjective] +painfully douloureusement[Adverb] +painstaking assidu(e)[Adjective] +paint peindre[Verb] +paint peinture[Noun] +paintbrush pinceau[Noun] +painter peintre[Noun] +painters peintre[Noun] +painting peinture[Noun] +paints couleurs[Noun] +pair couple[Noun] +pajamas pyjama[Noun] +pal copain (m)[Noun] +pal copine (f) +palace palais[Noun] +palatable agréable au goût[Adjective] +palaver palabres (f)[Noun] +pale pâle[Adjective] +palette palette (f)[Noun] +pall voile (m)[Noun] +pallet palette (f)[Noun] +pallette palette (f)[Noun] +pallor pâleur (f)[Noun] +palm (~ tree) palmier (m)[Noun] +palm paume (f)[Noun] +palpable évident(e)[Adjective] +palpable manifeste [Adjective] +paltry dérisoire[Adjective] +pamper choyer, dorloter[Verb] +pamphlet brochure (f)[Noun] +pan casserole (f)[Noun] +panacea panacée (f)[Noun] +panama Panama (m)[Noun] +pancake crêpe (f)[Noun] +panda panda (m)[Noun] +pandemonium tohu-bohu (m)[Noun] +pane vitre (f), carreau (m)[Noun] +panel invités (m)[Noun] +paneling lambris (m)[Noun] +panelling lambris (m)[Noun] +pang tiraillement (m)[Noun] +panic panique (f)[Noun] +panic paniquer[Verb] +panicky paniqué(e)[Adjective] +panorama panorama (m)[Noun] +pansy pensée(f)[Noun] +pant haleter[Verb] +panther panthère (f)[Noun] +panties culotte (f)[Noun] +pantry garde-manger (m)[Noun] +pants pantalon (m)[Noun] +papa papa (m)[Noun] +paper papier (m)[Noun] +paperback livre de poche (m)[Noun] +parameter paramètre[Noun] +passer passeur[Noun] +passion passion[Noun] +passionately passionne/ment[Adverb] +passive passif[Adjective] +passivity passivite/[Noun] +password mot de passe[Noun] +passwords mots de passe[Noun] +past passe/[Noun] +pasta pâtes alimentaires[Noun] +peat tourbe[Noun] +pectorals pectoraux[Noun] +peculiar important +penitence pe/nitence[Noun] +penitences pe/nitences[Noun] +penitency pe/nitence[Noun] +penitent pe/nitent[Noun] +pentadactyl pentadactyle[Adjective] +pentadactylism pentadactylisme[Noun] +pi pi[Noun] +pianist pianiste[Noun] +pianistic pianistique[Adjective] +piano piano[Noun] +picture image[Noun] +pictures images[Noun] +pie tarte[Noun] +pies tartes[Noun] +pig cochon[Noun] +pigeonhole pigeonnier[Noun] +pigment pigment[Noun] +pigmentation pigmentation[Noun] +pigments pigments[Noun] +pigs cochons[Noun] +pilot pilote[Noun] +pilots pilotes[Noun] +pilule pilule[Noun] +pine pin[Noun] +pineapple ananas[Noun] +pineapples ananas[Noun] +pines pins[Noun] +pink rose[Noun] +pocket poche[Noun] +pocketbook livre de poche[Noun] +pocketbooks livres de poche[Noun] +pockets poches[Noun] +podium podium[Noun] +pogrom pogrom[Noun] +pogroms pogroms[Noun] +pointer pointeur[Noun] +pointers pointeurs[Noun] +pointillism pointillisme[Noun] +pointillist pointilliste[Noun] +pointilliste pointilliste[Noun] +pointillistic pointilliste[Noun] +poison poison[Noun] +poisonous poison[Adjective] +poisonousness toxicite/[Noun] +poisons poisons[Noun] +polar polaire[Adjective] +polarities polarite/s[Noun] +polarity polarity[Noun] +polarize polariser[Verb] +polarized polarise/[Adjective] +polemical pole/mique[Adjective] +polemically de fac,on pole/mique[Adjective] +polemically de manie\re pole/mique[Adverb] +polemicize pole/miquer +police police[Noun] +policeman agent de police[Noun] +policeman agent[Noun] +policeman policier[Noun] +policemen agents de police[Noun] +policemen agents[Noun] +policemen policiers[Noun] +policewoman contractuelle[Noun] +policewomen contractuelles[Noun] +policy politique[Noun] +polish polonais[Adjective] +polish Polonais[Noun] +polite poli[Adjective] +politely poliment[Adverb] +politeness politesse[Noun] +political politique[Adjective] +politically politiquement[Adverb] +politician politicien[Noun] +politicians politiciens[Noun] +politics politique[Noun] +polka polka[Noun] +pollutant polluant[Noun] +pollute polluer[Verb] +polluted pollue/[Adjective] +polluter pollueur[Noun] +pollution pollution[Noun] +polonium polonium[Noun] +poltergeist poltergeist[Noun] +polyandrous polyandre[Adjective] +polyandry polyandrie[Noun] +pour french[Noun] +pout moue[Noun] +poverty pauvrete/[Noun] +powder poudre[Noun] +powdery poudreux[Adjective] +power puissance[Noun] +powerful puissant[Adjective] +powerless impuissant[Adjective] +powwow assemble/e[Noun] +practicability possibilite/[Noun] +practicable re/alisable[Adjective] +practical pratique[Adjective] +pray prier[Verb] +prayer prie\re[Noun] +prayers prie\res[Noun] +praying en prie\res[Adjective] +praying prie\re[Noun] +preach pre^cher[Verb] +preach prononcer[Verb] +preacher pasteur[Noun] +preacher pre/dicateur[Noun] +preachers pasteurs[Noun] +preachers pre/dicateurs[Noun] +preaches pre^che[Verb] +preaches prononce[Verb] +preachify faire la morale[Verb] +preaching pre/dication[Noun] +preaching pre^cheur[Adjective] +preaching sermons[Noun] +preachy pre^cheur[Adjective] +preachy sermonneur[Adjective] +preamplifier pre/amplificateur[Noun] +preamplifiers pre/amplificateurs[Noun] +prearrange arranger au pre/alable[Verb] +prearrange arranger d'avance[Verb] +prince prince[Noun] +princedom principaute/ +princely princier[Adjective] +princes princes[Verb] +princess princesse[Noun] +principal principal[Noun] +principal directeur[Noun] +principalities principaute/s[Noun] +principality principaute/ +principally principalement +principally surtout +principals directeurs +principle principe[Noun] +principles principes +print empreinte[Noun] +print impression[Noun] +print marque +printable imprimable[Adjective] +printed imprime/[Adjective] +printer imprimeur[Noun] +printer imprimante[Noun] +priorities priorite/ +priorities priorite/s +priority priorite/ +prove prouver[Verb] +pulse impulsion[Noun] +pulverizable pulverisable[Adjective] +pulverizables pulverisables[Adjective] +pulverization pulverisation[Noun] +pulverize pulveriser[Verb] +pulverized pulvérisé[Verb] +pulverizer pulverisateur[Noun] +pulverizers pulvérisateurs[Noun] +pulverizes pulvérises[Verb] +pulverizing pulve/risant[Verb] +puma puma[Noun] +pump pomper[Verb] +push pousser[Verb] +pushchair chaise roulante[Noun] +pushing poussé[Verb] +put mettre[Verb] +putdown poser[Verb] +putout éteindre[Verb] +putrefaction putréfaction[Noun] +quail caille[Noun] +quails cailles[Noun] +quake trembler[Verb] +quality qualite/[Noun] +qualm scrupule[Noun] +qualms scrupules[Noun] +quantity quantite/ +quarrel se disputer[Verb] +quarry carri\ere[Noun] +quarter quartier[Noun] +quarterdeck plage arri\ere[Noun] +quarterfinal quart de finale[Noun] +queen reine[Noun] +queer bizarre[Adjective] +quell re/primer[Verb] +quench se de/salte/rer +querulous ronchonneur[Adjective] +query question[Noun] +quest que^te[Noun] +question question[Noun] +queue queue[Noun] +quibble chicaner[Verb] +quick rapide[Adjective] +quicklime chaux vive[Noun] +quickly rapidement[Adverb] +quicksand sables mouvants[Noun] +quicksilver vif-argent[Noun] +quiet tranquille[Adjective] +quieten calmer[Verb] +quietly doucement[Adverb] +quill plume d'oie[Noun] +quilt e/dredon[Noun] +quirk bizarrerie[Noun] +quit se rendre[Verb] +quite assez[Adjective] +quota quota[Noun] +quotation citation[Noun] +quote citer[Verb] +r r[Noun] +rabbet feuillure[Noun] +rabbi rabbin +rabbinic rabbinique[Adjective] +rabbit lapin[Noun] +rabbits lapins[Noun] +rabble cohue[Noun] +rabid enrage/[Adjective] +rabies rage +raccoon raton-laveur +race course[Noun] +racehorse cheval de course +racemic rece/mique[Adjective] +racer coureur +races courses[Noun] +rachis rachis[Noun] +rachitic rachitique[Adjective] +rachitis rachitisme[Noun] +racial racial[Adjective] +racialism racisme[Noun] +racialist raciste[Noun] +racialistic raciste[Adjective] +racing de course +racism racisme[Noun] +racist raciste[Noun] +rack e/tag\ere[Noun] +racket raquette[Noun] +racket tumulte[Noun] +radar radar[Noun] +radars radars[Noun] +radio radio[Noun] +read lire[Verb] +readability lisibilite/[Noun] +readable lisible[Adjective] +reader lecteur[Noun] +readers lecteurs[Noun] +readership lecteurs[Noun] +readership lectorat[Noun] +readily de bonne gra^ce[Adverb] +readily facilement[Adverb] +readily volontiers[Adverb] +readiness empressement[Noun] +readiness facilite/[Noun] +reading interpre/tation[Noun] +reading lecture[Noun] +reading releve/[Noun] +readings interpre/tations[Noun] +readings lectures[Noun] +readjust rajuster[Verb] +readjust re/ajuster[Verb] +readjusts rajuste[Verb] +readjusts re/ajuste[Verb] +readout affichage[Noun] +readout d'affichage[Adjective] +readouts affichages[Noun] +reads lit[Verb] +ready dispose/[Adjective] +ready pre^t[Adjective] +ready prompt[Adjective] +reaffirm affirmer de nouveau[Verb] +reaffirm re/affirmer[Verb] +reaffirms affirme de nouveau[Verb] +reaffirms re/affirme[Verb] +reagent re/actif[Noun] +real naturel[Adjective] +real ve/ritable[Adjective] +real vrai[Adjective] +realisable re/alisable[Adjective] +realism re/alisme[Noun] +realist re/aliste[Noun] +realistic plein de re/alisme[Adjective] +realistic re/aliste[Adjective] +realistically avec re/alisme[Adverb] +reality re/alite/[Noun] +realize re/aliser[Verb] +really vraiment[Adverb] +reporter le reporter[Noun] +represent repre/senter[Verb] +request demande[Noun] +request exiger[Verb] +request reque^te[Noun] +road rue[Noun] +roads rues +roadwork chantier[Noun] +robber voleur[Noun] +room chambre +rotting decay[Verb] +sabbat un sabbat[Noun] +sabbath sabbat[Noun] +sabbatic sabatique[Noun] +sabbatical sabbatique[Adjective] +saber sabre[Noun] +sabin nom de personne qui a decouvert le vaccine contre poliomyltie[Noun] +sable martre[Noun] +sabot sabot[Noun] +sabotage sabotage[Noun] +sabotaged saboté[Verb] +sabotages sabotages[Noun] +saboteur saboteur[Noun] +sabra citoyen du pays Israel, personne ne en Israel[Noun] +sabras citoyens du pays Israel, personnese nes en Israel[Noun] +saccade une saccade[Noun] +saccharin saccharine[Verb] +saccharine saccharin[Noun] +saccharose saccharose[Noun] +sacerdotal appartient a une chose religieuse[Adjective] +sacerdotally une acte faite en manière sacrée[Adverb] +sachet un sachet[Noun] +sack sac[Noun] +sack virer[Verb] +sackcloth une vêtement de deuil[Noun] +sacked vire/[Adjective] +sackful une mesure "plein d'un sac"[Adjective] +sacks piller[Verb] +sacrament sacrament[Noun] +sacramental sacremental[Adjective] +sacraments sacrements[Noun] +sacre sacre[Noun] +sacred sacre/[Adjective] +sacrifice sacrifice[Noun] +sacrificed sacrifier[Verb] +sacrifices sacrifices[Noun] +sacrilege sacrile\ge[Noun] +sad malheureux[Adjective] +sad triste[Adjective] +sadden attrister[Verb] +sadder plus triste[Adjective] +saddest plus triste[Adjective] +saddle selle[Noun] +saddlebag une sacoche[Noun] +saddlebags des sacoches +saddlebow un arçon +saddlecloth une housse ( de cheval)[Noun] +saddled sellé[Verb] +saddleless sans selle +saddler un sellier[Noun] +saddlery une sellerie[Noun] +saddles une selle +saddletree un bois de selle[Noun] +saddling sellant[Verb] +sadism sadisme[Noun] +sadist sadiste[Noun] +sadistic sadique[Adjective] +sadistically sadiquement[Adverb] +sadists sadistes[Noun] +sadly tristement[Adverb] +sadness tristesse[Noun] +safari un voyage, en particulier en Afrique[Noun] +safe coffre-fort[Noun] +safecracker une personne qui ouvre une caisse illégalement[Noun] +safecracking l'acte d'ouvrir une caise illégalement[Noun] +safeguard une sauvegarde[Noun] +safeguarded sauvegardé[Verb] +safeguards garde fous[Noun] +safer pplus sauf[Adjective] +safes les caisses[Noun] +safest le plus sauf[Adjective] +safety le sûreté[Noun] +safflower le carthame[Noun] +saffron le safran[Noun] +sag plier, ployer[Verb] +saga une saga[Noun] +sagacious prudent[Adjective] +sagaciously prudemment[Adverb] +sagaciousness la sagacité[Noun] +sagacity la sagacité[Noun] +sage le sage[Noun] +sagely sagement[Adjective] +sago le sagou[Noun] +saguaro une type de cactus[Noun] +sahib une forme d'addresser pour un homme des Indes[Noun] +said dit[Verb] +sail naviguer[Verb] +sail voile[Noun] +sailable navigable[Adjective] +sailboat un bateau à voiles[Noun] +sailboater un marin des bateua à voiles[Noun] +sailcloth la toile à voiles[Noun] +sailor marin[Noun] +sailors les marins[Noun] +sails les voiles[Noun] +sainfoin le sainfoin ( bot.)[Noun] +saint saint(e)[Noun] +sainted sacré[Adjective] +sainthood la sainteté[Noun] +saints saint(e)s[Noun] +saith dit ( vieux anglais)[Verb] +sake le vin du riz japonais[Noun] +salability vendabilite/[Adjective] +salacious grivois[Adjective] +salad salade[Noun] +salads salades[Noun] +salamander salamandre[Noun] +salami salami[Noun] +salaried salarie/[Adjective] +salaries salaires[Noun] +sale solde[Noun] +saleable vendable[Adjective] +saleroom la salle des ventes[Noun] +sales les ventes[Noun] +salesclerk un vendeur +salesgirl une vendeuse[Noun] +saleslady une vendeuse[Noun] +salesman un vendeur[Noun] +salesmanship l'art de vendre[Noun] +salesmen les vendeurs[Noun] +salespeople les vendeurs[Noun] +salesperson un vendeur[Noun] +salesroom les salles de ventes[Noun] +saleswoman une vendeuse +saleswomen les vendeuses[Noun] +salient saillant[Adjective] +saline salin[Adjective] +salinity la salinité[Noun] +salinometer un salinomère[Noun] +salinometers des salinomètres[Noun] +saliva salive[Noun] +salivary salivaire[Adjective] +salivate saliver[Verb] +salivated a fait saliver[Verb] +salivates fait saliver[Verb] +salivating faisant saliver[Verb] +salivation ;a salivation[Noun] +sallies les sorties[Noun] +sallow jaunâtre[Adjective] +sallowish un peu jaunâtre[Adjective] +salmon saumon[Noun] +salmons saumons[Noun] +salon salon[Noun] +salons salons[Noun] +salt sel[Noun] +saltwater l'eau de mer[Noun] +saltworks la saline[Noun] +saltwort le soude ( bot.)[Noun] +salty sale/[Adjective] +salubrious salubre[Adjective] +salubrity la salubrité[Noun] +salvage le sauvetage[Noun] +salver le plateau[Noun] +samba la Samba, une danse originée du Brasil[Noun] +same même[Adjective] +sampan un bateua chinois[Noun] +samphire le passe-pierre (bot.)[Noun] +samurai un guerrier ancien japonais[Noun] +samurais des guerriers anciens japonais[Noun] +sand le sable[Noun] +sandal la sandale[Noun] +school e/cole[Noun] +sea mer[Noun] +sell vendre[Verb] +seller le vendeur[Noun] +sellers les vendeurs[Noun] +serendipity le serendiptiy[Verb] +serene le serene +seven sept[Adverb] +sevenfold sept fois[Adverb] +seventeen dix-sept[Adverb] +seventeenth dix-septie\me[Adjective] +seventh septie\me[Adjective] +seventies les anne/es soixante-dix[Noun] +seventieth soixante-dixie\me[Adjective] +seventy soixante-dix[Adverb] +seventyfold soixante-dix fois[Adverb] +sever blesser[Verb] +severalfold plusieurs fois[Adverb] +severe grave[Adjective] +severed blesse/ (m), blesse/e (f)[Adjective] +severely gravement[Adverb] +severities blessures (f)[Noun] +severity gravite/ (f)[Noun] +sewage e/pandage (m)[Noun] +sex sexe (m)[Noun] +sexagenarian se/xage/naire[Adjective] +shades lunettes de soleil (f)[Noun] +shadow ombre (f)[Noun] +shadows ombres[Noun] +shagreen chagrin[Noun] +shah schah[Noun] +shake secouer[Verb] +shakedown lit de fortune[Noun] +shaken secoue/[Adjective] +shaky tremblant[Adjective] +shaman chaman[Noun] +shamanism chamanisme[Noun] +shampoo shampooing +shampoos shampooings +sheep agnis[Noun] +sheepherder pastor[Noun] +ship ba^teau +ship navire[Noun] +shit merde[Noun] +sick malade[Adverb] +silver argent[Adjective] +sing chanter[Verb] +singer chanteur[Noun] +sink couler[Verb] +six six[Adverb] +sixteen seize[Adverb] +sixteenth seizie\me[Adjective] +sixties les anne/es soixante (f)[Noun] +sixty soixante[Adverb] +sixtyfold soixante fois[Adverb] +size taille (f), dimension (f)[Noun] +skate patin (m)[Noun] +skateboard planche a\ roulettes (f)[Noun] +skateboarder planchiste (m)[Noun] +skateboarding faire de la planche a\ roulettes[Verb] +skateboards planches a\ roulettes (f)[Noun] +skater patineur (m), patineuse (f)[Noun] +skaters patineurs (m), patineuses (f)[Noun] +skates patins (m)[Noun] +skating patinage (m)[Noun] +skill Habilete/[Noun] +skilled habile[Adjective] +skilless maladroit[Adjective] +skillful adroit[Adjective] +skills talents[Noun] +sky ciel[Noun] +skylark rossignol[Noun] +skyscraper gratte-ciel[Noun] +snout groin[Noun] +snow neige[Noun] +snowball boule de neige[Noun] +snowflake flocon de neige +snowman bonhomme de neige[Noun] +snowstorm tempe^te de neige[Noun] +software logiciel[Noun] +sorrel oseille[Noun] +sorrily tristement[Adverb] +sorrow tristesse[Noun] +sort trier[Verb] +sorted trié[Adjective] +sorter trieur[Noun] +soul âme[Noun] +spectra pl de spectrum, spectre[Noun] +spectrum Phys: spectre; Fig: gamme (de produit)[Noun] +speculate s'interroger, speculer, conjecturer[Verb] +speculation meditation; conjectures ; speculation +staple agrafe[Noun] +stapled agraf/e[Adjective] +stapler agrafeuse[Noun] +staplers agrafeuses[Noun] +staples agrafes[Noun] +star e/toile[Noun] +stars e/toiles[Noun] +start de/part[Noun] +stifled e/touffe/ +strength force[Noun] +stupid Stupide[Adjective] +subject asignatura[Noun] +succeed re/ussir[Verb] +success re/ussite/[Noun] +sun soleil[Noun] +sunbathe se bronzer[Verb] +sunny ensoleille/[Adjective] +suppressed e/touffe/ +suspect soupc,onner[Verb] +swear jurer ; preter serment[Verb] +tab happy[Adjective] +tab sortir[Verb] +tabernacle tabernacle[Noun] +table table[Noun] +tableau tableau[Noun] +tableaus tableaux[Noun] +tableaux tableaux[Noun] +tablecloth nappe[Noun] +tablecloths nappes[Noun] +tables tables[Noun] +tablet comprime/[Noun] +tablets comprime/s[Noun] +taboo tabou[Noun] +taboos tabous[Noun] +tachometer tachyme\tre[Noun] +tachometers tachyme\tres[Noun] +tacit tacite[Adjective] +tail queue (of animal)[Noun] +tailor tailleur[Noun] +tailored fait sur mesure[Adjective] +tailors tailleurs[Noun] +tails queues[Noun] +task tâche[Noun] +tasks tâches[Noun] +taste goût[Noun] +tasted goûté[Verb] +tasteless insipide[Adjective] +tear accroc[Noun] +tear de/chirer[Verb] +tear de/chirure[Noun] +tear larme[Noun] +teardrop larme[Noun] +tearful tout en pleurs[Adjective] +tearfully en pleurant[Adverb] +tearfully les larmes aux yeux[Adverb] +teargas gaz lacrymoge\ne[Noun] +tearjerker me/lo[Noun] +tearless avec yeux secs[Adjective] +tearless sans larmes[Adjective] +tearoom salon de the/[Noun] +tears de/chirures[Noun] +tears larmes[Noun] +tearstained barbouille/ de larmes[Adjective] +tearstained portant des traces de larmes[Adjective] +tease taquin[Noun] +tease taquiner[Verb] +tease tourmenter[Verb] +teasel carde\re[Noun] +teaser question dificile[Noun] +teaser taquin[Noun] +teases excite[Verb] +teases taquine[Verb] +teases taquins[Noun] +teasing railleur[Adjective] +teasing taquinerie[Noun] +teasingly d'un ton railleur[Adverb] +teasingly pour taquiner[Verb] +teaspoon cuille\re a\ cafe/[Noun] +teaspoon cuiller a\ cafe/[Noun] +teaspoonful cuillere/e a\ cafe/[Noun] +teat bout de sein[Noun] +teat mamelon[Noun] +teat tette[Noun] +teat trayon[Noun] +teatime l'heure du the/[Noun] +teats mamelons[Noun] +teats tettes[Noun] +ten dix[Adverb] +tendencies tendances (f)[Noun] +tendency tendance (f)[Noun] +tenderfoot visage pa^le (m)[Noun] +tenderly tendrement[Adverb] +thence de la\[Adverb] +thence pour cette raison[Adverb] +thenceforth de\s lors[Adverb] +thenceforward de\s lors[Adverb] +theocracy the/ocratie[Noun] +theocratic the/ocratique[Adjective] +theodolite the/odolite[Noun] +theologian the/ologien[Noun] +theologians the/ologiens +theological the/ologique[Adjective] +theologically the/ologiquement[Adverb] +theology the/ologie[Noun] +theorem the/ore\me[Noun] +theorems the/ore\mes[Noun] +theoretical the/ore/tique[Adjective] +theoretical the/orique[Adjective] +theoretically the/oriquement[Adverb] +theoretician the/oricien[Noun] +theoretician the/oricienne[Noun] +theoreticians the/oriciennes[Noun] +theoreticians the/oriciens[Noun] +theories the/ories[Noun] +theorist the/oricien[Noun] +theorist the/oricienne[Noun] +theorists the/oriciennes[Noun] +theorists the/oriciens[Noun] +theorize the/oriser[Verb] +thief voleur[Noun] +though cependant, pourtant[Adverb] +though quoique , bien que[Conjunction] +thought pensee,idee[Noun] +thought reflexion; intention, dessein[Noun] +thoughtful pensif, meditatif, reveur[Adjective] +thoughtful serieux, reflechi, prudent[Adjective] +thoughtfully pensivement[Adverb] +thoughtfulness meditation, recueillement[Adjective] +thoughtless irreflechi, etourdi[Adjective] +thoughtlessly etourdiment, a la legere, sans reflexion[Adverb] +thoughtlessness irreflexon, etourderie[Noun] +thousand mille, millier[Noun] +thousandth millieme[Noun] +thrash ecraser qn, rouer qn de coup, [Verb] +thrash se debattre, se demener[Verb] +thread enfiler (une aiguille); se faufiler ; fileter[Verb] +thread filament, fil de soie[Noun] +thread Filet, pas de vis [Noun] +threadbare elime, rape, use[Adjective] +threat menace[Noun] +threaten menacer[Verb] +threatening menacant[Adjective] +threateningly d'un ton menacant[Adverb] +three trois[Article] +tigress tiger[Noun] +today au'jour d'hui[Noun] +toe doigt a pied[Noun] +tradition tradition[Noun] +traditional traditional[Adjective] +trail piste[Noun] +train train[Noun] +trainee stagiare[Noun] +trainer encadreur[Noun] +traitor trai^tre[Noun] +transaction transaction[Noun] +transalpine transalpin[Adjective] +transcribe transcrire[Verb] +transfer transfert[Noun] +translate traduire[Verb] +translation traduction[Noun] +translator traducteur[Noun] +transmit transmettre[Verb] +tree arbre[Noun] +truck camion +two deux[Article] +ubiquitous omnipre/sent[Adjective] +ubiquity ubiquite/[Noun] +udder pis[Noun] +ugh pouah +uglier plus laid[Adjective] +ugliest le plus laid[Adjective] +uglify enlaidir[Verb] +uglily laidement +ugliness laideur[Noun] +ugly laid[Adjective] +ukulele guitare hawai.enne[Noun] +ulcer ulce\re[Noun] +ulcerate ulce/rer[Verb] +ulcerated ulce/reux[Adjective] +ulceration ulce/ration[Noun] +ulcerative ulce/ratif[Adjective] +ulna cubitus[Noun] +ultimo du mois dernier[Adverb] +unemployment chomage[Noun] +vacant (room, seat) libre; (stare) vague; (post) vacant[Adjective] +vacate quitter[Verb] +vacation vacances[Noun] +vaccinate vacciner[Verb] +vaccinated vacciner +vacuum vide; (vacuum cleaner) aspirateur [masc] [Noun] +vacuumed passer a\ l'aspirateur[Verb] +vagina vagin (masc.)[Noun] +vagrant vagabond(e) [m(f)][Noun] +vague vague; (outline, photograph) flou; (absent minded) distrait[Adjective] +vain (hope) vain; (promise) vide; (conceited) vaniteux, [f] -euse [Adjective] +wacky drole[Adjective] +wag remuer[Verb] +walnut la noix[Noun] +warehouse entrepot +warehouse entrepôt[Noun] +warehouses entrepôts[Noun] +wash laver[Verb] +weep pleurer[Verb] +weeping pleurs[Noun] +weeping qui pleure[Adjective] +weeps pleure[Verb] +weepy larmoyant[Adjective] +weepy me/lo[Noun] +weevil charanc,on[Noun] +weft trame[Noun] +weigh mesurer[Verb] +weigh peser[Verb] +weighing pese/e[Noun] +weighings pese/es[Noun] +weighs pe\se[Verb] +weight poids[Noun] +weighted leste/[Adjective] +weighted ponde/re/[Adjective] +weightily avec force[Adverb] +weightily puissamment[Adverb] +weighting lestage[Noun] +weighting plombage[Noun] +weightless e/tat d'apesanteur[Adjective] +weightlessness apesanteur[Noun] +weights attache un poids a\[Verb] +weights se/rie de poids[Noun] +weighty lourd[Adjective] +weighty pesant[Adjective] +weir barrage[Noun] +weird bizarre[Adjective] +weird e/trange[Adjective] +weirdie excentrique[Noun] +weirdies excentriques[Noun] +weirdly e/trangement[Adverb] +weirdness caracte\re e/trange[Noun] +weirdness e/trangete/ inquie/tante[Noun] +weirdo excentrique[Noun] +weirdos excentriques[Noun] +weirs barrages[Noun] +welcome agre/able[Adjective] +welcome bienvenu[Adjective] +welcome bienvenue[Noun] +welcome souhaiter la bienvenue a\[Verb] +where ou\[Adjective] +window la fene^tre[Noun] +window le guichet [tickets, etc.] +windowpane la glace[Noun] +windowpanes les glaces +windows les fene^tres +windshield le parebrise[Noun] +windstorm la tempe^te[Noun] +windup remonter[Verb] +wine le vin[Noun] +wineglass le verre de vin[Noun] +winegrower le vigneron[Noun] +winemaker l'encaveur (m)[Noun] +winemaking la vinification[Noun] +winepress le pressoir[Noun] +wines les vins[Noun] +winey vineux (-se)[Adjective] +wing l'aile (f)[Noun] +winglet l'aileron (m)[Noun] +wink un clin d'oeil[Noun] +winter l'hiver (m) +wipe essuyer +wire fil me/tallique, fil de fer[Noun] +wire telegramme[Noun] +wire telegraphier ; faire l'installation electrique[Verb] +wired branche , sonorise[Adjective] +wireless sans fil[Adjective] +wiring installation electrique[Noun] +wiry raide, rude ; maigre et nerveux +wisdom sagesse[Noun] +wise sage, prudent, savant[Adjective] +wisecrack astuce, sarcasme[Noun] +wisely sagement, prudement[Adverb] +wiser plus sage[Adjective] +wish desir, souhait[Noun] +wish desirer, souhaiter qch[Verb] +wishbone brechet[Noun] +wishes pl de wish, desir[Noun] +wishful that's wishfull thinking (on your part ): tu te fais des illusions[Adjective] +witch sorcie\re[Noun] +witches sorcie\res[Noun] +with avec[Conjunction] +withdraw retirer[Verb] +withdraw se retirer [intr] +without sans +witness te/moigner[Verb] +witness te/moin[Noun] +witnesses te/moins[Noun] +wolverine le carcajou[Noun] +wolverine le glouton[Noun] +world le monde[Noun] +worldwide mondial[Adjective] +xenophobe xe/nophobe[Noun] +xenophobia xénophobie[Noun] +xenophobic xe/nophobe[Adjective] +xerographic xe/rographique[Adjective] +xylem xyle\me[Noun] +xylene xyle\ne[Noun] +xylophone xylophone[Noun] +xylophones xylophone[Noun] +xylophonist joueur (joueuse) de xylophone[Noun] +xylose xylose[Noun] +xylotomic xylotomique[Adjective] +yacht yacht[Noun] +yachting yachting[Noun] +yachtsman yachtsman +yak yack[Noun] +yam patate douce[Noun] +yank tirer d'un coup sec[Verb] +yap japper[Verb] +yard yard (3 ft)[Noun] +yardstick mesure[Noun] +yarn fil[Noun] +yawn bâillement[Noun] +yawn bâiller[Verb] +yawning ba^illement[Noun] +yeah ouais! +year année[Noun] +yearbook annuaire[Noun] +yearlong annuel[Noun] +yearly annuel(le)[Adjective] +yearly annuellement[Adverb] +yearn désirer[Verb] +yearning de/sir[Noun] +yearningly de/sireux[Adjective] +years années[Noun] +yeast levure[Noun] +yell hurlement[Noun] +yell hurler[Verb] +yellow jaune[Adjective] +yellowed jauni[Adjective] +yellowing jaunissant[Adjective] +yellowish jauna^tre[Adjective] +yes oui +yesterday hier[Noun] +yet encore[Adverb] +yew if[Noun] +yield produire[Verb] +yoga yoga[Noun] +yoghurt yaourt[Noun] +yogurt yaourt[Noun] +yoke joug[Noun] +yolk jaune d'oeuf[Noun] +you (formal and/or plural) vous[Pronoun] +you (informal and singular) tu[Pronoun] +young jeune[Adjective] +younger plus jeune[Adjective] +youngster jeune[Noun] +youth jeunesse[Adjective] +youthful juvénile[Adjective] +yuppie yuppie[Noun] +zabaglione sabayon[Noun] +zany dingue[Adjective] +zazen zazen[Noun] +zeal zèle[Noun] +zealous zélé(e)[Adjective] +zebra zèbre[Noun] +zenith zénith[Noun] +zero zero[Noun] +zero zéro +zest piquant[Noun] +zigzag zigzaguer[Verb] +zinc zinc[Noun] +zipper fermeture[Noun] +zodiac zodiaque[Noun] +zodiac zondiaque[Noun] +zone zone[Noun] +zone zone[Noun] +zoo zoo[Noun] +zoology zoologie[Noun] +zoom aller en trombe[Verb] +zucchini courgette[Noun] diff --git a/tcl8.6/pkgs/thread2.8.4/tests/all.tcl b/tcl8.6/pkgs/thread2.8.4/tests/all.tcl new file mode 100644 index 0000000..74aca97 --- /dev/null +++ b/tcl8.6/pkgs/thread2.8.4/tests/all.tcl @@ -0,0 +1,59 @@ +# all.tcl -- +# +# This file contains a top-level script to run all of the Tcl +# tests. Execute it by invoking "source all.test" when running tcltest +# in this directory. +# +# Copyright (c) 1998-1999 by Scriptics Corporation. +# All rights reserved. + +package require tcltest +::tcltest::loadTestedCommands +package require Thread + +set ::tcltest::testSingleFile false +set ::tcltest::testsDirectory [file dir [info script]] + +# We need to ensure that the testsDirectory is absolute +::tcltest::normalizePath ::tcltest::testsDirectory + +puts stdout "Tcl $tcl_patchLevel tests running in interp: [info nameofexecutable]" +puts stdout "Tests running in working dir: $::tcltest::testsDirectory" +if {[llength $::tcltest::skip] > 0} { + puts stdout "Skipping tests that match: $::tcltest::skip" +} +if {[llength $::tcltest::match] > 0} { + puts stdout "Only running tests that match: $::tcltest::match" +} + +if {[llength $::tcltest::skipFiles] > 0} { + puts stdout "Skipping test files that match: $::tcltest::skipFiles" +} +if {[llength $::tcltest::matchFiles] > 0} { + puts stdout "Only sourcing test files that match: $::tcltest::matchFiles" +} + +set timeCmd {clock format [clock seconds]} +puts stdout "Tests began at [eval $timeCmd]" + +# These tests need to know which is the main thread +set ::tcltest::mainThread [thread::id] + +puts stdout "Thread [package provide Thread]" +puts stdout "Mainthread id is $::tcltest::mainThread" + +# Source each of the specified tests +foreach file [lsort [::tcltest::getMatchingFiles]] { + set tail [file tail $file] + puts stdout $tail + if {[catch {source $file} msg]} { + puts stdout $msg + } +} + +# Cleanup +puts stdout "\nTests ended at [eval $timeCmd]" +::tcltest::cleanupTests 1 + +return + diff --git a/tcl8.6/pkgs/thread2.8.4/tests/store-load.tcl b/tcl8.6/pkgs/thread2.8.4/tests/store-load.tcl new file mode 100644 index 0000000..4907349 --- /dev/null +++ b/tcl8.6/pkgs/thread2.8.4/tests/store-load.tcl @@ -0,0 +1,70 @@ +#!/usr/bin/env tclsh + +lappend auto_path . +package require Thread + +if {[llength $argv] != 3} { + puts "Usage: $argv0 handle path times" + puts { + handle + A persistent storage handle (see [tsv::array bind] manpage). + path + The path to file containing lines in the form of "key<tab>val", where + key is a single-word and val is everyting else. + times + The number of times to reload the data from persistent storage. + + This script reads lines of data from <path> and stores them into the + persistent storage described by <handle>. Values for duplicate keys are + handled as a lists. The persistent storage engine is then stress-tested by + reloading the whole store <times> times. + } + exit 1 +} + +lassign $argv handle path times + +### Cleanup +set filename [string range $handle [string first : $handle]+1 end] +file delete -force $filename + +### Load and store tab-separated values +tsv::array bind a $handle +set fd [open $path r] +set start [clock milliseconds] +set pairs 0 +while {[gets $fd line] > 0} { + if {[string index $line 0] eq {#}} { + continue + } + set tab [string first { } $line] + if {$tab == -1} { + continue + } + + set k [string range $line 0 $tab-1] + set v [string range $line $tab+1 end] + + if {![tsv::exists a $k]} { + incr pairs + } + + tsv::lappend a $k $v +} +puts "Stored $pairs pairs in [expr {[clock milliseconds]-$start}] milliseconds" + +tsv::array unbind a +tsv::unset a + +### Reload +set pairs 0 +set iter [time { + tsv::array bind a $handle + set pairs [tsv::array size a] + tsv::array unbind a + tsv::unset a +} $times] +puts "Loaded $pairs pairs $times times at $iter" + +## Dump file stats +puts "File $filename is [file size $filename] bytes long" diff --git a/tcl8.6/pkgs/thread2.8.4/tests/thread.test b/tcl8.6/pkgs/thread2.8.4/tests/thread.test new file mode 100644 index 0000000..9e7d227 --- /dev/null +++ b/tcl8.6/pkgs/thread2.8.4/tests/thread.test @@ -0,0 +1,1201 @@ +# Commands covered: thread +# +# This file contains a collection of tests for one or more of the Tcl +# built-in commands. Sourcing this file into Tcl runs the tests and +# generates output for errors. No output means no errors were found. +# +# Copyright (c) 1996 Sun Microsystems, Inc. +# Copyright (c) 1998-2000 Scriptics Corporation. +# Copyright (c) 2002 ActiveState Corporation. +# +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. + +package require tcltest +namespace import ::tcltest::* +tcltest::loadTestedCommands +package require Thread + +tcltest::testConstraint chanTransfer \ + [expr { $::tcl_platform(platform) == "unix" \ + || $::tcl_patchLevel > "8.4.10"}] + +set dummy [makeFile dummyForTransfer dummyForTransfer] +set tcltest::mainThread [thread::id] + +proc ThreadReap {} { + while {[llength [thread::names]] > 1} { + foreach tid [thread::names] { + if {$tid != $::tcltest::mainThread} { + catch {thread::release -wait $tid} + } + } + } + llength [thread::names] +} + +test thread-2.0 {no global thread command} { + info commands thread +} {} + +test thread-2.84 {thread subcommands} { + set cmds [info commands thread::*] + set idx [lsearch -exact $cmds ::thread::cancel] + lsort [lreplace $cmds $idx $idx] +} {::thread::attach ::thread::broadcast ::thread::cond ::thread::configure ::thread::create ::thread::detach ::thread::errorproc ::thread::eval ::thread::exists ::thread::exit ::thread::id ::thread::join ::thread::mutex ::thread::names ::thread::preserve ::thread::release ::thread::rwmutex ::thread::send ::thread::transfer ::thread::unwind ::thread::wait} + +test thread-3.0 {thread::names initial thread list} { + list [ThreadReap] [llength [thread::names]] +} {1 1} + +test thread-4.0 {thread::create: create server thread} { + ThreadReap + set tid [thread::create] + update + set l [llength [thread::names]] + ThreadReap + set l +} {2} + +test thread-4.1 {thread::create: create one shot thread} { + ThreadReap + thread::create {set x 5} + foreach try {0 1 2 4 5 6} { + # Try various ways to yield + update + after 10 + set l [llength [thread::names]] + if {$l == 1} { + break + } + } + ThreadReap + set l +} {1} + +test thread-4.2 {thread::create - create preservable thread} { + ThreadReap + set tid [thread::create -preserved] + set c [thread::preserve $tid] + thread::release -wait $tid + ThreadReap + set c +} {2} + +test thread-4.3 {thread::create - release a thread} { + ThreadReap + set tid [thread::create {thread::release}] + update + after 10 + set l [llength [thread::names]] + ThreadReap + set l +} {1} + +test thread-4.4 {thread::create - create joinable thread} { + ThreadReap + set tid [thread::create -joinable {set x 5}] + set c [thread::join $tid] + ThreadReap + set c +} {0} + +test thread-4.5 {thread::create - join detached thread} { + ThreadReap + set tid [thread::create] + thread::send -async $tid {after 1000 ; thread::release} + catch {set res [thread::join $tid]} msg + ThreadReap + lrange $msg 0 2 +} {cannot join thread} + +test thread-5.0 {thread::release} { + ThreadReap + set tid [thread::create {thread::release}] + update + after 10 + set l [llength [thread::names]] + ThreadReap + set l +} {1} + +test thread-6.0 {thread::unwind - simple unwind} { + ThreadReap + thread::create {thread::unwind} + update + after 10 + set l [llength [thread::names]] + ThreadReap + set l +} {1} + +test thread-6.1 {thread::unwind - blocked unwind} { + ThreadReap + thread::create {thread::unwind; vwait dummy} + update + after 10 + set l [llength [thread::names]] + ThreadReap + set l +} {2} + +test thread-7.0 {thread::exit} { + ThreadReap + set tid [thread::create -joinable {thread::exit}] + set c [thread::join $tid] + ThreadReap + set c +} {666} + +test thread-7.1 {thread::exit - # args} { + set tid [thread::create] + catch {thread::send $tid {thread::exit 1 0}} msg + set msg +} {wrong # args: should be "thread::exit ?status?"} + +test thread-7.2 {thread::exit - args} { + set tid [thread::create] + catch {thread::send $tid {thread::exit foo}} msg + set msg +} {expected integer but got "foo"} + +test thread-7.3 {thread::exit - status} { + ThreadReap + set tid [thread::create -joinable {thread::exit 0}] + set c [thread::join $tid] + ThreadReap + set c +} {0} + +test thread-8.0 {thread::exists - true} { + ThreadReap + set c [thread::exists [thread::create]] + ThreadReap + set c +} {1} + +test thread-8.1 {thread::exists - false} { + ThreadReap + set tid [thread::create {set x 5}] + update + after 10 + set c [thread::exists $tid] + ThreadReap + set c +} {0} + +test thread-9.0 {thread::id} { + expr {[thread::id] == $::tcltest::mainThread} +} {1} + +test thread-9.1 {thread::id - args} { + set x [catch {thread::id x} msg] + list $x $msg +} {1 {wrong # args: should be "thread::id"}} + +test thread-10.0 {thread::names args} { + set x [catch {thread::names x} msg] + list $x $msg +} {1 {wrong # args: should be "thread::names"}} + +test thread-11.0 {thread::send - no args} { + set x [catch {thread::send} msg] + list $x $msg +} {1 {wrong # args: should be "thread::send ?-async? ?-head? id script ?varName?"}} + +test thread-11.1 {thread::send - simple script} { + ThreadReap + set tid [thread::create] + set five [thread::send $tid {set x 5}] + ThreadReap + set five +} 5 + +test thread-11.2 {thread::send - bad thread id} { + set tid dummy + set x [catch {thread::send $tid {set x 5}} msg] + list $x $msg +} {1 {invalid thread handle "dummy"}} + +test thread-11.3 {thread::send - test TCL_ERROR return code} { + ThreadReap + set tid [thread::create] + set c [thread::send $tid {dummy} msg] + ThreadReap + list $c $msg} {1 {invalid command name "dummy"}} + +test thread-11.4 {thread::send - test TCL_RETURN return code} { + ThreadReap + set tid [thread::create] + set c [thread::send $tid {return} msg] + ThreadReap + list $c $msg +} {2 {}} + +test thread-11.5 {thread::send - test TCL_BREAK return code} { + ThreadReap + set tid [thread::create] + set c [thread::send $tid {break} msg] + ThreadReap + list $c $msg +} {3 {}} + +test thread-11.6 {thread::send - asynchronous send} { + ThreadReap + set tid [thread::create] + thread::send -async $tid {set x 5} + update + after 10 + set five [thread::send $tid {set x}] + ThreadReap + set five +} {5} + +test thread-11.7 {thread::send - async send with event-loop wait} { + ThreadReap + set res {} + set tid [thread::create] + thread::send -async $tid {set x 5} five + vwait five + lappend res $five; set five {} + thread::send -async $tid {set x 5} [binary format cccc 0x66 0x69 0x76 0x65]; # five as byte array without str-rep. + vwait five + lappend res $five; set five {} + ThreadReap + set res +} {5 5} + +test thread-11.7.1 {thread::send - sync send with var} { + ThreadReap + set res {} + set tid [thread::create] + thread::send $tid {set x 5} five + lappend res $five; set five {} + thread::send $tid {set x 5} [binary format cccc 0x66 0x69 0x76 0x65]; # five as byte array without str-rep. + lappend res $five; set five {} + ThreadReap + set res +} {5 5} + +test thread-11.8 {thread::send - send to self directly} { + thread::send [thread::id] {set x 5} five + set five +} {5} + +test thread-11.9 {thread::send - send to self asynchronously} { + set c [catch {thread::send -async [thread::id] {set x 5} five} msg] + list $c $msg +} {1 {can't notify self}} + + +test thread-11.10 {thread::send - preserve errorInfo} { + ThreadReap + set len [llength [thread::names]] + set tid [thread::create] + set c [catch {thread::send $tid {set undef}} msg] + ThreadReap + list $c $msg $errorInfo +} {1 {can't read "undef": no such variable} {can't read "undef": no such variable + while executing +"set undef" + invoked from within +"thread::send $tid {set undef}"}} + +test thread-11.11 {Thread_Send preserve errorCode} { + ThreadReap + set tid [thread::create] + set c [catch {thread::send $tid {error ERR INFO CODE}} msg] + ThreadReap + list $c $msg $errorCode +} {1 ERR CODE} + +test thread-12.0 {thread::wait} { + ThreadReap + set tid [thread::create {set x 5; thread::wait}] + thread::send $tid {set x} five + ThreadReap + set five +} {5} + +test thread-13.0 {thread::broadcast} { + ThreadReap + catch {unset tids} + foreach i {1 2 3 4} { + lappend tids [thread::create] + } + thread::broadcast {set x 5} + update + catch {unset r} + foreach tid $tids { + lappend r [thread::send $tid {if {[info exists x]} {set x}}] + } + ThreadReap + set r +} {5 5 5 5} + +test thread-13.1 {thread::broadcast no args} { + set c [catch {thread::broadcast} msg] + list $c $msg +} {1 {wrong # args: should be "thread::broadcast script"}} + + +test thread-14.0 {thread::eval - no arguments} { + set c [catch {thread::eval} msg] + list $c $msg +} {1 {wrong # args: should be "thread::eval ?-lock <mutexHandle>? arg ?arg...?"}} + +test thread-14.1 {thread::eval - bad arguments} { + set c [catch {thread::eval -lock} msg] + list $c $msg +} {1 {wrong # args: should be "thread::eval ?-lock <mutexHandle>? arg ?arg...?"}} + +test thread-14.2 {thread::eval - missing script argument} { + set c [catch {thread::eval -lock dummy} msg] + list $c $msg +} {1 {wrong # args: should be "thread::eval ?-lock <mutexHandle>? arg ?arg...?"}} + +test thread-14.3 {thread::eval - bad mutex handle} { + set c [catch {thread::eval -lock dummy {set x 5}} msg] + list $c $msg +} {1 {no such mutex "dummy"}} + +test thread-14.4 {thread::eval - nested eval} { + thread::eval {thread::eval {thread::eval {set x 5}}} +} {5} + +test thread-15.0 {thread::configure - bad arguments} { + set c [catch {thread::configure} msg] + list $c $msg +} {1 {wrong # args: should be "thread::configure threadlId ?optionName? ?value? ?optionName value?..."}} + +test thread-15.1 {thread::configure - bad thread id argument} { + set c [catch {thread::configure dummy} msg] + list $c $msg +} {1 {invalid thread handle "dummy"}} + +test thread-15.2 {thread::configure - bad configure option} { + set c [catch {thread::configure [thread::id] -dummy} msg] + list $c $msg +} {1 {bad option "-dummy", should be one of -eventmark, -unwindonerror or -errorstate}} + +test thread-15.3 {thread::configure - read all configure options} { + ThreadReap + set tid [thread::create] + catch {unset opts} + set opts [thread::configure $tid] + ThreadReap + expr {[llength $opts] % 2} +} {0} + +test thread-15.4 {thread::configure - check configure option names} { + ThreadReap + set tid [thread::create] + update + after 10 + catch {unset opts} + array set opts [thread::configure $tid] + ThreadReap + array names opts +} {-errorstate -unwindonerror -eventmark} + +test thread-15.5 {thread::configure - get one config option} { + ThreadReap + set tid [thread::create] + update + after 10 + set l "" + lappend l [thread::configure $tid -eventmark] + lappend l [thread::configure $tid -unwindonerror] + lappend l [thread::configure $tid -errorstate] + ThreadReap + set l +} {0 0 0} + +test thread-15.6 {thread::configure - set -unwindonerror option} { + ThreadReap + set tid [thread::create] + update + after 10 + thread::configure $tid -unwindonerror 1 + set c [catch {thread::send $tid {set dummy}}] + update + after 10 + set e [thread::exists $tid] + ThreadReap + list $c $e +} {1 0} + +test thread-15.7 {thread::configure - set -errorstate option} { + ThreadReap + set tid [thread::create] + update + after 10 + thread::configure $tid -errorstate 1 + set c [thread::send $tid {set dummy} msg] + ThreadReap + list $c $msg +} {1 {thread is in error}} + +test thread-15.8 {thread::configure - set -eventmark option} { + ThreadReap + set tid [thread::create] + update + after 10 + thread::configure $tid -eventmark 1 + thread::send -async $tid {after 2000} + set t1 [clock seconds] + thread::send -async $tid {after 2000} + set t2 [clock seconds] + ThreadReap + expr {($t2 - $t1) >= 2} +} {1} + +test thread-16.0 {thread::errorproc - args} { + set x [catch {thread::errorproc foo bar} msg] + list $x $msg +} {1 {wrong # args: should be "thread::errorproc ?proc?"}} + +test thread-16.1 {thread::errorproc - errorproc change} { + thread::errorproc foo + thread::errorproc ThreadError + set new [thread::errorproc] +} {ThreadError} + +test thread-16.2 {thread::errorproc - async reporting} { + set etid "" + set emsg "" + proc myerrproc {tid msg} { + global etid emsg + set etid $tid + set emsg $msg + } + ThreadReap + thread::errorproc myerrproc + set tid [thread::create] + update + after 10 + thread::send -async $tid {set x} + after 10 + update + ThreadReap + list [expr {$etid == $tid}] $emsg +} {1 {can't read "x": no such variable + while executing +"set x"}} + +test thread-17.1 {thread::transfer - channel lists} {chanTransfer} { + ThreadReap + set tid [thread::create] + set file [open $dummy r] + set res [regexp $file [file channels]] + thread::transfer $tid $file + lappend res [regexp $file [file channels]] + lappend res [regexp $file [thread::send $tid {file channels}]] + thread::send $tid "close $file" + ThreadReap + set res +} {1 0 1} + +test thread-17.2 {thread::transfer - target thread dying} {chanTransfer} { + ThreadReap + set tid [thread::create] + set file [open $dummy r] + thread::send -async $tid {after 3000 ; thread::release} + catch {thread::transfer $tid $file} msg + close $file + ThreadReap + set msg +} {transfer failed: target thread died} + +test thread-17.3 {thread::transfer - clearing of fileevents} {chanTransfer} { + proc _HandleIt_ {} { + global gotEvents tid file + if {$gotEvents == 0} { + thread::transfer $tid $file + # From now on no events should be delivered anymore, + # restricting the end value to 1 + } + incr gotEvents + } + ThreadReap + set tid [thread::create] + set file [open $dummy r] + set gotEvents 0 + fileevent $file readable _HandleIt_ + vwait gotEvents + thread::send $tid "close $file" + ThreadReap + set gotEvents +} {1} + +test thread-17.4 {thread::transfer - file - readable?} {chanTransfer} { + ThreadReap + set tid [thread::create] + set file [open $dummy r] + set res [regexp $file [file channels]] + thread::transfer $tid $file + set res [string length [thread::send $tid "read -nonewline $file"]] + thread::send $tid "close $file" + ThreadReap + set res +} [string length [::tcltest::viewFile dummyForTransfer]] + +test thread-17.5 {thread::transfer - file - closeable?} {chanTransfer} { + set tid [thread::create] + set file [open $dummy r] + set res [regexp $file [file channels]] + thread::transfer $tid $file + set res [thread::send $tid "close $file"] + ThreadReap + set res +} {} + +test thread-17.6 {thread::transfer - socket - readable?} {chanTransfer} { + set tid [thread::create] + set lsock "" + proc accept {sock host port} {global lsock ; set lsock $sock} + set listener [socket -server accept 0] + set port [lindex [fconfigure $listener -sockname] 2] + set socket [socket localhost $port] + vwait lsock + + thread::transfer $tid $socket + + puts $lsock hello + flush $lsock + + set res [thread::send $tid [list gets $socket]] + thread::send $tid [list close $socket] + + ThreadReap + close $listener + close $lsock + + set res +} {hello} + +test thread-17.7 {thread::transfer - socket - closeable?} {chanTransfer} { + set tid [thread::create] + set lsock "" + proc accept {sock host port} {global lsock ; set lsock $sock} + set listener [socket -server accept 0] + set port [lindex [fconfigure $listener -sockname] 2] + set socket [socket localhost $port] + vwait lsock + + thread::transfer $tid $socket + + set res [thread::send $tid "regexp {$socket} \[file channels\]"] + lappend res [thread::send $tid [list close $socket]] + lappend res [thread::send $tid "regexp {$socket} \[file channels\]"] + + ThreadReap + close $listener + close $lsock + + set res +} {1 {} 0} + +# We cannot test console channels, nor serials. Because we do not +# really know if they are available, and under what names. But a pipe +# channel, which uses the same type of code is something we can +# do. Lucky us. + +test thread-17.8 {thread::transfer - pipe - readable?} {chanTransfer} { + set tid [thread::create] + + set s [makeFile { + puts hello + flush stdout + exit + } pscript] + set pipe [open "|[info nameofexecutable] $s" r] + + thread::transfer $tid $pipe + + thread::send $tid [list set pipe $pipe] + + set res [thread::send $tid {gets $pipe}] + thread::send $tid {catch {close $pipe}} + + ThreadReap + removeFile pscript + + set res +} {hello} + +# The difference between 9 and 10 is the location of the close +# operation. For 9 it is the original thread, for 10 the other +# thread. 10 currently fails. It seems to be some signal stuff. + +test thread-17.9 {thread::transfer - pipe - closable?} {chanTransfer} { + set tid [thread::create] + + set s [makeFile { + fileevent stdin readable {if {[eof stdin]} {exit 0} ; gets stdin} + vwait forever + exit 0 + } pscript] + set pipe [open "|[info nameofexecutable] $s" r+] + thread::send $tid [list set chan $pipe] + + thread::transfer $tid $pipe + thread::send $tid {thread::detach $chan} + thread::attach $pipe + + set res [regexp $pipe [file channels]] + lappend res [close $pipe] + lappend res [regexp $pipe [file channels]] + + ThreadReap + removeFile pscript + + set res +} {1 {} 0} + +test thread-17.10 {thread::transfer - pipe - closable?} {chanTransfer} { + + set tid [thread::create] + + set s [makeFile { + fileevent stdin readable {if {[eof stdin]} {exit 0} ; gets stdin} + vwait forever + exit 0 + } pscript] + set pipe [open "|[info nameofexecutable] $s" r+] + thread::send $tid [list set chan $pipe] + + thread::transfer $tid $pipe + + set res [thread::send $tid {regexp $chan [file channels]}] + + if {[catch { + # This can fail on Linux, because there a thread cannot 'wait' on + # the children of a different thread (in the same process). This + # is for Linux < 2.4. For 2.4 it should be possible, but the + # language is cautionary, so it may still fail. + + lappend res [thread::send $tid {close $chan}] + }]} { + # Fake a result + lappend res {} + } + + lappend res [thread::send $tid {regexp $chan [file channels]}] + + ThreadReap + removeFile pscript + + set res +} {1 {} 0} + +test thread-17.11a {thread::transfer - pipe - readable event - no transfer} { + set tid [thread::create] + + set s [makeFile { + after 5000 {exit 0} + fileevent stdin readable { + if {[eof stdin]} {exit 0} + if {[gets stdin line] <0} return + puts response + } + vwait forever + exit 0 + } pscript] ;# {} + + set pipe [open "|[info nameofexecutable] $s" r+] + + fconfigure $pipe -blocking 0 + fileevent $pipe readable {read $pipe ; set cond ok} + after 3000 {set cond timeout} + + puts $pipe tick ; flush $pipe + + vwait ::cond + catch {close $pipe} + removeFile pscript + + set cond +} ok + +test thread-17.11b {thread::transfer - pipe - readable event - with transfer} { + set tid [thread::create] + + set s [makeFile { + after 5000 {exit 0} + fileevent stdin readable { + if {[eof stdin]} {exit 0} + if {[gets stdin line] <0} return + puts response + } + vwait forever + exit 0 + } pscript] ;# {} + set pipe [open "|[info nameofexecutable] $s" r+] + + thread::transfer $tid $pipe + + thread::send $tid [list set chan $pipe] + set cond [thread::send $tid { + fconfigure $chan -blocking 0 + fileevent $chan readable {read $chan ; set cond ok} + after 3000 {set cond timeout} + + puts $chan tick ; flush $chan + + vwait ::cond + catch {close $pipe} + set cond + }] + + ThreadReap + removeFile pscript + + set cond +} ok + + +test thread-18.0 {thread::detach - args} { + set x [catch {thread::detach} msg] + list $x $msg +} {1 {wrong # args: should be "thread::detach channel"}} + + +test thread-18.1 {thread::detach - channel} { + global fd + set fd [open $dummy r] + set r1 [regexp $fd [file channels]] + thread::detach $fd + set r2 [regexp $fd [file channels]] + list $r1 $r2 +} {1 0} + +test thread-18.2 {thread::attach - in different thread} { + global fd + ThreadReap + set tid [thread::create] + thread::send $tid "thread::attach $fd" + set r1 [thread::send $tid "regexp $fd \[file channels\]"] + thread::send $tid "thread::detach $fd" + list $r1 +} {1} + +test thread-18.3 {thread::attach - in same thread} { + global fd + thread::attach $fd + set r1 [regexp $fd [file channels]] + close $fd + set r1 +} {1} + +test thread-19.0 {thread::mutex - args} { + set x [catch {thread::mutex} msg] + list $x $msg +} {1 {wrong # args: should be "thread::mutex option ?args?"}} + +test thread-19.1 {thread::mutex - command options} { + set x [catch {thread::mutex dummy} msg] + list $x $msg +} {1 {bad option "dummy": must be create, destroy, lock, or unlock}} + +test thread-19.2 {thread::mutex - more command options} { + set x [catch {thread::mutex create -dummy} msg] + list $x $msg +} {1 {wrong # args: should be "thread::mutex create ?-recursive?"}} + + +test thread-19.3 {thread::mutex - create exclusive mutex} { + set emutex [thread::mutex create] + set c [regexp {mid[0-9]+} $emutex] + thread::mutex destroy $emutex + set c +} {1} + +test thread-19.4 {thread::mutex - create recursive mutex} { + set rmutex [thread::mutex create -recursive] + set c [regexp {rid[0-9]+} $rmutex] + thread::mutex destroy $rmutex + set c +} {1} + +test thread-19.5 {thread::mutex - lock/unlock exclusive mutex} { + set emutex [thread::mutex create] + thread::mutex lock $emutex + thread::mutex unlock $emutex + thread::mutex destroy $emutex +} {} + +test thread-19.6 {thread::mutex - deadlock exclusive mutex} { + set emutex [thread::mutex create] + thread::mutex lock $emutex + set x [catch {thread::mutex lock $emutex} msg] + thread::mutex unlock $emutex + thread::mutex destroy $emutex + list $x $msg +} {1 {locking the same exclusive mutex twice from the same thread}} + +test thread-19.7 {thread::mutex - lock invalid mutex} { + set x [catch {thread::mutex lock dummy} msg] + list $x $msg +} {1 {no such mutex "dummy"}} + +test thread-19.8 {thread::mutex - lock/unlock recursive mutex} { + set rmutex [thread::mutex create -recursive] + thread::mutex lock $rmutex + thread::mutex unlock $rmutex + thread::mutex destroy $rmutex +} {} + +test thread-19.9 {thread::mutex - deadlock exclusive mutex} { + set rmutex [thread::mutex create -recursive] + thread::mutex lock $rmutex + set x [catch {thread::mutex lock $rmutex} msg] + thread::mutex unlock $rmutex + thread::mutex unlock $rmutex + thread::mutex destroy $rmutex + list $x $msg +} {0 {}} + +test thread-19.10 {thread::mutex - destroy locked exclusive mutex} { + set emutex [thread::mutex create] + thread::mutex lock $emutex + set x [catch {thread::mutex destroy $emutex} msg] + thread::mutex unlock $emutex + thread::mutex destroy $emutex + list $x $msg +} {1 {mutex is in use}} + +test thread-19.11 {thread::mutex - destroy locked recursive mutex} { + set rmutex [thread::mutex create -recursive] + thread::mutex lock $rmutex + set x [catch {thread::mutex destroy $rmutex} msg] + thread::mutex unlock $rmutex + thread::mutex destroy $rmutex + list $x $msg +} {1 {mutex is in use}} + +test thread-19.12 {thread::mutex - lock exclusive between threads} { + ThreadReap + set tid [thread::create] + set emutex [thread::mutex create] + thread::send -async $tid [subst { + thread::mutex lock $emutex + after 2000 + thread::mutex unlock $emutex + }] + update + after 10 + set time1 [clock seconds] + thread::mutex lock $emutex + set time2 [clock seconds] + thread::mutex unlock $emutex + ThreadReap + thread::mutex destroy $emutex + expr {($time2 - $time1) >= 1} +} {1} + +test thread-19.13 {thread::mutex - lock args} { + set x [catch {thread::mutex lock} msg] + list $x $msg +} {1 {wrong # args: should be "thread::mutex lock mutexHandle"}} + +test thread-19.14 {thread::mutex - unlock args} { + set x [catch {thread::mutex unlock} msg] + list $x $msg +} {1 {wrong # args: should be "thread::mutex unlock mutexHandle"}} + +test thread-19.15 {thread::mutex - destroy args} { + set x [catch {thread::mutex destroy} msg] + list $x $msg +} {1 {wrong # args: should be "thread::mutex destroy mutexHandle"}} + +test thread-20.0 {thread::rwmutex - args} { + set x [catch {thread::rwmutex} msg] + list $x $msg +} {1 {wrong # args: should be "thread::rwmutex option ?args?"}} + +test thread-20.1 {thread::rwmutex - command options} { + set x [catch {thread::rwmutex dummy} msg] + list $x $msg +} {1 {bad option "dummy": must be create, destroy, rlock, wlock, or unlock}} + +test thread-20.2 {thread::rwmutex - more command options} { + set x [catch {thread::rwmutex create dummy} msg] + list $x $msg +} {1 {wrong # args: should be "thread::rwmutex create"}} + +test thread-20.3 {thread::rwmutex - more command options} { + set x [catch {thread::rwmutex create dummy} msg] + list $x $msg +} {1 {wrong # args: should be "thread::rwmutex create"}} + +test thread-20.4 {thread::rwmutex - mutex handle} { + set rwmutex [thread::rwmutex create] + set c [regexp {wid[0-9]+} $rwmutex] + thread::rwmutex destroy $rwmutex + set c +} {1} + +test thread-20.5 {thread::rwmutex - bad handle} { + set x [catch {thread::rwmutex rlock dummy} msg] + list $x $msg +} {1 {no such mutex "dummy"}} + +test thread-20.6 {thread::mutex - destroy readlocked mutex} { + set rwmutex [thread::rwmutex create] + thread::rwmutex rlock $rwmutex + set x [catch {thread::rwmutex destroy $rwmutex} msg] + thread::rwmutex unlock $rwmutex + thread::rwmutex destroy $rwmutex + list $x $msg +} {1 {mutex is in use}} + +test thread-20.7 {thread::mutex - destroy writelocked mutex} { + set rwmutex [thread::rwmutex create] + thread::rwmutex wlock $rwmutex + set x [catch {thread::rwmutex destroy $rwmutex} msg] + thread::rwmutex unlock $rwmutex + thread::rwmutex destroy $rwmutex + list $x $msg +} {1 {mutex is in use}} + +test thread-20.8 {thread::rwmutex - readlock mutex} { + ThreadReap + set tid [thread::create] + set rwmutex [thread::rwmutex create] + thread::send -async $tid [subst { + thread::rwmutex rlock $rwmutex + after 1000 + thread::rwmutex unlock $rwmutex + }] + update + after 10 + set time1 [clock seconds] + thread::rwmutex rlock $rwmutex + set time2 [clock seconds] + thread::rwmutex unlock $rwmutex + ThreadReap + thread::rwmutex destroy $rwmutex + expr {($time2 - $time1) < 1} +} {1} + +test thread-20.9 {thread::rwmutex - writelock mutex} { + ThreadReap + set tid [thread::create] + set rwmutex [thread::rwmutex create] + thread::send -async $tid [subst { + thread::rwmutex wlock $rwmutex + after 2000 + thread::rwmutex unlock $rwmutex + }] + update + after 10 + set time1 [clock seconds] + thread::rwmutex rlock $rwmutex + set time2 [clock seconds] + thread::rwmutex unlock $rwmutex + ThreadReap + thread::rwmutex destroy $rwmutex + expr {($time2 - $time1) >= 1} +} {1} + +test thread-20.10 {thread::rwmutex - readlock args} { + set x [catch {thread::rwmutex rlock} msg] + list $x $msg +} {1 {wrong # args: should be "thread::rwmutex rlock mutexHandle"}} + +test thread-20.11 {thread::rwmutex - writelock args} { + set x [catch {thread::rwmutex wlock} msg] + list $x $msg +} {1 {wrong # args: should be "thread::rwmutex wlock mutexHandle"}} + +test thread-20.12 {thread::rwmutex - unlock args} { + set x [catch {thread::rwmutex unlock} msg] + list $x $msg +} {1 {wrong # args: should be "thread::rwmutex unlock mutexHandle"}} + +test thread-20.13 {thread::rwmutex - destroy args} { + set x [catch {thread::rwmutex destroy} msg] + list $x $msg +} {1 {wrong # args: should be "thread::rwmutex destroy mutexHandle"}} + +test thread-20.14 {thread::mutex - write-lock write-locked mutex} { + set rwmutex [thread::rwmutex create] + thread::rwmutex wlock $rwmutex + set x [catch {thread::rwmutex wlock $rwmutex} msg] + thread::rwmutex unlock $rwmutex + thread::rwmutex destroy $rwmutex + list $x $msg +} {1 {write-locking the same read-write mutex twice from the same thread}} + +test thread-20.15 {thread::mutex - read-lock write-locked mutex} { + set rwmutex [thread::rwmutex create] + thread::rwmutex wlock $rwmutex + set x [catch {thread::rwmutex rlock $rwmutex} msg] + thread::rwmutex unlock $rwmutex + thread::rwmutex destroy $rwmutex + list $x $msg +} {1 {read-locking already write-locked mutex from the same thread}} + +test thread-20.16 {thread::mutex - unlock not locked mutex} { + set rwmutex [thread::rwmutex create] + set x [catch {thread::rwmutex unlock $rwmutex} msg] + thread::rwmutex destroy $rwmutex + list $x $msg +} {1 {mutex is not locked}} + +test thread-21.0 {thread::cond - args} { + set x [catch {thread::cond} msg] + list $x $msg +} {1 {wrong # args: should be "thread::cond option ?args?"}} + +test thread-21.1 {thread::cond - command options} { + set x [catch {thread::cond dummy} msg] + list $x $msg +} {1 {bad option "dummy": must be create, destroy, notify, or wait}} + +test thread-21.2 {thread::cond - more command options} { + set x [catch {thread::cond create dummy} msg] + list $x $msg +} {1 {wrong # args: should be "thread::cond create"}} + +test thread-21.3 {thread::cond - cond handle} { + set cond [thread::cond create] + set c [regexp {cid[0-9]+} $cond] + thread::cond destroy $cond + set c +} {1} + +test thread-21.4 {thread::cond - destroy args} { + set x [catch {thread::cond destroy} msg] + list $x $msg +} {1 {wrong # args: should be "thread::cond destroy condHandle ?args?"}} + +test thread-21.5 {thread::cond - destroy bad handle} { + set x [catch {thread::cond destroy dummy} msg] + list $x $msg +} {1 {no such condition variable "dummy"}} + +test thread-21.6 {thread::cond - notify args} { + set x [catch {thread::cond notify} msg] + list $x $msg +} {1 {wrong # args: should be "thread::cond notify condHandle ?args?"}} + +test thread-21.7 {thread::cond - wait args} { + set x [catch {thread::cond wait} msg] + list $x $msg +} {1 {wrong # args: should be "thread::cond wait condHandle ?args?"}} + +test thread-21.8 {thread::cond - wait bad handle} { + set x [catch {thread::cond wait dummy} msg] + list $x $msg +} {1 {no such condition variable "dummy"}} + +test thread-21.9 {thread::cond - wait no mutex} { + set cond [thread::cond create] + set x [catch {thread::cond wait $cond} msg] + thread::cond destroy $cond + list $x $msg +} {1 {wrong # args: should be "thread::cond wait condHandle mutexHandle ?timeout?"}} + +test thread-21.10 {thread::cond - wait bad mutex} { + set cond [thread::cond create] + set x [catch {thread::cond wait $cond dummy} msg] + thread::cond destroy $cond + list $x $msg +} {1 {no such mutex "dummy"}} + +test thread-21.11 {thread::cond - wait unlocked mutex} { + set cond [thread::cond create] + set emutex [thread::mutex create] + set x [catch {thread::cond wait $cond $emutex} msg] + thread::cond destroy $cond + thread::mutex destroy $emutex + list $x $msg +} {1 {mutex not locked or wrong type}} + +test thread-21.12 {thread::cond - wait locked mutex from wrong thread} { + ThreadReap + set tid [thread::create] + set emutex [thread::mutex create] + set cond [thread::cond create] + thread::mutex lock $emutex + thread::send -async $tid [subst -nocommands { + set code [catch {thread::cond wait $cond $emutex 1000} result] + }] + update + after 20 + thread::cond notify $cond + set c [thread::send $tid "set code"] + set r [thread::send $tid "set result"] + ThreadReap + thread::cond destroy $cond + thread::mutex unlock $emutex + thread::mutex destroy $emutex + list $c $r +} {1 {mutex not locked or wrong type}} + +test thread-21.13 {thread::cond - wait recursive mutex} { + set cond [thread::cond create] + set rmutex [thread::mutex create -recursive] + set x [catch {thread::cond wait $cond $rmutex} msg] + thread::cond destroy $cond + thread::mutex destroy $rmutex + list $x $msg +} {1 {mutex not locked or wrong type}} + +test thread-21.14 {thread::cond - wait readwrite mutex} { + set cond [thread::cond create] + set rwmutex [thread::rwmutex create] + set x [catch {thread::cond wait $cond $rwmutex} msg] + thread::cond destroy $cond + thread::rwmutex destroy $rwmutex + list $x $msg +} {1 {mutex not locked or wrong type}} + +test thread-21.15 {thread::cond - regular timed wait} { + ThreadReap + set tid [thread::create] + set emutex [thread::mutex create] + set cond [thread::cond create] + thread::send -async $tid [subst { + thread::mutex lock $emutex + thread::cond wait $cond $emutex 2000 + thread::mutex unlock $emutex + set test 1 + }] + update + after 10 + set time1 [clock seconds] + thread::cond notify $cond + set c [thread::send $tid "info exists test"] + set time2 [clock seconds] + ThreadReap + thread::mutex destroy $emutex + thread::cond destroy $cond + list $c [expr {($time2 - $time1) < 2}] +} {1 1} + +test thread-21.16 {thread::cond - delete waited variable} { + ThreadReap + set tid [thread::create] + set emutex [thread::mutex create] + set cond [thread::cond create] + thread::send -async $tid [subst { + thread::mutex lock $emutex + thread::cond wait $cond $emutex 500 + thread::mutex unlock $emutex + }] + update + after 10 + set c1 [catch {thread::cond destroy $cond} r1] + thread::cond notify $cond + after 1000 + set c2 [catch {thread::cond destroy $cond} r2] + ThreadReap + thread::mutex destroy $emutex + list $c1 $c2 $r1 $r2 +} {1 0 {condition variable is in use} {}} + +removeFile dummyForTransfer +::tcltest::cleanupTests diff --git a/tcl8.6/pkgs/thread2.8.4/tests/tkt-84be1b5a73.test b/tcl8.6/pkgs/thread2.8.4/tests/tkt-84be1b5a73.test new file mode 100644 index 0000000..946c6db --- /dev/null +++ b/tcl8.6/pkgs/thread2.8.4/tests/tkt-84be1b5a73.test @@ -0,0 +1,25 @@ +package require tcltest +namespace import ::tcltest::* +tcltest::loadTestedCommands +package require Thread + +# This test used to segfault before commit f4c95731c0. +test tkt-84be1b5a73 {Ticket 84be1b5a73} -body { + set t [thread::create] + set resultvar() {} + + trace add variable resultvar() write { + unset -nocomplain resultvar() + list} + + proc errorproc {tid einfo} {} + thread::errorproc errorproc + thread::send -async $t { + error "" + } resultvar() + + after 1000 { + set forever 1 + } + vwait forever +} -returnCodes 0 diff --git a/tcl8.6/pkgs/thread2.8.4/tests/tpool.test b/tcl8.6/pkgs/thread2.8.4/tests/tpool.test new file mode 100644 index 0000000..a09c863 --- /dev/null +++ b/tcl8.6/pkgs/thread2.8.4/tests/tpool.test @@ -0,0 +1 @@ +return diff --git a/tcl8.6/pkgs/thread2.8.4/tests/tsv.test b/tcl8.6/pkgs/thread2.8.4/tests/tsv.test new file mode 100644 index 0000000..d25b052 --- /dev/null +++ b/tcl8.6/pkgs/thread2.8.4/tests/tsv.test @@ -0,0 +1,107 @@ +package require tcltest +namespace import ::tcltest::* +tcltest::loadTestedCommands +package require Thread + +set backends {gdbm lmdb} + +foreach b $backends { + testConstraint have_$b [expr {$b in [tsv::handlers]}] +} + +foreach backend $backends { + set db "data" + file delete -force $db + set ::handle $backend:$db + + proc setup {} { + tsv::array bind a $::handle + } + proc cleanup {} { + tsv::array unbind a + } + + test tsv-$backend-1.0 {tsv::array isboud} \ + -constraints have_$backend \ + -setup { + setup + } -body { + tsv::array isbound a + } -cleanup { + cleanup + } -result {1} + + test tsv-$backend-1.1 {tsv::array bind - empty} \ + -constraints have_$backend \ + -setup { + setup + } -body { + tsv::array names b + } -cleanup { + cleanup + } -result {} + + test tsv-$backend-1.2 {tsv::set} \ + -constraints have_$backend \ + -setup { + setup + } -body { + tsv::set a Key Val + } -cleanup { + cleanup + } -result {Val} + + test tsv-$backend-1.3 {tsv::get - previously set was persisted} \ + -constraints have_$backend \ + -setup { + setup + } -body { + tsv::get a Key + } -cleanup { + cleanup + } -result {Val} + + test tsv-$backend-1.4 {tsv::array names - previously set was persisted} \ + -constraints have_$backend \ + -setup { + setup + } -body { + tsv::array names a + } -cleanup { + cleanup + } -result {Key} + + test tsv-$backend-1.5 {tsv::exists - previously set exists} \ + -constraints have_$backend \ + -setup { + setup + } -body { + tsv::exists a Key + } -cleanup { + cleanup + } -result {1} + + test tsv-$backend-1.6 {tsv::pop - get previously set} \ + -constraints have_$backend \ + -setup { + setup + } -body { + tsv::pop a Key + } -cleanup { + cleanup + } -result {Val} + + test tsv-$backend-1.7 {tsv::exists - popped was removed} \ + -constraints have_$backend \ + -setup { + setup + } -body { + tsv::exists a Key + } -cleanup { + cleanup + } -result {0} + + file delete -force $db +} + +::tcltest::cleanupTests diff --git a/tcl8.6/pkgs/thread2.8.4/tests/ttrace.test b/tcl8.6/pkgs/thread2.8.4/tests/ttrace.test new file mode 100644 index 0000000..a09c863 --- /dev/null +++ b/tcl8.6/pkgs/thread2.8.4/tests/ttrace.test @@ -0,0 +1 @@ +return diff --git a/tcl8.6/pkgs/thread2.8.4/unix/CONFIG b/tcl8.6/pkgs/thread2.8.4/unix/CONFIG new file mode 100644 index 0000000..cd3f23f --- /dev/null +++ b/tcl8.6/pkgs/thread2.8.4/unix/CONFIG @@ -0,0 +1,53 @@ +#!/bin/sh +# +# This file contains collection of configure directives +# for building the Threading extension. +# +# Comment-out next line if building with GCC compiler. +# +# CC=gcc; export CC +# +# +# Tcl on Unix (uses public Tcl library) +# ---------------------------------------------------- +# ../configure --enable-threads +# +# As of 2.6, the threading extension supports persistent +# shared variables. As an working example of this, there +# is a simple wrapper for the popular Gdbm library. +# Uncomment the following line if you like to compile the +# Gdbm wrapper for persistent shared variables. +# +# ../configure --enable-threads --with-gdbm +# +# If your Gdbm library is not installed in one of the +# default system locations (/usr/lib, /usr/local/lib ...) +# please use following directive. Note that both library +# file *and* includes should be located in "/my/gdbm". +# Of course, you have to replace the "/my/gdbm" below +# with the exact location, as found in your system: +# +# ../configure --enable-threads --with-gdbm=/my/gdbm +# +# +# AOLserver 4.X; Uses public Tcl library. +# ---------------------------------------------------- +# nsdir="/usr/local/naviserver" +# ../configure --enable-threads \ +# --with-naviserver=$nsdir \ +# --prefix=$nsdir --exec-prefix=$nsdir +# +# NaviServer/AOLserver uses its own package loading mechanism. +# To load, just do "ns_eval package require Thread" +# at the NaviServer/AOLserver startup or later from any thread. +# +# +# Mac OS X; Uses public Tcl library. +# ---------------------------------------------------- +# ../configure --enable-threads \ +# --mandir=/usr/local/share/man \ +# --libdir=/Library/Tcl \ +# --with-tcl=/Library/Frameworks/Tcl.framework \ +# --with-tclinclude=/Library/Frameworks/Tcl.framework/Headers +# +# EOF diff --git a/tcl8.6/pkgs/thread2.8.4/unix/README b/tcl8.6/pkgs/thread2.8.4/unix/README new file mode 100644 index 0000000..3b5e1db --- /dev/null +++ b/tcl8.6/pkgs/thread2.8.4/unix/README @@ -0,0 +1,70 @@ + +I. Building the Tcl thread extension for Unix +============================================= + +Extension can be compiled on several Unix derivates including various +distributions of Linux. Build process is pretty straightforward. I've +checked some versions of Solaris, Linux and Darwin, but the extension +should compile without problems on any Unix-like operating system +with a proper pthreads library implementation. + +To build on Unix-like operating systems, start with the CONFIG script +and see if there is already a combination of the "configure" options +which may satisfy your needs. If not, you can run the configure script +located in the root of the distribution directory with a choice of +supported options yourself. If yes, you can uncomment corresponding +lines from the CONFIG script and do: + + % sh CONFIG + +Either way, this will create a Makefile which you use to run "make" and +"make install". +You can use "make clean" to clean the directory from temporary compilation +files and/or "make distclean" to additionaly remove local config files. +You might want to do "make test" before doing the "make install" in order +to run the regression tests on the package. + +To explore other building options, look into the CONFIG file for more +information. + + +Note for NaviServer/AOLserver users +------------------------ + +The extension can be compiled as a loadable module for the +NaviServer/AOLserver version 4.0 or higher. In order to do this, +use "--with-naviserver" configure option to specify the directory +containing the NaviServer/AOLserver distribution. The CONFIG script +has an example how to invoke configure in order to build the +extension as NaviServer/AOLserver module. Note, however, that +"make install" and "make test" targets are still not supported for +NaviServer/AOLserver builds. This will be corrected in one of +the future releases. + +To fine-tune, you might also want to make the tsv::* commands replace +the NaviServer/AOLserver built-in nsv_* family of commands, since +they are API compatible and provide richer command set plus advanced +shared-object storage of shared data. Go to the generic/threadSvCmd.h +file and look at the beginning of the file for the: + +/* #define NSV_COMPAT 1 */ + +So, uncomment the line, recompile and there you go. + + +II. Building optional support libraries +======================================= + +As of 2.6 release, this extension supports persistent shared variables. +To use this functionality, you might need to download and compile some +other supporting libraries. Currently, there is a simple implementation +of shared variable persistency built atop of popular GNU Gdbm package. +You can obtain the latest version of the Gdbm package from the GNU +website at: http://www.gnu.org/software/gdbm/gdbm.html +To compile with GNU Gdbm support you must configure with --with-gdbm +switch. This option, if used, will try to locate the Gdbm library on +your system at couple of standard locations. You might override this +behaviour by giving --with-gdbm=/some/dir. Note that both library file +and the include file must then reside in this directory. + +-EOF- diff --git a/tcl8.6/pkgs/thread2.8.4/unix/threadUnix.c b/tcl8.6/pkgs/thread2.8.4/unix/threadUnix.c new file mode 100644 index 0000000..52d1530 --- /dev/null +++ b/tcl8.6/pkgs/thread2.8.4/unix/threadUnix.c @@ -0,0 +1,27 @@ +/* + * threadUnix.c -- + * + * Unix specific aspects for the thread extension. + * + * see http://dev.activestate.com/doc/howto/thread_model.html + * + * Some of this code is based on work done by Richard Hipp on behalf of + * Conservation Through Innovation, Limited, with their permission. + * + * Copyright (c) 1998 by Sun Microsystems, Inc. + * Copyright (c) 1999,2000 by Scriptics Corporation. + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + */ + +#include "../generic/tclThread.h" + +/* EOF $RCSfile: threadUnix.c,v $ */ + +/* Emacs Setup Variables */ +/* Local Variables: */ +/* mode: C */ +/* indent-tabs-mode: nil */ +/* c-basic-offset: 4 */ +/* End: */ diff --git a/tcl8.6/pkgs/thread2.8.4/win/CONFIG b/tcl8.6/pkgs/thread2.8.4/win/CONFIG new file mode 100644 index 0000000..471d89e --- /dev/null +++ b/tcl8.6/pkgs/thread2.8.4/win/CONFIG @@ -0,0 +1,21 @@ +# +# This is how I run configure. You'll want to change the +# pathnames to match your system, of course. +# +# Remember that if you use the --enable-sybols, you need to +# use the thread25d.dll in a tclsh that has also been compiled +# with symbols (e.g., tclsh84g.exe or tclsh84d.exe). +# If you want to build both debug and non-debug versions, then +# create "debug" and "release" directories and run configure +# from in those directories with the appropriate flags. +# +# Note the CC=gcc must be set *before* the "configure" is ran. +# This is really needed, otherwise configure will not be able +# to compile the small test file which checks the presence +# of the MinGW build environment. It is *not* enough to use +# "--enable-gcc" configure option; you *need* to define CC. +# + +export CC=gcc +sh ../configure --enable-threads --with-tcl=e:/tcl/win + diff --git a/tcl8.6/pkgs/thread2.8.4/win/README.txt b/tcl8.6/pkgs/thread2.8.4/win/README.txt new file mode 100644 index 0000000..91cce56 --- /dev/null +++ b/tcl8.6/pkgs/thread2.8.4/win/README.txt @@ -0,0 +1,67 @@ + +I. Building the Tcl thread extension for Windows +================================================ + +Thread extension supports two build options: + + +o. MinGW builds: +---------------- + +The extension can be compiled under Windows using the +MinGW (http://www.mingw.org) environment. You can also +download the ready-to-go copy of the MinGW from the +same place you've downloaded this extension. + +You should compile the Tcl core with MinGW first. After +that, you can compile the extension by running the +configure/make from this directory. You can also use the +CONFIG script to do this. You might want to edit the +script to match your environment and then just do: + + sh CONFIG + +This should go smoothly, once you got Tcl core compiled ok. + + +o. Microsoft MSVC++ build: +-------------------------- + +Files in this directory may be useful if you have not set up +your TEA (i.e., MinGW) environment and you're using the MSVC++ +from Micro$oft. + +To build the extension invoke the following command: + + nmake -f makefile.vc INSTALLDIR=<path-to-installed-tcl> + +INSTALLDIR is the path of the Tcl distribution where +tcl.h and other needed Tcl files are installed. +To build against a Tcl source build instead, + + nmake -f makefile.vc TCLDIR=<path-to-tcl-sources> + +Please look into the makefile.vc file for more options etc. + +Alternatively, you can open the extension workspace and project files +(thread_win.dsw and thread_win.dsp) from within the MSVC++ and press +the F7 key to build the extension under the control of the MSVC IDE. +NOTE: it is likely that the .dsw and .dsp files are out of date. At +least Visual Studio 2017 was not able to open those files. + +II. Building optional support libraries +======================================= + +As of 2.6 release, this extension supports persistent shared +variables. To use this functionality, you might need to download +and compile some other supporting libraries. Currently, there is +a simple implementation of shared variable persistency built atop +of popular GNU Gdbm package. You can obtain the latest version of +the Gdbm from: http://www.gnu.org/software/gdbm/gdbm.html. + +For the impatient, there are Windows ports of GNU Gdbm found on +various places on the Internet. The easiest way to start is to go +to the GnuWin32 project: http://sourceforge.net/projects/gnuwin32 +and fetch yourself a compiled GNU Gdbm DLL. + +-EOF- diff --git a/tcl8.6/pkgs/thread2.8.4/win/makefile.vc b/tcl8.6/pkgs/thread2.8.4/win/makefile.vc new file mode 100644 index 0000000..4c1c051 --- /dev/null +++ b/tcl8.6/pkgs/thread2.8.4/win/makefile.vc @@ -0,0 +1,63 @@ +#------------------------------------------------------------- -*- makefile -*-
+#
+# Makefile for thread extension
+#
+# Basic build, test and install
+# nmake /f makefile.vc INSTALLDIR=c:\tcl
+# nmake /f makefile.vc INSTALLDIR=c:\tcl test
+# nmake /f makefile.vc INSTALLDIR=c:\tcl install
+#
+# For other build options (debug, static etc.),
+# See TIP 477 (https://core.tcl.tk/tips/doc/trunk/tip/477.md) for
+# detailed documentation.
+#
+# In addition to the command line macros described there the following
+# may also be defined.
+# ADDOPTDEFINES - addition compiler options
+# ADDLINKOPTS - addition link options
+# E.g.
+# nmake -nologo -f makefile.vc TCLDIR=%TCLDIR% ... ADDOPTDEFINES="-I%LMDBDIR%" ADDLINKOPTS="%LMDBDIR%\Release\lmdb.lib"
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+#------------------------------------------------------------------------------
+
+PROJECT = thread
+RCFILE = thread.rc
+DOCDIR = $(ROOT)\doc\html
+
+PRJ_DEFINES = -D _CRT_SECURE_NO_DEPRECATE -D _CRT_NONSTDC_NO_DEPRECATE -D_CRT_SECURE_NO_WARNINGS
+PRJ_DEFINES = $(PRJ_DEFINES) -DTCL_TIP143 -DTCL_TIP285 -DTCL_NO_DEPRECATED=1 $(ADDOPTDEFINES)
+PRJ_LIBS = $(ADDLINKOPTS)
+
+!include "rules-ext.vc"
+
+PRJ_OBJS = \
+ $(TMP_DIR)\threadNs.obj \
+ $(TMP_DIR)\threadCmd.obj \
+ $(TMP_DIR)\threadSvCmd.obj \
+ $(TMP_DIR)\threadSpCmd.obj \
+ $(TMP_DIR)\threadPoolCmd.obj \
+ $(TMP_DIR)\psGdbm.obj \
+ $(TMP_DIR)\psLmdb.obj \
+ $(TMP_DIR)\threadSvListCmd.obj \
+ $(TMP_DIR)\threadSvKeylistCmd.obj \
+ $(TMP_DIR)\tclXkeylist.obj \
+ $(TMP_DIR)\threadWin.obj
+
+!include "$(_RULESDIR)\targets.vc"
+
+install: default-install-docs-html
+pkgindex: default-pkgindex-tea
+
+# Explicit dependency rules
+$(GENERICDIR)\psGdbm.c: $(GENERICDIR)\psGdbm.h
+$(GENERICDIR)\psLmdb.c: $(GENERICDIR)\psLmdb.h
+$(GENERICDIR)\threadCmd.c : $(GENERICDIR)\tclThreadInt.h
+$(GENERICDIR)\threadSpCmd.c : $(GENERICDIR)\tclThreadInt.h
+$(GENERICDIR)\threadSvCmd.c : $(GENERICDIR)\tclThreadInt.h
+$(GENERICDIR)\threadPoolCmd.c : $(GENERICDIR)\tclThreadInt.h
+$(GENERICDIR)\threadSvListCmd.c : $(GENERICDIR)\tclThreadInt.h
+$(GENERICDIR)\threadSvKeylistCmd.c : $(GENERICDIR)\tclThreadInt.h
+
diff --git a/tcl8.6/pkgs/thread2.8.4/win/nmakehlp.c b/tcl8.6/pkgs/thread2.8.4/win/nmakehlp.c new file mode 100644 index 0000000..b759020 --- /dev/null +++ b/tcl8.6/pkgs/thread2.8.4/win/nmakehlp.c @@ -0,0 +1,815 @@ +/* + * ---------------------------------------------------------------------------- + * nmakehlp.c -- + * + * This is used to fix limitations within nmake and the environment. + * + * Copyright (c) 2002 by David Gravereaux. + * Copyright (c) 2006 by Pat Thoyts + * + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. + * ---------------------------------------------------------------------------- + */ + +#define _CRT_SECURE_NO_DEPRECATE +#include <windows.h> +#pragma comment (lib, "user32.lib") +#pragma comment (lib, "kernel32.lib") +#include <stdio.h> +#include <math.h> + +/* + * This library is required for x64 builds with _some_ versions of MSVC + */ +#if defined(_M_IA64) || defined(_M_AMD64) +#if _MSC_VER >= 1400 && _MSC_VER < 1500 +#pragma comment(lib, "bufferoverflowU") +#endif +#endif + +/* ISO hack for dumb VC++ */ +#ifdef _MSC_VER +#define snprintf _snprintf +#endif + + +/* protos */ + +static int CheckForCompilerFeature(const char *option); +static int CheckForLinkerFeature(const char **options, int count); +static int IsIn(const char *string, const char *substring); +static int SubstituteFile(const char *substs, const char *filename); +static int QualifyPath(const char *path); +static int LocateDependency(const char *keyfile); +static const char *GetVersionFromFile(const char *filename, const char *match, int numdots); +static DWORD WINAPI ReadFromPipe(LPVOID args); + +/* globals */ + +#define CHUNK 25 +#define STATICBUFFERSIZE 1000 +typedef struct { + HANDLE pipe; + char buffer[STATICBUFFERSIZE]; +} pipeinfo; + +pipeinfo Out = {INVALID_HANDLE_VALUE, '\0'}; +pipeinfo Err = {INVALID_HANDLE_VALUE, '\0'}; + +/* + * exitcodes: 0 == no, 1 == yes, 2 == error + */ + +int +main( + int argc, + char *argv[]) +{ + char msg[300]; + DWORD dwWritten; + int chars; + const char *s; + + /* + * Make sure children (cl.exe and link.exe) are kept quiet. + */ + + SetErrorMode(SEM_FAILCRITICALERRORS | SEM_NOOPENFILEERRORBOX); + + /* + * Make sure the compiler and linker aren't effected by the outside world. + */ + + SetEnvironmentVariable("CL", ""); + SetEnvironmentVariable("LINK", ""); + + if (argc > 1 && *argv[1] == '-') { + switch (*(argv[1]+1)) { + case 'c': + if (argc != 3) { + chars = snprintf(msg, sizeof(msg) - 1, + "usage: %s -c <compiler option>\n" + "Tests for whether cl.exe supports an option\n" + "exitcodes: 0 == no, 1 == yes, 2 == error\n", argv[0]); + WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars, + &dwWritten, NULL); + return 2; + } + return CheckForCompilerFeature(argv[2]); + case 'l': + if (argc < 3) { + chars = snprintf(msg, sizeof(msg) - 1, + "usage: %s -l <linker option> ?<mandatory option> ...?\n" + "Tests for whether link.exe supports an option\n" + "exitcodes: 0 == no, 1 == yes, 2 == error\n", argv[0]); + WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars, + &dwWritten, NULL); + return 2; + } + return CheckForLinkerFeature(&argv[2], argc-2); + case 'f': + if (argc == 2) { + chars = snprintf(msg, sizeof(msg) - 1, + "usage: %s -f <string> <substring>\n" + "Find a substring within another\n" + "exitcodes: 0 == no, 1 == yes, 2 == error\n", argv[0]); + WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars, + &dwWritten, NULL); + return 2; + } else if (argc == 3) { + /* + * If the string is blank, there is no match. + */ + + return 0; + } else { + return IsIn(argv[2], argv[3]); + } + case 's': + if (argc == 2) { + chars = snprintf(msg, sizeof(msg) - 1, + "usage: %s -s <substitutions file> <file>\n" + "Perform a set of string map type substutitions on a file\n" + "exitcodes: 0\n", + argv[0]); + WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars, + &dwWritten, NULL); + return 2; + } + return SubstituteFile(argv[2], argv[3]); + case 'V': + if (argc != 4) { + chars = snprintf(msg, sizeof(msg) - 1, + "usage: %s -V filename matchstring\n" + "Extract a version from a file:\n" + "eg: pkgIndex.tcl \"package ifneeded http\"", + argv[0]); + WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars, + &dwWritten, NULL); + return 0; + } + s = GetVersionFromFile(argv[2], argv[3], *(argv[1]+2) - '0'); + if (s && *s) { + printf("%s\n", s); + return 0; + } else + return 1; /* Version not found. Return non-0 exit code */ + + case 'Q': + if (argc != 3) { + chars = snprintf(msg, sizeof(msg) - 1, + "usage: %s -Q path\n" + "Emit the fully qualified path\n" + "exitcodes: 0 == no, 1 == yes, 2 == error\n", argv[0]); + WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars, + &dwWritten, NULL); + return 2; + } + return QualifyPath(argv[2]); + + case 'L': + if (argc != 3) { + chars = snprintf(msg, sizeof(msg) - 1, + "usage: %s -L keypath\n" + "Emit the fully qualified path of directory containing keypath\n" + "exitcodes: 0 == success, 1 == not found, 2 == error\n", argv[0]); + WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars, + &dwWritten, NULL); + return 2; + } + return LocateDependency(argv[2]); + } + } + chars = snprintf(msg, sizeof(msg) - 1, + "usage: %s -c|-f|-l|-Q|-s|-V ...\n" + "This is a little helper app to equalize shell differences between WinNT and\n" + "Win9x and get nmake.exe to accomplish its job.\n", + argv[0]); + WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars, &dwWritten, NULL); + return 2; +} + +static int +CheckForCompilerFeature( + const char *option) +{ + STARTUPINFO si; + PROCESS_INFORMATION pi; + SECURITY_ATTRIBUTES sa; + DWORD threadID; + char msg[300]; + BOOL ok; + HANDLE hProcess, h, pipeThreads[2]; + char cmdline[100]; + + hProcess = GetCurrentProcess(); + + ZeroMemory(&pi, sizeof(PROCESS_INFORMATION)); + ZeroMemory(&si, sizeof(STARTUPINFO)); + si.cb = sizeof(STARTUPINFO); + si.dwFlags = STARTF_USESTDHANDLES; + si.hStdInput = INVALID_HANDLE_VALUE; + + ZeroMemory(&sa, sizeof(SECURITY_ATTRIBUTES)); + sa.nLength = sizeof(SECURITY_ATTRIBUTES); + sa.lpSecurityDescriptor = NULL; + sa.bInheritHandle = FALSE; + + /* + * Create a non-inheritible pipe. + */ + + CreatePipe(&Out.pipe, &h, &sa, 0); + + /* + * Dupe the write side, make it inheritible, and close the original. + */ + + DuplicateHandle(hProcess, h, hProcess, &si.hStdOutput, 0, TRUE, + DUPLICATE_SAME_ACCESS | DUPLICATE_CLOSE_SOURCE); + + /* + * Same as above, but for the error side. + */ + + CreatePipe(&Err.pipe, &h, &sa, 0); + DuplicateHandle(hProcess, h, hProcess, &si.hStdError, 0, TRUE, + DUPLICATE_SAME_ACCESS | DUPLICATE_CLOSE_SOURCE); + + /* + * Base command line. + */ + + lstrcpy(cmdline, "cl.exe -nologo -c -TC -Zs -X -Fp.\\_junk.pch "); + + /* + * Append our option for testing + */ + + lstrcat(cmdline, option); + + /* + * Filename to compile, which exists, but is nothing and empty. + */ + + lstrcat(cmdline, " .\\nul"); + + ok = CreateProcess( + NULL, /* Module name. */ + cmdline, /* Command line. */ + NULL, /* Process handle not inheritable. */ + NULL, /* Thread handle not inheritable. */ + TRUE, /* yes, inherit handles. */ + DETACHED_PROCESS, /* No console for you. */ + NULL, /* Use parent's environment block. */ + NULL, /* Use parent's starting directory. */ + &si, /* Pointer to STARTUPINFO structure. */ + &pi); /* Pointer to PROCESS_INFORMATION structure. */ + + if (!ok) { + DWORD err = GetLastError(); + int chars = snprintf(msg, sizeof(msg) - 1, + "Tried to launch: \"%s\", but got error [%u]: ", cmdline, err); + + FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM|FORMAT_MESSAGE_IGNORE_INSERTS| + FORMAT_MESSAGE_MAX_WIDTH_MASK, 0L, err, 0, (LPVOID)&msg[chars], + (300-chars), 0); + WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, lstrlen(msg), &err,NULL); + return 2; + } + + /* + * Close our references to the write handles that have now been inherited. + */ + + CloseHandle(si.hStdOutput); + CloseHandle(si.hStdError); + + WaitForInputIdle(pi.hProcess, 5000); + CloseHandle(pi.hThread); + + /* + * Start the pipe reader threads. + */ + + pipeThreads[0] = CreateThread(NULL, 0, ReadFromPipe, &Out, 0, &threadID); + pipeThreads[1] = CreateThread(NULL, 0, ReadFromPipe, &Err, 0, &threadID); + + /* + * Block waiting for the process to end. + */ + + WaitForSingleObject(pi.hProcess, INFINITE); + CloseHandle(pi.hProcess); + + /* + * Wait for our pipe to get done reading, should it be a little slow. + */ + + WaitForMultipleObjects(2, pipeThreads, TRUE, 500); + CloseHandle(pipeThreads[0]); + CloseHandle(pipeThreads[1]); + + /* + * Look for the commandline warning code in both streams. + * - in MSVC 6 & 7 we get D4002, in MSVC 8 we get D9002. + */ + + return !(strstr(Out.buffer, "D4002") != NULL + || strstr(Err.buffer, "D4002") != NULL + || strstr(Out.buffer, "D9002") != NULL + || strstr(Err.buffer, "D9002") != NULL + || strstr(Out.buffer, "D2021") != NULL + || strstr(Err.buffer, "D2021") != NULL); +} + +static int +CheckForLinkerFeature( + const char **options, + int count) +{ + STARTUPINFO si; + PROCESS_INFORMATION pi; + SECURITY_ATTRIBUTES sa; + DWORD threadID; + char msg[300]; + BOOL ok; + HANDLE hProcess, h, pipeThreads[2]; + int i; + char cmdline[255]; + + hProcess = GetCurrentProcess(); + + ZeroMemory(&pi, sizeof(PROCESS_INFORMATION)); + ZeroMemory(&si, sizeof(STARTUPINFO)); + si.cb = sizeof(STARTUPINFO); + si.dwFlags = STARTF_USESTDHANDLES; + si.hStdInput = INVALID_HANDLE_VALUE; + + ZeroMemory(&sa, sizeof(SECURITY_ATTRIBUTES)); + sa.nLength = sizeof(SECURITY_ATTRIBUTES); + sa.lpSecurityDescriptor = NULL; + sa.bInheritHandle = TRUE; + + /* + * Create a non-inheritible pipe. + */ + + CreatePipe(&Out.pipe, &h, &sa, 0); + + /* + * Dupe the write side, make it inheritible, and close the original. + */ + + DuplicateHandle(hProcess, h, hProcess, &si.hStdOutput, 0, TRUE, + DUPLICATE_SAME_ACCESS | DUPLICATE_CLOSE_SOURCE); + + /* + * Same as above, but for the error side. + */ + + CreatePipe(&Err.pipe, &h, &sa, 0); + DuplicateHandle(hProcess, h, hProcess, &si.hStdError, 0, TRUE, + DUPLICATE_SAME_ACCESS | DUPLICATE_CLOSE_SOURCE); + + /* + * Base command line. + */ + + lstrcpy(cmdline, "link.exe -nologo "); + + /* + * Append our option for testing. + */ + + for (i = 0; i < count; i++) { + lstrcat(cmdline, " \""); + lstrcat(cmdline, options[i]); + lstrcat(cmdline, "\""); + } + + ok = CreateProcess( + NULL, /* Module name. */ + cmdline, /* Command line. */ + NULL, /* Process handle not inheritable. */ + NULL, /* Thread handle not inheritable. */ + TRUE, /* yes, inherit handles. */ + DETACHED_PROCESS, /* No console for you. */ + NULL, /* Use parent's environment block. */ + NULL, /* Use parent's starting directory. */ + &si, /* Pointer to STARTUPINFO structure. */ + &pi); /* Pointer to PROCESS_INFORMATION structure. */ + + if (!ok) { + DWORD err = GetLastError(); + int chars = snprintf(msg, sizeof(msg) - 1, + "Tried to launch: \"%s\", but got error [%u]: ", cmdline, err); + + FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM|FORMAT_MESSAGE_IGNORE_INSERTS| + FORMAT_MESSAGE_MAX_WIDTH_MASK, 0L, err, 0, (LPVOID)&msg[chars], + (300-chars), 0); + WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, lstrlen(msg), &err,NULL); + return 2; + } + + /* + * Close our references to the write handles that have now been inherited. + */ + + CloseHandle(si.hStdOutput); + CloseHandle(si.hStdError); + + WaitForInputIdle(pi.hProcess, 5000); + CloseHandle(pi.hThread); + + /* + * Start the pipe reader threads. + */ + + pipeThreads[0] = CreateThread(NULL, 0, ReadFromPipe, &Out, 0, &threadID); + pipeThreads[1] = CreateThread(NULL, 0, ReadFromPipe, &Err, 0, &threadID); + + /* + * Block waiting for the process to end. + */ + + WaitForSingleObject(pi.hProcess, INFINITE); + CloseHandle(pi.hProcess); + + /* + * Wait for our pipe to get done reading, should it be a little slow. + */ + + WaitForMultipleObjects(2, pipeThreads, TRUE, 500); + CloseHandle(pipeThreads[0]); + CloseHandle(pipeThreads[1]); + + /* + * Look for the commandline warning code in the stderr stream. + */ + + return !(strstr(Out.buffer, "LNK1117") != NULL || + strstr(Err.buffer, "LNK1117") != NULL || + strstr(Out.buffer, "LNK4044") != NULL || + strstr(Err.buffer, "LNK4044") != NULL || + strstr(Out.buffer, "LNK4224") != NULL || + strstr(Err.buffer, "LNK4224") != NULL); +} + +static DWORD WINAPI +ReadFromPipe( + LPVOID args) +{ + pipeinfo *pi = (pipeinfo *) args; + char *lastBuf = pi->buffer; + DWORD dwRead; + BOOL ok; + + again: + if (lastBuf - pi->buffer + CHUNK > STATICBUFFERSIZE) { + CloseHandle(pi->pipe); + return (DWORD)-1; + } + ok = ReadFile(pi->pipe, lastBuf, CHUNK, &dwRead, 0L); + if (!ok || dwRead == 0) { + CloseHandle(pi->pipe); + return 0; + } + lastBuf += dwRead; + goto again; + + return 0; /* makes the compiler happy */ +} + +static int +IsIn( + const char *string, + const char *substring) +{ + return (strstr(string, substring) != NULL); +} + +/* + * GetVersionFromFile -- + * Looks for a match string in a file and then returns the version + * following the match where a version is anything acceptable to + * package provide or package ifneeded. + */ + +static const char * +GetVersionFromFile( + const char *filename, + const char *match, + int numdots) +{ + size_t cbBuffer = 100; + static char szBuffer[100]; + char *szResult = NULL; + FILE *fp = fopen(filename, "rt"); + + if (fp != NULL) { + /* + * Read data until we see our match string. + */ + + while (fgets(szBuffer, cbBuffer, fp) != NULL) { + LPSTR p, q; + + p = strstr(szBuffer, match); + if (p != NULL) { + /* + * Skip to first digit after the match. + */ + + p += strlen(match); + while (*p && !isdigit(*p)) { + ++p; + } + + /* + * Find ending whitespace. + */ + + q = p; + while (*q && (strchr("0123456789.ab", *q)) && ((!strchr(".ab", *q) + && (!strchr("ab", q[-1])) || --numdots))) { + ++q; + } + + memcpy(szBuffer, p, q - p); + szBuffer[q-p] = 0; + szResult = szBuffer; + break; + } + } + fclose(fp); + } + return szResult; +} + +/* + * List helpers for the SubstituteFile function + */ + +typedef struct list_item_t { + struct list_item_t *nextPtr; + char * key; + char * value; +} list_item_t; + +/* insert a list item into the list (list may be null) */ +static list_item_t * +list_insert(list_item_t **listPtrPtr, const char *key, const char *value) +{ + list_item_t *itemPtr = malloc(sizeof(list_item_t)); + if (itemPtr) { + itemPtr->key = strdup(key); + itemPtr->value = strdup(value); + itemPtr->nextPtr = NULL; + + while(*listPtrPtr) { + listPtrPtr = &(*listPtrPtr)->nextPtr; + } + *listPtrPtr = itemPtr; + } + return itemPtr; +} + +static void +list_free(list_item_t **listPtrPtr) +{ + list_item_t *tmpPtr, *listPtr = *listPtrPtr; + while (listPtr) { + tmpPtr = listPtr; + listPtr = listPtr->nextPtr; + free(tmpPtr->key); + free(tmpPtr->value); + free(tmpPtr); + } +} + +/* + * SubstituteFile -- + * As windows doesn't provide anything useful like sed and it's unreliable + * to use the tclsh you are building against (consider x-platform builds - + * eg compiling AMD64 target from IX86) we provide a simple substitution + * option here to handle autoconf style substitutions. + * The substitution file is whitespace and line delimited. The file should + * consist of lines matching the regular expression: + * \s*\S+\s+\S*$ + * + * Usage is something like: + * nmakehlp -S << $** > $@ + * @PACKAGE_NAME@ $(PACKAGE_NAME) + * @PACKAGE_VERSION@ $(PACKAGE_VERSION) + * << + */ + +static int +SubstituteFile( + const char *substitutions, + const char *filename) +{ + size_t cbBuffer = 1024; + static char szBuffer[1024], szCopy[1024]; + char *szResult = NULL; + list_item_t *substPtr = NULL; + FILE *fp, *sp; + + fp = fopen(filename, "rt"); + if (fp != NULL) { + + /* + * Build a list of substutitions from the first filename + */ + + sp = fopen(substitutions, "rt"); + if (sp != NULL) { + while (fgets(szBuffer, cbBuffer, sp) != NULL) { + unsigned char *ks, *ke, *vs, *ve; + ks = (unsigned char*)szBuffer; + while (ks && *ks && isspace(*ks)) ++ks; + ke = ks; + while (ke && *ke && !isspace(*ke)) ++ke; + vs = ke; + while (vs && *vs && isspace(*vs)) ++vs; + ve = vs; + while (ve && *ve && !(*ve == '\r' || *ve == '\n')) ++ve; + *ke = 0, *ve = 0; + list_insert(&substPtr, (char*)ks, (char*)vs); + } + fclose(sp); + } + + /* debug: dump the list */ +#ifdef _DEBUG + { + int n = 0; + list_item_t *p = NULL; + for (p = substPtr; p != NULL; p = p->nextPtr, ++n) { + fprintf(stderr, "% 3d '%s' => '%s'\n", n, p->key, p->value); + } + } +#endif + + /* + * Run the substitutions over each line of the input + */ + + while (fgets(szBuffer, cbBuffer, fp) != NULL) { + list_item_t *p = NULL; + for (p = substPtr; p != NULL; p = p->nextPtr) { + char *m = strstr(szBuffer, p->key); + if (m) { + char *cp, *op, *sp; + cp = szCopy; + op = szBuffer; + while (op != m) *cp++ = *op++; + sp = p->value; + while (sp && *sp) *cp++ = *sp++; + op += strlen(p->key); + while (*op) *cp++ = *op++; + *cp = 0; + memcpy(szBuffer, szCopy, sizeof(szCopy)); + } + } + printf(szBuffer); + } + + list_free(&substPtr); + } + fclose(fp); + return 0; +} + +BOOL FileExists(LPCTSTR szPath) +{ +#ifndef INVALID_FILE_ATTRIBUTES + #define INVALID_FILE_ATTRIBUTES ((DWORD)-1) +#endif + DWORD pathAttr = GetFileAttributes(szPath); + return (pathAttr != INVALID_FILE_ATTRIBUTES && + !(pathAttr & FILE_ATTRIBUTE_DIRECTORY)); +} + + +/* + * QualifyPath -- + * + * This composes the current working directory with a provided path + * and returns the fully qualified and normalized path. + * Mostly needed to setup paths for testing. + */ + +static int +QualifyPath( + const char *szPath) +{ + char szCwd[MAX_PATH + 1]; + + GetFullPathName(szPath, sizeof(szCwd)-1, szCwd, NULL); + printf("%s\n", szCwd); + return 0; +} + +/* + * Implements LocateDependency for a single directory. See that command + * for an explanation. + * Returns 0 if found after printing the directory. + * Returns 1 if not found but no errors. + * Returns 2 on any kind of error + * Basically, these are used as exit codes for the process. + */ +static int LocateDependencyHelper(const char *dir, const char *keypath) +{ + HANDLE hSearch; + char path[MAX_PATH+1]; + int dirlen, keylen, ret; + WIN32_FIND_DATA finfo; + + if (dir == NULL || keypath == NULL) + return 2; /* Have no real error reporting mechanism into nmake */ + dirlen = strlen(dir); + if ((dirlen + 3) > sizeof(path)) + return 2; + strncpy(path, dir, dirlen); + strncpy(path+dirlen, "\\*", 3); /* Including terminating \0 */ + keylen = strlen(keypath); + +#if 0 /* This function is not available in Visual C++ 6 */ + /* + * Use numerics 0 -> FindExInfoStandard, + * 1 -> FindExSearchLimitToDirectories, + * as these are not defined in Visual C++ 6 + */ + hSearch = FindFirstFileEx(path, 0, &finfo, 1, NULL, 0); +#else + hSearch = FindFirstFile(path, &finfo); +#endif + if (hSearch == INVALID_HANDLE_VALUE) + return 1; /* Not found */ + + /* Loop through all subdirs checking if the keypath is under there */ + ret = 1; /* Assume not found */ + do { + int sublen; + /* + * We need to check it is a directory despite the + * FindExSearchLimitToDirectories in the above call. See SDK docs + */ + if ((finfo.dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY) == 0) + continue; + sublen = strlen(finfo.cFileName); + if ((dirlen+1+sublen+1+keylen+1) > sizeof(path)) + continue; /* Path does not fit, assume not matched */ + strncpy(path+dirlen+1, finfo.cFileName, sublen); + path[dirlen+1+sublen] = '\\'; + strncpy(path+dirlen+1+sublen+1, keypath, keylen+1); + if (FileExists(path)) { + /* Found a match, print to stdout */ + path[dirlen+1+sublen] = '\0'; + QualifyPath(path); + ret = 0; + break; + } + } while (FindNextFile(hSearch, &finfo)); + FindClose(hSearch); + return ret; +} + +/* + * LocateDependency -- + * + * Locates a dependency for a package. + * keypath - a relative path within the package directory + * that is used to confirm it is the correct directory. + * The search path for the package directory is currently only + * the parent and grandparent of the current working directory. + * If found, the command prints + * name_DIRPATH=<full path of located directory> + * and returns 0. If not found, does not print anything and returns 1. + */ +static int LocateDependency(const char *keypath) +{ + int i, ret; + static char *paths[] = {"..", "..\\..", "..\\..\\.."}; + + for (i = 0; i < (sizeof(paths)/sizeof(paths[0])); ++i) { + ret = LocateDependencyHelper(paths[i], keypath); + if (ret == 0) + return ret; + } + return ret; +} + + +/* + * Local variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * indent-tabs-mode: t + * tab-width: 8 + * End: + */ diff --git a/tcl8.6/pkgs/thread2.8.4/win/pkg.vc b/tcl8.6/pkgs/thread2.8.4/win/pkg.vc new file mode 100644 index 0000000..4a98337 --- /dev/null +++ b/tcl8.6/pkgs/thread2.8.4/win/pkg.vc @@ -0,0 +1,6 @@ +# remember to change configure.ac as well when these change
+# (then re-autoconf)
+
+PACKAGE_MAJOR = 2
+PACKAGE_MINOR = 8
+PACKAGE_VERSION = "2.8.4"
diff --git a/tcl8.6/pkgs/thread2.8.4/win/rules-ext.vc b/tcl8.6/pkgs/thread2.8.4/win/rules-ext.vc new file mode 100644 index 0000000..531e070 --- /dev/null +++ b/tcl8.6/pkgs/thread2.8.4/win/rules-ext.vc @@ -0,0 +1,118 @@ +# This file should only be included in makefiles for Tcl extensions,
+# NOT in the makefile for Tcl itself.
+
+!ifndef _RULES_EXT_VC
+
+# We need to run from the directory the parent makefile is located in.
+# nmake does not tell us what makefile was used to invoke it so parent
+# makefile has to set the MAKEFILEVC macro or we just make a guess and
+# warn if we think that is not the case.
+!if "$(MAKEFILEVC)" == ""
+
+!if exist("$(PROJECT).vc")
+MAKEFILEVC = $(PROJECT).vc
+!elseif exist("makefile.vc")
+MAKEFILEVC = makefile.vc
+!endif
+!endif # "$(MAKEFILEVC)" == ""
+
+!if !exist("$(MAKEFILEVC)")
+MSG = ^
+You must run nmake from the directory containing the project makefile.^
+If you are doing that and getting this message, set the MAKEFILEVC^
+macro to the name of the project makefile.
+!message WARNING: $(MSG)
+!endif
+
+!if "$(PROJECT)" == "tcl"
+!error The rules-ext.vc file is not intended for Tcl itself.
+!endif
+
+# We extract version numbers using the nmakehlp program. For now use
+# the local copy of nmakehlp. Once we locate Tcl, we will use that
+# one if it is newer.
+!if [$(CC) -nologo "nmakehlp.c" -link -subsystem:console > nul]
+!endif
+
+# First locate the Tcl directory that we are working with.
+!if "$(TCLDIR)" != ""
+
+_RULESDIR = $(TCLDIR:/=\)
+
+!else
+
+# If an installation path is specified, that is also the Tcl directory.
+# Also Tk never builds against an installed Tcl, it needs Tcl sources
+!if defined(INSTALLDIR) && "$(PROJECT)" != "tk"
+_RULESDIR=$(INSTALLDIR:/=\)
+!else
+# Locate Tcl sources
+!if [echo _RULESDIR = \> nmakehlp.out] \
+ || [nmakehlp -L generic\tcl.h >> nmakehlp.out]
+_RULESDIR = ..\..\tcl
+!else
+!include nmakehlp.out
+!endif
+
+!endif # defined(INSTALLDIR)....
+
+!endif # ifndef TCLDIR
+
+# Now look for the targets.vc file under the Tcl root. Note we check this
+# file and not rules.vc because the latter also exists on older systems.
+!if exist("$(_RULESDIR)\lib\nmake\targets.vc") # Building against installed Tcl
+_RULESDIR = $(_RULESDIR)\lib\nmake
+!elseif exist("$(_RULESDIR)\win\targets.vc") # Building against Tcl sources
+_RULESDIR = $(_RULESDIR)\win
+!else
+# If we have not located Tcl's targets file, most likely we are compiling
+# against an older version of Tcl and so must use our own support files.
+_RULESDIR = .
+!endif
+
+!if "$(_RULESDIR)" != "."
+# Potentially using Tcl's support files. If this extension has its own
+# nmake support files, need to compare the versions and pick newer.
+
+!if exist("rules.vc") # The extension has its own copy
+
+!if [echo TCL_RULES_MAJOR = \> versions.vc] \
+ && [nmakehlp -V "$(_RULESDIR)\rules.vc" RULES_VERSION_MAJOR >> versions.vc]
+!endif
+!if [echo TCL_RULES_MINOR = \>> versions.vc] \
+ && [nmakehlp -V "$(_RULESDIR)\rules.vc" RULES_VERSION_MINOR >> versions.vc]
+!endif
+
+!if [echo OUR_RULES_MAJOR = \>> versions.vc] \
+ && [nmakehlp -V "rules.vc" RULES_VERSION_MAJOR >> versions.vc]
+!endif
+!if [echo OUR_RULES_MINOR = \>> versions.vc] \
+ && [nmakehlp -V "rules.vc" RULES_VERSION_MINOR >> versions.vc]
+!endif
+!include versions.vc
+# We have a newer version of the support files, use them
+!if ($(TCL_RULES_MAJOR) != $(OUR_RULES_MAJOR)) || ($(TCL_RULES_MINOR) < $(OUR_RULES_MINOR))
+_RULESDIR = .
+!endif
+
+!endif # if exist("rules.vc")
+
+!endif # if $(_RULESDIR) != "."
+
+# Let rules.vc know what copy of nmakehlp.c to use.
+NMAKEHLPC = $(_RULESDIR)\nmakehlp.c
+
+# Get rid of our internal defines before calling rules.vc
+!undef TCL_RULES_MAJOR
+!undef TCL_RULES_MINOR
+!undef OUR_RULES_MAJOR
+!undef OUR_RULES_MINOR
+
+!if exist("$(_RULESDIR)\rules.vc")
+!message *** Using $(_RULESDIR)\rules.vc
+!include "$(_RULESDIR)\rules.vc"
+!else
+!error *** Could not locate rules.vc in $(_RULESDIR)
+!endif
+
+!endif # _RULES_EXT_VC
\ No newline at end of file diff --git a/tcl8.6/pkgs/thread2.8.4/win/rules.vc b/tcl8.6/pkgs/thread2.8.4/win/rules.vc new file mode 100644 index 0000000..13b3fba --- /dev/null +++ b/tcl8.6/pkgs/thread2.8.4/win/rules.vc @@ -0,0 +1,1740 @@ +#------------------------------------------------------------- -*- makefile -*-
+# rules.vc --
+#
+# Part of the nmake based build system for Tcl and its extensions.
+# This file does all the hard work in terms of parsing build options,
+# compiler switches, defining common targets and macros. The Tcl makefile
+# directly includes this. Extensions include it via "rules-ext.vc".
+#
+# See TIP 477 (https://core.tcl.tk/tips/doc/trunk/tip/477.md) for
+# detailed documentation.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# Copyright (c) 2001-2003 David Gravereaux.
+# Copyright (c) 2003-2008 Patrick Thoyts
+# Copyright (c) 2017 Ashok P. Nadkarni
+#------------------------------------------------------------------------------
+
+!ifndef _RULES_VC
+_RULES_VC = 1
+
+# The following macros define the version of the rules.vc nmake build system
+# For modifications that are not backward-compatible, you *must* change
+# the major version.
+RULES_VERSION_MAJOR = 1
+RULES_VERSION_MINOR = 2
+
+# The PROJECT macro must be defined by parent makefile.
+!if "$(PROJECT)" == ""
+!error *** Error: Macro PROJECT not defined! Please define it before including rules.vc
+!endif
+
+!if "$(PRJ_PACKAGE_TCLNAME)" == ""
+PRJ_PACKAGE_TCLNAME = $(PROJECT)
+!endif
+
+# Also special case Tcl and Tk to save some typing later
+DOING_TCL = 0
+DOING_TK = 0
+!if "$(PROJECT)" == "tcl"
+DOING_TCL = 1
+!elseif "$(PROJECT)" == "tk"
+DOING_TK = 1
+!endif
+
+!ifndef NEED_TK
+# Backwards compatibility
+!ifdef PROJECT_REQUIRES_TK
+NEED_TK = $(PROJECT_REQUIRES_TK)
+!else
+NEED_TK = 0
+!endif
+!endif
+
+!ifndef NEED_TCL_SOURCE
+NEED_TCL_SOURCE = 0
+!endif
+
+!ifdef NEED_TK_SOURCE
+!if $(NEED_TK_SOURCE)
+NEED_TK = 1
+!endif
+!else
+NEED_TK_SOURCE = 0
+!endif
+
+################################################################
+# Nmake is a pretty weak environment in syntax and capabilities
+# so this file is necessarily verbose. It's broken down into
+# the following parts.
+#
+# 0. Sanity check that compiler environment is set up and initialize
+# any built-in settings from the parent makefile
+# 1. First define the external tools used for compiling, copying etc.
+# as this is independent of everything else.
+# 2. Figure out our build structure in terms of the directory, whether
+# we are building Tcl or an extension, etc.
+# 3. Determine the compiler and linker versions
+# 4. Build the nmakehlp helper application
+# 5. Determine the supported compiler options and features
+# 6. Parse the OPTS macro value for user-specified build configuration
+# 7. Parse the STATS macro value for statistics instrumentation
+# 8. Parse the CHECKS macro for additional compilation checks
+# 9. Extract Tcl, and possibly Tk, version numbers from the headers
+# 10. Based on this selected configuration, construct the output
+# directory and file paths
+# 11. Construct the paths where the package is to be installed
+# 12. Set up the actual options passed to compiler and linker based
+# on the information gathered above.
+# 13. Define some standard build targets and implicit rules. These may
+# be optionally disabled by the parent makefile.
+# 14. (For extensions only.) Compare the configuration of the target
+# Tcl and the extensions and warn against discrepancies.
+#
+# One final note about the macro names used. They are as they are
+# for historical reasons. We would like legacy extensions to
+# continue to work with this make include file so be wary of
+# changing them for consistency or clarity.
+
+# 0. Sanity check compiler environment
+
+# Check to see we are configured to build with MSVC (MSDEVDIR, MSVCDIR or
+# VCINSTALLDIR) or with the MS Platform SDK (MSSDK or WindowsSDKDir)
+
+!if !defined(MSDEVDIR) && !defined(MSVCDIR) && !defined(VCINSTALLDIR) && !defined(MSSDK) && !defined(WINDOWSSDKDIR)
+MSG = ^
+Visual C++ compiler environment not initialized.
+!error $(MSG)
+!endif
+
+# We need to run from the directory the parent makefile is located in.
+# nmake does not tell us what makefile was used to invoke it so parent
+# makefile has to set the MAKEFILEVC macro or we just make a guess and
+# warn if we think that is not the case.
+!if "$(MAKEFILEVC)" == ""
+
+!if exist("$(PROJECT).vc")
+MAKEFILEVC = $(PROJECT).vc
+!elseif exist("makefile.vc")
+MAKEFILEVC = makefile.vc
+!endif
+!endif # "$(MAKEFILEVC)" == ""
+
+!if !exist("$(MAKEFILEVC)")
+MSG = ^
+You must run nmake from the directory containing the project makefile.^
+If you are doing that and getting this message, set the MAKEFILEVC^
+macro to the name of the project makefile.
+!message WARNING: $(MSG)
+!endif
+
+
+################################################################
+# 1. Define external programs being used
+
+#----------------------------------------------------------
+# Set the proper copy method to avoid overwrite questions
+# to the user when copying files and selecting the right
+# "delete all" method.
+#----------------------------------------------------------
+
+RMDIR = rmdir /S /Q
+CPY = xcopy /i /y >NUL
+CPYDIR = xcopy /e /i /y >NUL
+COPY = copy /y >NUL
+MKDIR = mkdir
+
+######################################################################
+# 2. Figure out our build environment in terms of what we're building.
+#
+# (a) Tcl itself
+# (b) Tk
+# (c) a Tcl extension using libraries/includes from an *installed* Tcl
+# (d) a Tcl extension using libraries/includes from Tcl source directory
+#
+# This last is needed because some extensions still need
+# some Tcl interfaces that are not publicly exposed.
+#
+# The fragment will set the following macros:
+# ROOT - root of this module sources
+# COMPATDIR - source directory that holds compatibility sources
+# DOCDIR - source directory containing documentation files
+# GENERICDIR - platform-independent source directory
+# WINDIR - Windows-specific source directory
+# TESTDIR - directory containing test files
+# TOOLSDIR - directory containing build tools
+# _TCLDIR - root of the Tcl installation OR the Tcl sources. Not set
+# when building Tcl itself.
+# _INSTALLDIR - native form of the installation path. For Tcl
+# this will be the root of the Tcl installation. For extensions
+# this will be the lib directory under the root.
+# TCLINSTALL - set to 1 if _TCLDIR refers to
+# headers and libraries from an installed Tcl, and 0 if built against
+# Tcl sources. Not set when building Tcl itself. Yes, not very well
+# named.
+# _TCL_H - native path to the tcl.h file
+#
+# If Tk is involved, also sets the following
+# _TKDIR - native form Tk installation OR Tk source. Not set if building
+# Tk itself.
+# TKINSTALL - set 1 if _TKDIR refers to installed Tk and 0 if Tk sources
+# _TK_H - native path to the tk.h file
+
+# Root directory for sources and assumed subdirectories
+ROOT = $(MAKEDIR)\..
+# The following paths CANNOT have spaces in them as they appear on the
+# left side of implicit rules.
+!ifndef COMPATDIR
+COMPATDIR = $(ROOT)\compat
+!endif
+!ifndef DOCDIR
+DOCDIR = $(ROOT)\doc
+!endif
+!ifndef GENERICDIR
+GENERICDIR = $(ROOT)\generic
+!endif
+!ifndef TOOLSDIR
+TOOLSDIR = $(ROOT)\tools
+!endif
+!ifndef TESTDIR
+TESTDIR = $(ROOT)\tests
+!endif
+!ifndef LIBDIR
+!if exist("$(ROOT)\library")
+LIBDIR = $(ROOT)\library
+!else
+LIBDIR = $(ROOT)\lib
+!endif
+!endif
+!ifndef DEMODIR
+!if exist("$(LIBDIR)\demos")
+DEMODIR = $(LIBDIR)\demos
+!else
+DEMODIR = $(ROOT)\demos
+!endif
+!endif # ifndef DEMODIR
+# Do NOT enclose WINDIR in a !ifndef because Windows always defines
+# WINDIR env var to point to c:\windows!
+# TBD - This is a potentially dangerous conflict, rename WINDIR to
+# something else
+WINDIR = $(ROOT)\win
+
+!ifndef RCDIR
+!if exist("$(WINDIR)\rc")
+RCDIR = $(WINDIR)\rc
+!else
+RCDIR = $(WINDIR)
+!endif
+!endif
+RCDIR = $(RCDIR:/=\)
+
+# The target directory where the built packages and binaries will be installed.
+# INSTALLDIR is the (optional) path specified by the user.
+# _INSTALLDIR is INSTALLDIR using the backslash separator syntax
+!ifdef INSTALLDIR
+### Fix the path separators.
+_INSTALLDIR = $(INSTALLDIR:/=\)
+!else
+### Assume the normal default.
+_INSTALLDIR = $(HOMEDRIVE)\Tcl
+!endif
+
+!if $(DOING_TCL)
+
+# BEGIN Case 2(a) - Building Tcl itself
+
+# Only need to define _TCL_H
+_TCL_H = ..\generic\tcl.h
+
+# END Case 2(a) - Building Tcl itself
+
+!elseif $(DOING_TK)
+
+# BEGIN Case 2(b) - Building Tk
+
+TCLINSTALL = 0 # Tk always builds against Tcl source, not an installed Tcl
+!if "$(TCLDIR)" == ""
+!if [echo TCLDIR = \> nmakehlp.out] \
+ || [nmakehlp -L generic\tcl.h >> nmakehlp.out]
+!error *** Could not locate Tcl source directory.
+!endif
+!include nmakehlp.out
+!endif # TCLDIR == ""
+
+_TCLDIR = $(TCLDIR:/=\)
+_TCL_H = $(_TCLDIR)\generic\tcl.h
+!if !exist("$(_TCL_H)")
+!error Could not locate tcl.h. Please set the TCLDIR macro to point to the Tcl *source* directory.
+!endif
+
+_TK_H = ..\generic\tk.h
+
+# END Case 2(b) - Building Tk
+
+!else
+
+# BEGIN Case 2(c) or (d) - Building an extension other than Tk
+
+# If command line has specified Tcl location through TCLDIR, use it
+# else default to the INSTALLDIR setting
+!if "$(TCLDIR)" != ""
+
+_TCLDIR = $(TCLDIR:/=\)
+!if exist("$(_TCLDIR)\include\tcl.h") # Case 2(c) with TCLDIR defined
+TCLINSTALL = 1
+_TCL_H = $(_TCLDIR)\include\tcl.h
+!elseif exist("$(_TCLDIR)\generic\tcl.h") # Case 2(d) with TCLDIR defined
+TCLINSTALL = 0
+_TCL_H = $(_TCLDIR)\generic\tcl.h
+!endif
+
+!else # # Case 2(c) for extensions with TCLDIR undefined
+
+# Need to locate Tcl depending on whether it needs Tcl source or not.
+# If we don't, check the INSTALLDIR for an installed Tcl first
+
+!if exist("$(_INSTALLDIR)\include\tcl.h") && !$(NEED_TCL_SOURCE)
+
+TCLINSTALL = 1
+TCLDIR = $(_INSTALLDIR)\..
+# NOTE: we will be resetting _INSTALLDIR to _INSTALLDIR/lib for extensions
+# later so the \.. accounts for the /lib
+_TCLDIR = $(_INSTALLDIR)\..
+_TCL_H = $(_TCLDIR)\include\tcl.h
+
+!else # exist(...) && ! $(NEED_TCL_SOURCE)
+
+!if [echo _TCLDIR = \> nmakehlp.out] \
+ || [nmakehlp -L generic\tcl.h >> nmakehlp.out]
+!error *** Could not locate Tcl source directory.
+!endif
+!include nmakehlp.out
+TCLINSTALL = 0
+TCLDIR = $(_TCLDIR)
+_TCL_H = $(_TCLDIR)\generic\tcl.h
+
+!endif # exist(...) && ! $(NEED_TCL_SOURCE)
+
+!endif # TCLDIR
+
+!ifndef _TCL_H
+MSG =^
+Failed to find tcl.h. The TCLDIR macro is set incorrectly or is not set and default path does not contain tcl.h.
+!error $(MSG)
+!endif
+
+# Now do the same to locate Tk headers and libs if project requires Tk
+!if $(NEED_TK)
+
+!if "$(TKDIR)" != ""
+
+_TKDIR = $(TKDIR:/=\)
+!if exist("$(_TKDIR)\include\tk.h")
+TKINSTALL = 1
+_TK_H = $(_TKDIR)\include\tk.h
+!elseif exist("$(_TKDIR)\generic\tk.h")
+TKINSTALL = 0
+_TK_H = $(_TKDIR)\generic\tk.h
+!endif
+
+!else # TKDIR not defined
+
+# Need to locate Tcl depending on whether it needs Tcl source or not.
+# If we don't, check the INSTALLDIR for an installed Tcl first
+
+!if exist("$(_INSTALLDIR)\include\tk.h") && !$(NEED_TK_SOURCE)
+
+TKINSTALL = 1
+# NOTE: we will be resetting _INSTALLDIR to _INSTALLDIR/lib for extensions
+# later so the \.. accounts for the /lib
+_TKDIR = $(_INSTALLDIR)\..
+_TK_H = $(_TKDIR)\include\tk.h
+TKDIR = $(_TKDIR)
+
+!else # exist("$(_INSTALLDIR)\include\tk.h") && !$(NEED_TK_SOURCE)
+
+!if [echo _TKDIR = \> nmakehlp.out] \
+ || [nmakehlp -L generic\tk.h >> nmakehlp.out]
+!error *** Could not locate Tk source directory.
+!endif
+!include nmakehlp.out
+TKINSTALL = 0
+TKDIR = $(_TKDIR)
+_TK_H = $(_TKDIR)\generic\tk.h
+
+!endif # exist("$(_INSTALLDIR)\include\tk.h") && !$(NEED_TK_SOURCE)
+
+!endif # TKDIR
+
+!ifndef _TK_H
+MSG =^
+Failed to find tk.h. The TKDIR macro is set incorrectly or is not set and default path does not contain tk.h.
+!error $(MSG)
+!endif
+
+!endif # NEED_TK
+
+!if $(NEED_TCL_SOURCE) && $(TCLINSTALL)
+MSG = ^
+*** Warning: This extension requires the source distribution of Tcl.^
+*** Please set the TCLDIR macro to point to the Tcl sources.
+!error $(MSG)
+!endif
+
+!if $(NEED_TK_SOURCE)
+!if $(TKINSTALL)
+MSG = ^
+*** Warning: This extension requires the source distribution of Tk.^
+*** Please set the TKDIR macro to point to the Tk sources.
+!error $(MSG)
+!endif
+!endif
+
+
+# If INSTALLDIR set to Tcl installation root dir then reset to the
+# lib dir for installing extensions
+!if exist("$(_INSTALLDIR)\include\tcl.h")
+_INSTALLDIR=$(_INSTALLDIR)\lib
+!endif
+
+# END Case 2(c) or (d) - Building an extension
+!endif # if $(DOING_TCL)
+
+################################################################
+# 3. Determine compiler version and architecture
+# In this section, we figure out the compiler version and the
+# architecture for which we are building. This sets the
+# following macros:
+# VCVERSION - the internal compiler version as 1200, 1400, 1910 etc.
+# This is also printed by the compiler in dotted form 19.10 etc.
+# VCVER - the "marketing version", for example Visual C++ 6 for internal
+# compiler version 1200. This is kept only for legacy reasons as it
+# does not make sense for recent Microsoft compilers. Only used for
+# output directory names.
+# ARCH - set to IX86 or AMD64 depending on 32- or 64-bit target
+# NATIVE_ARCH - set to IX86 or AMD64 for the host machine
+# MACHINE - same as $(ARCH) - legacy
+# _VC_MANIFEST_EMBED_{DLL,EXE} - commands for embedding a manifest if needed
+# CFG_ENCODING - set to an character encoding.
+# TBD - this is passed to compiler as TCL_CFGVAL_ENCODING but can't
+# see where it is used
+
+cc32 = $(CC) # built-in default.
+link32 = link
+lib32 = lib
+rc32 = $(RC) # built-in default.
+
+#----------------------------------------------------------------
+# Figure out the compiler architecture and version by writing
+# the C macros to a file, preprocessing them with the C
+# preprocessor and reading back the created file
+
+_HASH=^#
+_VC_MANIFEST_EMBED_EXE=
+_VC_MANIFEST_EMBED_DLL=
+VCVER=0
+!if ![echo VCVERSION=_MSC_VER > vercl.x] \
+ && ![echo $(_HASH)if defined(_M_IX86) >> vercl.x] \
+ && ![echo ARCH=IX86 >> vercl.x] \
+ && ![echo $(_HASH)elif defined(_M_AMD64) >> vercl.x] \
+ && ![echo ARCH=AMD64 >> vercl.x] \
+ && ![echo $(_HASH)endif >> vercl.x] \
+ && ![$(cc32) -nologo -TC -P vercl.x 2>NUL]
+!include vercl.i
+!if $(VCVERSION) < 1900
+!if ![echo VCVER= ^\> vercl.vc] \
+ && ![set /a $(VCVERSION) / 100 - 6 >> vercl.vc]
+!include vercl.vc
+!endif
+!else
+# The simple calculation above does not apply to new Visual Studio releases
+# Keep the compiler version in its native form.
+VCVER = $(VCVERSION)
+!endif
+!endif
+
+!if ![del 2>NUL /q/f vercl.x vercl.i vercl.vc]
+!endif
+
+#----------------------------------------------------------------
+# The MACHINE macro is used by legacy makefiles so set it as well
+!ifdef MACHINE
+!if "$(MACHINE)" == "x86"
+!undef MACHINE
+MACHINE = IX86
+!elseif "$(MACHINE)" == "x64"
+!undef MACHINE
+MACHINE = AMD64
+!endif
+!if "$(MACHINE)" != "$(ARCH)"
+!error Specified MACHINE macro $(MACHINE) does not match detected target architecture $(ARCH).
+!endif
+!else
+MACHINE=$(ARCH)
+!endif
+
+#------------------------------------------------------------
+# Figure out the *host* architecture by reading the registry
+
+!if ![reg query HKLM\Hardware\Description\System\CentralProcessor\0 /v Identifier | findstr /i x86]
+NATIVE_ARCH=IX86
+!else
+NATIVE_ARCH=AMD64
+!endif
+
+# Since MSVC8 we must deal with manifest resources.
+!if $(VCVERSION) >= 1400
+_VC_MANIFEST_EMBED_EXE=if exist $@.manifest mt -nologo -manifest $@.manifest -outputresource:$@;1
+_VC_MANIFEST_EMBED_DLL=if exist $@.manifest mt -nologo -manifest $@.manifest -outputresource:$@;2
+!endif
+
+!ifndef CFG_ENCODING
+CFG_ENCODING = \"cp1252\"
+!endif
+
+################################################################
+# 4. Build the nmakehlp program
+# This is a helper app we need to overcome nmake's limiting
+# environment. We will call out to it to get various bits of
+# information about supported compiler options etc.
+#
+# Tcl itself will always use the nmakehlp.c program which is
+# in its own source. This is the "master" copy and kept updated.
+#
+# Extensions built against an installed Tcl will use the installed
+# copy of Tcl's nmakehlp.c if there is one and their own version
+# otherwise. In the latter case, they would also be using their own
+# rules.vc. Note that older versions of Tcl do not install nmakehlp.c
+# or rules.vc.
+#
+# Extensions built against Tcl sources will use the one from the Tcl source.
+#
+# When building an extension using a sufficiently new version of Tcl,
+# rules-ext.vc will define NMAKEHLPC appropriately to point to the
+# copy of nmakehlp.c to be used.
+
+!ifndef NMAKEHLPC
+# Default to the one in the current directory (the extension's own nmakehlp.c)
+NMAKEHLPC = nmakehlp.c
+
+!if !$(DOING_TCL)
+!if $(TCLINSTALL)
+!if exist("$(_TCLDIR)\lib\nmake\nmakehlp.c")
+NMAKEHLPC = $(_TCLDIR)\lib\nmake\nmakehlp.c
+!endif
+!else # ! $(TCLINSTALL)
+!if exist("$(_TCLDIR)\win\nmakehlp.c")
+NMAKEHLPC = $(_TCLDIR)\win\nmakehlp.c
+!endif
+!endif # $(TCLINSTALL)
+!endif # !$(DOING_TCL)
+
+!endif # NMAKEHLPC
+
+# We always build nmakehlp even if it exists since we do not know
+# what source it was built from.
+!if [$(cc32) -nologo "$(NMAKEHLPC)" -link -subsystem:console > nul]
+!endif
+
+################################################################
+# 5. Test for compiler features
+# Visual C++ compiler options have changed over the years. Check
+# which options are supported by the compiler in use.
+#
+# The following macros are set:
+# OPTIMIZATIONS - the compiler flags to be used for optimized builds
+# DEBUGFLAGS - the compiler flags to be used for debug builds
+# LINKERFLAGS - Flags passed to the linker
+#
+# Note that these are the compiler settings *available*, not those
+# that will be *used*. The latter depends on the OPTS macro settings
+# which we have not yet parsed.
+#
+# Also note that some of the flags in OPTIMIZATIONS are not really
+# related to optimization. They are placed there only for legacy reasons
+# as some extensions expect them to be included in that macro.
+
+# -Op improves float consistency. Note only needed for older compilers
+# Newer compilers do not need or support this option.
+!if [nmakehlp -c -Op]
+FPOPTS = -Op
+!endif
+
+# Strict floating point semantics - present in newer compilers in lieu of -Op
+!if [nmakehlp -c -fp:strict]
+FPOPTS = $(FPOPTS) -fp:strict
+!endif
+
+!if "$(MACHINE)" == "IX86"
+### test for pentium errata
+!if [nmakehlp -c -QI0f]
+!message *** Compiler has 'Pentium 0x0f fix'
+FPOPTS = $(FPOPTS) -QI0f
+!else
+!message *** Compiler does not have 'Pentium 0x0f fix'
+!endif
+!endif
+
+### test for optimizations
+# /O2 optimization includes /Og /Oi /Ot /Oy /Ob2 /Gs /GF /Gy as per
+# documentation. Note we do NOT want /Gs as that inserts a _chkstk
+# stack probe at *every* function entry, not just those with more than
+# a page of stack allocation resulting in a performance hit. However,
+# /O2 documentation is misleading as its stack probes are simply the
+# default page size locals allocation probes and not what is implied
+# by an explicit /Gs option.
+
+OPTIMIZATIONS = $(FPOPTS)
+
+!if [nmakehlp -c -O2]
+OPTIMIZING = 1
+OPTIMIZATIONS = $(OPTIMIZATIONS) -O2
+!else
+# Legacy, really. All modern compilers support this
+!message *** Compiler does not have 'Optimizations'
+OPTIMIZING = 0
+!endif
+
+# Checks for buffer overflows in local arrays
+!if [nmakehlp -c -GS]
+OPTIMIZATIONS = $(OPTIMIZATIONS) -GS
+!endif
+
+# Link time optimization. Note that this option (potentially) makes
+# generated libraries only usable by the specific VC++ version that
+# created it. Requires /LTCG linker option
+!if [nmakehlp -c -GL]
+OPTIMIZATIONS = $(OPTIMIZATIONS) -GL
+CC_GL_OPT_ENABLED = 1
+!else
+# In newer compilers -GL and -YX are incompatible.
+!if [nmakehlp -c -YX]
+OPTIMIZATIONS = $(OPTIMIZATIONS) -YX
+!endif
+!endif # [nmakehlp -c -GL]
+
+DEBUGFLAGS = $(FPOPTS)
+
+# Run time error checks. Not available or valid in a release, non-debug build
+# RTC is for modern compilers, -GZ is legacy
+!if [nmakehlp -c -RTC1]
+DEBUGFLAGS = $(DEBUGFLAGS) -RTC1
+!elseif [nmakehlp -c -GZ]
+DEBUGFLAGS = $(DEBUGFLAGS) -GZ
+!endif
+
+#----------------------------------------------------------------
+# Linker flags
+
+# LINKER_TESTFLAGS are for internal use when we call nmakehlp to test
+# if the linker supports a specific option. Without these flags link will
+# return "LNK1561: entry point must be defined" error compiling from VS-IDE:
+# They are not passed through to the actual application / extension
+# link rules.
+!ifndef LINKER_TESTFLAGS
+LINKER_TESTFLAGS = /DLL /NOENTRY /OUT:nmakehlp.out
+!endif
+
+LINKERFLAGS =
+
+# If compiler has enabled link time optimization, linker must too with -ltcg
+!ifdef CC_GL_OPT_ENABLED
+!if [nmakehlp -l -ltcg $(LINKER_TESTFLAGS)]
+LINKERFLAGS = $(LINKERFLAGS) -ltcg
+!endif
+!endif
+
+########################################################################
+# 6. Parse the OPTS macro to work out the requested build configuration.
+# Based on this, we will construct the actual switches to be passed to the
+# compiler and linker using the macros defined in the previous section.
+# The following macros are defined by this section based on OPTS
+# STATIC_BUILD - 0 -> Tcl is to be built as a shared library
+# 1 -> build as a static library and shell
+# TCL_THREADS - legacy but always 1 on Windows since winsock requires it.
+# DEBUG - 1 -> debug build, 0 -> release builds
+# SYMBOLS - 1 -> generate PDB's, 0 -> no PDB's
+# PROFILE - 1 -> generate profiling info, 0 -> no profiling
+# PGO - 1 -> profile based optimization, 0 -> no
+# MSVCRT - 1 -> link to dynamic C runtime even when building static Tcl build
+# 0 -> link to static C runtime for static Tcl build.
+# Does not impact shared Tcl builds (STATIC_BUILD == 0)
+# TCL_USE_STATIC_PACKAGES - 1 -> statically link the registry and dde extensions
+# in the Tcl shell. 0 -> keep them as shared libraries
+# Does not impact shared Tcl builds.
+# USE_THREAD_ALLOC - 1 -> Use a shared global free pool for allocation.
+# 0 -> Use the non-thread allocator.
+# UNCHECKED - 1 -> when doing a debug build with symbols, use the release
+# C runtime, 0 -> use the debug C runtime.
+# USE_STUBS - 1 -> compile to use stubs interfaces, 0 -> direct linking
+# CONFIG_CHECK - 1 -> check current build configuration against Tcl
+# configuration (ignored for Tcl itself)
+# Further, LINKERFLAGS are modified based on above.
+
+# Default values for all the above
+STATIC_BUILD = 0
+TCL_THREADS = 1
+DEBUG = 0
+SYMBOLS = 0
+PROFILE = 0
+PGO = 0
+MSVCRT = 1
+TCL_USE_STATIC_PACKAGES = 0
+USE_THREAD_ALLOC = 1
+UNCHECKED = 0
+CONFIG_CHECK = 1
+!if $(DOING_TCL)
+USE_STUBS = 0
+!else
+USE_STUBS = 1
+!endif
+
+# If OPTS is not empty AND does not contain "none" which turns off all OPTS
+# set the above macros based on OPTS content
+!if "$(OPTS)" != "" && ![nmakehlp -f "$(OPTS)" "none"]
+
+# OPTS are specified, parse them
+
+!if [nmakehlp -f $(OPTS) "static"]
+!message *** Doing static
+STATIC_BUILD = 1
+!endif
+
+!if [nmakehlp -f $(OPTS) "nostubs"]
+!message *** Not using stubs
+USE_STUBS = 0
+!endif
+
+!if [nmakehlp -f $(OPTS) "nomsvcrt"]
+!message *** Doing nomsvcrt
+MSVCRT = 0
+!else
+!if [nmakehlp -f $(OPTS) "msvcrt"]
+!message *** Doing msvcrt
+MSVCRT = 1
+!else
+!if !$(STATIC_BUILD)
+MSVCRT = 1
+!else
+MSVCRT = 0
+!endif
+!endif
+!endif # [nmakehlp -f $(OPTS) "nomsvcrt"]
+
+!if [nmakehlp -f $(OPTS) "staticpkg"] && $(STATIC_BUILD)
+!message *** Doing staticpkg
+TCL_USE_STATIC_PACKAGES = 1
+!else
+TCL_USE_STATIC_PACKAGES = 0
+!endif
+
+!if [nmakehlp -f $(OPTS) "nothreads"]
+!message *** Compile explicitly for non-threaded tcl
+TCL_THREADS = 0
+USE_THREAD_ALLOC= 0
+!else
+TCL_THREADS = 1
+USE_THREAD_ALLOC= 1
+!endif
+
+!if [nmakehlp -f $(OPTS) "symbols"]
+!message *** Doing symbols
+DEBUG = 1
+!else
+DEBUG = 0
+!endif
+
+!if [nmakehlp -f $(OPTS) "pdbs"]
+!message *** Doing pdbs
+SYMBOLS = 1
+!else
+SYMBOLS = 0
+!endif
+
+!if [nmakehlp -f $(OPTS) "profile"]
+!message *** Doing profile
+PROFILE = 1
+!else
+PROFILE = 0
+!endif
+
+!if [nmakehlp -f $(OPTS) "pgi"]
+!message *** Doing profile guided optimization instrumentation
+PGO = 1
+!elseif [nmakehlp -f $(OPTS) "pgo"]
+!message *** Doing profile guided optimization
+PGO = 2
+!else
+PGO = 0
+!endif
+
+!if [nmakehlp -f $(OPTS) "loimpact"]
+!message *** Warning: ignoring option "loimpact" - deprecated on modern Windows.
+!endif
+
+# TBD - should get rid of this option
+!if [nmakehlp -f $(OPTS) "thrdalloc"]
+!message *** Doing thrdalloc
+USE_THREAD_ALLOC = 1
+!endif
+
+!if [nmakehlp -f $(OPTS) "tclalloc"]
+USE_THREAD_ALLOC = 0
+!endif
+
+!if [nmakehlp -f $(OPTS) "unchecked"]
+!message *** Doing unchecked
+UNCHECKED = 1
+!else
+UNCHECKED = 0
+!endif
+
+!if [nmakehlp -f $(OPTS) "noconfigcheck"]
+CONFIG_CHECK = 1
+!else
+CONFIG_CHECK = 0
+!endif
+
+!endif # "$(OPTS)" != "" && ... parsing of OPTS
+
+# Set linker flags based on above
+
+!if $(PGO) > 1
+!if [nmakehlp -l -ltcg:pgoptimize $(LINKER_TESTFLAGS)]
+LINKERFLAGS = $(LINKERFLAGS:-ltcg=) -ltcg:pgoptimize
+!else
+MSG=^
+This compiler does not support profile guided optimization.
+!error $(MSG)
+!endif
+!elseif $(PGO) > 0
+!if [nmakehlp -l -ltcg:pginstrument $(LINKER_TESTFLAGS)]
+LINKERFLAGS = $(LINKERFLAGS:-ltcg=) -ltcg:pginstrument
+!else
+MSG=^
+This compiler does not support profile guided optimization.
+!error $(MSG)
+!endif
+!endif
+
+################################################################
+# 7. Parse the STATS macro to configure code instrumentation
+# The following macros are set by this section:
+# TCL_MEM_DEBUG - 1 -> enables memory allocation instrumentation
+# 0 -> disables
+# TCL_COMPILE_DEBUG - 1 -> enables byte compiler logging
+# 0 -> disables
+
+# Default both are off
+TCL_MEM_DEBUG = 0
+TCL_COMPILE_DEBUG = 0
+
+!if "$(STATS)" != "" && ![nmakehlp -f "$(STATS)" "none"]
+
+!if [nmakehlp -f $(STATS) "memdbg"]
+!message *** Doing memdbg
+TCL_MEM_DEBUG = 1
+!else
+TCL_MEM_DEBUG = 0
+!endif
+
+!if [nmakehlp -f $(STATS) "compdbg"]
+!message *** Doing compdbg
+TCL_COMPILE_DEBUG = 1
+!else
+TCL_COMPILE_DEBUG = 0
+!endif
+
+!endif
+
+####################################################################
+# 8. Parse the CHECKS macro to configure additional compiler checks
+# The following macros are set by this section:
+# WARNINGS - compiler switches that control the warnings level
+# TCL_NO_DEPRECATED - 1 -> disable support for deprecated functions
+# 0 -> enable deprecated functions
+
+# Defaults - Permit deprecated functions and warning level 3
+TCL_NO_DEPRECATED = 0
+WARNINGS = -W3
+
+!if "$(CHECKS)" != "" && ![nmakehlp -f "$(CHECKS)" "none"]
+
+!if [nmakehlp -f $(CHECKS) "nodep"]
+!message *** Doing nodep check
+TCL_NO_DEPRECATED = 1
+!endif
+
+!if [nmakehlp -f $(CHECKS) "fullwarn"]
+!message *** Doing full warnings check
+WARNINGS = -W4
+!if [nmakehlp -l -warn:3 $(LINKER_TESTFLAGS)]
+LINKERFLAGS = $(LINKERFLAGS) -warn:3
+!endif
+!endif
+
+!if [nmakehlp -f $(CHECKS) "64bit"] && [nmakehlp -c -Wp64]
+!message *** Doing 64bit portability warnings
+WARNINGS = $(WARNINGS) -Wp64
+!endif
+
+!endif
+
+################################################################
+# 9. Extract various version numbers
+# For Tcl and Tk, version numbers are extracted from tcl.h and tk.h
+# respectively. For extensions, versions are extracted from the
+# configure.in or configure.ac from the TEA configuration if it
+# exists, and unset otherwise.
+# Sets the following macros:
+# TCL_MAJOR_VERSION
+# TCL_MINOR_VERSION
+# TCL_PATCH_LEVEL
+# TCL_VERSION
+# TK_MAJOR_VERSION
+# TK_MINOR_VERSION
+# TK_PATCH_LEVEL
+# TK_VERSION
+# DOTVERSION - set as (for example) 2.5
+# VERSION - set as (for example 25)
+#--------------------------------------------------------------
+
+!if [echo REM = This file is generated from rules.vc > versions.vc]
+!endif
+!if [echo TCL_MAJOR_VERSION = \>> versions.vc] \
+ && [nmakehlp -V "$(_TCL_H)" TCL_MAJOR_VERSION >> versions.vc]
+!endif
+!if [echo TCL_MINOR_VERSION = \>> versions.vc] \
+ && [nmakehlp -V "$(_TCL_H)" TCL_MINOR_VERSION >> versions.vc]
+!endif
+!if [echo TCL_PATCH_LEVEL = \>> versions.vc] \
+ && [nmakehlp -V "$(_TCL_H)" TCL_PATCH_LEVEL >> versions.vc]
+!endif
+
+!if defined(_TK_H)
+!if [echo TK_MAJOR_VERSION = \>> versions.vc] \
+ && [nmakehlp -V $(_TK_H) TK_MAJOR_VERSION >> versions.vc]
+!endif
+!if [echo TK_MINOR_VERSION = \>> versions.vc] \
+ && [nmakehlp -V $(_TK_H) TK_MINOR_VERSION >> versions.vc]
+!endif
+!if [echo TK_PATCH_LEVEL = \>> versions.vc] \
+ && [nmakehlp -V $(_TK_H) TK_PATCH_LEVEL >> versions.vc]
+!endif
+!endif # _TK_H
+
+!include versions.vc
+
+TCL_VERSION = $(TCL_MAJOR_VERSION)$(TCL_MINOR_VERSION)
+TCL_DOTVERSION = $(TCL_MAJOR_VERSION).$(TCL_MINOR_VERSION)
+!if defined(_TK_H)
+TK_VERSION = $(TK_MAJOR_VERSION)$(TK_MINOR_VERSION)
+TK_DOTVERSION = $(TK_MAJOR_VERSION).$(TK_MINOR_VERSION)
+!endif
+
+# Set DOTVERSION and VERSION
+!if $(DOING_TCL)
+
+DOTVERSION = $(TCL_MAJOR_VERSION).$(TCL_MINOR_VERSION)
+VERSION = $(TCL_VERSION)
+
+!elseif $(DOING_TK)
+
+DOTVERSION = $(TK_DOTVERSION)
+VERSION = $(TK_VERSION)
+
+!else # Doing a non-Tk extension
+
+# If parent makefile has not defined DOTVERSION, try to get it from TEA
+# first from a configure.in file, and then from configure.ac
+!ifndef DOTVERSION
+!if [echo DOTVERSION = \> versions.vc] \
+ || [nmakehlp -V $(ROOT)\configure.in ^[$(PROJECT)^] >> versions.vc]
+!if [echo DOTVERSION = \> versions.vc] \
+ || [nmakehlp -V $(ROOT)\configure.ac ^[$(PROJECT)^] >> versions.vc]
+!error *** Could not figure out extension version. Please define DOTVERSION in parent makefile before including rules.vc.
+!endif
+!endif
+!include versions.vc
+!endif # DOTVERSION
+VERSION = $(DOTVERSION:.=)
+
+!endif # $(DOING_TCL) ... etc.
+
+################################################################
+# 10. Construct output directory and file paths
+# Figure-out how to name our intermediate and output directories.
+# In order to avoid inadvertent mixing of object files built using
+# different compilers, build configurations etc.,
+#
+# Naming convention (suffixes):
+# t = full thread support.
+# s = static library (as opposed to an import library)
+# g = linked to the debug enabled C run-time.
+# x = special static build when it links to the dynamic C run-time.
+#
+# The following macros are set in this section:
+# SUFX - the suffix to use for binaries based on above naming convention
+# BUILDDIRTOP - the toplevel default output directory
+# is of the form {Release,Debug}[_AMD64][_COMPILERVERSION]
+# TMP_DIR - directory where object files are created
+# OUT_DIR - directory where output executables are created
+# Both TMP_DIR and OUT_DIR are defaulted only if not defined by the
+# parent makefile (or command line). The default values are
+# based on BUILDDIRTOP.
+# STUBPREFIX - name of the stubs library for this project
+# PRJIMPLIB - output path of the generated project import library
+# PRJLIBNAME - name of generated project library
+# PRJLIB - output path of generated project library
+# PRJSTUBLIBNAME - name of the generated project stubs library
+# PRJSTUBLIB - output path of the generated project stubs library
+# RESFILE - output resource file (only if not static build)
+
+SUFX = tsgx
+
+!if $(DEBUG)
+BUILDDIRTOP = Debug
+!else
+BUILDDIRTOP = Release
+!endif
+
+!if "$(MACHINE)" != "IX86"
+BUILDDIRTOP =$(BUILDDIRTOP)_$(MACHINE)
+!endif
+!if $(VCVER) > 6
+BUILDDIRTOP =$(BUILDDIRTOP)_VC$(VCVER)
+!endif
+
+!if !$(DEBUG) || $(DEBUG) && $(UNCHECKED)
+SUFX = $(SUFX:g=)
+!endif
+
+TMP_DIRFULL = .\$(BUILDDIRTOP)\$(PROJECT)_ThreadedDynamicStaticX
+
+!if !$(STATIC_BUILD)
+TMP_DIRFULL = $(TMP_DIRFULL:Static=)
+SUFX = $(SUFX:s=)
+EXT = dll
+TMP_DIRFULL = $(TMP_DIRFULL:X=)
+SUFX = $(SUFX:x=)
+!else
+TMP_DIRFULL = $(TMP_DIRFULL:Dynamic=)
+EXT = lib
+!if !$(MSVCRT)
+TMP_DIRFULL = $(TMP_DIRFULL:X=)
+SUFX = $(SUFX:x=)
+!endif
+!endif
+
+!if !$(TCL_THREADS)
+TMP_DIRFULL = $(TMP_DIRFULL:Threaded=)
+SUFX = $(SUFX:t=)
+!endif
+
+!ifndef TMP_DIR
+TMP_DIR = $(TMP_DIRFULL)
+!ifndef OUT_DIR
+OUT_DIR = .\$(BUILDDIRTOP)
+!endif
+!else
+!ifndef OUT_DIR
+OUT_DIR = $(TMP_DIR)
+!endif
+!endif
+
+# Relative paths -> absolute
+!if [echo OUT_DIR = \> nmakehlp.out] \
+ || [nmakehlp -Q "$(OUT_DIR)" >> nmakehlp.out]
+!error *** Could not fully qualify path OUT_DIR=$(OUT_DIR)
+!endif
+!if [echo TMP_DIR = \>> nmakehlp.out] \
+ || [nmakehlp -Q "$(TMP_DIR)" >> nmakehlp.out]
+!error *** Could not fully qualify path TMP_DIR=$(TMP_DIR)
+!endif
+!include nmakehlp.out
+
+# The name of the stubs library for the project being built
+STUBPREFIX = $(PROJECT)stub
+
+# Set up paths to various Tcl executables and libraries needed by extensions
+!if $(DOING_TCL)
+
+TCLSHNAME = $(PROJECT)sh$(VERSION)$(SUFX).exe
+TCLSH = $(OUT_DIR)\$(TCLSHNAME)
+TCLIMPLIB = $(OUT_DIR)\$(PROJECT)$(VERSION)$(SUFX).lib
+TCLLIBNAME = $(PROJECT)$(VERSION)$(SUFX).$(EXT)
+TCLLIB = $(OUT_DIR)\$(TCLLIBNAME)
+
+TCLSTUBLIBNAME = $(STUBPREFIX)$(VERSION).lib
+TCLSTUBLIB = $(OUT_DIR)\$(TCLSTUBLIBNAME)
+TCL_INCLUDES = -I"$(WINDIR)" -I"$(GENERICDIR)"
+
+!else # ! $(DOING_TCL)
+
+!if $(TCLINSTALL) # Building against an installed Tcl
+
+# When building extensions, we need to locate tclsh. Depending on version
+# of Tcl we are building against, this may or may not have a "t" suffix.
+# Try various possibilities in turn.
+TCLSH = $(_TCLDIR)\bin\tclsh$(TCL_VERSION)$(SUFX).exe
+!if !exist("$(TCLSH)") && $(TCL_THREADS)
+TCLSH = $(_TCLDIR)\bin\tclsh$(TCL_VERSION)t$(SUFX).exe
+!endif
+!if !exist("$(TCLSH)")
+TCLSH = $(_TCLDIR)\bin\tclsh$(TCL_VERSION)$(SUFX:t=).exe
+!endif
+
+TCLSTUBLIB = $(_TCLDIR)\lib\tclstub$(TCL_VERSION).lib
+TCLIMPLIB = $(_TCLDIR)\lib\tcl$(TCL_VERSION)$(SUFX).lib
+# When building extensions, may be linking against Tcl that does not add
+# "t" suffix (e.g. 8.5 or 8.7). If lib not found check for that possibility.
+!if !exist("$(TCLIMPLIB)")
+TCLIMPLIB = $(_TCLDIR)\lib\tcl$(TCL_VERSION)$(SUFX:t=).lib
+!endif
+TCL_LIBRARY = $(_TCLDIR)\lib
+TCLREGLIB = $(_TCLDIR)\lib\tclreg13$(SUFX:t=).lib
+TCLDDELIB = $(_TCLDIR)\lib\tcldde14$(SUFX:t=).lib
+TCLTOOLSDIR = \must\have\tcl\sources\to\build\this\target
+TCL_INCLUDES = -I"$(_TCLDIR)\include"
+
+!else # Building against Tcl sources
+
+TCLSH = $(_TCLDIR)\win\$(BUILDDIRTOP)\tclsh$(TCL_VERSION)$(SUFX).exe
+!if !exist($(TCLSH)) && $(TCL_THREADS)
+TCLSH = $(_TCLDIR)\win\$(BUILDDIRTOP)\tclsh$(TCL_VERSION)t$(SUFX).exe
+!endif
+!if !exist($(TCLSH))
+TCLSH = $(_TCLDIR)\win\$(BUILDDIRTOP)\tclsh$(TCL_VERSION)$(SUFX:t=).exe
+!endif
+TCLSTUBLIB = $(_TCLDIR)\win\$(BUILDDIRTOP)\tclstub$(TCL_VERSION).lib
+TCLIMPLIB = $(_TCLDIR)\win\$(BUILDDIRTOP)\tcl$(TCL_VERSION)$(SUFX).lib
+# When building extensions, may be linking against Tcl that does not add
+# "t" suffix (e.g. 8.5 or 8.7). If lib not found check for that possibility.
+!if !exist("$(TCLIMPLIB)")
+TCLIMPLIB = $(_TCLDIR)\win\$(BUILDDIRTOP)\tcl$(TCL_VERSION)$(SUFX:t=).lib
+!endif
+TCL_LIBRARY = $(_TCLDIR)\library
+TCLREGLIB = $(_TCLDIR)\win\$(BUILDDIRTOP)\tclreg13$(SUFX:t=).lib
+TCLDDELIB = $(_TCLDIR)\win\$(BUILDDIRTOP)\tcldde14$(SUFX:t=).lib
+TCLTOOLSDIR = $(_TCLDIR)\tools
+TCL_INCLUDES = -I"$(_TCLDIR)\generic" -I"$(_TCLDIR)\win"
+
+!endif # TCLINSTALL
+
+tcllibs = "$(TCLSTUBLIB)" "$(TCLIMPLIB)"
+
+!endif # $(DOING_TCL)
+
+# We need a tclsh that will run on the host machine as part of the build.
+# IX86 runs on all architectures.
+!ifndef TCLSH_NATIVE
+!if "$(MACHINE)" == "IX86" || "$(MACHINE)" == "$(NATIVE_ARCH)"
+TCLSH_NATIVE = $(TCLSH)
+!else
+!error You must explicitly set TCLSH_NATIVE for cross-compilation
+!endif
+!endif
+
+# Do the same for Tk and Tk extensions that require the Tk libraries
+!if $(DOING_TK) || $(NEED_TK)
+WISHNAMEPREFIX = wish
+WISHNAME = $(WISHNAMEPREFIX)$(TK_VERSION)$(SUFX).exe
+TKLIBNAME = $(PROJECT)$(TK_VERSION)$(SUFX).$(EXT)
+TKSTUBLIBNAME = tkstub$(TK_VERSION).lib
+TKIMPLIBNAME = tk$(TK_VERSION)$(SUFX).lib
+
+!if $(DOING_TK)
+WISH = $(OUT_DIR)\$(WISHNAME)
+TKSTUBLIB = $(OUT_DIR)\$(TKSTUBLIBNAME)
+TKIMPLIB = $(OUT_DIR)\$(TKIMPLIBNAME)
+TKLIB = $(OUT_DIR)\$(TKLIBNAME)
+TK_INCLUDES = -I"$(WINDIR)" -I"$(GENERICDIR)"
+
+!else # effectively NEED_TK
+
+!if $(TKINSTALL) # Building against installed Tk
+WISH = $(_TKDIR)\bin\$(WISHNAME)
+TKSTUBLIB = $(_TKDIR)\lib\$(TKSTUBLIBNAME)
+TKIMPLIB = $(_TKDIR)\lib\$(TKIMPLIBNAME)
+# When building extensions, may be linking against Tk that does not add
+# "t" suffix (e.g. 8.5 or 8.7). If lib not found check for that possibility.
+!if !exist("$(TKIMPLIB)")
+TKIMPLIBNAME = tk$(TK_VERSION)$(SUFX:t=).lib
+TKIMPLIB = $(_TKDIR)\lib\$(TKIMPLIBNAME)
+!endif
+TK_INCLUDES = -I"$(_TKDIR)\include"
+!else # Building against Tk sources
+WISH = $(_TKDIR)\win\$(BUILDDIRTOP)\$(WISHNAME)
+TKSTUBLIB = $(_TKDIR)\win\$(BUILDDIRTOP)\$(TKSTUBLIBNAME)
+TKIMPLIB = $(_TKDIR)\win\$(BUILDDIRTOP)\$(TKIMPLIBNAME)
+# When building extensions, may be linking against Tk that does not add
+# "t" suffix (e.g. 8.5 or 8.7). If lib not found check for that possibility.
+!if !exist("$(TKIMPLIB)")
+TKIMPLIBNAME = tk$(TK_VERSION)$(SUFX:t=).lib
+TKIMPLIB = $(_TKDIR)\win\$(BUILDDIRTOP)\$(TKIMPLIBNAME)
+!endif
+TK_INCLUDES = -I"$(_TKDIR)\generic" -I"$(_TKDIR)\win" -I"$(_TKDIR)\xlib"
+!endif # TKINSTALL
+tklibs = "$(TKSTUBLIB)" "$(TKIMPLIB)"
+
+!endif # $(DOING_TK)
+!endif # $(DOING_TK) || $(NEED_TK)
+
+# Various output paths
+PRJIMPLIB = $(OUT_DIR)\$(PROJECT)$(VERSION)$(SUFX:t=).lib
+PRJLIBNAME = $(PROJECT)$(VERSION)$(SUFX:t=).$(EXT)
+PRJLIB = $(OUT_DIR)\$(PRJLIBNAME)
+
+PRJSTUBLIBNAME = $(STUBPREFIX)$(VERSION).lib
+PRJSTUBLIB = $(OUT_DIR)\$(PRJSTUBLIBNAME)
+
+# If extension parent makefile has not defined a resource definition file,
+# we will generate one from standard template.
+!if !$(DOING_TCL) && !$(DOING_TK) && !$(STATIC_BUILD)
+!ifdef RCFILE
+RESFILE = $(TMP_DIR)\$(RCFILE:.rc=.res)
+!else
+RESFILE = $(TMP_DIR)\$(PROJECT).res
+!endif
+!endif
+
+###################################################################
+# 11. Construct the paths for the installation directories
+# The following macros get defined in this section:
+# LIB_INSTALL_DIR - where libraries should be installed
+# BIN_INSTALL_DIR - where the executables should be installed
+# DOC_INSTALL_DIR - where documentation should be installed
+# SCRIPT_INSTALL_DIR - where scripts should be installed
+# INCLUDE_INSTALL_DIR - where C include files should be installed
+# DEMO_INSTALL_DIR - where demos should be installed
+# PRJ_INSTALL_DIR - where package will be installed (not set for Tcl and Tk)
+
+!if $(DOING_TCL) || $(DOING_TK)
+LIB_INSTALL_DIR = $(_INSTALLDIR)\lib
+BIN_INSTALL_DIR = $(_INSTALLDIR)\bin
+DOC_INSTALL_DIR = $(_INSTALLDIR)\doc
+!if $(DOING_TCL)
+SCRIPT_INSTALL_DIR = $(_INSTALLDIR)\lib\$(PROJECT)$(TCL_MAJOR_VERSION).$(TCL_MINOR_VERSION)
+!else # DOING_TK
+SCRIPT_INSTALL_DIR = $(_INSTALLDIR)\lib\$(PROJECT)$(TK_MAJOR_VERSION).$(TK_MINOR_VERSION)
+!endif
+DEMO_INSTALL_DIR = $(SCRIPT_INSTALL_DIR)\demos
+INCLUDE_INSTALL_DIR = $(_INSTALLDIR)\include
+
+!else # extension other than Tk
+
+PRJ_INSTALL_DIR = $(_INSTALLDIR)\$(PROJECT)$(DOTVERSION)
+LIB_INSTALL_DIR = $(PRJ_INSTALL_DIR)
+BIN_INSTALL_DIR = $(PRJ_INSTALL_DIR)
+DOC_INSTALL_DIR = $(PRJ_INSTALL_DIR)
+SCRIPT_INSTALL_DIR = $(PRJ_INSTALL_DIR)
+DEMO_INSTALL_DIR = $(PRJ_INSTALL_DIR)\demos
+INCLUDE_INSTALL_DIR = $(_INSTALLDIR)\..\include
+
+!endif
+
+###################################################################
+# 12. Set up actual options to be passed to the compiler and linker
+# Now we have all the information we need, set up the actual flags and
+# options that we will pass to the compiler and linker. The main
+# makefile should use these in combination with whatever other flags
+# and switches are specific to it.
+# The following macros are defined, names are for historical compatibility:
+# OPTDEFINES - /Dxxx C macro flags based on user-specified OPTS
+# COMPILERFLAGS - /Dxxx C macro flags independent of any configuration opttions
+# crt - Compiler switch that selects the appropriate C runtime
+# cdebug - Compiler switches related to debug AND optimizations
+# cwarn - Compiler switches that set warning levels
+# cflags - complete compiler switches (subsumes cdebug and cwarn)
+# ldebug - Linker switches controlling debug information and optimization
+# lflags - complete linker switches (subsumes ldebug) except subsystem type
+# dlllflags - complete linker switches to build DLLs (subsumes lflags)
+# conlflags - complete linker switches for console program (subsumes lflags)
+# guilflags - complete linker switches for GUI program (subsumes lflags)
+# baselibs - minimum Windows libraries required. Parent makefile can
+# define PRJ_LIBS before including rules.rc if additional libs are needed
+
+OPTDEFINES = -DTCL_CFGVAL_ENCODING=$(CFG_ENCODING) -DSTDC_HEADERS
+
+!if $(TCL_MEM_DEBUG)
+OPTDEFINES = $(OPTDEFINES) -DTCL_MEM_DEBUG
+!endif
+!if $(TCL_COMPILE_DEBUG)
+OPTDEFINES = $(OPTDEFINES) -DTCL_COMPILE_DEBUG -DTCL_COMPILE_STATS
+!endif
+!if $(TCL_THREADS)
+OPTDEFINES = $(OPTDEFINES) -DTCL_THREADS=1
+!if $(USE_THREAD_ALLOC)
+OPTDEFINES = $(OPTDEFINES) -DUSE_THREAD_ALLOC=1
+!endif
+!endif
+!if $(STATIC_BUILD)
+OPTDEFINES = $(OPTDEFINES) -DSTATIC_BUILD
+!endif
+!if $(TCL_NO_DEPRECATED)
+OPTDEFINES = $(OPTDEFINES) -DTCL_NO_DEPRECATED
+!endif
+
+!if $(USE_STUBS)
+# Note we do not define USE_TCL_STUBS even when building tk since some
+# test targets in tk do not use stubs
+!if ! $(DOING_TCL)
+USE_STUBS_DEFS = -DUSE_TCL_STUBS -DUSE_TCLOO_STUBS
+!if $(NEED_TK)
+USE_STUBS_DEFS = $(USE_STUBS_DEFS) -DUSE_TK_STUBS
+!endif
+!endif
+!endif # USE_STUBS
+
+!if !$(DEBUG)
+OPTDEFINES = $(OPTDEFINES) -DNDEBUG
+!if $(OPTIMIZING)
+OPTDEFINES = $(OPTDEFINES) -DTCL_CFG_OPTIMIZED
+!endif
+!endif
+!if $(PROFILE)
+OPTDEFINES = $(OPTDEFINES) -DTCL_CFG_PROFILED
+!endif
+!if "$(MACHINE)" == "AMD64"
+OPTDEFINES = $(OPTDEFINES) -DTCL_CFG_DO64BIT
+!endif
+!if $(VCVERSION) < 1300
+OPTDEFINES = $(OPTDEFINES) -DNO_STRTOI64
+!endif
+
+# _ATL_XP_TARGETING - Newer SDK's need this to build for XP
+COMPILERFLAGS = /D_ATL_XP_TARGETING
+
+# Following is primarily for the benefit of extensions. Tcl 8.5 builds
+# Tcl without /DUNICODE, while 8.6 builds with it defined. When building
+# an extension, it is advisable (but not mandated) to use the same Windows
+# API as the Tcl build. This is accordingly defaulted below. A particular
+# extension can override this by pre-definining USE_WIDECHAR_API.
+!ifndef USE_WIDECHAR_API
+!if $(TCL_VERSION) > 85
+USE_WIDECHAR_API = 1
+!else
+USE_WIDECHAR_API = 0
+!endif
+!endif
+
+!if $(USE_WIDECHAR_API)
+COMPILERFLAGS = $(COMPILERFLAGS) /DUNICODE /D_UNICODE
+!endif
+
+# Like the TEA system only set this non empty for non-Tk extensions
+# Note: some extensions use PACKAGE_NAME and others use PACKAGE_TCLNAME
+# so we pass both
+!if !$(DOING_TCL) && !$(DOING_TK)
+PKGNAMEFLAGS = -DPACKAGE_NAME="\"$(PRJ_PACKAGE_TCLNAME)\"" \
+ -DPACKAGE_TCLNAME="\"$(PRJ_PACKAGE_TCLNAME)\"" \
+ -DPACKAGE_VERSION="\"$(DOTVERSION)\"" \
+ -DMODULE_SCOPE=extern
+!endif
+
+# crt picks the C run time based on selected OPTS
+!if $(MSVCRT)
+!if $(DEBUG) && !$(UNCHECKED)
+crt = -MDd
+!else
+crt = -MD
+!endif
+!else
+!if $(DEBUG) && !$(UNCHECKED)
+crt = -MTd
+!else
+crt = -MT
+!endif
+!endif
+
+# cdebug includes compiler options for debugging as well as optimization.
+!if $(DEBUG)
+
+# In debugging mode, optimizations need to be disabled
+cdebug = -Zi -Od $(DEBUGFLAGS)
+
+!else
+
+cdebug = $(OPTIMIZATIONS)
+!if $(SYMBOLS)
+cdebug = $(cdebug) -Zi
+!endif
+
+!endif # $(DEBUG)
+
+# cwarn includes default warning levels.
+cwarn = $(WARNINGS)
+
+!if "$(MACHINE)" == "AMD64"
+# Disable pointer<->int warnings related to cast between different sizes
+# There are a gadzillion of these due to use of ClientData and
+# clutter up compiler
+# output increasing chance of a real warning getting lost. So disable them.
+# Eventually some day, Tcl will be 64-bit clean.
+cwarn = $(cwarn) -wd4311 -wd4312
+!endif
+
+### Common compiler options that are architecture specific
+!if "$(MACHINE)" == "ARM"
+carch = -D_ARM_WINAPI_PARTITION_DESKTOP_SDK_AVAILABLE
+!else
+carch =
+!endif
+
+!if $(DEBUG)
+# Turn warnings into errors
+cwarn = $(cwarn) -WX
+!endif
+
+INCLUDES = $(TCL_INCLUDES) $(TK_INCLUDES) $(PRJ_INCLUDES)
+!if !$(DOING_TCL) && !$(DOING_TK)
+INCLUDES = $(INCLUDES) -I"$(GENERICDIR)" -I"$(WINDIR)" -I"$(COMPATDIR)"
+!endif
+
+# These flags are defined roughly in the order of the pre-reform
+# rules.vc/makefile.vc to help visually compare that the pre- and
+# post-reform build logs
+
+# cflags contains generic flags used for building practically all object files
+cflags = -nologo -c $(COMPILERFLAGS) $(carch) $(cwarn) -Fp$(TMP_DIR)^\ $(cdebug)
+
+# appcflags contains $(cflags) and flags for building the application
+# object files (e.g. tclsh, or wish) pkgcflags contains $(cflags) plus
+# flags used for building shared object files The two differ in the
+# BUILD_$(PROJECT) macro which should be defined only for the shared
+# library *implementation* and not for its caller interface
+
+appcflags = $(cflags) $(crt) $(INCLUDES) $(TCL_DEFINES) $(PRJ_DEFINES) $(OPTDEFINES) $(USE_STUBS_DEFS)
+appcflags_nostubs = $(cflags) $(crt) $(INCLUDES) $(TCL_DEFINES) $(PRJ_DEFINES) $(OPTDEFINES)
+pkgcflags = $(appcflags) $(PKGNAMEFLAGS) -DBUILD_$(PROJECT)
+pkgcflags_nostubs = $(appcflags_nostubs) $(PKGNAMEFLAGS) -DBUILD_$(PROJECT)
+
+# stubscflags contains $(cflags) plus flags used for building a stubs
+# library for the package. Note: -DSTATIC_BUILD is defined in
+# $(OPTDEFINES) only if the OPTS configuration indicates a static
+# library. However the stubs library is ALWAYS static hence included
+# here irrespective of the OPTS setting.
+#
+# TBD - tclvfs has a comment that stubs libs should not be compiled with -GL
+# without stating why. Tcl itself compiled stubs libs with this flag.
+# so we do not remove it from cflags. -GL may prevent extensions
+# compiled with one VC version to fail to link against stubs library
+# compiled with another VC version. Check for this and fix accordingly.
+stubscflags = $(cflags) $(PKGNAMEFLAGS) $(PRJ_DEFINES) $(OPTDEFINES) -Zl -DSTATIC_BUILD $(INCLUDES)
+
+# Link flags
+
+!if $(DEBUG)
+ldebug = -debug -debugtype:cv
+!else
+ldebug = -release -opt:ref -opt:icf,3
+!if $(SYMBOLS)
+ldebug = $(ldebug) -debug -debugtype:cv
+!endif
+!endif
+
+# Note: Profiling is currently only possible with the Visual Studio Enterprise
+!if $(PROFILE)
+ldebug= $(ldebug) -profile
+!endif
+
+### Declarations common to all linker versions
+lflags = -nologo -machine:$(MACHINE) $(LINKERFLAGS) $(ldebug)
+
+!if $(MSVCRT) && !($(DEBUG) && !$(UNCHECKED)) && $(VCVERSION) >= 1900
+lflags = $(lflags) -nodefaultlib:libucrt.lib
+!endif
+
+dlllflags = $(lflags) -dll
+conlflags = $(lflags) -subsystem:console
+guilflags = $(lflags) -subsystem:windows
+
+# Libraries that are required for every image.
+# Extensions should define any additional libraries with $(PRJ_LIBS)
+winlibs = kernel32.lib advapi32.lib
+
+!if $(NEED_TK)
+winlibs = $(winlibs) gdi32.lib user32.lib uxtheme.lib
+!endif
+
+# Avoid 'unresolved external symbol __security_cookie' errors.
+# c.f. http://support.microsoft.com/?id=894573
+!if "$(MACHINE)" == "AMD64"
+!if $(VCVERSION) > 1399 && $(VCVERSION) < 1500
+winlibs = $(winlibs) bufferoverflowU.lib
+!endif
+!endif
+
+baselibs = $(winlibs) $(PRJ_LIBS)
+
+!if $(MSVCRT) && !($(DEBUG) && !$(UNCHECKED)) && $(VCVERSION) >= 1900
+baselibs = $(baselibs) ucrt.lib
+!endif
+
+################################################################
+# 13. Define standard commands, common make targets and implicit rules
+
+CCPKGCMD = $(cc32) $(pkgcflags) -Fo$(TMP_DIR)^\
+CCAPPCMD = $(cc32) $(appcflags) -Fo$(TMP_DIR)^\
+CCSTUBSCMD = $(cc32) $(stubscflags) -Fo$(TMP_DIR)^\
+
+LIBCMD = $(lib32) -nologo $(LINKERFLAGS) -out:$@
+DLLCMD = $(link32) $(dlllflags) -out:$@ $(baselibs) $(tcllibs) $(tklibs)
+
+CONEXECMD = $(link32) $(conlflags) -out:$@ $(baselibs) $(tcllibs) $(tklibs)
+GUIEXECMD = $(link32) $(guilflags) -out:$@ $(baselibs) $(tcllibs) $(tklibs)
+RESCMD = $(rc32) -fo $@ -r -i "$(GENERICDIR)" -i "$(TMP_DIR)" \
+ $(TCL_INCLUDES) \
+ -DDEBUG=$(DEBUG) -d UNCHECKED=$(UNCHECKED) \
+ -DCOMMAVERSION=$(DOTVERSION:.=,),0 \
+ -DDOTVERSION=\"$(DOTVERSION)\" \
+ -DVERSION=\"$(VERSION)\" \
+ -DSUFX=\"$(SUFX:t=)\" \
+ -DPROJECT=\"$(PROJECT)\" \
+ -DPRJLIBNAME=\"$(PRJLIBNAME)\"
+
+!ifndef DEFAULT_BUILD_TARGET
+DEFAULT_BUILD_TARGET = $(PROJECT)
+!endif
+
+default-target: $(DEFAULT_BUILD_TARGET)
+
+default-pkgindex:
+ @echo package ifneeded $(PRJ_PACKAGE_TCLNAME) $(DOTVERSION) \
+ [list load [file join $$dir $(PRJLIBNAME)]] > $(OUT_DIR)\pkgIndex.tcl
+
+default-pkgindex-tea:
+ @if exist $(ROOT)\pkgIndex.tcl.in nmakehlp -s << $(ROOT)\pkgIndex.tcl.in > $(OUT_DIR)\pkgIndex.tcl
+@PACKAGE_VERSION@ $(DOTVERSION)
+@PACKAGE_NAME@ $(PRJ_PACKAGE_TCLNAME)
+@PACKAGE_TCLNAME@ $(PRJ_PACKAGE_TCLNAME)
+@PKG_LIB_FILE@ $(PRJLIBNAME)
+<<
+
+
+default-install: default-install-binaries default-install-libraries
+
+default-install-binaries: $(PRJLIB)
+ @echo Installing binaries to '$(SCRIPT_INSTALL_DIR)'
+ @if not exist "$(SCRIPT_INSTALL_DIR)" mkdir "$(SCRIPT_INSTALL_DIR)"
+ @$(CPY) $(PRJLIB) "$(SCRIPT_INSTALL_DIR)" >NUL
+
+default-install-libraries: $(OUT_DIR)\pkgIndex.tcl
+ @echo Installing libraries to '$(SCRIPT_INSTALL_DIR)'
+ @if exist $(LIBDIR) $(CPY) $(LIBDIR)\*.tcl "$(SCRIPT_INSTALL_DIR)"
+ @echo Installing package index in '$(SCRIPT_INSTALL_DIR)'
+ @$(CPY) $(OUT_DIR)\pkgIndex.tcl $(SCRIPT_INSTALL_DIR)
+
+default-install-stubs:
+ @echo Installing stubs library to '$(SCRIPT_INSTALL_DIR)'
+ @if not exist "$(SCRIPT_INSTALL_DIR)" mkdir "$(SCRIPT_INSTALL_DIR)"
+ @$(CPY) $(PRJSTUBLIB) "$(SCRIPT_INSTALL_DIR)" >NUL
+
+default-install-docs-html:
+ @echo Installing documentation files to '$(DOC_INSTALL_DIR)'
+ @if not exist "$(DOC_INSTALL_DIR)" mkdir "$(DOC_INSTALL_DIR)"
+ @if exist $(DOCDIR) for %f in ("$(DOCDIR)\*.html" "$(DOCDIR)\*.css" "$(DOCDIR)\*.png") do @$(COPY) %f "$(DOC_INSTALL_DIR)"
+
+default-install-docs-n:
+ @echo Installing documentation files to '$(DOC_INSTALL_DIR)'
+ @if not exist "$(DOC_INSTALL_DIR)" mkdir "$(DOC_INSTALL_DIR)"
+ @if exist $(DOCDIR) for %f in ("$(DOCDIR)\*.n") do @$(COPY) %f "$(DOC_INSTALL_DIR)"
+
+default-install-demos:
+ @echo Installing demos to '$(DEMO_INSTALL_DIR)'
+ @if not exist "$(DEMO_INSTALL_DIR)" mkdir "$(DEMO_INSTALL_DIR)"
+ @if exist $(DEMODIR) $(CPYDIR) "$(DEMODIR)" "$(DEMO_INSTALL_DIR)"
+
+default-clean:
+ @echo Cleaning $(TMP_DIR)\* ...
+ @if exist $(TMP_DIR)\nul $(RMDIR) $(TMP_DIR)
+ @echo Cleaning $(WINDIR)\nmakehlp.obj, nmakehlp.exe ...
+ @if exist $(WINDIR)\nmakehlp.obj del $(WINDIR)\nmakehlp.obj
+ @if exist $(WINDIR)\nmakehlp.exe del $(WINDIR)\nmakehlp.exe
+ @if exist $(WINDIR)\nmakehlp.out del $(WINDIR)\nmakehlp.out
+ @echo Cleaning $(WINDIR)\nmhlp-out.txt ...
+ @if exist $(WINDIR)\nmhlp-out.txt del $(WINDIR)\nmhlp-out.txt
+ @echo Cleaning $(WINDIR)\_junk.pch ...
+ @if exist $(WINDIR)\_junk.pch del $(WINDIR)\_junk.pch
+ @echo Cleaning $(WINDIR)\vercl.x, vercl.i ...
+ @if exist $(WINDIR)\vercl.x del $(WINDIR)\vercl.x
+ @if exist $(WINDIR)\vercl.i del $(WINDIR)\vercl.i
+ @echo Cleaning $(WINDIR)\versions.vc, version.vc ...
+ @if exist $(WINDIR)\versions.vc del $(WINDIR)\versions.vc
+ @if exist $(WINDIR)\version.vc del $(WINDIR)\version.vc
+
+default-hose: default-clean
+ @echo Hosing $(OUT_DIR)\* ...
+ @if exist $(OUT_DIR)\nul $(RMDIR) $(OUT_DIR)
+
+# Only for backward compatibility
+default-distclean: default-hose
+
+default-setup:
+ @if not exist $(OUT_DIR)\nul mkdir $(OUT_DIR)
+ @if not exist $(TMP_DIR)\nul mkdir $(TMP_DIR)
+
+!if "$(TESTPAT)" != ""
+TESTFLAGS = $(TESTFLAGS) -file $(TESTPAT)
+!endif
+
+default-test: default-setup $(PROJECT)
+ @set TCLLIBPATH=$(OUT_DIR:\=/)
+ @if exist $(LIBDIR) for %f in ("$(LIBDIR)\*.tcl") do @$(COPY) %f "$(OUT_DIR)"
+ cd "$(TESTDIR)" && $(DEBUGGER) $(TCLSH) all.tcl $(TESTFLAGS)
+
+default-shell: default-setup $(PROJECT)
+ @set TCLLIBPATH=$(OUT_DIR:\=/)
+ @if exist $(LIBDIR) for %f in ("$(LIBDIR)\*.tcl") do @$(COPY) %f "$(OUT_DIR)"
+ $(DEBUGGER) $(TCLSH)
+
+# Generation of Windows version resource
+!ifdef RCFILE
+
+# Note: don't use $** in below rule because there may be other dependencies
+# and only the "master" rc must be passed to the resource compiler
+$(TMP_DIR)\$(PROJECT).res: $(RCDIR)\$(PROJECT).rc
+ $(RESCMD) $(RCDIR)\$(PROJECT).rc
+
+!else
+
+# If parent makefile has not defined a resource definition file,
+# we will generate one from standard template.
+$(TMP_DIR)\$(PROJECT).res: $(TMP_DIR)\$(PROJECT).rc
+
+$(TMP_DIR)\$(PROJECT).rc:
+ @$(COPY) << $(TMP_DIR)\$(PROJECT).rc
+#include <winver.h>
+
+VS_VERSION_INFO VERSIONINFO
+ FILEVERSION COMMAVERSION
+ PRODUCTVERSION COMMAVERSION
+ FILEFLAGSMASK 0x3fL
+#ifdef DEBUG
+ FILEFLAGS VS_FF_DEBUG
+#else
+ FILEFLAGS 0x0L
+#endif
+ FILEOS VOS_NT_WINDOWS32
+ FILETYPE VFT_DLL
+ FILESUBTYPE 0x0L
+BEGIN
+ BLOCK "StringFileInfo"
+ BEGIN
+ BLOCK "040904b0"
+ BEGIN
+ VALUE "FileDescription", "Tcl extension " PROJECT
+ VALUE "OriginalFilename", PRJLIBNAME
+ VALUE "FileVersion", DOTVERSION
+ VALUE "ProductName", "Package " PROJECT " for Tcl"
+ VALUE "ProductVersion", DOTVERSION
+ END
+ END
+ BLOCK "VarFileInfo"
+ BEGIN
+ VALUE "Translation", 0x409, 1200
+ END
+END
+
+<<
+
+!endif # ifdef RCFILE
+
+!ifndef DISABLE_IMPLICIT_RULES
+DISABLE_IMPLICIT_RULES = 0
+!endif
+
+!if !$(DISABLE_IMPLICIT_RULES)
+# Implicit rule definitions - only for building library objects. For stubs and
+# main application, the master makefile should define explicit rules.
+
+{$(ROOT)}.c{$(TMP_DIR)}.obj::
+ $(CCPKGCMD) @<<
+$<
+<<
+
+{$(WINDIR)}.c{$(TMP_DIR)}.obj::
+ $(CCPKGCMD) @<<
+$<
+<<
+
+{$(GENERICDIR)}.c{$(TMP_DIR)}.obj::
+ $(CCPKGCMD) @<<
+$<
+<<
+
+{$(COMPATDIR)}.c{$(TMP_DIR)}.obj::
+ $(CCPKGCMD) @<<
+$<
+<<
+
+{$(RCDIR)}.rc{$(TMP_DIR)}.res:
+ $(RESCMD) $<
+
+{$(WINDIR)}.rc{$(TMP_DIR)}.res:
+ $(RESCMD) $<
+
+{$(TMP_DIR)}.rc{$(TMP_DIR)}.res:
+ $(RESCMD) $<
+
+.SUFFIXES:
+.SUFFIXES:.c .rc
+
+!endif
+
+################################################################
+# 14. Sanity check selected options against Tcl build options
+# When building an extension, certain configuration options should
+# match the ones used when Tcl was built. Here we check and
+# warn on a mismatch.
+!if ! $(DOING_TCL)
+
+!if $(TCLINSTALL) # Building against an installed Tcl
+!if exist("$(_TCLDIR)\lib\nmake\tcl.nmake")
+TCLNMAKECONFIG = "$(_TCLDIR)\lib\nmake\tcl.nmake"
+!endif
+!else # ! $(TCLINSTALL) - building against Tcl source
+!if exist("$(OUT_DIR)\tcl.nmake")
+TCLNMAKECONFIG = "$(OUT_DIR)\tcl.nmake"
+!endif
+!endif # TCLINSTALL
+
+!if $(CONFIG_CHECK)
+!ifdef TCLNMAKECONFIG
+!include $(TCLNMAKECONFIG)
+
+!if defined(CORE_MACHINE) && "$(CORE_MACHINE)" != "$(MACHINE)"
+!error ERROR: Build target ($(MACHINE)) does not match the Tcl library architecture ($(CORE_MACHINE)).
+!endif
+!if defined(CORE_USE_THREAD_ALLOC) && $(CORE_USE_THREAD_ALLOC) != $(USE_THREAD_ALLOC)
+!message WARNING: Value of USE_THREAD_ALLOC ($(USE_THREAD_ALLOC)) does not match its Tcl core value ($(CORE_USE_THREAD_ALLOC)).
+!endif
+!if defined(CORE_DEBUG) && $(CORE_DEBUG) != $(DEBUG)
+!message WARNING: Value of DEBUG ($(DEBUG)) does not match its Tcl library configuration ($(DEBUG)).
+!endif
+!endif
+
+!endif # TCLNMAKECONFIG
+
+!endif # ! $(DOING_TCL)
+
+
+#----------------------------------------------------------
+# Display stats being used.
+#----------------------------------------------------------
+
+!if !$(DOING_TCL)
+!message *** Building against Tcl at '$(_TCLDIR)'
+!endif
+!if !$(DOING_TK) && $(NEED_TK)
+!message *** Building against Tk at '$(_TKDIR)'
+!endif
+!message *** Intermediate directory will be '$(TMP_DIR)'
+!message *** Output directory will be '$(OUT_DIR)'
+!message *** Installation, if selected, will be in '$(_INSTALLDIR)'
+!message *** Suffix for binaries will be '$(SUFX)'
+!message *** Compiler version $(VCVER). Target $(MACHINE), host $(NATIVE_ARCH).
+
+!endif # ifdef _RULES_VC
diff --git a/tcl8.6/pkgs/thread2.8.4/win/targets.vc b/tcl8.6/pkgs/thread2.8.4/win/targets.vc new file mode 100644 index 0000000..7f1d388 --- /dev/null +++ b/tcl8.6/pkgs/thread2.8.4/win/targets.vc @@ -0,0 +1,98 @@ +#------------------------------------------------------------- -*- makefile -*-
+# targets.vc --
+#
+# Part of the nmake based build system for Tcl and its extensions.
+# This file defines some standard targets for the convenience of extensions
+# and can be optionally included by the extension makefile.
+# See TIP 477 (https://core.tcl.tk/tips/doc/trunk/tip/477.md) for docs.
+
+$(PROJECT): setup pkgindex $(PRJLIB)
+
+!ifdef PRJ_STUBOBJS
+$(PROJECT): $(PRJSTUBLIB)
+$(PRJSTUBLIB): $(PRJ_STUBOBJS)
+ $(LIBCMD) $**
+
+$(PRJ_STUBOBJS):
+ $(CCSTUBSCMD) %s
+!endif # PRJ_STUBOBJS
+
+!ifdef PRJ_MANIFEST
+$(PROJECT): $(PRJLIB).manifest
+$(PRJLIB).manifest: $(PRJ_MANIFEST)
+ @nmakehlp -s << $** >$@
+@MACHINE@ $(MACHINE:IX86=X86)
+<<
+!endif
+
+!if "$(PROJECT)" != "tcl" && "$(PROJECT)" != "tk"
+$(PRJLIB): $(PRJ_OBJS) $(RESFILE)
+!if $(STATIC_BUILD)
+ $(LIBCMD) $**
+!else
+ $(DLLCMD) $**
+ $(_VC_MANIFEST_EMBED_DLL)
+!endif
+ -@del $*.exp
+!endif
+
+!if "$(PRJ_HEADERS)" != "" && "$(PRJ_OBJS)" != ""
+$(PRJ_OBJS): $(PRJ_HEADERS)
+!endif
+
+# If parent makefile has defined stub objects, add their installation
+# to the default install
+!if "$(PRJ_STUBOBJS)" != ""
+default-install: default-install-stubs
+!endif
+
+# Unlike the other default targets, these cannot be in rules.vc because
+# the executed command depends on existence of macro PRJ_HEADERS_PUBLIC
+# that the parent makefile will not define until after including rules-ext.vc
+!if "$(PRJ_HEADERS_PUBLIC)" != ""
+default-install: default-install-headers
+default-install-headers:
+ @echo Installing headers to '$(INCLUDE_INSTALL_DIR)'
+ @for %f in ($(PRJ_HEADERS_PUBLIC)) do @$(COPY) %f "$(INCLUDE_INSTALL_DIR)"
+!endif
+
+!if "$(DISABLE_STANDARD_TARGETS)" == ""
+DISABLE_STANDARD_TARGETS = 0
+!endif
+
+!if "$(DISABLE_TARGET_setup)" == ""
+DISABLE_TARGET_setup = 0
+!endif
+!if "$(DISABLE_TARGET_install)" == ""
+DISABLE_TARGET_install = 0
+!endif
+!if "$(DISABLE_TARGET_clean)" == ""
+DISABLE_TARGET_clean = 0
+!endif
+!if "$(DISABLE_TARGET_test)" == ""
+DISABLE_TARGET_test = 0
+!endif
+!if "$(DISABLE_TARGET_shell)" == ""
+DISABLE_TARGET_shell = 0
+!endif
+
+!if !$(DISABLE_STANDARD_TARGETS)
+!if !$(DISABLE_TARGET_setup)
+setup: default-setup
+!endif
+!if !$(DISABLE_TARGET_install)
+install: default-install
+!endif
+!if !$(DISABLE_TARGET_clean)
+clean: default-clean
+realclean: hose
+hose: default-hose
+distclean: realclean default-distclean
+!endif
+!if !$(DISABLE_TARGET_test)
+test: default-test
+!endif
+!if !$(DISABLE_TARGET_shell)
+shell: default-shell
+!endif
+!endif # DISABLE_STANDARD_TARGETS
diff --git a/tcl8.6/pkgs/thread2.8.4/win/thread.rc b/tcl8.6/pkgs/thread2.8.4/win/thread.rc new file mode 100644 index 0000000..d59d065 --- /dev/null +++ b/tcl8.6/pkgs/thread2.8.4/win/thread.rc @@ -0,0 +1,57 @@ +// Version resource script +// + +#include <winver.h> + +#define RESOURCE_INCLUDED + +LANGUAGE 0x9, 0x1 /* LANG_ENGLISH, SUBLANG_DEFAULT */ + +#ifndef COMMAVERSION +#define COMMAVERSION PACKAGE_MAJOR,PACKAGE_MINOR,0,0 +#endif + +#ifndef DOTVERSION +#define DOTVERSION PACKAGE_VERSION +#endif + +#ifndef PRJLIBNAME +#ifdef DEBUG +#define PRJLIBNAME "thread" STRINGIFY(JOIN(PACKAGE_MAJOR,PACKAGE_MINOR)) "d.dll\0" +#else +#define PRJLIBNAME "thread" STRINGIFY(JOIN(PACKAGE_MAJOR,PACKAGE_MINOR)) ".dll\0" +#endif +#endif + +VS_VERSION_INFO VERSIONINFO + FILEVERSION COMMAVERSION + PRODUCTVERSION COMMAVERSION + FILEFLAGSMASK 0x3fL +#if DEBUG + FILEFLAGS 0x1L +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS_NT_WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904b0" /* LANG_ENGLISH/SUBLANG_ENGLISH_US, Unicode CP */ + BEGIN + VALUE "FileDescription", "Threading extension library for Tcl" + VALUE "OriginalFilename", PRJLIBNAME + VALUE "CompanyName", "NONE! Open-sourced with no owner\0" + VALUE "FileVersion", DOTVERSION + VALUE "LegalCopyright", "Under BSD license\0" + VALUE "ProductName", "Tcl for Windows\0" + VALUE "ProductVersion", DOTVERSION + VALUE "Authors", "Brent Welch,\r\n" "Andreas Kupries, \r\n" "David Gravereaux,\r\n" "Zoran Vasiljevic" "\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x409, 1200 + END +END diff --git a/tcl8.6/pkgs/thread2.8.4/win/threadWin.c b/tcl8.6/pkgs/thread2.8.4/win/threadWin.c new file mode 100644 index 0000000..9730ae4 --- /dev/null +++ b/tcl8.6/pkgs/thread2.8.4/win/threadWin.c @@ -0,0 +1,54 @@ +/* + * threadWin.c -- + * + * Windows specific aspects for the thread extension. + * + * see http://dev.activestate.com/doc/howto/thread_model.html + * + * Some of this code is based on work done by Richard Hipp on behalf of + * Conservation Through Innovation, Limited, with their permission. + * + * Copyright (c) 1998 by Sun Microsystems, Inc. + * Copyright (c) 1999,2000 by Scriptics Corporation. + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + */ + +#include <windows.h> +#include <process.h> +#include "../generic/tclThread.h" + +#if 0 +/* only Windows 2000 (XP, too??) has this function */ +HANDLE (WINAPI *winOpenThreadProc)(DWORD, BOOL, DWORD); + +void +ThreadpInit (void) +{ + HMODULE hKernel = GetModuleHandle("kernel32.dll"); + winOpenThreadProc = (HANDLE (WINAPI *)(DWORD, BOOL, DWORD)) + GetProcAddress(hKernel, "OpenThread"); +} + +int +ThreadpKill (Tcl_Interp *interp, long id) +{ + HANDLE hThread; + int result = TCL_OK; + + if (winOpenThreadProc) { + hThread = winOpenThreadProc(THREAD_TERMINATE, FALSE, id); + /* + * not to be misunderstood as "devilishly clever", + * but evil in it's pure form. + */ + TerminateThread(hThread, 666); + } else { + Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), + "Can't (yet) kill threads on this OS, sorry.", NULL); + result = TCL_ERROR; + } + return result; +} +#endif diff --git a/tcl8.6/pkgs/thread2.8.4/win/thread_win.dsp b/tcl8.6/pkgs/thread2.8.4/win/thread_win.dsp new file mode 100644 index 0000000..0c1e0bc --- /dev/null +++ b/tcl8.6/pkgs/thread2.8.4/win/thread_win.dsp @@ -0,0 +1,275 @@ +# Microsoft Developer Studio Project File - Name="thread" - Package Owner=<4>
+# Microsoft Developer Studio Generated Build File, Format Version 6.00
+# ** DO NOT EDIT **
+
+# TARGTYPE "Win32 (x86) External Target" 0x0106
+
+CFG=thread - Win32 Debug
+!MESSAGE This is not a valid makefile. To build this project using NMAKE,
+!MESSAGE use the Export Makefile command and run
+!MESSAGE
+!MESSAGE NMAKE /f "thread_win.mak".
+!MESSAGE
+!MESSAGE You can specify a configuration when running NMAKE
+!MESSAGE by defining the macro CFG on the command line. For example:
+!MESSAGE
+!MESSAGE NMAKE /f "thread_win.mak" CFG="thread - Win32 Debug"
+!MESSAGE
+!MESSAGE Possible choices for configuration are:
+!MESSAGE
+!MESSAGE "thread - Win32 Release" (based on "Win32 (x86) External Target")
+!MESSAGE "thread - Win32 Debug" (based on "Win32 (x86) External Target")
+!MESSAGE
+
+# Begin Project
+# PROP AllowPerConfigDependencies 0
+# PROP Scc_ProjName ""
+# PROP Scc_LocalPath ""
+
+!IF "$(CFG)" == "thread - Win32 Release"
+
+# PROP BASE Use_MFC 0
+# PROP BASE Use_Debug_Libraries 0
+# PROP BASE Output_Dir "Release"
+# PROP BASE Intermediate_Dir "Release"
+# PROP BASE Cmd_Line "NMAKE /f thread.mak"
+# PROP BASE Rebuild_Opt "/a"
+# PROP BASE Target_File "thread.exe"
+# PROP BASE Bsc_Name "thread.bsc"
+# PROP BASE Target_Dir ""
+# PROP Use_MFC 0
+# PROP Use_Debug_Libraries 0
+# PROP Output_Dir "Release"
+# PROP Intermediate_Dir "Release"
+# PROP Cmd_Line "nmake -nologo -f makefile.vc TCLDIR=E:\tcl MSVCDIR=IDE"
+# PROP Rebuild_Opt "-a"
+# PROP Target_File "Release\thread27.dll"
+# PROP Bsc_Name ""
+# PROP Target_Dir ""
+
+!ELSEIF "$(CFG)" == "thread - Win32 Debug"
+
+# PROP BASE Use_MFC 0
+# PROP BASE Use_Debug_Libraries 1
+# PROP BASE Output_Dir "Debug"
+# PROP BASE Intermediate_Dir "Debug"
+# PROP BASE Cmd_Line "NMAKE /f thread.mak"
+# PROP BASE Rebuild_Opt "/a"
+# PROP BASE Target_File "thread.exe"
+# PROP BASE Bsc_Name "thread.bsc"
+# PROP BASE Target_Dir ""
+# PROP Use_MFC 0
+# PROP Use_Debug_Libraries 1
+# PROP Output_Dir "Debug"
+# PROP Intermediate_Dir "Debug"
+# PROP Cmd_Line "nmake -nologo -f makefile.vc OPTS=symbols TCLDIR=E:\tcl MSVCDIR=IDE"
+# PROP Rebuild_Opt "-a"
+# PROP Target_File "Debug\thread27d.dll"
+# PROP Bsc_Name ""
+# PROP Target_Dir ""
+
+!ENDIF
+
+# Begin Target
+
+# Name "thread - Win32 Release"
+# Name "thread - Win32 Debug"
+
+!IF "$(CFG)" == "thread - Win32 Release"
+
+!ELSEIF "$(CFG)" == "thread - Win32 Debug"
+
+!ENDIF
+
+ROOT=..
+
+# Begin Group "generic"
+
+# PROP Default_Filter ""
+# Begin Source File
+
+SOURCE=$(ROOT)\generic\threadNs.c
+# End Source File
+# Begin Source File
+
+SOURCE=$(ROOT)\generic\psGdbm.c
+# End Source File
+# Begin Source File
+
+SOURCE=$(ROOT)\generic\psGdbm.h
+# End Source File
+# Begin Source File
+
+SOURCE=$(ROOT)\generic\tclThread.h
+# End Source File
+# Begin Source File
+
+SOURCE=$(ROOT)\generic\tclThreadInt.h
+# End Source File
+# Begin Source File
+
+SOURCE=$(ROOT)\generic\tclXkeylist.c
+# End Source File
+# Begin Source File
+
+SOURCE=$(ROOT)\generic\tclXkeylist.h
+# End Source File
+# Begin Source File
+
+SOURCE=$(ROOT)\generic\threadCmd.c
+# End Source File
+# Begin Source File
+
+SOURCE=$(ROOT)\generic\threadPoolCmd.c
+# End Source File
+# Begin Source File
+
+SOURCE=$(ROOT)\generic\threadSpCmd.c
+# End Source File
+# Begin Source File
+
+SOURCE=$(ROOT)\generic\threadSvCmd.c
+# End Source File
+# Begin Source File
+
+SOURCE=$(ROOT)\generic\threadSvCmd.h
+# End Source File
+# Begin Source File
+
+SOURCE=$(ROOT)\generic\threadSvKeylistCmd.c
+# End Source File
+# Begin Source File
+
+SOURCE=$(ROOT)\generic\threadSvKeylistCmd.h
+# End Source File
+# Begin Source File
+
+SOURCE=$(ROOT)\generic\threadSvListCmd.c
+# End Source File
+# Begin Source File
+
+SOURCE=$(ROOT)\generic\threadSvListCmd.h
+# End Source File
+# End Group
+# Begin Group "doc"
+
+# PROP Default_Filter ""
+# Begin Group "html"
+
+# PROP Default_Filter ""
+# Begin Source File
+
+SOURCE=$(ROOT)\doc\html\thread.html
+# End Source File
+# Begin Source File
+
+SOURCE=$(ROOT)\doc\html\tpool.html
+# End Source File
+# Begin Source File
+
+SOURCE=$(ROOT)\doc\html\tsv.html
+# End Source File
+# Begin Source File
+
+SOURCE=$(ROOT)\doc\html\ttrace.html
+# End Source File
+# End Group
+# Begin Group "man"
+
+# PROP Default_Filter ""
+# Begin Source File
+
+SOURCE=$(ROOT)\doc\man\thread.n
+# End Source File
+# Begin Source File
+
+SOURCE=$(ROOT)\doc\man\tpool.n
+# End Source File
+# Begin Source File
+
+SOURCE=$(ROOT)\doc\man\tsv.n
+# End Source File
+# Begin Source File
+
+SOURCE=$(ROOT)\doc\man\ttrace.n
+# End Source File
+# End Group
+# Begin Source File
+
+SOURCE=$(ROOT)\doc\format.tcl
+# End Source File
+# Begin Source File
+
+SOURCE=$(ROOT)\doc\man.macros
+# End Source File
+# Begin Source File
+
+SOURCE=$(ROOT)\doc\thread.man
+# End Source File
+# Begin Source File
+
+SOURCE=$(ROOT)\doc\tpool.man
+# End Source File
+# Begin Source File
+
+SOURCE=$(ROOT)\doc\tsv.man
+# End Source File
+# Begin Source File
+
+SOURCE=$(ROOT)\doc\ttrace.man
+# End Source File
+# End Group
+# Begin Group "win"
+
+# PROP Default_Filter ""
+# Begin Group "vc"
+
+# PROP Default_Filter ""
+# Begin Source File
+
+SOURCE=.\makefile.vc
+# End Source File
+# Begin Source File
+
+SOURCE=.\nmakehlp.c
+# End Source File
+# Begin Source File
+
+SOURCE=.\pkg.vc
+# End Source File
+# Begin Source File
+
+SOURCE=.\README.vc.txt
+# End Source File
+# Begin Source File
+
+SOURCE=.\rules.vc
+# End Source File
+# End Group
+# Begin Source File
+
+SOURCE=$(ROOT)\win\README.txt
+# End Source File
+# Begin Source File
+
+SOURCE=$(ROOT)\win\thread.rc
+# End Source File
+# Begin Source File
+
+SOURCE=$(ROOT)\win\threadWin.c
+# End Source File
+# End Group
+# Begin Source File
+
+SOURCE=$(ROOT)\ChangeLog
+# End Source File
+# Begin Source File
+
+SOURCE=$(ROOT)\license.terms
+# End Source File
+# Begin Source File
+
+SOURCE=$(ROOT)\README
+# End Source File
+# End Target
+# End Project
diff --git a/tcl8.6/pkgs/thread2.8.4/win/thread_win.dsw b/tcl8.6/pkgs/thread2.8.4/win/thread_win.dsw new file mode 100644 index 0000000..5599cd6 --- /dev/null +++ b/tcl8.6/pkgs/thread2.8.4/win/thread_win.dsw @@ -0,0 +1,29 @@ +Microsoft Developer Studio Workspace File, Format Version 6.00
+# WARNING: DO NOT EDIT OR DELETE THIS WORKSPACE FILE!
+
+###############################################################################
+
+Project: "thread"=.\thread.dsp - Package Owner=<4>
+
+Package=<5>
+{{{
+}}}
+
+Package=<4>
+{{{
+}}}
+
+###############################################################################
+
+Global:
+
+Package=<5>
+{{{
+}}}
+
+Package=<3>
+{{{
+}}}
+
+###############################################################################
+
|