├── .gitmodules
├── win
    ├── pkg.vc
    ├── tclclockmod.dsw
    ├── tclclockmod.sln
    ├── tclclockmod.rc
    ├── README.md
    ├── tclclockmod.vcproj
    ├── tclclockmod.dsp
    ├── makefile.vc
    ├── rules.vc
    └── nmakehlp.c
├── .gitignore
├── tests
    ├── clock-ivm.test
    └── all.tcl
├── aclocal.m4
├── unix
    ├── README.FreeBSD
    └── README
├── generic
    ├── tclClockModInt.h
    ├── tclClockMod.c
    ├── tclStrIdxTree.h
    ├── tclClockModInt.c
    ├── tclStrIdxTree.c
    └── tclDate.h
├── pkgIndex.tcl.in
├── lib
    └── loader.tcl
├── license.terms
├── .github
    └── workflows
    │   └── ci-nix.yml
├── README.md
├── tests-perf
    ├── test-performance.tcl
    └── clock.perf.tcl
├── configure.ac
└── Makefile.in


/.gitmodules:
--------------------------------------------------------------------------------
1 | [submodule "tclconfig"]
2 | 	path = tclconfig
3 | 	url = https://github.com/tcltk/tclconfig.git
4 | 


--------------------------------------------------------------------------------
/win/pkg.vc:
--------------------------------------------------------------------------------
1 | # remember to change configure.ac as well when these change
2 | # (then re-autoconf)
3 | 
4 | PACKAGE_MAJOR	= 8
5 | PACKAGE_MINOR	= 6
6 | PACKAGE_RELEASE	= 703
7 | PACKAGE_VERSION	= "8.6.703"
8 | 


--------------------------------------------------------------------------------
/.gitignore:
--------------------------------------------------------------------------------
 1 | .svn
 2 | .gitattributes
 3 | /autom4te.cache/
 4 | /win/Debug_*
 5 | /win/Release_*
 6 | /win/nmakehlp.obj
 7 | /win/nmakehlp.exe
 8 | /unix/*.o
 9 | /unix/*.so
10 | /unix/Makefile
11 | /unix/config.log
12 | /unix/config.status
13 | /unix/pkgIndex.tcl
14 | 
15 | 


--------------------------------------------------------------------------------
/tests/clock-ivm.test:
--------------------------------------------------------------------------------
1 | # clock-ivm.test --
2 | #
3 | # This test file covers the 'clock' command using inverted validity mode.
4 | #
5 | # See the file "clock.test" for more information.
6 | 
7 | clock configure -valid [expr {![clock configure -valid]}]
8 | source [file join [file dirname [info script]] clock.test]


--------------------------------------------------------------------------------
/aclocal.m4:
--------------------------------------------------------------------------------
 1 | #
 2 | # Pull in the standard Tcl autoconf macros.
 3 | # If you don't have the "tclconfig" subdirectory, it is a dependent CVS
 4 | # module. Either "cvs -d <root> checkout tclconfig" right here, or
 5 | # re-checkout the thread module
 6 | #
 7 | builtin(include,tclconfig/tcl.m4)
 8 | 
 9 | # EOF
10 | 


--------------------------------------------------------------------------------
/unix/README.FreeBSD:
--------------------------------------------------------------------------------
 1 | #
 2 | # This makes sure that TEA knows about all the necessary bits and stuffs them into configure from configure.in
 3 | #
 4 | autoreconf
 5 | 
 6 | #
 7 | # This keeps configure honest if you have both clang and gcc installed
 8 | #
 9 | CC=clang CXX=clang++ ./configure --prefix=/usr/local --with-tcl=/usr/local/lib/tcl8.6
10 | 
11 | # Then "make clean" and "make"
12 | 


--------------------------------------------------------------------------------
/win/tclclockmod.dsw:
--------------------------------------------------------------------------------
 1 | Microsoft Developer Studio Workspace File, Format Version 6.00
 2 | # WARNING: DO NOT EDIT OR DELETE THIS WORKSPACE FILE!
 3 | 
 4 | ###############################################################################
 5 | 
 6 | Project: "tclclockmod"=.\tclclockmod.dsp - Package Owner=<4>
 7 | 
 8 | Package=<5>
 9 | {{{
10 | }}}
11 | 
12 | Package=<4>
13 | {{{
14 | }}}
15 | 
16 | ###############################################################################
17 | 
18 | Global:
19 | 
20 | Package=<5>
21 | {{{
22 | }}}
23 | 
24 | Package=<3>
25 | {{{
26 | }}}
27 | 
28 | ###############################################################################
29 | 
30 | 


--------------------------------------------------------------------------------
/win/tclclockmod.sln:
--------------------------------------------------------------------------------
 1 | 
 2 | Microsoft Visual Studio Solution File, Format Version 10.00
 3 | # Visual Studio 2008
 4 | Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "tclclockmod", "tclclockmod.vcproj", "{74B0C4A1-9F61-4442-B304-BC290ACD8FE4}"
 5 | EndProject
 6 | Global
 7 | 	GlobalSection(SolutionConfigurationPlatforms) = preSolution
 8 | 		Debug|Win32 = Debug|Win32
 9 | 		Release|Win32 = Release|Win32
10 | 	EndGlobalSection
11 | 	GlobalSection(ProjectConfigurationPlatforms) = postSolution
12 | 		{74B0C4A1-9F61-4442-B304-BC290ACD8FE4}.Debug|Win32.ActiveCfg = Debug|Win32
13 | 		{74B0C4A1-9F61-4442-B304-BC290ACD8FE4}.Debug|Win32.Build.0 = Debug|Win32
14 | 		{74B0C4A1-9F61-4442-B304-BC290ACD8FE4}.Release|Win32.ActiveCfg = Release|Win32
15 | 		{74B0C4A1-9F61-4442-B304-BC290ACD8FE4}.Release|Win32.Build.0 = Release|Win32
16 | 	EndGlobalSection
17 | 	GlobalSection(SolutionProperties) = preSolution
18 | 		HideSolutionNode = FALSE
19 | 	EndGlobalSection
20 | EndGlobal
21 | 


--------------------------------------------------------------------------------
/unix/README:
--------------------------------------------------------------------------------
 1 | 
 2 | Building the fast clock Tcl-module extension for Unix
 3 | =====================================================
 4 | 
 5 | Extension can be compiled on several Unix derivates including various
 6 | distributions of Linux.
 7 | 
 8 | To build on Unix-like operating systems:
 9 | 
10 |     % ../configure ?options ...?
11 | 
12 | Either way, this will create a Makefile which you use to run "make" and
13 | "make install":
14 | 
15 | You can use "make clean" to clean the directory from temporary compilation
16 | files and/or "make distclean" to additionaly remove local config files.
17 | You might want to do "make test" before doing the "make install" in order
18 | to run the regression tests on the package.
19 | 
20 | To explore other building options, look into the file "configure" for more
21 | information.
22 | 
23 | Example for typical build on x86 systems:
24 | 
25 |     $ cd unix
26 |     $ ../configure --with-tcl=../../tcl8.6/unix
27 |     $ make clean && make
28 | 
29 | Example for typical build on x64 systems:
30 | 
31 |     $ cd unix
32 |     $ ../configure --enable-64bit --enable-64bit-vis --with-tcl=../../tcl8.6/unix
33 |     $ make clean && make
34 | 
35 | -EOF-
36 | 


--------------------------------------------------------------------------------
/generic/tclClockModInt.h:
--------------------------------------------------------------------------------
 1 | /*
 2 |  * tclClockModInt.h --
 3 |  *
 4 |  * Internal declarations of fast tcl clock module.
 5 |  *
 6 |  * Copyright (c) 2017 Serg G. Brester (aka sebres)
 7 |  *
 8 |  * See the file "license.terms" for information on usage and redistribution
 9 |  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
10 |  */
11 | 
12 | #ifndef _TCLCLOCKMODINT_H
13 | #define _TCLCLOCKMODINT_H
14 | 
15 | /*
16 |  * [MSVC] fallback to replace C++ keyword "inline" with C keyword "__inline" 
17 |  * Otherwise depending on the VC-version, context, include-order it can cause:
18 |  *  error C2054: expected '(' to follow 'inline'
19 |  */
20 | #if defined(_MSC_VER) && !defined(inline)
21 | #   define inline   __inline
22 | #endif
23 | 
24 | /*
25 |  * several tclInt.h internals (tcl8.6 version depending):
26 |  */
27 | 
28 | #ifndef TclUtfNext
29 | #define TclUtfNext(src)	\
30 | 	( (((unsigned char) *(src)) < 0xC0) ? src + 1 : Tcl_UtfNext(src) )
31 | #endif
32 | 
33 | /*
34 |  * Signal using modified tcl version (dict smartref's, etc.)
35 |  */
36 | 
37 | /* #if !defined BUILD_tcl */
38 | #define TCL_AVAIL_SBMOD 0
39 | #define TCL_CLOCKMOD_SCOPE
40 | /* else 
41 | #define TCL_AVAIL_SBMOD 1
42 | #define TCL_CLOCKMOD_SCOPE static
43 | */
44 | /* #endif */
45 | 
46 | #endif /* _TCLCLOCKMODINT_H */
47 | 


--------------------------------------------------------------------------------
/pkgIndex.tcl.in:
--------------------------------------------------------------------------------
 1 | # -*- tcl -*-
 2 | # Tcl package index file, version 1.1
 3 | #
 4 | 
 5 | package ifneeded tclclockmod @PACKAGE_VERSION@ [string map [list \$\$DIR$$ [list $dir]] {
 6 |   # check pre-requirements (>= 8.6.5) :
 7 |   package require Tcl 8.6.5
 8 |   # load module:
 9 |   load [file join $$DIR$$ @PKG_LIB_FILE@]
10 |   # load tcl-clock stubs:
11 |   if {[file exists [file join $$DIR$$ clock.tcl]]} {
12 |     source -encoding utf-8 [file join $$DIR$$ clock.tcl]
13 |   } elseif {[file exists [file join $$DIR$$ lib clock.tcl]]} {
14 |     source -encoding utf-8 [file join $$DIR$$ lib clock.tcl]
15 |   } elseif {[file exists [file join $$DIR$$ .. lib clock.tcl]]} {
16 |     source -encoding utf-8 [file join $$DIR$$ .. lib clock.tcl]
17 |   } else {
18 |     source -encoding utf-8 [file join $$DIR$$ .. .. lib clock.tcl]
19 |   }
20 |   # initialize new clock-ensemble:
21 |   proc clock args {
22 |     set cmdmap [dict create]
23 |     foreach cmd {add clicks format microseconds milliseconds scan seconds configure} {
24 |       dict set cmdmap $cmd ::tcl::clock::$cmd
25 |     }
26 |     namespace inscope ::tcl::clock [list namespace ensemble create -command \
27 |       [uplevel 1 [list ::namespace origin [::lindex [info level 0] 0]]] \
28 |       -map $cmdmap]
29 |     ::tcl::namespace::ensemble-compile "::clock"
30 | 
31 |     uplevel 1 [info level 0]
32 |   }
33 |   # loaded:
34 |   package provide tclclockmod @PACKAGE_VERSION@
35 | }]


--------------------------------------------------------------------------------
/lib/loader.tcl:
--------------------------------------------------------------------------------
 1 | # save clockmode path:
 2 | set ::tcl::clock::LibDir [file dirname [info script]]
 3 | 
 4 | # rewrite clock ensemble:
 5 | proc ::clock args {
 6 |   if {$::tcl_platform(platform) ne {windows}} {
 7 |     set lib "unix"
 8 |     set name "lib"
 9 |   } else {
10 |     set lib "win"
11 |     set name ""
12 |   }
13 |   append name tclclockmod * [info sharedlibextension]
14 |   # first try from lib directory (like installed):
15 |   set lib [glob -nocomplain [file join $::tcl::clock::LibDir $name]]
16 |   # second try find library from current directory (debug, release, platform etc.),
17 |   # hereafter in path relative current lib (like unistalled):
18 |   if {![llength $lib]} {
19 |     foreach plib [list \
20 |       [if {[info exists ::BUILDDIR]} {set ::BUILDDIR} else pwd] \
21 |       [file dirname $::tcl::clock::LibDir] \
22 |     ] {
23 |       # now from unix, win, Release:
24 |       foreach lib [list {} Release* $lib [file join $lib Release*]] {
25 |         #puts "**** try $plib / $lib -- [file join $plib $lib $name]"
26 |         set lib [glob -nocomplain [file join $plib $lib $name]]
27 |         #puts "==== $lib"
28 |         if {[llength $lib]} break
29 |       }
30 |       if {[llength $lib]} break
31 |     }
32 |     if {![llength $lib]} {
33 |       error "tclclockmod shared library not found relative \"[pwd]\"."
34 |     }
35 |   }
36 |   # load library:
37 |   load [lindex $lib 0]
38 | 
39 |   # overload new tcl-clock stubs:
40 |   source [file join $::tcl::clock::LibDir clock.tcl]
41 | 
42 |   # and ensemble:
43 |   set cmdmap [dict create]
44 |   foreach cmd {add clicks format microseconds milliseconds scan seconds configure} {
45 |     dict set cmdmap $cmd ::tcl::clock::$cmd
46 |   }
47 |   namespace inscope ::tcl::clock [list namespace ensemble create -command \
48 |     [uplevel 1 [list ::namespace origin [::lindex [info level 0] 0]]] \
49 |     -map $cmdmap]
50 |   ::tcl::namespace::ensemble-compile "::clock"
51 | 
52 |   uplevel 1 [info level 0]
53 | }
54 | 


--------------------------------------------------------------------------------
/win/tclclockmod.rc:
--------------------------------------------------------------------------------
 1 | // Version resource script
 2 | //
 3 | 
 4 | #include <winver.h>
 5 | 
 6 | #define RESOURCE_INCLUDED
 7 | #include <tcl.h>
 8 | 
 9 | LANGUAGE 0x9, 0x1    /* LANG_ENGLISH, SUBLANG_DEFAULT */
10 | 
11 | #define MOD_RELEASE_LEVEL 1
12 | #define MOD_RELEASE "mod." STRINGIFY(MOD_RELEASE_LEVEL)
13 | 
14 | #define VERSION_STRING STRINGIFY(JOIN(PACKAGE_MAJOR,PACKAGE_MINOR))
15 | 
16 | VS_VERSION_INFO VERSIONINFO
17 |  FILEVERSION    PACKAGE_MAJOR,PACKAGE_MINOR,PACKAGE_RELEASE,MOD_RELEASE_LEVEL
18 |  PRODUCTVERSION PACKAGE_MAJOR,PACKAGE_MINOR,PACKAGE_RELEASE,0
19 |  FILEFLAGSMASK  0x3fL
20 | #if DEBUG
21 |  FILEFLAGS 0x1L
22 | #else
23 |  FILEFLAGS 0x0L
24 | #endif
25 |  FILEOS     0x4    /* VOS__WINDOWS32 */
26 |  FILETYPE     0x2    /* VFT_DLL */
27 |  FILESUBTYPE     0x0L
28 | BEGIN
29 |     BLOCK "StringFileInfo"
30 |     BEGIN
31 |         BLOCK "040904b0" /* LANG_ENGLISH/SUBLANG_ENGLISH_US, Unicode CP */
32 |         BEGIN
33 |             VALUE "FileDescription", "Fast tcl-clock extension module for Tcl VERSION_STRING " " (" MOD_RELEASE ")\0"
34 | #if DEBUG
35 |             VALUE "OriginalFilename", "tclclockmod" VERSION_STRING "d.dll\0"
36 | #else
37 |             VALUE "OriginalFilename", "tclclockmod" VERSION_STRING ".dll\0"
38 | #endif
39 |             VALUE "CompanyName", "NONE! Open-sourced with no owner\0"
40 |             VALUE "FileVersion", PACKAGE_VERSION " (" MOD_RELEASE ")\0"
41 |             VALUE "LegalCopyright", "Copyright \251 1991-2016 by Serg G. Brester, Karl Lehenbauer, Mark Diekhans, Kevin B. Kenny, Sun Microsystems, Inc., ActiveState Corporation and Tcl community\0"
42 |             VALUE "ProductName", "Tcl for Windows\0"
43 |             VALUE "ProductVersion", PACKAGE_VERSION " (" MOD_RELEASE ")\0"
44 |             VALUE "Authors", "Serg G. Brester (sebres),\r\n" "Tcl community" "\0"
45 |             VALUE "Modification", "(" MOD_RELEASE ")" " \251 2005-2017 by Serg G. Brester (sebres.de)\0"
46 |         END
47 |     END
48 |     BLOCK "VarFileInfo"
49 |     BEGIN
50 |         VALUE "Translation", 0x409, 1200
51 |     END
52 | END
53 | 


--------------------------------------------------------------------------------
/license.terms:
--------------------------------------------------------------------------------
 1 | This software is copyrighted by the Regents of the University of
 2 | California, Sun Microsystems, Inc., Scriptics Corporation,
 3 | and other parties.  The following terms apply to all files associated
 4 | with the software unless explicitly disclaimed in individual files.
 5 | 
 6 | The authors hereby grant permission to use, copy, modify, distribute,
 7 | and license this software and its documentation for any purpose, provided
 8 | that existing copyright notices are retained in all copies and that this
 9 | notice is included verbatim in any distributions. No written agreement,
10 | license, or royalty fee is required for any of the authorized uses.
11 | Modifications to this software may be copyrighted by their authors
12 | and need not follow the licensing terms described here, provided that
13 | the new terms are clearly indicated on the first page of each file where
14 | they apply.
15 | 
16 | IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY
17 | FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
18 | ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY
19 | DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE
20 | POSSIBILITY OF SUCH DAMAGE.
21 | 
22 | THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES,
23 | INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY,
24 | FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT.  THIS SOFTWARE
25 | IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE
26 | NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
27 | MODIFICATIONS.
28 | 
29 | GOVERNMENT USE: If you are acquiring this software on behalf of the
30 | U.S. government, the Government shall have only "Restricted Rights"
31 | in the software and related documentation as defined in the Federal
32 | Acquisition Regulations (FARs) in Clause 52.227.19 (c) (2).  If you
33 | are acquiring the software on behalf of the Department of Defense, the
34 | software shall be classified as "Commercial Computer Software" and the
35 | Government shall have only "Restricted Rights" as defined in Clause
36 | 252.227-7013 (c) (1) of DFARs.  Notwithstanding the foregoing, the
37 | authors grant the U.S. Government and others acting in its behalf
38 | permission to use and distribute the software in accordance with the
39 | terms specified in this license.
40 | 


--------------------------------------------------------------------------------
/win/README.md:
--------------------------------------------------------------------------------
 1 | 
 2 | Building the fast clock Tcl-module extension for Windows
 3 | ========================================================
 4 | 
 5 | This extension currently supports build with Microsoft Visual Studio (>= 6.0):
 6 | 
 7 | MINGW build (MINGW32/MINGW64 with MSYS):
 8 | ----------------------------------
 9 | 
10 | To build the extension using MINGW you will need TEA-tclconfig (the autoconf 
11 | machinery for Tcl Extension Architecture (TEA)-compliant extensions), so clone 
12 | it using git from https://github.com/tcltk/tclconfig, or with fossil from
13 | https://core.tcl.tk/tclconfig, or if you have it already, you could also simply
14 | copy/link it to the root-folder of this extension.
15 | 
16 |     # prepare for build (obtain TEA-config in win-folder):
17 |     cd win
18 |     git clone https://github.com/tcltk/tclconfig.git ./tclconfig
19 | 
20 | Then start msys-console, create and enter build-folder
21 | (here as example used Release_MGW64 in win-folder of extension)
22 | and invoke the following commands:
23 | 
24 |     # enter build folder:
25 |     mkdir -p ./Release_MGW64 && cd ./Release_MGW64
26 |     # configure:
27 |     ../../configure --with-tcl=$(readlink -f ../../..)/tcl8.6/win/Release_MGW64 --enable-64bit
28 |     # make library:
29 |     make
30 |     
31 | If you have some newest incompatible toolchain resp. some changes in TEA-config,
32 | required rebuild of `configure` script, you could reconfigure it before, using 
33 | `autoconf` command in root of extension folder.
34 | 
35 | Microsoft MSVC++ build:
36 | -----------------------
37 | 
38 | To build the extension invoke the following command:
39 | 
40 |     nmake -f makefile.vc TCLDIR=<path>
41 | 
42 | You would need to give the <path> of the Tcl distribution where
43 | tcl.h and other needed Tcl files are located.
44 | Please look into the makefile.vc file for more information.
45 | 
46 | Alternatively, you can open the extension workspace and project files
47 | (tclclockmod.dsw / tclclockmod.dsp resp. tclclockmod.sln / tclclockmod.vcproj) 
48 | from within the MSVC++ and press the F7 key to build the extension under the
49 | control of the MSVC IDE.
50 | 
51 | Example for typical build on x86 windows-systems with Visual Studio:
52 | 
53 |     if "%VCINSTALLDIR%" == "" call "%VS90COMNTOOLS%vsvars32.bat"
54 |     set OPTDEFINES=-DWIN32 -D_WINDOWS -D_USE_32BIT_TIME_T
55 |     set TCLDIR=..\..\tcl8.6
56 |     nmake -nologo -f makefile.vc TCLDIR=%TCLDIR% OPTS=threads,thrdalloc OPTIMIZATIONS="-Ox -Ot -Oi -Gs" ADDOPTDEFINES="%OPTDEFINES% -DNDEBUG"
57 | 
58 | 


--------------------------------------------------------------------------------
/generic/tclClockMod.c:
--------------------------------------------------------------------------------
 1 | /*
 2 |  * tclClockMod.c --
 3 |  *
 4 |  * Internal implementations of fast tcl clock module.
 5 |  *
 6 |  * Copyright (c) 2017 Serg G. Brester (aka sebres)
 7 |  *
 8 |  * See the file "license.terms" for information on usage and redistribution
 9 |  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
10 |  */
11 | 
12 | 
13 | #include "tclClockModInt.h"
14 | #include "tcl.h"
15 | 
16 | const Tcl_ObjType* tclIntTypePtr;
17 | const Tcl_ObjType* tclWideIntTypePtr;
18 | const Tcl_ObjType* tclBignumTypePtr;
19 | const Tcl_ObjType* tclListTypePtr;
20 | 
21 | const char *tclEmptyStringRep;
22 | 
23 | extern void _InitModTclIntInternals(Tcl_Interp *interp);
24 | extern int  _InitModTclIntInterp(Tcl_Interp *interp);
25 | extern void TclClockInit(Tcl_Interp *interp);
26 | 
27 | /*
28 |  *----------------------------------------------------------------------
29 |  */
30 | 
31 | void _InitModTclInternals(Tcl_Interp *interp) {
32 | 
33 |     Tcl_Obj *obj;
34 | 
35 |     /*
36 |      * There is no other way to get some internal tcl-primitives
37 |      * w/o this tricks, regardless whether using stubs or not
38 |      * (linked directly).
39 |      */
40 | 
41 |   #if 0
42 |     obj = Tcl_NewIntObj(0);
43 |     tclIntTypePtr = obj->typePtr;
44 |     Tcl_DecrRefCount(obj);
45 |     obj = Tcl_NewWideIntObj(0);
46 |     tclWideIntTypePtr = obj->typePtr;
47 |     Tcl_DecrRefCount(obj);   
48 |   #endif
49 | 
50 |     tclIntTypePtr = Tcl_GetObjType("int");
51 |     tclWideIntTypePtr = Tcl_GetObjType("wideInt");
52 |     tclBignumTypePtr = Tcl_GetObjType("bignum");
53 |     tclListTypePtr = Tcl_GetObjType("list");
54 | 
55 |     obj = Tcl_NewObj();
56 |     tclEmptyStringRep = obj->bytes;
57 |     Tcl_DecrRefCount(obj);
58 | 
59 |     if (1) {
60 |         _InitModTclIntInternals(interp);
61 |     }
62 | }
63 | 
64 | 
65 | /*
66 |  *----------------------------------------------------------------------
67 |  *
68 |  * Tclclockmod_Init --
69 |  *
70 |  *  Initialize the module.
71 |  *
72 |  * Results:
73 |  *  TCL_OK if the package was properly initialized.
74 |  *
75 |  *----------------------------------------------------------------------
76 |  */
77 | 
78 | DLLEXPORT int
79 | Tclclockmod_Init(
80 |     Tcl_Interp *interp) /* The current Tcl interpreter */
81 | {
82 |     static int initialized = 0;
83 | 
84 |     if (!initialized) {
85 | 	if (Tcl_InitStubs(interp, "8.6", 0) == NULL) {
86 | 	    return TCL_ERROR;
87 | 	}
88 | 	_InitModTclInternals(interp);
89 | 	initialized = 1;
90 |     }
91 |     if (_InitModTclIntInterp(interp) != TCL_OK) {
92 | 	return TCL_ERROR;
93 |     }
94 | 
95 |     TclClockInit(interp);
96 | 
97 |     return TCL_OK;
98 | }
99 | 


--------------------------------------------------------------------------------
/.github/workflows/ci-nix.yml:
--------------------------------------------------------------------------------
 1 | name: CI-nix
 2 | 
 3 | # Controls when the action will run. Triggers the workflow on push or pull request
 4 | # events but only for the master branch
 5 | on:
 6 |   push:
 7 |     paths-ignore:
 8 |     - 'doc/**'
 9 |   pull_request:
10 |     paths-ignore:
11 |     - 'doc/**'
12 | 
13 | # A workflow run is made up of one or more jobs that can run sequentially or in parallel
14 | jobs:
15 |   build:
16 |     runs-on: ${{ matrix.os }}
17 | 
18 |     strategy:
19 |       matrix:
20 |         os: [ubuntu-latest]
21 |         compiler: [gcc, clang]
22 | 
23 |       fail-fast: false
24 | 
25 |     steps:
26 |       - name: Checkout
27 |         uses: actions/checkout@v4
28 |         # with:
29 |         #   submodules: recursive
30 |       - name: Install dependencies
31 |         if: matrix.os != 'macos-latest'
32 |         run: |
33 |           sudo apt-get install tcl tcl-dev
34 |       
35 |       # - name: Install dependencies MacOS
36 |       #   if: matrix.os == 'macos-latest'
37 |       #   run: |
38 |       #     sudo brew install tcl-devel
39 | 
40 |       - name: Pre-requirements
41 |         run: |
42 |           test -f ../tclconfig/tcl.m4 && echo "use ../tclconfig" || {
43 |             test -f tclconfig/tcl.m4 && echo "use ./tclconfig" || \
44 |               echo 'checkout tclconfig module ...' && \
45 |               git submodule update --init --recursive tclconfig && echo "tclconfig module is up-to-date" || {
46 |                 echo 'checkout modules failed, clone ...' && \
47 |                 git clone https://github.com/tcltk/tclconfig.git ../tclconfig
48 |               }
49 |           }
50 |       - name: Software versions tcl/${{ matrix.compiler }}
51 |         run: |
52 |           echo "${{ matrix.COMPILER }}: $(${{ matrix.COMPILER }} --version)"
53 |           echo "TCL: $(echo puts [info patchlevel] | tclsh)"
54 | 
55 |       - name: Configure ${{ matrix.compiler }}
56 |         env:
57 |           CC: ${{ matrix.compiler }}
58 |         run: |
59 |           test -f configure && echo "configure already exists in $(pwd) ..." || autoreconf -f
60 |           mkdir ./unix/build-${{ matrix.compiler }}; cd "$_"
61 |           ../../configure --with-tcl=/usr/lib/tcl8.6
62 | 
63 |       - name: Build ${{ matrix.compiler }}
64 |         working-directory: ./unix/build-${{ matrix.compiler }}
65 |         env:
66 |           CC: ${{ matrix.compiler }}
67 |         run: |
68 |           make -j4
69 | 
70 |       - name: Test ${{ matrix.compiler }}
71 |         working-directory: ./unix/build-${{ matrix.compiler }}
72 |         run: |
73 |           echo $TZ; timedatectl status
74 |           # tclsh ../../tests/all.tcl
75 |           make test
76 | 
77 |       - name: Install ${{ matrix.compiler }}
78 |         working-directory: ./unix/build-${{ matrix.compiler }}
79 |         run: |
80 |           sudo make install
81 |           echo 'if {[catch {package require tclclockmod; clock format -now}]} {puts stderr "ERROR!"; exit 1} else {puts "OK."}' | tclsh
82 | 
83 |       - name: Clean ${{ matrix.compiler }}
84 |         working-directory: ./unix/build-${{ matrix.compiler }}
85 |         run: |
86 |           make clean
87 | 
88 | 


--------------------------------------------------------------------------------
/win/tclclockmod.vcproj:
--------------------------------------------------------------------------------
  1 | <?xml version="1.0" encoding="Windows-1252"?>
  2 | <VisualStudioProject
  3 | 	ProjectType="Visual C++"
  4 | 	Version="9,00"
  5 | 	Name="tclclockmod"
  6 | 	ProjectGUID="{74B0C4A1-9F61-4442-B304-BC290ACD8FE4}"
  7 | 	RootNamespace="tclclockmod"
  8 | 	Keyword="MakeFileProj"
  9 | 	TargetFrameworkVersion="0"
 10 | 	>
 11 | 	<Platforms>
 12 | 		<Platform
 13 | 			Name="Win32"
 14 | 		/>
 15 | 	</Platforms>
 16 | 	<ToolFiles>
 17 | 	</ToolFiles>
 18 | 	<Configurations>
 19 | 		<Configuration
 20 | 			Name="Debug|Win32"
 21 | 			OutputDirectory="$(TargetDir)"
 22 | 			IntermediateDirectory="$(TargetDir)"
 23 | 			ConfigurationType="0"
 24 | 			InheritedPropertySheets="$(VCInstallDir)VCProjectDefaults\UpgradeFromVC60.vsprops"
 25 | 			UseOfMFC="0"
 26 | 			ATLMinimizesCRunTimeLibraryUsage="false"
 27 | 			>
 28 | 			<Tool
 29 | 				Name="VCNMakeTool"
 30 | 				BuildCommandLine="nmake -nologo -f makefile.vc OPTS=symbols TCLDIR=$(ProjectDir)\..\..\tcl8.6-timerate MSVCDIR=IDE"
 31 | 				ReBuildCommandLine="nmake -nologo -f makefile.vc OPTS=symbols TCLDIR=$(ProjectDir)\..\..\tcl8.6-timerate MSVCDIR=IDE -a"
 32 | 				CleanCommandLine=""
 33 | 				Output="Debug_VC9\tclclockmod86gt.dll"
 34 | 				PreprocessorDefinitions=""
 35 | 				IncludeSearchPath=""
 36 | 				ForcedIncludes=""
 37 | 				AssemblySearchPath=""
 38 | 				ForcedUsingAssemblies=""
 39 | 				CompileAsManaged=""
 40 | 			/>
 41 | 		</Configuration>
 42 | 		<Configuration
 43 | 			Name="Release|Win32"
 44 | 			OutputDirectory="$(TargetDir)"
 45 | 			IntermediateDirectory="$(TargetDir)"
 46 | 			ConfigurationType="0"
 47 | 			UseOfMFC="0"
 48 | 			ATLMinimizesCRunTimeLibraryUsage="false"
 49 | 			>
 50 | 			<Tool
 51 | 				Name="VCNMakeTool"
 52 | 				BuildCommandLine="nmake -nologo -f makefile.vc TCLDIR=$(ProjectDir)\..\..\tcl8.6-timerate MSVCDIR=IDE"
 53 | 				ReBuildCommandLine="nmake -nologo -f makefile.vc TCLDIR=$(ProjectDir)\..\..\tcl8.6-timerate MSVCDIR=IDE -a"
 54 | 				CleanCommandLine=""
 55 | 				Output="Release_VC9\tclclockmod86t.dll"
 56 | 				PreprocessorDefinitions=""
 57 | 				IncludeSearchPath=""
 58 | 				ForcedIncludes=""
 59 | 				AssemblySearchPath=""
 60 | 				ForcedUsingAssemblies=""
 61 | 				CompileAsManaged=""
 62 | 			/>
 63 | 		</Configuration>
 64 | 	</Configurations>
 65 | 	<References>
 66 | 	</References>
 67 | 	<Files>
 68 | 		<Filter
 69 | 			Name="generic"
 70 | 			>
 71 | 			<File
 72 | 				RelativePath="..\generic\tclClock.c"
 73 | 				>
 74 | 			</File>
 75 | 			<File
 76 | 				RelativePath="..\generic\tclClockFmt.c"
 77 | 				>
 78 | 			</File>
 79 | 			<File
 80 | 				RelativePath="..\generic\tclClockMod.c"
 81 | 				>
 82 | 			</File>
 83 | 			<File
 84 | 				RelativePath="..\generic\tclClockModInt.c"
 85 | 				>
 86 | 			</File>
 87 | 			<File
 88 | 				RelativePath="..\generic\tclClockModInt.h"
 89 | 				>
 90 | 			</File>
 91 | 			<File
 92 | 				RelativePath="..\generic\tclDate.c"
 93 | 				>
 94 | 			</File>
 95 | 			<File
 96 | 				RelativePath="..\generic\tclDate.h"
 97 | 				>
 98 | 			</File>
 99 | 			<File
100 | 				RelativePath="..\generic\tclStrIdxTree.c"
101 | 				>
102 | 			</File>
103 | 			<File
104 | 				RelativePath="..\generic\tclStrIdxTree.h"
105 | 				>
106 | 			</File>
107 | 		</Filter>
108 | 	</Files>
109 | 	<Globals>
110 | 	</Globals>
111 | </VisualStudioProject>
112 | 


--------------------------------------------------------------------------------
/tests/all.tcl:
--------------------------------------------------------------------------------
  1 | # prepare:
  2 | set TEST_OPTIONS {}
  3 | if {[lsearch [namespace children] ::tcltest] == -1} {
  4 |   package require tcltest
  5 |   namespace import tcltest::*
  6 |   ::tcltest::configure {*}[set TEST_OPTIONS $::argv]
  7 |   proc ::tcltest::exit {args} {}
  8 | }
  9 | 
 10 | puts [outputChannel] "Testing with [info patchlevel] from [info nameofexecutable] ..."
 11 | 
 12 | # register callback:
 13 | array set ::TestSummary {Total 0 Passed 0 Skipped 0 Failed 0 TotFailed 0 skippedBecauseLst {} File {}}
 14 | proc ::tcltest::__ReportSummary {} {
 15 |   variable numTestFiles
 16 |   # single test-file:
 17 |   puts -nonewline [outputChannel] "${numTestFiles}. $::TestSummary(File):"
 18 |   foreach index [list "Total" "Passed" "Skipped" "Failed"] {
 19 |     puts -nonewline [outputChannel] "\t$index\t$::TestSummary($index)"
 20 |   }
 21 |   puts [outputChannel] ""
 22 |   # its constraints:
 23 |   if {[llength $::TestSummary(skippedBecauseLst)] > 0} {
 24 |     array set skippedBecause $::TestSummary(skippedBecauseLst)
 25 |     set constraintList [array names skippedBecause]
 26 |     puts [outputChannel] "   Skipped:"
 27 |     foreach constraint [lsort $constraintList] {
 28 |       puts [outputChannel] "\t$skippedBecause($constraint)\t$constraint"
 29 |     }
 30 |   }
 31 |   puts [outputChannel] ""
 32 | }
 33 | proc ::tcltest::__ReportToParent {total passed skipped failed skippedLst args} {
 34 |   array set ::TestSummary [list \
 35 |     Total $total Passed $passed Skipped $skipped Failed $failed skippedBecauseLst $skippedLst args $args]
 36 |   incr ::TestSummary(TotFailed) $failed
 37 |   ::tcltest::__ReportSummary
 38 |   ::tcltest::ReportedFromChild $total $passed $skipped $failed $skippedLst {*}$args
 39 | }
 40 | proc ::tcltest::__SortFiles {lst} {
 41 |   set slst {}
 42 |   foreach f $lst {
 43 |     lappend slst [list [file rootname $f] $f]
 44 |   }
 45 |   set lst {}
 46 |   foreach f [lsort -dictionary -index 0 $slst] {
 47 |     lappend lst [lindex $f 1]
 48 |   }
 49 |   return $lst
 50 | }
 51 | 
 52 | set TESTDIR [file normalize [file dirname [info script]]]
 53 | set BUILDDIR [pwd]
 54 | if {![::tcl::pkgconfig get debug]} { # allow to load lib from current directory in debug:
 55 |   # switch to temp directory:
 56 |   if {[catch {
 57 |     cd $::env(TEMP)
 58 |   }]} {
 59 |     cd /tmp/
 60 |   }
 61 | }
 62 | set GLOB_OPTIONS {
 63 |   puts [outputChannel] "  Load library ..."
 64 |   # load library:
 65 |   source [file dirname [file dirname $TESTFILE]]/lib/loader.tcl
 66 |   # test it is really new version:
 67 |   clock format -now -format "%Es" -gmt 1
 68 |   puts [outputChannel] "  Test ..."
 69 | }
 70 | foreach testfile [::tcltest::__SortFiles [::tcltest::GetMatchingFiles $TESTDIR]] {
 71 |   # prepare single run:
 72 |   set ::TestSummary(File) [file root [file tail $testfile]]
 73 |   incr ::tcltest::numTestFiles
 74 |   puts -nonewline [outputChannel] [set msg "== ${::tcltest::numTestFiles}. $::TestSummary(File) "]
 75 |   puts [outputChannel] [string repeat = [expr {80-[string length $msg]}]]
 76 |   set slave [interp create]
 77 |   interp eval $slave [package ifneeded tcltest $tcltest::Version]
 78 |   $slave eval {namespace import tcltest::*}
 79 |   interp alias $slave ::tcltest::ReportToParent {} ::tcltest::__ReportToParent
 80 |   $slave eval [list set TESTFILE [file join $TESTDIR $testfile]]
 81 |   $slave eval [list set BUILDDIR $BUILDDIR]
 82 |   $slave eval [list ::tcltest::configure {*}$TEST_OPTIONS]
 83 |   $slave eval $GLOB_OPTIONS
 84 |   # invoke test suite:
 85 |   $slave eval {
 86 |     source $TESTFILE
 87 |   }
 88 |   interp delete $slave
 89 | }
 90 | 
 91 | # commit:
 92 | puts [outputChannel] "\n[string repeat ==== 20]"
 93 | ::tcltest::cleanupTests 1
 94 | 
 95 | # if calling direct:
 96 | if {[info exists ::argv0] && [file tail $::argv0] eq [file tail [info script]]} {
 97 |   if {$::TestSummary(TotFailed)} {
 98 |     puts stderr "\n[string repeat ** 20]"
 99 |     puts stderr "** ERROR: totally $::TestSummary(TotFailed) test(s) failed"
100 |     puts stderr [string repeat ** 20]
101 |     exit 1
102 |   }
103 |   puts [outputChannel] "\nOK."
104 | }
105 | 


--------------------------------------------------------------------------------
/win/tclclockmod.dsp:
--------------------------------------------------------------------------------
  1 | # Microsoft Developer Studio Project File - Name="tclclockmod" - Package Owner=<4>
  2 | # Microsoft Developer Studio Generated Build File, Format Version 6.00
  3 | # ** DO NOT EDIT **
  4 | 
  5 | # TARGTYPE "Win32 (x86) External Target" 0x0106
  6 | 
  7 | CFG=tclclockmod - Win32 Debug
  8 | !MESSAGE This is not a valid makefile. To build this project using NMAKE,
  9 | !MESSAGE use the Export Makefile command and run
 10 | !MESSAGE
 11 | !MESSAGE NMAKE /f "makefile.vc".
 12 | !MESSAGE
 13 | !MESSAGE You can specify a configuration when running NMAKE
 14 | !MESSAGE by defining the macro CFG on the command line. For example:
 15 | !MESSAGE
 16 | !MESSAGE NMAKE /f "makefile.vc" CFG="tclclockmod - Win32 Debug"
 17 | !MESSAGE
 18 | !MESSAGE Possible choices for configuration are:
 19 | !MESSAGE
 20 | !MESSAGE "tclclockmod - Win32 Release" (based on "Win32 (x86) External Target")
 21 | !MESSAGE "tclclockmod - Win32 Debug" (based on "Win32 (x86) External Target")
 22 | !MESSAGE
 23 | 
 24 | # Begin Project
 25 | # PROP AllowPerConfigDependencies 0
 26 | # PROP Scc_ProjName ""
 27 | # PROP Scc_LocalPath ""
 28 | 
 29 | !IF  "$(CFG)" == "tclclockmod - Win32 Release"
 30 | 
 31 | # PROP BASE Use_MFC 0
 32 | # PROP BASE Use_Debug_Libraries 0
 33 | # PROP BASE Output_Dir "Release"
 34 | # PROP BASE Intermediate_Dir "Release"
 35 | # PROP BASE Cmd_Line "NMAKE /f makefile.vc"
 36 | # PROP BASE Rebuild_Opt "/a"
 37 | # PROP BASE Target_File "tclclockmod.dll"
 38 | # PROP BASE Bsc_Name "tclclockmod.bsc"
 39 | # PROP BASE Target_Dir ""
 40 | # PROP Use_MFC 0
 41 | # PROP Use_Debug_Libraries 0
 42 | # PROP Output_Dir "Release"
 43 | # PROP Intermediate_Dir "Release"
 44 | # PROP Cmd_Line "nmake -nologo -f makefile.vc TCLDIR=E:\tcl MSVCDIR=IDE"
 45 | # PROP Rebuild_Opt "-a"
 46 | # PROP Target_File "Release\tclclockmod.dll"
 47 | # PROP Bsc_Name ""
 48 | # PROP Target_Dir ""
 49 | 
 50 | !ELSEIF  "$(CFG)" == "tclclockmod - Win32 Debug"
 51 | 
 52 | # PROP BASE Use_MFC 0
 53 | # PROP BASE Use_Debug_Libraries 1
 54 | # PROP BASE Output_Dir "Debug"
 55 | # PROP BASE Intermediate_Dir "Debug"
 56 | # PROP BASE Cmd_Line "NMAKE /f makefile.vc"
 57 | # PROP BASE Rebuild_Opt "/a"
 58 | # PROP BASE Target_File "tclclockmod.exe"
 59 | # PROP BASE Bsc_Name "tclclockmod.bsc"
 60 | # PROP BASE Target_Dir ""
 61 | # PROP Use_MFC 0
 62 | # PROP Use_Debug_Libraries 1
 63 | # PROP Output_Dir "Debug"
 64 | # PROP Intermediate_Dir "Debug"
 65 | # PROP Cmd_Line "nmake -nologo -f makefile.vc OPTS=symbols TCLDIR=E:\tcl MSVCDIR=IDE"
 66 | # PROP Rebuild_Opt "-a"
 67 | # PROP Target_File "Debug\tclclockmodg.dll"
 68 | # PROP Bsc_Name ""
 69 | # PROP Target_Dir ""
 70 | 
 71 | !ENDIF
 72 | 
 73 | # Begin Target
 74 | 
 75 | # Name "tclclockmod - Win32 Release"
 76 | # Name "tclclockmod - Win32 Debug"
 77 | 
 78 | !IF  "$(CFG)" == "tclclockmod - Win32 Release"
 79 | 
 80 | !ELSEIF  "$(CFG)" == "tclclockmod - Win32 Debug"
 81 | 
 82 | !ENDIF
 83 | 
 84 | ROOT=..
 85 | 
 86 | # Begin Group "generic"
 87 | 
 88 | # PROP Default_Filter ""
 89 | # Begin Source File
 90 | 
 91 | SOURCE=$(ROOT)\generic\tclClock.c
 92 | # End Source File
 93 | # Begin Source File
 94 | 
 95 | SOURCE=$(ROOT)\generic\tclClockFmt.c
 96 | # End Source File
 97 | # Begin Source File
 98 | 
 99 | SOURCE=$(ROOT)\generic\tclClockMod.c
100 | # End Source File
101 | # Begin Source File
102 | 
103 | SOURCE=$(ROOT)\generic\tclClockModInt.c
104 | # End Source File
105 | # Begin Source File
106 | 
107 | SOURCE=$(ROOT)\generic\tclClockModInt.h
108 | # End Source File
109 | # Begin Source File
110 | 
111 | SOURCE=$(ROOT)\generic\tclDate.c
112 | # End Source File
113 | # Begin Source File
114 | 
115 | SOURCE=$(ROOT)\generic\tclDate.h
116 | # End Source File
117 | # Begin Source File
118 | 
119 | SOURCE=$(ROOT)\generic\tclStrIdxTree.c
120 | # End Source File
121 | # Begin Source File
122 | 
123 | SOURCE=$(ROOT)\generic\tclStrIdxTree.h
124 | # End Source File
125 | # End Group
126 | 
127 | # Begin Group "win"
128 | 
129 | # PROP Default_Filter ""
130 | # Begin Group "vc"
131 | 
132 | # PROP Default_Filter ""
133 | # Begin Source File
134 | 
135 | SOURCE=$(ROOT)\win\makefile.vc
136 | # End Source File
137 | # Begin Source File
138 | 
139 | SOURCE=$(ROOT)\win\nmakehlp.c
140 | # End Source File
141 | # Begin Source File
142 | 
143 | SOURCE=$(ROOT)\win\pkg.vc
144 | # End Source File
145 | # Begin Source File
146 | 
147 | SOURCE=$(ROOT)\win\rules.vc
148 | # End Source File
149 | # Begin Source File
150 | 
151 | SOURCE=$(ROOT)\win\tclclockmod.rc
152 | # End Source File
153 | # End Group
154 | # Begin Source File
155 | 
156 | SOURCE=$(ROOT)\win\README.txt
157 | # End Source File
158 | # End Group
159 | # Begin Source File
160 | 
161 | SOURCE=$(ROOT)\license.terms
162 | # End Source File
163 | # Begin Source File
164 | 
165 | SOURCE=$(ROOT)\README
166 | # End Source File
167 | # End Target
168 | # End Project
169 | 


--------------------------------------------------------------------------------
/generic/tclStrIdxTree.h:
--------------------------------------------------------------------------------
  1 | /*
  2 |  * tclStrIdxTree.h --
  3 |  *
  4 |  *	Declarations of string index tries and other primitives currently
  5 |  *  back-ported from tclSE.
  6 |  *
  7 |  * Copyright (c) 2016 Serg G. Brester (aka sebres)
  8 |  *
  9 |  * See the file "license.terms" for information on usage and redistribution
 10 |  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 11 |  */
 12 | 
 13 | #ifndef _TCLSTRIDXTREE_H
 14 | #define _TCLSTRIDXTREE_H
 15 | 
 16 | #include "tclClockModInt.h"
 17 | 
 18 | /*
 19 |  * Main structures declarations of index tree and entry
 20 |  */
 21 | 
 22 | typedef struct TclStrIdxTree {
 23 |     struct TclStrIdx *firstPtr;
 24 |     struct TclStrIdx *lastPtr;
 25 | } TclStrIdxTree;
 26 | 
 27 | typedef struct TclStrIdx {
 28 |     struct TclStrIdxTree childTree;
 29 |     struct TclStrIdx *nextPtr;
 30 |     struct TclStrIdx *prevPtr;
 31 |     Tcl_Obj	*key;
 32 |     int		 length;
 33 |     ClientData	 value;
 34 | } TclStrIdx;
 35 | 
 36 | 
 37 | /*
 38 |  *----------------------------------------------------------------------
 39 |  *
 40 |  * TclUtfFindEqual, TclUtfFindEqualNC --
 41 |  *
 42 |  *  Find largest part of string cs in string cin (case sensitive and not).
 43 |  *
 44 |  * Results:
 45 |  *  Return position of UTF character in cs after last equal character.
 46 |  *
 47 |  * Side effects:
 48 |  *  None.
 49 |  *
 50 |  *----------------------------------------------------------------------
 51 |  */
 52 | 
 53 | static inline const char *
 54 | TclUtfFindEqual(
 55 |     register const char *cs,	/* UTF string to find in cin. */
 56 |     register const char *cse,	/* End of cs */
 57 |     register const char *cin,	/* UTF string will be browsed. */
 58 |     register const char *cine)	/* End of cin */
 59 | {
 60 |     register const char *ret = cs;
 61 |     Tcl_UniChar ch1, ch2;
 62 |     do {
 63 | 	cs += TclUtfToUniChar(cs, &ch1);
 64 | 	cin += TclUtfToUniChar(cin, &ch2);
 65 | 	if (ch1 != ch2) break;
 66 |     } while ((ret = cs) < cse && cin < cine);
 67 |     return ret;
 68 | }
 69 | 
 70 | static inline const char *
 71 | TclUtfFindEqualNC(
 72 |     register const char *cs,	/* UTF string to find in cin. */
 73 |     register const char *cse,	/* End of cs */
 74 |     register const char *cin,	/* UTF string will be browsed. */
 75 |     register const char *cine,	/* End of cin */
 76 |     const char	     **cinfnd)	/* Return position in cin */
 77 | {
 78 |     register const char *ret = cs;
 79 |     Tcl_UniChar ch1, ch2;
 80 |     do {
 81 | 	cs += TclUtfToUniChar(cs, &ch1);
 82 | 	cin += TclUtfToUniChar(cin, &ch2);
 83 | 	if (ch1 != ch2) {
 84 | 	    ch1 = Tcl_UniCharToLower(ch1);
 85 | 	    ch2 = Tcl_UniCharToLower(ch2);
 86 | 	    if (ch1 != ch2) break;
 87 | 	}
 88 | 	*cinfnd = cin;
 89 |     } while ((ret = cs) < cse && cin < cine);
 90 |     return ret;
 91 | }
 92 | 
 93 | static inline const char *
 94 | TclUtfFindEqualNCInLwr(
 95 |     register const char *cs,	/* UTF string (in anycase) to find in cin. */
 96 |     register const char *cse,	/* End of cs */
 97 |     register const char *cin,	/* UTF string (in lowercase) will be browsed. */
 98 |     register const char *cine,	/* End of cin */
 99 |     const char	     **cinfnd)	/* Return position in cin */
100 | {
101 |     register const char *ret = cs;
102 |     Tcl_UniChar ch1, ch2;
103 |     do {
104 | 	cs += TclUtfToUniChar(cs, &ch1);
105 | 	cin += TclUtfToUniChar(cin, &ch2);
106 | 	if (ch1 != ch2) {
107 | 	    ch1 = Tcl_UniCharToLower(ch1);
108 | 	    if (ch1 != ch2) break;
109 | 	}
110 | 	*cinfnd = cin;
111 |     } while ((ret = cs) < cse && cin < cine);
112 |     return ret;
113 | }
114 | 
115 | /*
116 |  * Primitives to safe set, reset and free references.
117 |  */
118 | 
119 | #define Tcl_UnsetObjRef(obj) \
120 |   if (obj != NULL) { Tcl_DecrRefCount(obj); obj = NULL; }
121 | #define Tcl_InitObjRef(obj, val) \
122 |   obj = val; if (obj) { Tcl_IncrRefCount(obj); }
123 | #define Tcl_SetObjRef(obj, val) \
124 | if (1) { \
125 |   Tcl_Obj *nval = val; \
126 |   if (obj != nval) { \
127 |     Tcl_Obj *prev = obj; \
128 |     Tcl_InitObjRef(obj, nval); \
129 |     if (prev != NULL) { Tcl_DecrRefCount(prev); }; \
130 |   } \
131 | }
132 | 
133 | /*
134 |  * Prototypes of module functions.
135 |  */
136 | 
137 | MODULE_SCOPE const char*
138 | 		    TclStrIdxTreeSearch(TclStrIdxTree **foundParent,
139 | 			TclStrIdx **foundItem, TclStrIdxTree *tree,
140 | 			const char *start, const char *end);
141 | 
142 | MODULE_SCOPE int    TclStrIdxTreeBuildFromList(TclStrIdxTree *idxTree,
143 | 			int lstc, Tcl_Obj **lstv, ClientData *values);
144 | 
145 | MODULE_SCOPE Tcl_Obj*
146 | 		    TclStrIdxTreeNewObj();
147 | 
148 | MODULE_SCOPE TclStrIdxTree*
149 | 		    TclStrIdxTreeGetFromObj(Tcl_Obj *objPtr);
150 | 
151 | #if 1
152 | 
153 | MODULE_SCOPE int    TclStrIdxTreeTestObjCmd(ClientData, Tcl_Interp *,
154 | 			int, Tcl_Obj *const objv[]);
155 | #endif
156 | 
157 | #endif /* _TCLSTRIDXTREE_H */
158 | 


--------------------------------------------------------------------------------
/README.md:
--------------------------------------------------------------------------------
  1 | 
  2 |           _____   _  ___ _         _   __  __         _ 
  3 |          |_   _|_| |/ __| |___  __| |_|  \/  |___  __| |
  4 |            | |/ _| | (__| / _ \/ _| / / |\/| / _ \/ _` |
  5 |            |_|\__|_|\___|_\___/\__|_\_\_|  |_\___/\__,_|
  6 |            v.8.6.7-03                         2018/12/03
  7 |                                                        
  8 | 
  9 | ## TclClockMod: the [fastest, most powerful](#performance-) Tcl clock engine written in C
 10 | 
 11 | What is this ?
 12 | ==============
 13 | 
 14 | This is the source distribution of the Tcl clock extension: the [faster](#performance-) 
 15 | Tcl-module for the replacement of the standard "clock" ensemble of tcl.
 16 | 
 17 | You need to have your Tcl core compiled also.
 18 | 
 19 | This extension is a freely available open source package. You can do
 20 | virtually anything you like with it, such as modifying it, redistributing
 21 | it, and selling it either in whole or in part.  See the "license.terms"
 22 | file in the top-level distribution directory for complete information.
 23 | 
 24 | **Now this clock-engine is a [part of Tcl 8.7 / 9.0 core.](#integration-in-tcl-87--90-core)**
 25 | 
 26 | How to compile ?
 27 | ----------------
 28 | 
 29 | Only Unix-like and Windows platforms are supported at the moment. Depending
 30 | on your platform (Unix-like or Windows) go to the appropriate directory
 31 | (unix or win) and start with the README file. Macintosh platform is supported
 32 | similar way the Tcl core does it also.
 33 | 
 34 | How to use ?
 35 | ------------
 36 | 
 37 | ```tcl
 38 | package require tclclockmod
 39 | clock format now
 40 | ```
 41 | 
 42 | Performance ?
 43 | -------------
 44 | 
 45 | Current performance increase (in comparison vs the tcl-core clock):
 46 | 
 47 | Function | Performance increase | tclclockmod | tcl8.6-clock
 48 | -------- | -------------------- | ----------- | ------------
 49 | `clock format` | 15 - 20 times faster | 0.27 - 4.28 µs/# | 5.45 - 45 µs/#
 50 | `clock scan -format` | 40 - 70 times (up to 100 times faster \*)<br/><sub>\* some previously extremely slow scans</sub> | 0.44 - 1.72 µs/# | 21 - 120 µs/#
 51 | `clock scan` (freescan) | 15 - 20 times | 0.51 - 5.84 µs/# | 12 - 77 µs/#
 52 | `clock add` | 50 - 90 times | 0.31 - 0.68 µs/# | 15 - 45 µs/#
 53 | 
 54 | The difference is much more larger, if the tests are running multi-threaded with parasitic load.
 55 | 
 56 | #### How the performance is measured:
 57 | 
 58 | Both tcl-core as well as tclclockmod has a file [tests-perf/clock.perf.tcl](./tests-perf/clock.perf.tcl) which can be used to compare the execution times of original clock and tclclockmod. It can be also simply performed from the tclsh, with and without loading of the module.<br/>
 59 | Here is a diff illustrating that (which amounted to 112x speed-up):
 60 | ```diff
 61 |   % timerate -calibrate {}
 62 |   % clock scan "" -timezone :CET; clock scan "" -gmt 1; # warming up
 63 |   % timerate { clock scan "2009-06-30T18:30:00 CEST" -format "%Y-%m-%dT%H:%M:%S %z" -gmt 1 }
 64 | - 66.1134 µs/# 15118 # 15125.5 #/sec 999.502 net-ms
 65 | + 0.587048 µs/# 1612463 # 1703438 #/sec 946.593 net-ms
 66 | ```
 67 | 
 68 | Tcl compatibility:
 69 | =================
 70 | 
 71 | Although this clock-ensemble version is almost 100% compatible (except of some 
 72 | changes of the logic as regards the bug-fixing), but you should nevertheless
 73 | test it with your application.
 74 | 
 75 | The module is currently usable with latest Tcl 8.6th version (>= 8.6.6), but can
 76 | be used also with previous versions since 8.6.0 (note that some packages like 
 77 | "msgcat" should be upgraded in this case).
 78 | 
 79 | Integration in Tcl 8.7 / 9.0 core:
 80 | ------------------------------------
 81 | 
 82 | Since [TIP 688](https://core.tcl-lang.org/tips/doc/trunk/tip/688.md) (commits [GH/tcl/e736133f9c72](https://github.com/tcltk/tcl/commit/e736133f9c72a69186f1d6845b5fb52de03c23ab) or [CORE/tcl/7137ea11e9e343f6](https://core.tcl-lang.org/tcl/info/7137ea11e9e343f6)) this is a part of Tcl 8.7 / 9.0 and therefore fully compatible to newest core-tcl now, excepting few things (like `clock configure` -> `tcl::unsupported::clock::configure`).
 83 | 
 84 | Code status (CI):
 85 | -----------------
 86 | 
 87 | * GH-actions:
 88 |   - [![CI-nix](https://github.com/sebres/tclclockmod/actions/workflows/ci-nix.yml/badge.svg)](https://github.com/sebres/tclclockmod/actions/workflows/ci-nix.yml)
 89 | 
 90 | Contact:
 91 | --------
 92 | 
 93 | ### Bugs, feature requests, discussions?
 94 | Use github [issue-tracker](https://github.com/sebres/tclclockmod).
 95 | 
 96 | ### You just appreciate this program:
 97 | send kudos to the original author ([Sergey G. Brester](mailto:github@sebres.de)).
 98 | 
 99 | Thanks:
100 | -------
101 | 
102 | - FlightAware for the inspiration for me to write it (due to their bounty-program).
103 | - TCT and all other contributors for the great language (long live Tcl!).
104 | 
105 | 
106 | License:
107 | --------
108 | 
109 | See the file "license.terms" for information on usage and redistribution of
110 | this file, and for a DISCLAIMER OF ALL WARRANTIES.
111 | 


--------------------------------------------------------------------------------
/tests-perf/test-performance.tcl:
--------------------------------------------------------------------------------
  1 | # ------------------------------------------------------------------------
  2 | #
  3 | # test-performance.tcl --
  4 | #
  5 | #  This file provides common performance tests for comparison of tcl-speed
  6 | #  degradation or regression by switching between branches.
  7 | #
  8 | #  To execute test case evaluate direct corresponding file "tests-perf\*.perf.tcl".
  9 | #
 10 | # ------------------------------------------------------------------------
 11 | #
 12 | # Copyright (c) 2014 Serg G. Brester (aka sebres)
 13 | #
 14 | # See the file "license.terms" for information on usage and redistribution
 15 | # of this file.
 16 | #
 17 | 
 18 | # check test performance framework is available in tcl-core:
 19 | apply {{} {
 20 |   foreach lib [list \
 21 |     [file join [info library] tests-perf test-performance.tcl] \
 22 |     [file join [file dirname [info library]] tests-perf test-performance.tcl] \
 23 |   ] {
 24 |     if {[file exists $lib]} {
 25 |       source $lib
 26 |       return -code return {}; # found/loaded - use it
 27 |     }
 28 |   }
 29 | }}
 30 | 
 31 | # last known version of the framework:
 32 | 
 33 | namespace eval ::tclTestPerf {
 34 | # warm-up interpeter compiler env, calibrate timerate measurement functionality:
 35 | 
 36 | # if no timerate here - import from unsupported:
 37 | if {[namespace which -command timerate] eq {}} {
 38 |   namespace inscope ::tcl::unsupported {namespace export timerate}
 39 |   namespace import ::tcl::unsupported::timerate
 40 | }
 41 | 
 42 | # if not yet calibrated:
 43 | if {[lindex [timerate {} 10] 6] >= (10-1)} {
 44 |   puts -nonewline "Calibration ... "; flush stdout
 45 |   puts "done: [lrange \
 46 |     [timerate -calibrate {}] \
 47 |   0 1]"
 48 | }
 49 | 
 50 | proc {**STOP**} {args} {
 51 |   return -code error -level 4 "**STOP** in [info level [expr {[info level]-2}]] [join $args { }]"
 52 | }
 53 | 
 54 | proc _test_get_commands {lst} {
 55 |   regsub -all {(?:^|\n)[ \t]*(\#[^\n]*|\msetup\M[^\n]*|\mcleanup\M[^\n]*)(?=\n\s*(?:[\{\#]|setup|cleanup|$))} $lst "\n{\\1}"
 56 | }
 57 | 
 58 | proc _test_out_total {} {
 59 |   upvar _ _
 60 | 
 61 |   set tcnt [llength $_(itm)]
 62 |   if {!$tcnt} {
 63 |     puts ""
 64 |     return
 65 |   }
 66 | 
 67 |   set mintm 0x7fffffff
 68 |   set maxtm 0
 69 |   set nettm 0
 70 |   set wtm 0
 71 |   set wcnt 0
 72 |   set i 0
 73 |   foreach tm $_(itm) {
 74 |     if {[llength $tm] > 6} {
 75 |       set nettm [expr {$nettm + [lindex $tm 6]}]
 76 |     }
 77 |     set wtm [expr {$wtm + [lindex $tm 0]}]
 78 |     set wcnt [expr {$wcnt + [lindex $tm 2]}]
 79 |     set tm [lindex $tm 0]
 80 |     if {$tm > $maxtm} {set maxtm $tm; set maxi $i}
 81 |     if {$tm < $mintm} {set mintm $tm; set mini $i}
 82 |     incr i
 83 |   }
 84 | 
 85 |   puts [string repeat ** 40]
 86 |   set s [format "%d cases in %.2f sec." $tcnt [expr {([clock milliseconds] - $_(starttime)) / 1000.0}]]
 87 |   if {$nettm > 0} {
 88 |     append s [format " (%.2f net-sec.)" [expr {$nettm / 1000.0}]]
 89 |   }
 90 |   puts "Total $s:"
 91 |   lset _(m) 0 [format %.6f $wtm]
 92 |   lset _(m) 2 $wcnt
 93 |   lset _(m) 4 [format %.3f [expr {$wcnt / (($nettm ? $nettm : ($tcnt * [lindex $_(reptime) 0])) / 1000.0)}]]
 94 |   if {[llength $_(m)] > 6} {
 95 |     lset _(m) 6 [format %.3f $nettm]
 96 |   }
 97 |   puts $_(m)
 98 |   puts "Average:"
 99 |   lset _(m) 0 [format %.6f [expr {[lindex $_(m) 0] / $tcnt}]]
100 |   lset _(m) 2 [expr {[lindex $_(m) 2] / $tcnt}]
101 |   if {[llength $_(m)] > 6} {
102 |     lset _(m) 6 [format %.3f [expr {[lindex $_(m) 6] / $tcnt}]]
103 |     lset _(m) 4 [format %.0f [expr {[lindex $_(m) 2] / [lindex $_(m) 6] * 1000}]]
104 |   }
105 |   puts $_(m)
106 |   puts "Min:"
107 |   puts [lindex $_(itm) $mini]
108 |   puts "Max:"
109 |   puts [lindex $_(itm) $maxi]
110 |   puts [string repeat ** 40]
111 |   puts ""
112 |   unset -nocomplain _(itm) _(starttime)
113 | }
114 | 
115 | proc _test_start {reptime} {
116 |   upvar _ _
117 |   array set _ [list itm {} reptime $reptime starttime [clock milliseconds] -from-run 0]
118 | }
119 | 
120 | proc _test_iter {args} {
121 |   if {[llength $args] > 2} {
122 |     return -code error "wrong # args: should be \"[lindex [info level [info level]] 0] ?level? measure-result\""
123 |   }
124 |   set lvl 1
125 |   if {[llength $args] > 1} {
126 |     set args [lassign $args lvl]
127 |   }
128 |   upvar $lvl _ _
129 |   puts [set _(m) {*}$args]
130 |   lappend _(itm) $_(m)
131 |   puts ""
132 | }
133 | 
134 | proc _adjust_maxcount {reptime maxcount} {
135 |   if {[llength $reptime] > 1} {
136 |     lreplace $reptime 1 1 [expr {min($maxcount,[lindex $reptime 1])}]
137 |   } else {
138 |     lappend reptime $maxcount
139 |   }
140 | }
141 | 
142 | proc _test_run {args} {
143 |   upvar _ _
144 |   # parse args:
145 |   array set _ {-no-result 0 -uplevel 0 -convert-result {}}
146 |   while {[llength $args] > 2} {
147 |     if {![info exists _([set o [lindex $args 0]])]} {
148 |       break
149 |     }
150 |     if {[string is boolean -strict $_($o)]} {
151 |       set _($o) [expr {! $_($o)}]
152 |       set args [lrange $args 1 end]
153 |     } else {
154 |       if {[llength $args] <= 2} {
155 |         return -code error "value expected for option $o"
156 |       }
157 |       set _($o) [lindex $args 1]
158 |       set args [lrange $args 2 end]
159 |     }
160 |   }
161 |   unset -nocomplain o
162 |   if {[llength $args] < 2 || [llength $args] > 3} {
163 |     return -code error "wrong # args: should be \"[lindex [info level [info level]] 0] ?-no-result? reptime lst ?outcmd?\""
164 |   }
165 |   set _(outcmd) {puts}
166 |   set args [lassign $args reptime lst]
167 |   if {[llength $args]} {
168 |     set _(outcmd) [lindex $args 0]
169 |   }
170 |   # avoid output if only once:
171 |   if {[lindex $reptime 0] <= 1 || ([llength $reptime] > 1 && [lindex $reptime 1] == 1)} {
172 |     set _(-no-result) 1
173 |   }
174 |   if {![info exists _(itm)]} {
175 |     array set _ [list itm {} reptime $reptime starttime [clock milliseconds] -from-run 1]
176 |   } else {
177 |     array set _ [list reptime $reptime]
178 |   }
179 | 
180 |   # process measurement:
181 |   foreach _(c) [_test_get_commands $lst] {
182 |     {*}$_(outcmd) "% [regsub -all {\n[ \t]*} $_(c) {; }]"
183 |     if {[regexp {^\s*\#} $_(c)]} continue
184 |     if {[regexp {^\s*(?:setup|cleanup)\s+} $_(c)]} {
185 |       set _(c) [lindex $_(c) 1]
186 |       if {$_(-uplevel)} {
187 |         set _(c) [list uplevel 1 $_(c)]
188 |       }
189 |       {*}$_(outcmd) [if 1 $_(c)]
190 |       continue
191 |     }
192 |     if {$_(-uplevel)} {
193 |       set _(c) [list uplevel 1 $_(c)]
194 |     }
195 |     set _(ittime) $_(reptime)
196 |     # if output result (and not once):
197 |     if {!$_(-no-result)} {
198 |       set _(r) [if 1 $_(c)]
199 |       if {$_(-convert-result) ne ""} { set _(r) [if 1 $_(-convert-result)] }
200 |       {*}$_(outcmd) $_(r)
201 |       if {[llength $_(ittime)] > 1} { # decrement max-count
202 |         lset _(ittime) 1 [expr {[lindex $_(ittime) 1] - 1}]
203 |       }
204 |     }
205 |     {*}$_(outcmd) [set _(m) [timerate $_(c) {*}$_(ittime)]]
206 |     lappend _(itm) $_(m)
207 |     {*}$_(outcmd) ""
208 |   }
209 |   if {$_(-from-run)} {
210 |     _test_out_total
211 |   }
212 | }
213 | 
214 | }; # end of namespace ::tclTestPerf
215 | 


--------------------------------------------------------------------------------
/generic/tclClockModInt.c:
--------------------------------------------------------------------------------
  1 | /*
  2 |  * tclClockModInt.c --
  3 |  *
  4 |  * Internal implementations of fast tcl clock module.
  5 |  *
  6 |  * Copyright (c) 2017 Serg G. Brester (aka sebres)
  7 |  *
  8 |  * See the file "license.terms" for information on usage and redistribution
  9 |  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 10 |  */
 11 | 
 12 | 
 13 | #include "tclClockModInt.h"
 14 | #include "tclInt.h"
 15 | 
 16 | CompileProc *_TclCompileBasicMin0ArgCmd;
 17 | CompileProc *_TclCompileBasicMin1ArgCmd;
 18 | CompileProc *_TclCompileClockClicksCmd;
 19 | CompileProc *_TclCompileClockReadingCmd;
 20 | 
 21 | 
 22 | int TclCompileBasicMin0ArgCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr,
 23 |     struct Command *cmdPtr, struct CompileEnv *compEnvPtr)
 24 | {
 25 |     return _TclCompileBasicMin0ArgCmd(interp, parsePtr, cmdPtr, compEnvPtr);
 26 | };
 27 | int TclCompileBasicMin1ArgCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr,
 28 |     struct Command *cmdPtr, struct CompileEnv *compEnvPtr)
 29 | {
 30 |     return _TclCompileBasicMin1ArgCmd(interp, parsePtr, cmdPtr, compEnvPtr);
 31 | };
 32 | int TclCompileClockClicksCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr,
 33 |     struct Command *cmdPtr, struct CompileEnv *compEnvPtr)
 34 | {
 35 |     return _TclCompileClockClicksCmd(interp, parsePtr, cmdPtr, compEnvPtr);
 36 | };
 37 | int TclCompileClockReadingCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr,
 38 |     struct Command *cmdPtr, struct CompileEnv *compEnvPtr)
 39 | {
 40 |     return _TclCompileClockReadingCmd(interp, parsePtr, cmdPtr, compEnvPtr);
 41 | };
 42 | 
 43 | /*
 44 |  *----------------------------------------------------------------------
 45 |  */
 46 | 
 47 | /*
 48 |  * Because of missing extranals (stubs/lib) for some functions like 
 49 |  * TclpGetWideClicks, TclpGetMicroseconds, etc.
 50 |  */
 51 | 
 52 | Tcl_ObjCmdProc *_ClockClicksObjCmd;
 53 | Tcl_ObjCmdProc *_ClockMillisecondsObjCmd;
 54 | Tcl_ObjCmdProc *_ClockMicrosecondsObjCmd;
 55 | Tcl_ObjCmdProc * _TclNRCatchObjCmd;
 56 | 
 57 | int ClockClicksObjCmd(ClientData clientData, Tcl_Interp *interp,
 58 |    int objc, Tcl_Obj *const *objv)
 59 | {
 60 |     return _ClockClicksObjCmd(clientData, interp, objc, objv);
 61 | }
 62 | int ClockMillisecondsObjCmd(ClientData clientData, Tcl_Interp *interp,
 63 |    int objc, Tcl_Obj *const *objv)
 64 | {
 65 |     return _ClockMillisecondsObjCmd(clientData, interp, objc, objv);
 66 | }
 67 | int ClockMicrosecondsObjCmd(ClientData clientData, Tcl_Interp *interp,
 68 |    int objc, Tcl_Obj *const *objv)
 69 | {
 70 |     return _ClockMicrosecondsObjCmd(clientData, interp, objc, objv);
 71 | }
 72 | 
 73 | int Tcl_CatchObjCmd(ClientData dummy, Tcl_Interp *interp,
 74 |    int objc, Tcl_Obj *const objv[])
 75 | {
 76 |     return Tcl_NRCallObjProc(interp, _TclNRCatchObjCmd, dummy, objc, objv);
 77 | }
 78 | 
 79 | /* Currently no external declaration for tclStringHashKeyType */
 80 | 
 81 | static unsigned
 82 | HashStringKey(
 83 |     Tcl_HashTable *tablePtr,	/* Hash table. */
 84 |     void *keyPtr)		/* Key from which to compute hash value. */
 85 | {
 86 |     register const char *string = keyPtr;
 87 |     register unsigned int result;
 88 |     register char c;
 89 |     if ((result = UCHAR(*string)) != 0) {
 90 | 	while ((c = *++string) != 0) {
 91 | 	    result += (result << 3) + UCHAR(c);
 92 | 	}
 93 |     }
 94 |     return result;
 95 | }
 96 | static int
 97 | CompareStringKeys(
 98 |     void *keyPtr,		/* New key to compare. */
 99 |     Tcl_HashEntry *hPtr)	/* Existing key to compare. */
100 | {
101 |     register const char *p1 = (const char *) keyPtr;
102 |     register const char *p2 = (const char *) hPtr->key.string;
103 | 
104 |     return !strcmp(p1, p2);
105 | }
106 | const Tcl_HashKeyType tclStringHashKeyType = {
107 |     TCL_HASH_KEY_TYPE_VERSION,		/* version */
108 |     0,					/* flags */
109 |     HashStringKey,			/* hashKeyProc */
110 |     CompareStringKeys,			/* compareKeysProc */
111 |     NULL,				/* allocEntryProc (overriden) */
112 |     NULL				/* freeEntryProc (overriden) */
113 | };
114 | 
115 | 
116 | /*
117 |  *----------------------------------------------------------------------
118 |  *
119 |  * Tcl_DictObjSmartRef --
120 |  *
121 |  * Workaround to simulate dict smartref: guarantees editable dict (as single reference)
122 |  *
123 |  *----------------------------------------------------------------------
124 |  */
125 | 
126 | Tcl_Obj *
127 | Tcl_DictObjSmartRef(
128 |     Tcl_Interp *interp,
129 |     Tcl_Obj    *dictPtr)
130 | {
131 | /*    if (Tcl_IsShared(dictPtr)) { */
132 | 	dictPtr = Tcl_DuplicateObj(dictPtr);
133 | /*    } */
134 |     return dictPtr;
135 | }
136 | 
137 | 
138 | /*
139 |  *----------------------------------------------------------------------
140 |  */
141 | 
142 | /* MODULE_SCOPE */
143 | size_t TclEnvEpoch = 0;		/* Epoch of the tcl environment
144 | 				 * (if changed with tcl-env). */
145 | 
146 | /* ARGSUSED */
147 | static char *
148 | EnvEpochTraceProc(
149 |     ClientData clientData,	/* Not used. */
150 |     Tcl_Interp *interp,		/* Interpreter whose "env" variable is being
151 | 				 * modified. */
152 |     const char *name1,		/* Better be "env". */
153 |     const char *name2,		/* Name of variable being modified, or NULL if
154 | 				 * whole array is being deleted (UTF-8). */
155 |     int flags)			/* Indicates what's happening. */
156 | {
157 |     /*
158 |      * Increase env-epoch if changed.
159 |      */
160 | 
161 |     if (flags & TCL_TRACE_ARRAY) {
162 | 	TclEnvEpoch++;
163 | 	return NULL;
164 |     }
165 |     if (name2 == NULL) {
166 | 	return NULL;
167 |     }
168 |     if (flags & TCL_TRACE_WRITES) {
169 | 	TclEnvEpoch++;
170 |     }
171 |     else
172 |     if (flags & TCL_TRACE_UNSETS) {
173 | 	TclEnvEpoch++;
174 |     }
175 |     return NULL;
176 | }
177 | 
178 | 
179 | /*
180 |  * TclpCompileEnsemblObjCmd --
181 |  */
182 | int TclpCompileEnsemblObjCmd(
183 |     ClientData unused, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
184 | {
185 |     int ensFlags = 0;
186 |     Tcl_Command token = Tcl_FindCommand(interp, "clock", NULL, TCL_GLOBAL_ONLY);
187 |     if (!token) {
188 | 	return TCL_ERROR;
189 |     }
190 |     if (Tcl_GetEnsembleFlags(interp, token, &ensFlags) != TCL_OK) {
191 | 	return TCL_ERROR;
192 |     }
193 |     ensFlags |= ENSEMBLE_COMPILE;
194 |     return Tcl_SetEnsembleFlags(interp, token, ensFlags);
195 | }
196 | 
197 | 
198 | #define InterpCommand(interp, cmdName) \
199 |     ((Command*)Tcl_FindCommand(interp, (cmdName), NULL, TCL_GLOBAL_ONLY))
200 | 
201 | /*
202 |  * _InitModTclIntInternals --
203 |  */
204 | void _InitModTclIntInternals(Tcl_Interp *interp) {
205 |     /*
206 |      * There is no other way to get some internal tcl-primitives
207 |      * w/o this tricks, regardless whether using stubs or not
208 |      * (linked directly).
209 |      */
210 |     _TclCompileBasicMin0ArgCmd =
211 | 	InterpCommand(interp, "::tcl::namespace::export")->compileProc;
212 |     _TclCompileBasicMin1ArgCmd =
213 | 	InterpCommand(interp, "::tcl::dict::remove")->compileProc;
214 |     _TclCompileClockClicksCmd =
215 | 	InterpCommand(interp, "::tcl::clock::clicks")->compileProc;
216 |     _TclCompileClockReadingCmd =
217 | 	InterpCommand(interp, "::tcl::clock::seconds")->compileProc;
218 | 
219 |     /* Compatible < 8.6.7 versions: */
220 |     if (!_TclCompileClockClicksCmd || !_TclCompileClockReadingCmd) {
221 | 	_TclCompileClockClicksCmd = _TclCompileBasicMin0ArgCmd;
222 | 	_TclCompileClockReadingCmd = _TclCompileBasicMin0ArgCmd;
223 |     }
224 | 
225 |     _ClockClicksObjCmd =
226 | 	InterpCommand(interp, "::tcl::clock::clicks")->objProc;
227 |     _ClockMillisecondsObjCmd =
228 | 	InterpCommand(interp, "::tcl::clock::milliseconds")->objProc;
229 |     _ClockMicrosecondsObjCmd =
230 | 	InterpCommand(interp, "::tcl::clock::microseconds")->objProc;
231 | 
232 |     _TclNRCatchObjCmd =
233 | 	InterpCommand(interp, "::catch")->nreProc;
234 | }
235 | 
236 | /*
237 |  * _InitModTclIntInterp --
238 |  */
239 | int _InitModTclIntInterp(Tcl_Interp *interp) {
240 |     /* Create compiling ensemble command */
241 |     if (Tcl_CreateObjCommand(interp, "::tcl::namespace::ensemble-compile",
242 | 		TclpCompileEnsemblObjCmd, NULL, NULL) == NULL) {
243 | 	return TCL_ERROR;
244 |     };
245 | 
246 |     /* Icrement env-epoch if env variable changed */
247 |     if (Tcl_TraceVar2(interp, "env", NULL,
248 | 	    TCL_GLOBAL_ONLY | TCL_TRACE_WRITES | TCL_TRACE_UNSETS |
249 | 	    TCL_TRACE_ARRAY, EnvEpochTraceProc, NULL) != TCL_OK) {
250 | 	return TCL_ERROR;
251 |     };
252 | 
253 |     return TCL_OK;
254 | }
255 | 


--------------------------------------------------------------------------------
/configure.ac:
--------------------------------------------------------------------------------
  1 | #!/bin/bash -norc
  2 | dnl	This file is an input file used by the GNU "autoconf" program to
  3 | dnl	generate the file "configure", which is run during Tcl installation
  4 | dnl	to configure the system for the local environment.
  5 | 
  6 | #-----------------------------------------------------------------------
  7 | # Sample configure.ac for Tcl Extensions.  The only places you should
  8 | # need to modify this file are marked by the string __CHANGE__
  9 | #-----------------------------------------------------------------------
 10 | 
 11 | #-----------------------------------------------------------------------
 12 | # __CHANGE__
 13 | # Set your package name and version numbers here.
 14 | #
 15 | # This initializes the environment with PACKAGE_NAME and PACKAGE_VERSION
 16 | # set as provided.  These will also be added as -D defs in your Makefile
 17 | # so you can encode the package version directly into the source files.
 18 | #-----------------------------------------------------------------------
 19 | 
 20 | AC_INIT([tclclockmod], [8.6.706])
 21 | 
 22 | #--------------------------------------------------------------------
 23 | # Call TEA_INIT as the first TEA_ macro to set up initial vars.
 24 | # This will define a ${TEA_PLATFORM} variable == "unix" or "windows"
 25 | # as well as PKG_LIB_FILE and PKG_STUB_LIB_FILE.
 26 | #--------------------------------------------------------------------
 27 | 
 28 | TEA_INIT([3.10])
 29 | 
 30 | AC_CONFIG_AUX_DIR(tclconfig)
 31 | 
 32 | #--------------------------------------------------------------------
 33 | # Load the tclConfig.sh file
 34 | #--------------------------------------------------------------------
 35 | 
 36 | TEA_PATH_TCLCONFIG
 37 | TEA_LOAD_TCLCONFIG
 38 | 
 39 | if test "${TCL_MAJOR_VERSION}" -ne 8 ; then
 40 |     AC_MSG_ERROR([${PACKAGE_NAME} ${PACKAGE_VERSION} requires Tcl 8.6+
 41 | Found config for Tcl ${TCL_VERSION}])
 42 | fi
 43 | if test "${TCL_MINOR_VERSION}" -lt 6 ; then
 44 |     AC_MSG_ERROR([${PACKAGE_NAME} ${PACKAGE_VERSION} requires Tcl 8.6+
 45 | Found config for Tcl ${TCL_VERSION}])
 46 | fi
 47 | 
 48 | #--------------------------------------------------------------------
 49 | # Load the tkConfig.sh file if necessary (Tk extension)
 50 | #--------------------------------------------------------------------
 51 | 
 52 | #TEA_PATH_TKCONFIG
 53 | #TEA_LOAD_TKCONFIG
 54 | 
 55 | #-----------------------------------------------------------------------
 56 | # Handle the --prefix=... option by defaulting to what Tcl gave.
 57 | # Must be called after TEA_LOAD_TCLCONFIG and before TEA_SETUP_COMPILER.
 58 | #-----------------------------------------------------------------------
 59 | 
 60 | TEA_PREFIX
 61 | 
 62 | #-----------------------------------------------------------------------
 63 | # Standard compiler checks.
 64 | # This sets up CC by using the CC env var, or looks for gcc otherwise.
 65 | # This also calls AC_PROG_CC and a few others to create the basic setup
 66 | # necessary to compile executables.
 67 | #-----------------------------------------------------------------------
 68 | 
 69 | TEA_SETUP_COMPILER
 70 | 
 71 | #-----------------------------------------------------------------------
 72 | # Default TCL declarations (can be missing in the tclconfig).
 73 | #-----------------------------------------------------------------------
 74 | 
 75 | AC_CHECK_TYPE([intptr_t], [
 76 |     AC_DEFINE([HAVE_INTPTR_T], 1, [Do we have the intptr_t type?])], [
 77 |     AC_CACHE_CHECK([for pointer-size signed integer type], tcl_cv_intptr_t, [
 78 |     for tcl_cv_intptr_t in "int" "long" "long long" none; do
 79 |   if test "$tcl_cv_intptr_t" != none; then
 80 |       AC_COMPILE_IFELSE([AC_LANG_BOOL_COMPILE_TRY([AC_INCLUDES_DEFAULT],
 81 |         [[sizeof (void *) <= sizeof ($tcl_cv_intptr_t)]])],
 82 |     [tcl_ok=yes], [tcl_ok=no])
 83 |       test "$tcl_ok" = yes && break; fi
 84 |     done])
 85 |     if test "$tcl_cv_intptr_t" != none; then
 86 |   AC_DEFINE_UNQUOTED([intptr_t], [$tcl_cv_intptr_t], [Signed integer
 87 |      type wide enough to hold a pointer.])
 88 |     fi
 89 | ])
 90 | AC_CHECK_TYPE([uintptr_t], [
 91 |     AC_DEFINE([HAVE_UINTPTR_T], 1, [Do we have the uintptr_t type?])], [
 92 |     AC_CACHE_CHECK([for pointer-size unsigned integer type], tcl_cv_uintptr_t, [
 93 |     for tcl_cv_uintptr_t in "unsigned int" "unsigned long" "unsigned long long" \
 94 |       none; do
 95 |   if test "$tcl_cv_uintptr_t" != none; then
 96 |       AC_COMPILE_IFELSE([AC_LANG_BOOL_COMPILE_TRY([AC_INCLUDES_DEFAULT],
 97 |         [[sizeof (void *) <= sizeof ($tcl_cv_uintptr_t)]])],
 98 |     [tcl_ok=yes], [tcl_ok=no])
 99 |       test "$tcl_ok" = yes && break; fi
100 |     done])
101 |     if test "$tcl_cv_uintptr_t" != none; then
102 |   AC_DEFINE_UNQUOTED([uintptr_t], [$tcl_cv_uintptr_t], [Unsigned integer
103 |      type wide enough to hold a pointer.])
104 |     fi
105 | ])
106 | 
107 | #-----------------------------------------------------------------------
108 | # __CHANGE__
109 | # Specify the C source files to compile in TEA_ADD_SOURCES,
110 | # public headers that need to be installed in TEA_ADD_HEADERS,
111 | # stub library C source files to compile in TEA_ADD_STUB_SOURCES,
112 | # and runtime Tcl library files in TEA_ADD_TCL_SOURCES.
113 | # This defines PKG(_STUB)_SOURCES, PKG(_STUB)_OBJECTS, PKG_HEADERS
114 | # and PKG_TCL_SOURCES.
115 | #-----------------------------------------------------------------------
116 | 
117 | TEA_ADD_SOURCES([generic/tclClock.c           \
118 |                  generic/tclClockFmt.c        \
119 |                  generic/tclDate.c            \
120 |                  generic/tclStrIdxTree.c      \
121 |                  generic/tclClockMod.c        \
122 |                  generic/tclClockModInt.c     \
123 | ])
124 | # Don't install headers (may overwrite tcl-own headers if same folder):
125 | #TEA_ADD_HEADERS([generic/tclDate.h            \
126 | #                 generic/tclStrIdxTree.h      \
127 | #                 generic/tclClockModInt.h     \
128 | #])
129 | 
130 | #TEA_ADD_STUB_SOURCES([])
131 | 
132 | TEA_ADD_TCL_SOURCES([lib/clock.tcl])
133 | 
134 | #--------------------------------------------------------------------
135 | # __CHANGE__
136 | # Choose which headers you need.  Extension authors should try very
137 | # hard to only rely on the Tcl public header files.  Internal headers
138 | # contain private data structures and are subject to change without
139 | # notice.
140 | # This MUST be called after TEA_LOAD_TCLCONFIG / TEA_LOAD_TKCONFIG
141 | #--------------------------------------------------------------------
142 | 
143 | TEA_PUBLIC_TCL_HEADERS
144 | TEA_PRIVATE_TCL_HEADERS
145 | 
146 | #TEA_PUBLIC_TK_HEADERS
147 | #TEA_PRIVATE_TK_HEADERS
148 | #TEA_PATH_X
149 | 
150 | #--------------------------------------------------------------------
151 | # Check whether --enable-threads or --disable-threads was given.
152 | # This auto-enables if Tcl was compiled threaded.
153 | #--------------------------------------------------------------------
154 | 
155 | TEA_ENABLE_THREADS
156 | 
157 | #--------------------------------------------------------------------
158 | # The statement below defines a collection of symbols related to
159 | # building as a shared library instead of a static library.
160 | #--------------------------------------------------------------------
161 | 
162 | TEA_ENABLE_SHARED
163 | 
164 | #--------------------------------------------------------------------
165 | # This macro figures out what flags to use with the compiler/linker
166 | # when building shared/static debug/optimized objects.  This information
167 | # can be taken from the tclConfig.sh file, but this figures it all out.
168 | #--------------------------------------------------------------------
169 | 
170 | TEA_CONFIG_CFLAGS
171 | 
172 | #--------------------------------------------------------------------
173 | # Set the default compiler switches based on the --enable-symbols option.
174 | #--------------------------------------------------------------------
175 | 
176 | TEA_ENABLE_SYMBOLS
177 | 
178 | #--------------------------------------------------------------------
179 | # Everyone should be linking against the Tcl stub library.  If you
180 | # can't for some reason, remove this definition.  If you aren't using
181 | # stubs, you also need to modify the SHLIB_LD_LIBS setting below to
182 | # link against the non-stubbed Tcl library.  Add Tk too if necessary.
183 | #--------------------------------------------------------------------
184 | 
185 | AC_DEFINE(USE_TCL_STUBS, 1, [Use Tcl stubs])
186 | 
187 | #--------------------------------------------------------------------
188 | # Enable compile-time support for TIP #143 and TIP #285.  When using
189 | # a pre-Tcl 8.5 or 8.6 core, respectively, the actual functionality
190 | # will not be available at runtime.
191 | #--------------------------------------------------------------------
192 | 
193 | #AC_DEFINE(TCL_TIP143, 1, [Enable TIP #143 support])
194 | #AC_DEFINE(TCL_TIP285, 1, [Enable TIP #285 support])
195 | 
196 | #--------------------------------------------------------------------
197 | # This macro generates a line to use when building a library.  It
198 | # depends on values set by the TEA_ENABLE_SHARED, TEA_ENABLE_SYMBOLS,
199 | # and TEA_LOAD_TCLCONFIG macros above.
200 | #--------------------------------------------------------------------
201 | 
202 | TEA_MAKE_LIB
203 | 
204 | #--------------------------------------------------------------------
205 | # Determine the name of the tclsh and/or wish executables in the
206 | # Tcl and Tk build directories or the location they were installed
207 | # into. These paths are used to support running test cases only,
208 | # the Makefile should not be making use of these paths to generate
209 | # a pkgIndex.tcl file or anything else at extension build time.
210 | #--------------------------------------------------------------------
211 | 
212 | TEA_PROG_TCLSH
213 | #TEA_PROG_WISH
214 | 
215 | #--------------------------------------------------------------------
216 | # Finally, substitute all of the various values into the Makefile.
217 | # You may alternatively have a special pkgIndex.tcl.in or other files
218 | # which require substituting th AC variables in.  Include these here.
219 | #--------------------------------------------------------------------
220 | 
221 | AC_OUTPUT([Makefile pkgIndex.tcl])
222 | 


--------------------------------------------------------------------------------
/generic/tclStrIdxTree.c:
--------------------------------------------------------------------------------
  1 | /*
  2 |  * tclStrIdxTree.c --
  3 |  *
  4 |  *	Contains the routines for managing string index tries in Tcl.
  5 |  *
  6 |  *	This code is back-ported from the tclSE engine, by Serg G. Brester.
  7 |  *
  8 |  * Copyright (c) 2016 by Sergey G. Brester aka sebres. All rights reserved.
  9 |  *
 10 |  * See the file "license.terms" for information on usage and redistribution of
 11 |  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 12 |  *
 13 |  * -----------------------------------------------------------------------
 14 |  *
 15 |  * String index tries are prepaired structures used for fast greedy search of the string
 16 |  * (index) by unique string prefix as key.
 17 |  *
 18 |  * Index tree build for two lists together can be explained in the following datagram
 19 |  *
 20 |  * Lists:
 21 |  *
 22 |  *	{Januar Februar Maerz April Mai Juni Juli August September Oktober November Dezember}
 23 |  *	{Jnr Fbr Mrz Apr Mai Jni Jli Agt Spt Okt Nvb Dzb}
 24 |  *
 25 |  * Index-Tree:
 26 |  *
 27 |  *	j		 0	 *	...
 28 |  *	 anuar		 1	 *
 29 |  *	 u		 0	 *	a		 0
 30 |  *	  ni		 6	 *	 pril		 4
 31 |  *	  li		 7	 *	 ugust		 8
 32 |  *	 n		 0	 *	 gt		 8
 33 |  *	  r		 1	 *	s		 9
 34 |  *	  i		 6	 *	 eptember	 9
 35 |  *	 li		 7	 *	 pt		 9
 36 |  *	f		 2	 *	oktober		10
 37 |  *	 ebruar		 2	 *	n		11
 38 |  *	 br		 2	 *	 ovember	11
 39 |  *	m		 0	 *	 vb		11
 40 |  *	 a		 0	 *	d		12
 41 |  *	  erz		 3	 *	 ezember	12
 42 |  *	  i		 5	 *	 zb		12
 43 |  *	 rz		 3	 *
 44 |  *	...
 45 |  *
 46 |  * Thereby value 0 shows pure group items (corresponding ambigous matches).
 47 |  * But the group may have a value if it contains only same values
 48 |  * (see for example group "f" above).
 49 |  *
 50 |  * StrIdxTree's are very fast, so:
 51 |  *    build of above-mentioned tree takes about 10 microseconds.
 52 |  *    search of string index in this tree takes fewer as 0.1 microseconds.
 53 |  *
 54 |  */
 55 | 
 56 | #include "tclInt.h"
 57 | #include "tclStrIdxTree.h"
 58 | 
 59 | 
 60 | /*
 61 |  *----------------------------------------------------------------------
 62 |  *
 63 |  * TclStrIdxTreeSearch --
 64 |  *
 65 |  *  Find largest part of string "start" in indexed tree (case sensitive).
 66 |  *
 67 |  *  Also used for building of string index tree.
 68 |  *
 69 |  * Results:
 70 |  *  Return position of UTF character in start after last equal character
 71 |  *  and found item (with parent).
 72 |  *
 73 |  * Side effects:
 74 |  *  None.
 75 |  *
 76 |  *----------------------------------------------------------------------
 77 |  */
 78 | 
 79 | const char*
 80 | TclStrIdxTreeSearch(
 81 |     TclStrIdxTree **foundParent, /* Return value of found sub tree (used for tree build) */
 82 |     TclStrIdx	  **foundItem,	 /* Return value of found item */
 83 |     TclStrIdxTree  *tree,	 /* Index tree will be browsed */
 84 |     const char	*start,		 /* UTF string to find in tree */
 85 |     const char	*end)		 /* End of string */
 86 | {
 87 |     TclStrIdxTree *parent = tree, *prevParent = tree;
 88 |     TclStrIdx  *item = tree->firstPtr, *prevItem = NULL;
 89 |     const char *s = start, *f, *cin, *cinf, *prevf = NULL;
 90 |     int offs = 0;
 91 | 
 92 |     if (item == NULL) {
 93 | 	goto done;
 94 |     }
 95 | 
 96 |     /* search in tree */
 97 |     do {
 98 | 	cinf = cin = TclGetString(item->key) + offs;
 99 | 	f = TclUtfFindEqualNCInLwr(s, end, cin, cin + item->length - offs, &cinf);
100 | 	/* if something was found */
101 | 	if (f > s) {
102 | 	    /* if whole string was found */
103 | 	    if (f >= end) {
104 | 		start = f;
105 | 		goto done;
106 | 	    };
107 | 	    /* set new offset and shift start string */
108 | 	    offs += cinf - cin;
109 | 	    s = f;
110 | 	    /* if match item, go deeper as long as possible */
111 | 	    if (offs >= item->length && item->childTree.firstPtr) {
112 | 		/* save previuosly found item (if not ambigous) for
113 | 		 * possible fallback (few greedy match) */
114 | 		if (item->value != NULL) {
115 | 		    prevf = f;
116 | 		    prevItem = item;
117 | 		    prevParent = parent;
118 | 		}
119 | 		parent = &item->childTree;
120 | 		item = item->childTree.firstPtr;
121 | 		continue;
122 | 	    }
123 | 	    /* no children - return this item and current chars found */
124 | 	    start = f;
125 | 	    goto done;
126 | 	}
127 | 
128 | 	item = item->nextPtr;
129 | 
130 |     } while (item != NULL);
131 | 
132 |     /* fallback (few greedy match) not ambigous (has a value) */
133 |     if (prevItem != NULL) {
134 | 	item = prevItem;
135 | 	parent = prevParent;
136 | 	start = prevf;
137 |     }
138 | 
139 | done:
140 | 
141 |     if (foundParent)
142 | 	*foundParent = parent;
143 |     if (foundItem)
144 | 	*foundItem = item;
145 |     return start;
146 | }
147 | 
148 | void
149 | TclStrIdxTreeFree(
150 |     TclStrIdx *tree)
151 | {
152 |     while (tree != NULL) {
153 | 	TclStrIdx *t;
154 | 	Tcl_DecrRefCount(tree->key);
155 | 	if (tree->childTree.firstPtr != NULL) {
156 | 	    TclStrIdxTreeFree(tree->childTree.firstPtr);
157 | 	}
158 | 	t = tree, tree = tree->nextPtr;
159 | 	ckfree(t);
160 |     }
161 | }
162 | 
163 | /*
164 |  * Several bidirectional list primitives
165 |  */
166 | static inline void
167 | TclStrIdxTreeInsertBranch(
168 |     TclStrIdxTree *parent,
169 |     register TclStrIdx *item,
170 |     register TclStrIdx *child)
171 | {
172 |     if (parent->firstPtr == child)
173 | 	parent->firstPtr = item;
174 |     if (parent->lastPtr == child)
175 | 	parent->lastPtr = item;
176 |     if ( (item->nextPtr = child->nextPtr) ) {
177 | 	item->nextPtr->prevPtr = item;
178 | 	child->nextPtr = NULL;
179 |     }
180 |     if ( (item->prevPtr = child->prevPtr) ) {
181 | 	item->prevPtr->nextPtr = item;
182 | 	child->prevPtr = NULL;
183 |     }
184 |     item->childTree.firstPtr = child;
185 |     item->childTree.lastPtr = child;
186 | }
187 | 
188 | static inline void
189 | TclStrIdxTreeAppend(
190 |     register TclStrIdxTree *parent,
191 |     register TclStrIdx	   *item)
192 | {
193 |     if (parent->lastPtr != NULL) {
194 | 	parent->lastPtr->nextPtr = item;
195 |     }
196 |     item->prevPtr = parent->lastPtr;
197 |     item->nextPtr = NULL;
198 |     parent->lastPtr = item;
199 |     if (parent->firstPtr == NULL) {
200 | 	parent->firstPtr = item;
201 |     }
202 | }
203 | 
204 | 
205 | /*
206 |  *----------------------------------------------------------------------
207 |  *
208 |  * TclStrIdxTreeBuildFromList --
209 |  *
210 |  * Build or extend string indexed tree from tcl list.
211 |  * If the values not given the values of built list are indices starts with 1.
212 |  * Value of 0 is thereby reserved to the ambigous values.
213 |  *
214 |  * Important: by multiple lists, optimal tree can be created only if list with
215 |  * larger strings used firstly.
216 |  *
217 |  * Results:
218 |  *  Returns a standard Tcl result.
219 |  *
220 |  * Side effects:
221 |  *  None.
222 |  *
223 |  *----------------------------------------------------------------------
224 |  */
225 | 
226 | int
227 | TclStrIdxTreeBuildFromList(
228 |     TclStrIdxTree *idxTree,
229 |     int	       lstc,
230 |     Tcl_Obj  **lstv,
231 |     ClientData *values)
232 | {
233 |     Tcl_Obj  **lwrv;
234 |     int i, ret = TCL_ERROR;
235 |     ClientData val;
236 |     const char *s, *e, *f;
237 |     TclStrIdx	*item;
238 | 
239 |     /* create lowercase reflection of the list keys */
240 | 
241 |     lwrv = ckalloc(sizeof(Tcl_Obj*) * lstc);
242 |     if (lwrv == NULL) {
243 | 	return TCL_ERROR;
244 |     }
245 |     for (i = 0; i < lstc; i++) {
246 | 	lwrv[i] = Tcl_DuplicateObj(lstv[i]);
247 | 	if (lwrv[i] == NULL) {
248 | 	    return TCL_ERROR;
249 | 	}
250 | 	Tcl_IncrRefCount(lwrv[i]);
251 | 	lwrv[i]->length = Tcl_UtfToLower(TclGetString(lwrv[i]));
252 |     }
253 | 
254 |     /* build index tree of the list keys */
255 |     for (i = 0; i < lstc; i++) {
256 | 	TclStrIdxTree *foundParent = idxTree;
257 | 	e = s = TclGetString(lwrv[i]);
258 | 	e += lwrv[i]->length;
259 | 	val = values ? values[i] : INT2PTR(i+1);
260 | 
261 | 	/* ignore empty keys (impossible to index it) */
262 | 	if (lwrv[i]->length == 0) continue;
263 | 
264 | 	item = NULL;
265 | 	if (idxTree->firstPtr != NULL) {
266 | 	    TclStrIdx  *foundItem;
267 | 	    f = TclStrIdxTreeSearch(&foundParent, &foundItem,
268 | 		idxTree, s, e);
269 | 	    /* if common prefix was found */
270 | 	    if (f > s) {
271 | 		/* ignore element if fulfilled or ambigous */
272 | 		if (f == e) {
273 | 		    continue;
274 | 		}
275 | 		/* if shortest key was found with the same value,
276 | 		 * just replace its current key with longest key */
277 | 		if ( foundItem->value == val
278 | 		  && foundItem->length <= lwrv[i]->length
279 | 		  && foundItem->length <= (f - s) /* only if found item is covered in full */
280 | 		  && foundItem->childTree.firstPtr == NULL
281 | 		) {
282 | 		    Tcl_SetObjRef(foundItem->key, lwrv[i]);
283 | 		    foundItem->length = lwrv[i]->length;
284 | 		    continue;
285 | 		}
286 | 		/* split tree (e. g. j->(jan,jun) + jul == j->(jan,ju->(jun,jul)) )
287 | 		 * but don't split by fulfilled child of found item ( ii->iii->iiii ) */
288 | 		if (foundItem->length != (f - s)) {
289 | 		    /* first split found item (insert one between parent and found + new one) */
290 | 		    item = ckalloc(sizeof(*item));
291 | 		    if (item == NULL) {
292 | 			goto done;
293 | 		    }
294 | 		    Tcl_InitObjRef(item->key, foundItem->key);
295 | 		    item->length = f - s;
296 | 		    /* set value or mark as ambigous if not the same value of both */
297 | 		    item->value = (foundItem->value == val) ? val : NULL;
298 | 		    /* insert group item between foundParent and foundItem */
299 | 		    TclStrIdxTreeInsertBranch(foundParent, item, foundItem);
300 | 		    foundParent = &item->childTree;
301 | 		} else {
302 | 		    /* the new item should be added as child of found item */
303 | 		    foundParent = &foundItem->childTree;
304 | 		}
305 | 	    }
306 | 	}
307 | 	/* append item at end of found parent */
308 | 	item = ckalloc(sizeof(*item));
309 | 	if (item == NULL) {
310 | 	    goto done;
311 | 	}
312 | 	item->childTree.lastPtr = item->childTree.firstPtr = NULL;
313 | 	Tcl_InitObjRef(item->key, lwrv[i]);
314 | 	item->length = lwrv[i]->length;
315 | 	item->value = val;
316 | 	TclStrIdxTreeAppend(foundParent, item);
317 |     };
318 | 
319 |     ret = TCL_OK;
320 | 
321 | done:
322 | 
323 |     if (lwrv != NULL) {
324 | 	for (i = 0; i < lstc; i++) {
325 | 	    Tcl_DecrRefCount(lwrv[i]);
326 | 	}
327 | 	ckfree(lwrv);
328 |     }
329 | 
330 |     if (ret != TCL_OK) {
331 | 	if (idxTree->firstPtr != NULL) {
332 | 	    TclStrIdxTreeFree(idxTree->firstPtr);
333 | 	}
334 |     }
335 | 
336 |     return ret;
337 | }
338 | 
339 | 
340 | static void
341 | StrIdxTreeObj_DupIntRepProc(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr);
342 | static void
343 | StrIdxTreeObj_FreeIntRepProc(Tcl_Obj *objPtr);
344 | static void
345 | StrIdxTreeObj_UpdateStringProc(Tcl_Obj *objPtr);
346 | 
347 | Tcl_ObjType StrIdxTreeObjType = {
348 |     "str-idx-tree",		    /* name */
349 |     StrIdxTreeObj_FreeIntRepProc,   /* freeIntRepProc */
350 |     StrIdxTreeObj_DupIntRepProc,    /* dupIntRepProc */
351 |     StrIdxTreeObj_UpdateStringProc, /* updateStringProc */
352 |     NULL			    /* setFromAnyProc */
353 | };
354 | 
355 | Tcl_Obj*
356 | TclStrIdxTreeNewObj()
357 | {
358 |     Tcl_Obj *objPtr = Tcl_NewObj();
359 |     objPtr->internalRep.twoPtrValue.ptr1 = NULL;
360 |     objPtr->internalRep.twoPtrValue.ptr2 = NULL;
361 |     objPtr->typePtr = &StrIdxTreeObjType;
362 |     /* return tree root in internal representation */
363 |     return objPtr;
364 | }
365 | 
366 | static void
367 | StrIdxTreeObj_DupIntRepProc(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr)
368 | {
369 |     /* follow links (smart pointers) */
370 |     if ( srcPtr->internalRep.twoPtrValue.ptr1 != NULL
371 |       && srcPtr->internalRep.twoPtrValue.ptr2 == NULL
372 |     ) {
373 | 	srcPtr = (Tcl_Obj*)srcPtr->internalRep.twoPtrValue.ptr1;
374 |     }
375 |     /* create smart pointer to it (ptr1 != NULL, ptr2 = NULL) */
376 |     Tcl_InitObjRef(*((Tcl_Obj **)&copyPtr->internalRep.twoPtrValue.ptr1),
377 | 	srcPtr);
378 |     copyPtr->internalRep.twoPtrValue.ptr2 = NULL;
379 |     copyPtr->typePtr = &StrIdxTreeObjType;
380 | }
381 | 
382 | static void
383 | StrIdxTreeObj_FreeIntRepProc(Tcl_Obj *objPtr)
384 | {
385 |     /* follow links (smart pointers) */
386 |     if ( objPtr->internalRep.twoPtrValue.ptr1 != NULL
387 |       && objPtr->internalRep.twoPtrValue.ptr2 == NULL
388 |     ) {
389 | 	/* is a link */
390 | 	Tcl_UnsetObjRef(*((Tcl_Obj **)&objPtr->internalRep.twoPtrValue.ptr1));
391 |     } else {
392 | 	/* is a tree */
393 | 	TclStrIdxTree *tree = (TclStrIdxTree*)&objPtr->internalRep.twoPtrValue.ptr1;
394 | 	if (tree->firstPtr != NULL) {
395 | 	    TclStrIdxTreeFree(tree->firstPtr);
396 | 	}
397 | 	objPtr->internalRep.twoPtrValue.ptr1 = NULL;
398 | 	objPtr->internalRep.twoPtrValue.ptr2 = NULL;
399 |     }
400 |     objPtr->typePtr = NULL;
401 | };
402 | 
403 | static void
404 | StrIdxTreeObj_UpdateStringProc(Tcl_Obj *objPtr)
405 | {
406 |     /* currently only dummy empty string possible */
407 |     objPtr->length = 0;
408 |     objPtr->bytes = tclEmptyStringRep;
409 | };
410 | 
411 | TclStrIdxTree *
412 | TclStrIdxTreeGetFromObj(Tcl_Obj *objPtr) {
413 |     /* follow links (smart pointers) */
414 |     if (objPtr->typePtr != &StrIdxTreeObjType) {
415 | 	return NULL;
416 |     }
417 |     if ( objPtr->internalRep.twoPtrValue.ptr1 != NULL
418 |       && objPtr->internalRep.twoPtrValue.ptr2 == NULL
419 |     ) {
420 | 	objPtr = (Tcl_Obj*)objPtr->internalRep.twoPtrValue.ptr1;
421 |     }
422 |     /* return tree root in internal representation */
423 |     return (TclStrIdxTree*)&objPtr->internalRep.twoPtrValue.ptr1;
424 | }
425 | 
426 | /*
427 |  * Several debug primitives
428 |  */
429 | #if 0
430 | /* currently unused, debug resp. test purposes only */
431 | 
432 | void
433 | TclStrIdxTreePrint(
434 |     Tcl_Interp *interp,
435 |     TclStrIdx  *tree,
436 |     int offs)
437 | {
438 |     Tcl_Obj *obj[2];
439 |     const char *s;
440 |     Tcl_InitObjRef(obj[0], Tcl_NewStringObj("::puts", -1));
441 |     while (tree != NULL) {
442 | 	s = TclGetString(tree->key) + offs;
443 | 	Tcl_InitObjRef(obj[1], Tcl_ObjPrintf("%*s%.*s\t:%d",
444 | 		offs, "", tree->length - offs, s, tree->value));
445 | 	Tcl_PutsObjCmd(NULL, interp, 2, obj);
446 | 	Tcl_UnsetObjRef(obj[1]);
447 | 	if (tree->childTree.firstPtr != NULL) {
448 | 	    TclStrIdxTreePrint(interp, tree->childTree.firstPtr, tree->length);
449 | 	}
450 | 	tree = tree->nextPtr;
451 |     }
452 |     Tcl_UnsetObjRef(obj[0]);
453 | }
454 | 
455 | 
456 | int
457 | TclStrIdxTreeTestObjCmd(
458 |     ClientData clientData, Tcl_Interp *interp,
459 |     int objc, Tcl_Obj *const objv[])
460 | {
461 |     const char *cs, *cin, *ret;
462 | 
463 |     static const char *const options[] = {
464 | 	"index", "puts-index", "findequal",
465 | 	NULL
466 |     };
467 |     enum optionInd {
468 | 	O_INDEX,  O_PUTS_INDEX, O_FINDEQUAL
469 |     };
470 |     int optionIndex;
471 | 
472 |     if (objc < 2) {
473 | 	Tcl_WrongNumArgs(interp, 1, objv, "");
474 | 	return TCL_ERROR;
475 |     }
476 |     if (Tcl_GetIndexFromObj(interp, objv[1], options,
477 | 	"option", 0, &optionIndex) != TCL_OK) {
478 | 	Tcl_SetErrorCode(interp, "CLOCK", "badOption",
479 | 		Tcl_GetString(objv[1]), NULL);
480 | 	return TCL_ERROR;
481 |     }
482 |     switch (optionIndex) {
483 |     case O_FINDEQUAL:
484 | 	if (objc < 4) {
485 | 	    Tcl_WrongNumArgs(interp, 1, objv, "");
486 | 	    return TCL_ERROR;
487 | 	}
488 | 	cs = TclGetString(objv[2]);
489 | 	cin = TclGetString(objv[3]);
490 | 	ret = TclUtfFindEqual(
491 | 	    cs, cs + objv[1]->length, cin, cin + objv[2]->length);
492 | 	Tcl_SetObjResult(interp, Tcl_NewIntObj(ret - cs));
493 |     break;
494 |     case O_INDEX:
495 |     case O_PUTS_INDEX:
496 | 
497 |     if (1) {
498 | 	Tcl_Obj **lstv;
499 | 	int i, lstc;
500 | 	TclStrIdxTree idxTree = {NULL, NULL};
501 | 	i = 1;
502 | 	while (++i < objc) {
503 | 	    if (TclListObjGetElements(interp, objv[i],
504 | 		    &lstc, &lstv) != TCL_OK) {
505 | 		return TCL_ERROR;
506 | 	    };
507 | 	    TclStrIdxTreeBuildFromList(&idxTree, lstc, lstv, NULL);
508 | 	}
509 | 	if (optionIndex == O_PUTS_INDEX) {
510 | 	    TclStrIdxTreePrint(interp, idxTree.firstPtr, 0);
511 | 	}
512 | 	TclStrIdxTreeFree(idxTree.firstPtr);
513 |     }
514 |     break;
515 |     }
516 | 
517 |     return TCL_OK;
518 | }
519 | 
520 | #endif
521 | 
522 | /*
523 |  * Local Variables:
524 |  * mode: c
525 |  * c-basic-offset: 4
526 |  * fill-column: 78
527 |  * End:
528 |  */
529 | 


--------------------------------------------------------------------------------
/win/makefile.vc:
--------------------------------------------------------------------------------
  1 | #------------------------------------------------------------- -*- makefile -*-
  2 | # makefile.vc --
  3 | #
  4 | #	Microsoft Visual C++ makefile for use with nmake.exe v1.62+ (VC++ 5.0+)
  5 | #
  6 | # See the file "license.terms" for information on usage and redistribution
  7 | # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  8 | #
  9 | # Copyright (c) 1995-1996 Sun Microsystems, Inc.
 10 | # Copyright (c) 1998-2000 Ajuba Solutions.
 11 | # Copyright (c) 2001-2005 ActiveState Corporation.
 12 | # Copyright (c) 2001-2004 David Gravereaux.
 13 | # Copyright (c) 2003-2008 Pat Thoyts.
 14 | #------------------------------------------------------------------------------
 15 | 
 16 | # Check to see we are configured to build with MSVC (MSDEVDIR, MSVCDIR or
 17 | # VCINSTALLDIR) or with the MS Platform SDK (MSSDK or WindowsSDKDir)
 18 | !if !defined(MSDEVDIR) && !defined(MSVCDIR) && !defined(VCINSTALLDIR) && !defined(MSSDK) && !defined(WINDOWSSDKDIR)
 19 | MSG = ^
 20 | You need to run vcvars32.bat from Developer Studio or setenv.bat from the^
 21 | Platform SDK first to setup the environment.  Jump to this line to read^
 22 | the build instructions.
 23 | !error $(MSG)
 24 | !endif
 25 | 
 26 | #------------------------------------------------------------------------------
 27 | # HOW TO USE this makefile:
 28 | #
 29 | # 1)  It is now necessary to have MSVCDir, MSDevDir or MSSDK set in the
 30 | #     environment.  This is used as a check to see if vcvars32.bat had been
 31 | #     run prior to running nmake or during the installation of Microsoft
 32 | #     Visual C++, MSVCDir had been set globally and the PATH adjusted.
 33 | #     Either way is valid.
 34 | #
 35 | #     You'll need to run vcvars32.bat contained in the MsDev's vc(98)/bin
 36 | #     directory to setup the proper environment, if needed, for your
 37 | #     current setup.  This is a needed bootstrap requirement and allows the
 38 | #     swapping of different environments to be easier.
 39 | #
 40 | # 2)  To use the Platform SDK (not expressly needed), run setenv.bat after
 41 | #     vcvars32.bat according to the instructions for it.  This can also
 42 | #     turn on the 64-bit compiler, if your SDK has it.
 43 | #
 44 | # 3)  Targets are:
 45 | #	all       -- Builds everything.
 46 | #	<project> -- Builds the project (eg: nmake sample)
 47 | #	test      -- Builds and runs the test suite.
 48 | #	install   -- Installs the built binaries and libraries to $(INSTALLDIR)
 49 | #		     in an appropriate subdirectory.
 50 | #	clean/realclean/distclean -- varying levels of cleaning.
 51 | #
 52 | # 4)  Macros usable on the commandline:
 53 | #	INSTALLDIR=<path>
 54 | #		Sets where to install Tcl from the built binaries.
 55 | #		C:\Progra~1\Tcl is assumed when not specified.
 56 | #
 57 | #	OPTS=static,msvcrt,staticpkg,nothreads,symbols,profile,loimpact,none
 58 | #		Sets special options for the core.  The default is for none.
 59 | #		Any combination of the above may be used (comma separated).
 60 | #		'none' will over-ride everything to nothing.
 61 | #
 62 | #		static  =  Builds a static library of the core instead of a
 63 | #			   dll.  The shell will be static (and large), as well.
 64 | #		msvcrt  =  Affects the static option only to switch it from
 65 | #			   using libcmt(d) as the C runtime [by default] to
 66 | #			   msvcrt(d). This is useful for static embedding
 67 | #			   support.
 68 | #		staticpkg = Affects the static option only to switch
 69 | #			   tclshXX.exe to have the dde and reg extension linked
 70 | #			   inside it.
 71 | #		nothreads = Turns off multithreading support.
 72 | #		thrdalloc = Use the thread allocator (shared global free pool)
 73 | #			   This is the default on threaded builds.
 74 | #		symbols  = Debug build. Links to the debug C runtime, disables
 75 | #			   optimizations and creates pdb symbols files.
 76 | #		profile  = Adds profiling hooks.  Map file is assumed.
 77 | #		loimpact = Adds a flag for how NT treats the heap to keep memory
 78 | #			   in use, low.  This is said to impact alloc performance.
 79 | #
 80 | #	STATS=memdbg,compdbg,none
 81 | #		Sets optional memory and bytecode compiler debugging code added
 82 | #		to the core.  The default is for none.  Any combination of the
 83 | #		above may be used (comma separated).  'none' will over-ride
 84 | #		everything to nothing.
 85 | #
 86 | #		memdbg   = Enables the debugging memory allocator.
 87 | #		compdbg  = Enables byte compilation logging.
 88 | #
 89 | #	MACHINE=(ARM|AMD64|IA64|X86)
 90 | #		Set the machine type used for the compiler, linker, and
 91 | #		resource compiler.  This hook is needed to tell the tools
 92 | #		when alternate platforms are requested.  IX86 is the default
 93 | #		when not specified. If the CPU environment variable has been
 94 | #		set (ie: recent Platform SDK) then MACHINE is set from CPU.
 95 | #
 96 | #	TMP_DIR=<path>
 97 | #	OUT_DIR=<path>
 98 | #		Hooks to allow the intermediate and output directories to be
 99 | #		changed.  $(OUT_DIR) is assumed to be
100 | #		$(BINROOT)\(Release|Debug) based on if symbols are requested.
101 | #		$(TMP_DIR) will de $(OUT_DIR)\<buildtype> by default.
102 | #
103 | #	TESTPAT=<file>
104 | #		Reads the tests requested to be run from this file.
105 | #
106 | #	CFG_ENCODING=encoding
107 | #		name of encoding for configuration information. Defaults
108 | #		to cp1252
109 | #
110 | # 5)  Examples:
111 | #
112 | #	Basic syntax of calling nmake looks like this:
113 | #	nmake [-nologo] -f makefile.vc [target|macrodef [target|macrodef] [...]]
114 | #
115 | #                        Standard (no frills)
116 | #       c:\tcl_src\win\>c:\progra~1\micros~1\vc98\bin\vcvars32.bat
117 | #       Setting environment for using Microsoft Visual C++ tools.
118 | #       c:\tcl_src\win\>nmake -f makefile.vc all
119 | #       c:\tcl_src\win\>nmake -f makefile.vc install INSTALLDIR=c:\progra~1\tcl
120 | #
121 | #                         Building for Win64
122 | #       c:\tcl_src\win\>c:\progra~1\micros~1\vc98\bin\vcvars32.bat
123 | #       Setting environment for using Microsoft Visual C++ tools.
124 | #       c:\tcl_src\win\>c:\progra~1\platfo~1\setenv.bat /pre64 /RETAIL
125 | #       Targeting Windows pre64 RETAIL
126 | #       c:\tcl_src\win\>nmake -f makefile.vc MACHINE=IA64
127 | #
128 | #------------------------------------------------------------------------------
129 | #==============================================================================
130 | #------------------------------------------------------------------------------
131 | 
132 | !if !exist("makefile.vc")
133 | MSG = ^
134 | You must run this makefile only from the directory it is in.^
135 | Please `cd` to its location first.
136 | !error $(MSG)
137 | !endif
138 | 
139 | #-------------------------------------------------------------------------
140 | # Project specific information (EDIT)
141 | #
142 | # You should edit this with the name and version of your project. This
143 | # information is used to generate the name of the package library and
144 | # it's install location.
145 | #
146 | # For example, the sample extension is  going to build sample05.dll and
147 | # would install it into $(INSTALLDIR)\lib\sample05
148 | #
149 | # You need to specify the object files that need to be linked into your
150 | # binary here.
151 | #
152 | #-------------------------------------------------------------------------
153 | 
154 | PROJECT = tclclockmod
155 | 
156 | # Uncomment the following line if this is a Tk extension.
157 | #PROJECT_REQUIRES_TK=1
158 | !include "rules.vc"
159 | 
160 | !include "pkg.vc"
161 | 
162 | DOTVERSION      = $(PACKAGE_VERSION:"=) #"
163 | VERSION         = $(PACKAGE_MAJOR)$(PACKAGE_MINOR)
164 | STUBPREFIX      = $(PROJECT)stub
165 | 
166 | DLLOBJS = \
167 | 	$(TMP_DIR)\tclClock.obj \
168 | 	$(TMP_DIR)\tclClockFmt.obj \
169 | 	$(TMP_DIR)\tclDate.obj \
170 | 	$(TMP_DIR)\tclStrIdxTree.obj \
171 |   $(TMP_DIR)\tclClockMod.obj \
172 |   $(TMP_DIR)\tclClockModInt.obj \
173 | !if !$(STATIC_BUILD)
174 | 	$(TMP_DIR)\tclclockmod.res
175 | !endif
176 | 
177 | PRJHEADERS =
178 | 
179 | #-------------------------------------------------------------------------
180 | # Target names and paths ( shouldn't need changing )
181 | #-------------------------------------------------------------------------
182 | 
183 | BINROOT		= $(MAKEDIR)
184 | ROOT            = $(MAKEDIR)\..
185 | 
186 | PRJIMPLIB	= $(OUT_DIR)\$(PROJECT)$(VERSION)$(SUFX).lib
187 | PRJLIBNAME	= $(PROJECT)$(VERSION)$(SUFX).$(EXT)
188 | PRJLIB		= $(OUT_DIR)\$(PRJLIBNAME)
189 | 
190 | PRJSTUBLIBNAME	= $(STUBPREFIX)$(VERSION).lib
191 | PRJSTUBLIB	= $(OUT_DIR)\$(PRJSTUBLIBNAME)
192 | 
193 | ### Make sure we use backslash only.
194 | PRJ_INSTALL_DIR         = $(_INSTALLDIR)\$(PROJECT)$(DOTVERSION)
195 | LIB_INSTALL_DIR		= $(PRJ_INSTALL_DIR)
196 | BIN_INSTALL_DIR		= $(PRJ_INSTALL_DIR)
197 | DOC_INSTALL_DIR		= $(PRJ_INSTALL_DIR)
198 | SCRIPT_INSTALL_DIR	= $(PRJ_INSTALL_DIR)
199 | INCLUDE_INSTALL_DIR	= $(_TCLDIR)\include
200 | 
201 | ### The following paths CANNOT have spaces in them.
202 | GENERICDIR	= $(ROOT)\generic
203 | WINDIR		= $(ROOT)\win
204 | LIBDIR          = $(ROOT)\lib
205 | DOCDIR		= $(ROOT)\doc
206 | TOOLSDIR	= $(ROOT)\tools
207 | COMPATDIR	= $(ROOT)\compat
208 | 
209 | #---------------------------------------------------------------------
210 | # Compile flags
211 | #---------------------------------------------------------------------
212 | 
213 | !if !$(DEBUG)
214 | !if $(OPTIMIZING)
215 | ### This cranks the optimization level to maximize speed
216 | cdebug	= $(OPTIMIZATIONS)
217 | !else
218 | cdebug	=
219 | !endif
220 | !else if "$(MACHINE)" == "IA64"
221 | ### Warnings are too many, can't support warnings into errors.
222 | cdebug	= -Zi -Od $(DEBUGFLAGS)
223 | !else
224 | cdebug	= -Zi -W3 $(DEBUGFLAGS)
225 | !endif
226 | 
227 | ### Common compiler options that are architecture specific
228 | !if "$(MACHINE)" == "ARM"
229 | carch = -D_ARM_WINAPI_PARTITION_DESKTOP_SDK_AVAILABLE
230 | !else
231 | carch =
232 | !endif
233 | 
234 | ### Declarations common to all compiler options
235 | cwarn = $(WARNINGS) -D _CRT_SECURE_NO_DEPRECATE -D _CRT_NONSTDC_NO_DEPRECATE
236 | cflags = -nologo -c $(COMPILERFLAGS) $(carch) $(cwarn) -Fp$(TMP_DIR)^\
237 | 
238 | !if $(MSVCRT)
239 | !if $(DEBUG) && !$(UNCHECKED)
240 | crt = -MDd
241 | !else
242 | crt = -MD
243 | !endif
244 | !else
245 | !if $(DEBUG) && !$(UNCHECKED)
246 | crt = -MTd
247 | !else
248 | crt = -MT
249 | !endif
250 | !endif
251 | 
252 | cflags = $(cflags) -DMODULE_SCOPE=extern -DUSE_TCL_STUBS
253 | #cflags = $(cflags) -DMODULE_SCOPE=extern
254 | cflags = $(cflags) -DTCL_TIP143 -DTCL_TIP285
255 | !if defined(TKSTUBLIB)
256 | cflags = $(cflags) -DUSE_TK_STUBS
257 | !endif
258 | 
259 | INCLUDES	= $(TCL_INCLUDES) -I"$(WINDIR)" -I"$(GENERICDIR)"
260 | BASE_CFLAGS	= $(cflags) $(cdebug) $(crt) $(INCLUDES)
261 | CON_CFLAGS	= $(cflags) $(cdebug) $(crt) -DCONSOLE
262 | TCL_CFLAGS	= -DPACKAGE_NAME="\"$(PROJECT)\"" \
263 | 		  -DPACKAGE_VERSION="\"$(DOTVERSION)\"" \
264 | 		  -DBUILD_$(PROJECT) \
265 | 		  $(BASE_CFLAGS) $(OPTDEFINES)
266 | 
267 | ### Stubs files should not be compiled with -GL
268 | STUB_CFLAGS     = $(cflags) $(cdebug:-GL=) #$(TK_DEFINES)
269 | 
270 | #---------------------------------------------------------------------
271 | # Link flags
272 | #---------------------------------------------------------------------
273 | 
274 | !if $(DEBUG)
275 | ldebug	= -debug
276 | !if $(MSVCRT)
277 | ldebug = $(ldebug) -nodefaultlib:msvcrt
278 | !endif
279 | !else
280 | ldebug	= -release -opt:ref -opt:icf,3
281 | !endif
282 | 
283 | ### Declarations common to all linker options
284 | lflags	= -nologo -machine:$(MACHINE) $(LINKERFLAGS) $(ldebug)
285 | 
286 | !if $(PROFILE)
287 | lflags	= $(lflags) -profile
288 | !endif
289 | 
290 | !if $(ALIGN98_HACK) && !$(STATIC_BUILD)
291 | ### Align sections for PE size savings.
292 | lflags	= $(lflags) -opt:nowin98
293 | !else if !$(ALIGN98_HACK) && $(STATIC_BUILD)
294 | ### Align sections for speed in loading by choosing the virtual page size.
295 | lflags	= $(lflags) -align:4096
296 | !endif
297 | 
298 | !if $(LOIMPACT)
299 | lflags	= $(lflags) -ws:aggressive
300 | !endif
301 | 
302 | dlllflags = $(lflags) -dll
303 | conlflags = $(lflags) -subsystem:console
304 | guilflags = $(lflags) -subsystem:windows
305 | !if !$(STATIC_BUILD)
306 | baselibs  = $(TCLSTUBLIB)
307 | #baselibs  = $(TCLIMPLIB)
308 | !if defined(TKSTUBLIB)
309 | baselibs  = $(baselibs) $(TKSTUBLIB)
310 | !endif
311 | !endif
312 | 
313 | # Avoid 'unresolved external symbol __security_cookie' errors.
314 | # c.f. http://support.microsoft.com/?id=894573
315 | !if "$(MACHINE)" == "IA64" || "$(MACHINE)" == "AMD64"
316 | !if $(VCVERSION) > 1399 && $(VCVERSION) < 1500
317 | baselibs   = $(baselibs) bufferoverflowU.lib
318 | !endif
319 | !endif
320 | 
321 | #---------------------------------------------------------------------
322 | # TclTest flags
323 | #---------------------------------------------------------------------
324 | 
325 | !if "$(TESTPAT)" != ""
326 | TESTFLAGS = $(TESTFLAGS) -file $(TESTPAT)
327 | !endif
328 | 
329 | #---------------------------------------------------------------------
330 | # Project specific targets (EDIT)
331 | #---------------------------------------------------------------------
332 | 
333 | all:	    setup $(PROJECT)
334 | $(PROJECT): setup pkgIndex $(PRJLIB)
335 | install:    install-binaries install-libraries install-docs
336 | pkgIndex:   $(OUT_DIR)\pkgIndex.tcl
337 | 
338 | test: setup $(PROJECT)
339 | 	@set TCL_LIBRARY=$(TCL_LIBRARY:\=/)
340 | 	@set TCLLIBPATH=$(OUT_DIR_PATH:\=/)
341 | 	@$(CPY) $(LIBDIR)\*.tcl $(OUT_DIR)
342 | !if $(TCLINSTALL)
343 | 	@set PATH=$(_TCLDIR)\bin;$(PATH)
344 | !else
345 | 	@set PATH=$(_TCLDIR)\win\$(BUILDDIRTOP);$(PATH)
346 | !endif
347 | 	$(DEBUGGER) $(TCLSH) "$(ROOT)/tests/all.tcl" $(TESTFLAGS)
348 | 
349 | shell: setup $(PROJECT)
350 | 	@set VLERQ_LIBRARY=$(LIBDIR:\=/)
351 | 	@set TCL_LIBRARY=$(TCL_LIBRARY:\=/)
352 | 	@set TCLLIBPATH=$(OUT_DIR:\=/)
353 | 	@$(CPY) $(LIBDIR)\*.tcl $(OUT_DIR)
354 | !if $(TCLINSTALL)
355 | 	@set PATH=$(_TCLDIR)\bin;$(PATH)
356 | !else
357 | 	@set PATH=$(_TCLDIR)\win\$(BUILDDIRTOP);$(PATH)
358 | !endif
359 | 	$(DEBUGGER) $(TCLSH) $(SCRIPT)
360 | 
361 | setup:
362 | 	@if not exist $(OUT_DIR)\nul mkdir $(OUT_DIR)
363 | 	@if not exist $(TMP_DIR)\nul mkdir $(TMP_DIR)
364 | 
365 | # See <tcl>/win/coffbase.txt for extension base addresses.
366 | $(PRJLIB): $(DLLOBJS)
367 | !if $(STATIC_BUILD)
368 | 	$(lib32) -nologo -out:$@ @<<
369 | $**
370 | <<
371 | !else
372 | 	$(link32) $(dlllflags) -base:0x10C80000 -out:$@ $(baselibs) @<<
373 | $**
374 | <<
375 | 	$(_VC_MANIFEST_EMBED_DLL)
376 | 	-@del $*.exp
377 | !endif
378 | 
379 | $(PRJSTUBLIB): $(PRJSTUBOBJS)
380 | 	$(lib32) -nologo -nodefaultlib -out:$@ $(PRJSTUBOBJS)
381 | 
382 | #---------------------------------------------------------------------
383 | # Implicit rules
384 | #---------------------------------------------------------------------
385 | 
386 | {$(WINDIR)}.c{$(TMP_DIR)}.obj::
387 |     $(cc32) $(TCL_CFLAGS) -DBUILD_$(PROJECT) -Fo$(TMP_DIR)\ @<<
388 | $<
389 | <<
390 | 
391 | {$(GENERICDIR)}.c{$(TMP_DIR)}.obj::
392 |     $(cc32) $(TCL_CFLAGS) -DBUILD_$(PROJECT) -Fo$(TMP_DIR)\ @<<
393 | $<
394 | <<
395 | 
396 | {$(COMPATDIR)}.c{$(TMP_DIR)}.obj::
397 |     $(cc32) $(TCL_CFLAGS) -DBUILD_$(PROJECT) -Fo$(TMP_DIR)\ @<<
398 | $<
399 | <<
400 | 
401 | {$(WINDIR)}.rc{$(TMP_DIR)}.res:
402 | 	$(rc32) -fo $@ -r -i "$(GENERICDIR)" $(TCL_INCLUDES) \
403 | 		-D_WIN32 -D__WIN32__ \
404 | 		-DCOMMAVERSION=$(DOTVERSION:.=,),0 \
405 | 		-DDOTVERSION=\"$(DOTVERSION)\" \
406 | 		-DVERSION=\"$(VERSION)$(SUFX)\" \
407 | 		-DDEBUG=$(DEBUG) \
408 | 		-DPACKAGE_MAJOR=$(PACKAGE_MAJOR) \
409 | 		-DPACKAGE_MINOR=$(PACKAGE_MINOR) \
410 | 		-DPACKAGE_RELEASE=$(PACKAGE_RELEASE) \
411 | 		-DPACKAGE_VERSION=\"$(PACKAGE_VERSION)\" \
412 | !if $(DEBUG)
413 | 	-d DEBUG \
414 | !endif
415 | !if $(TCL_THREADS)
416 | 	-d TCL_THREADS \
417 | !endif
418 | !if $(STATIC_BUILD)
419 | 	-d STATIC_BUILD \
420 | !endif
421 | 	$<
422 | 
423 | .SUFFIXES:
424 | .SUFFIXES:.c .rc
425 | 
426 | #-------------------------------------------------------------------------
427 | # Explicit dependency rules
428 | #
429 | #-------------------------------------------------------------------------
430 | 
431 | #{$(WINDIR)}.c{$(TMP_DIR)}.obj ::
432 | $(GENERICDIR)\tclClock.c : $(GENERICDIR)\tclClockModInt.h $(GENERICDIR)\tclDate.h $(GENERICDIR)\tclStrIdxTree.h
433 | $(GENERICDIR)\tclClockFmt.c : $(GENERICDIR)\tclClockModInt.h $(GENERICDIR)\tclDate.h $(GENERICDIR)\tclStrIdxTree.h
434 | $(GENERICDIR)\tclDate.c : $(GENERICDIR)\tclClockModInt.h $(GENERICDIR)\tclDate.h $(GENERICDIR)\tclStrIdxTree.h
435 | $(GENERICDIR)\tclStrIdxTree.c : $(GENERICDIR)\tclClockModInt.h $(GENERICDIR)\tclStrIdxTree.h
436 | $(GENERICDIR)\tclClockMod.c: $(GENERICDIR)\tclClockModInt.h
437 | $(GENERICDIR)\tclClockModInt.c: $(GENERICDIR)\tclClockModInt.h
438 | 
439 | .PHONY: $(OUT_DIR)\pkgIndex.tcl
440 | 
441 | $(OUT_DIR)\pkgIndex.tcl: $(ROOT)\pkgIndex.tcl.in
442 | 	@nmakehlp -s << $** > $@
443 | @PACKAGE_NAME@       tclclockmod
444 | @PACKAGE_VERSION@    $(DOTVERSION)
445 | @PKG_LIB_FILE@       $(PRJLIBNAME)
446 | <<
447 | 
448 | #---------------------------------------------------------------------
449 | # Installation. (EDIT)
450 | #
451 | # You may need to modify this section to reflect the final distribution
452 | # of your files and possibly to generate documentation.
453 | #
454 | #---------------------------------------------------------------------
455 | 
456 | install-binaries:
457 | 	@echo Installing binaries to '$(SCRIPT_INSTALL_DIR)'
458 | 	@if not exist "$(SCRIPT_INSTALL_DIR)" mkdir "$(SCRIPT_INSTALL_DIR)"
459 | 	@$(CPY) $(PRJLIB) "$(SCRIPT_INSTALL_DIR)" >NUL
460 | 
461 | install-libraries:
462 | 	@echo Installing library files to '$(SCRIPT_INSTALL_DIR)'
463 | 	@if exist $(LIBDIR) $(CPY) $(LIBDIR)\*.tcl "$(SCRIPT_INSTALL_DIR)"
464 | 	@$(CPY) $(OUT_DIR)\pkgIndex.tcl "$(SCRIPT_INSTALL_DIR)"
465 | 
466 | install-docs:
467 | 	@echo Installing documentation files to '$(DOC_INSTALL_DIR)'
468 | 	@if exist $(DOCDIR)\man $(CPY) $(DOCDIR)\man\*.n "$(DOC_INSTALL_DIR)"
469 | 
470 | #---------------------------------------------------------------------
471 | # Clean up
472 | #---------------------------------------------------------------------
473 | 
474 | clean:
475 | 	@if exist $(TMP_DIR)\nul $(RMDIR) $(TMP_DIR)
476 | 	@if exist $(WINDIR)\version.vc del $(WINDIR)\version.vc
477 | 	@if exist $(WINDIR)\vercl.i del $(WINDIR)\vercl.i
478 | 	@if exist $(WINDIR)\vercl.x del $(WINDIR)\vercl.x
479 | 	@if exist $(WINDIR)\_junk.pch del $(WINDIR)\_junk.pch
480 | 
481 | realclean: clean
482 | 	@if exist $(OUT_DIR)\nul $(RMDIR) $(OUT_DIR)
483 | 
484 | distclean: realclean
485 | 	@if exist $(WINDIR)\nmakehlp.exe del $(WINDIR)\nmakehlp.exe
486 | 	@if exist $(WINDIR)\nmakehlp.obj del $(WINDIR)\nmakehlp.obj
487 | 


--------------------------------------------------------------------------------
/Makefile.in:
--------------------------------------------------------------------------------
  1 | # Makefile.in --
  2 | #
  3 | #	This file is a Makefile for the Thread Extension.  If it has the name
  4 | #	"Makefile.in" then it is a template for a Makefile;  to generate the
  5 | #	actual Makefile, run "./configure", which is a configuration script
  6 | #	generated by the "autoconf" program (constructs like "@foo@" will get
  7 | #	replaced in the actual Makefile.
  8 | #
  9 | # Copyright (c) 1999 Scriptics Corporation.
 10 | # Copyright (c) 2002-2005 ActiveState Corporation.
 11 | #
 12 | # See the file "license.terms" for information on usage and redistribution
 13 | # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 14 | 
 15 | #========================================================================
 16 | # Add additional lines to handle any additional AC_SUBST cases that
 17 | # have been added in a customized configure script.
 18 | #========================================================================
 19 | 
 20 | #SAMPLE_NEW_VAR	= @SAMPLE_NEW_VAR@
 21 | 
 22 | #========================================================================
 23 | # Nothing of the variables below this line should need to be changed.
 24 | # Please check the TARGETS section below to make sure the make targets
 25 | # are correct.
 26 | #========================================================================
 27 | 
 28 | #========================================================================
 29 | # The names of the source files is defined in the configure script.
 30 | # The object files are used for linking into the final library.
 31 | # This will be used when a dist target is added to the Makefile.
 32 | # It is not important to specify the directory, as long as it is the
 33 | # $(srcdir) or in the generic, win or unix subdirectory.
 34 | #========================================================================
 35 | 
 36 | PKG_SOURCES	= @PKG_SOURCES@
 37 | PKG_OBJECTS	= @PKG_OBJECTS@
 38 | 
 39 | PKG_STUB_SOURCES = @PKG_STUB_SOURCES@
 40 | PKG_STUB_OBJECTS = @PKG_STUB_OBJECTS@
 41 | 
 42 | #========================================================================
 43 | # PKG_TCL_SOURCES identifies Tcl runtime files that are associated with
 44 | # this package that need to be installed, if any.
 45 | #========================================================================
 46 | 
 47 | PKG_TCL_SOURCES = @PKG_TCL_SOURCES@
 48 | 
 49 | #========================================================================
 50 | # This is a list of public header files to be installed, if any.
 51 | #========================================================================
 52 | 
 53 | PKG_HEADERS	= @PKG_HEADERS@
 54 | 
 55 | #========================================================================
 56 | # "PKG_LIB_FILE" refers to the library (dynamic or static as per
 57 | # configuration options) composed of the named objects.
 58 | #========================================================================
 59 | 
 60 | PKG_LIB_FILE	= @PKG_LIB_FILE@
 61 | PKG_STUB_LIB_FILE = @PKG_STUB_LIB_FILE@
 62 | 
 63 | lib_BINARIES	= $(PKG_LIB_FILE)
 64 | BINARIES	= $(lib_BINARIES)
 65 | 
 66 | SHELL		= @SHELL@
 67 | 
 68 | srcdir		= @srcdir@
 69 | prefix		= @prefix@
 70 | exec_prefix	= @exec_prefix@
 71 | 
 72 | bindir		= @bindir@
 73 | libdir		= @libdir@
 74 | includedir	= @includedir@
 75 | datarootdir	= @datarootdir@
 76 | datadir		= @datadir@
 77 | mandir		= @mandir@
 78 | 
 79 | DESTDIR		=
 80 | 
 81 | PKG_DIR		= $(PACKAGE_NAME)$(PACKAGE_VERSION)
 82 | pkgdatadir	= $(datadir)/$(PKG_DIR)
 83 | pkglibdir	= $(libdir)/$(PKG_DIR)
 84 | pkgincludedir	= $(includedir)/$(PKG_DIR)
 85 | 
 86 | top_builddir	= .
 87 | 
 88 | INSTALL_OPTIONS	=
 89 | INSTALL		= @INSTALL@ ${INSTALL_OPTIONS}
 90 | INSTALL_DATA_DIR = @INSTALL_DATA_DIR@
 91 | INSTALL_DATA	= @INSTALL_DATA@
 92 | INSTALL_PROGRAM	= @INSTALL_PROGRAM@
 93 | INSTALL_SCRIPT	= @INSTALL_SCRIPT@
 94 | INSTALL_LIBRARY	= @INSTALL_LIBRARY@
 95 | 
 96 | PACKAGE_NAME	= @PACKAGE_NAME@
 97 | PACKAGE_VERSION	= @PACKAGE_VERSION@
 98 | CC		= @CC@
 99 | CFLAGS_DEFAULT	= @CFLAGS_DEFAULT@
100 | CFLAGS_WARNING	= @CFLAGS_WARNING@
101 | EXEEXT		= @EXEEXT@
102 | LDFLAGS_DEFAULT	= @LDFLAGS_DEFAULT@
103 | MAKE_LIB	= @MAKE_LIB@
104 | MAKE_SHARED_LIB	= @MAKE_SHARED_LIB@
105 | MAKE_STATIC_LIB	= @MAKE_STATIC_LIB@
106 | MAKE_STUB_LIB	= @MAKE_STUB_LIB@
107 | OBJEXT		= @OBJEXT@
108 | RANLIB		= @RANLIB@
109 | RANLIB_STUB	= @RANLIB_STUB@
110 | SHLIB_CFLAGS	= @SHLIB_CFLAGS@
111 | SHLIB_LD	= @SHLIB_LD@
112 | SHLIB_LD_LIBS	= @SHLIB_LD_LIBS@
113 | STLIB_LD	= @STLIB_LD@
114 | #TCL_DEFS	= @TCL_DEFS@
115 | TCL_BIN_DIR	= @TCL_BIN_DIR@
116 | TCL_SRC_DIR	= @TCL_SRC_DIR@
117 | #TK_BIN_DIR	= @TK_BIN_DIR@
118 | #TK_SRC_DIR	= @TK_SRC_DIR@
119 | 
120 | # Not used, but retained for reference of what libs Tcl required
121 | #TCL_LIBS	= @TCL_LIBS@
122 | 
123 | #========================================================================
124 | # TCLLIBPATH seeds the auto_path in Tcl's init.tcl so we can test our
125 | # package without installing.  The other environment variables allow us
126 | # to test against an uninstalled Tcl.  Add special env vars that you
127 | # require for testing here (like TCLX_LIBRARY).
128 | #========================================================================
129 | 
130 | EXTRA_PATH	= $(top_builddir):$(TCL_BIN_DIR)
131 | #EXTRA_PATH	= $(top_builddir):$(TCL_BIN_DIR):$(TK_BIN_DIR)
132 | TCLLIBPATH	= $(top_builddir)
133 | TCLSH_ENV	= TCL_LIBRARY=`@CYGPATH@ $(TCL_SRC_DIR)/library`
134 | PKG_ENV		= TCL_THREAD_LIBRARY=`@CYGPATH@ $(srcdir)/lib` \
135 | 		  @LD_LIBRARY_PATH_VAR@="$(EXTRA_PATH):$(@LD_LIBRARY_PATH_VAR@)" \
136 | 		  PATH="$(EXTRA_PATH):$(PATH)" \
137 | 		  TCLLIBPATH="$(TCLLIBPATH) $(top_builddir)/../lib"
138 | 
139 | TCLSH_PROG	= @TCLSH_PROG@
140 | TCLSH		= $(PKG_ENV) $(TCLSH_ENV) $(TCLSH_PROG)
141 | 
142 | #WISH_ENV	= TK_LIBRARY=`@CYGPATH@ $(TK_SRC_DIR)/library`
143 | #WISH_PROG	= @WISH_PROG@
144 | #WISH		= $(PKG_ENV) $(TCLSH_ENV) $(WISH_ENV) $(WISH_PROG)
145 | 
146 | SHARED_BUILD	= @SHARED_BUILD@
147 | 
148 | INCLUDES	= @PKG_INCLUDES@ @TCL_INCLUDES@
149 | #INCLUDES	= @PKG_INCLUDES@ @TCL_INCLUDES@ @TK_INCLUDES@ @TK_XINCLUDES@
150 | 
151 | PKG_CFLAGS	= @PKG_CFLAGS@
152 | 
153 | # TCL_DEFS is not strictly need here, but if you remove it, then you
154 | # must make sure that configure.ac checks for the necessary components
155 | # that your library may use.  TCL_DEFS can actually be a problem if
156 | # you do not compile with a similar machine setup as the Tcl core was
157 | # compiled with.
158 | #DEFS		= $(TCL_DEFS) @DEFS@ $(PKG_CFLAGS)
159 | DEFS		= @DEFS@ $(PKG_CFLAGS)
160 | 
161 | # Move pkgIndex.tcl to 'BINARIES' var if it is generated in the Makefile
162 | CONFIG_CLEAN_FILES = Makefile pkgIndex.tcl
163 | CLEANFILES	= @CLEANFILES@
164 | 
165 | CPPFLAGS	= @CPPFLAGS@
166 | LIBS		= @PKG_LIBS@ @LIBS@
167 | AR		= @AR@
168 | CFLAGS		= @CFLAGS@
169 | COMPILE		= $(CC) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS)
170 | 
171 | .SUFFIXES: .c .$(OBJEXT)
172 | 
173 | #========================================================================
174 | # Start of user-definable TARGETS section
175 | #========================================================================
176 | 
177 | #========================================================================
178 | # TEA TARGETS.  Please note that the "libraries:" target refers to platform
179 | # independent files, and the "binaries:" target includes executable programs and
180 | # platform-dependent libraries.  Modify these targets so that they install
181 | # the various pieces of your package.  The make and install rules
182 | # for the BINARIES that you specified above have already been done.
183 | #========================================================================
184 | 
185 | all: binaries libraries doc
186 | 
187 | #========================================================================
188 | # The binaries target builds executable programs, Windows .dll's, unix
189 | # shared/static libraries, and any other platform-dependent files.
190 | # The list of targets to build for "binaries:" is specified at the top
191 | # of the Makefile, in the "BINARIES" variable.
192 | #========================================================================
193 | 
194 | binaries: $(BINARIES)
195 | 
196 | libraries:
197 | 
198 | #========================================================================
199 | # Your doc target should differentiate from doc builds (by the developer)
200 | # and doc installs (see install-doc), which just install the docs on the
201 | # end user machine when building from source.
202 | #========================================================================
203 | 
204 | doc:
205 | 
206 | install: all install-binaries install-libraries install-doc
207 | 
208 | install-binaries: binaries install-lib-binaries install-bin-binaries
209 | 
210 | #========================================================================
211 | # This rule installs platform-independent files, such as header files.
212 | # The list=...; for p in $$list handles the empty list case x-platform.
213 | #========================================================================
214 | 
215 | install-libraries: libraries
216 | 	@$(INSTALL_DATA_DIR) $(DESTDIR)$(includedir)
217 | 	@echo "Installing header files in $(DESTDIR)$(includedir)"
218 | 	@list='$(PKG_HEADERS)'; for i in $$list; do \
219 | 	    echo "Installing $(srcdir)/$$i" ; \
220 | 	    $(INSTALL_DATA) $(srcdir)/$$i $(DESTDIR)$(includedir) ; \
221 | 	done;
222 | 
223 | #========================================================================
224 | # Install documentation.  Unix manpages should go in the $(mandir)
225 | # directory.
226 | #========================================================================
227 | 
228 | install-doc: doc
229 | 	@$(INSTALL_DATA_DIR) $(DESTDIR)$(mandir)/mann
230 | 	@echo "Installing documentation in $(DESTDIR)$(mandir)"
231 | 	@list='$(srcdir)/doc/man/*.n'; for i in $$list; do \
232 | 	    if [ -f $$i ]; then \
233 | 	        echo "Installing $$i"; \
234 | 	        rm -f $(DESTDIR)$(mandir)/mann/`basename $$i`; \
235 | 	        $(INSTALL_DATA) $$i $(DESTDIR)$(mandir)/mann ; \
236 | 	    fi; \
237 | 	done
238 | 
239 | test: binaries libraries
240 | 	$(TCLSH) `@CYGPATH@ $(srcdir)/tests/all.tcl` $(TESTFLAGS) \
241 | 		-load "package ifneeded ${PACKAGE_NAME} ${PACKAGE_VERSION} \
242 | 			[list load `@CYGPATH@ $(PKG_LIB_FILE)` $(PACKAGE_NAME)]"
243 | 
244 | shell: binaries libraries
245 | 	@$(TCLSH) $(SCRIPT)
246 | 
247 | gdb:
248 | 	$(TCLSH_ENV) gdb $(TCLSH_PROG) $(SCRIPT)
249 | 
250 | VALGRINDARGS =	--tool=memcheck --num-callers=8 --leak-resolution=high \
251 | 		--leak-check=yes --show-reachable=yes -v
252 | 
253 | valgrind: binaries libraries
254 | 	$(TCLSH_ENV) valgrind $(VALGRINDARGS) $(TCLSH_PROG) \
255 | 		`@CYGPATH@ $(srcdir)/tests/all.tcl` $(TESTFLAGS)
256 | 
257 | valgrindshell: binaries libraries
258 | 	$(TCLSH_ENV) valgrind $(VALGRINDARGS) $(TCLSH_PROG) $(SCRIPT)
259 | 
260 | depend:
261 | 
262 | #========================================================================
263 | # $(PKG_LIB_FILE) should be listed as part of the BINARIES variable
264 | # mentioned above.  That will ensure that this target is built when you
265 | # run "make binaries".
266 | #
267 | # The $(PKG_OBJECTS) objects are created and linked into the final
268 | # library.  In most cases these object files will correspond to the
269 | # source files above.
270 | #========================================================================
271 | 
272 | $(PKG_LIB_FILE): $(PKG_OBJECTS)
273 | 	-rm -f $(PKG_LIB_FILE)
274 | 	${MAKE_LIB}
275 | 	$(RANLIB) $(PKG_LIB_FILE)
276 | 
277 | $(PKG_STUB_LIB_FILE): $(PKG_STUB_OBJECTS)
278 | 	-rm -f $(PKG_STUB_LIB_FILE)
279 | 	${MAKE_STUB_LIB}
280 | 	$(RANLIB_STUB) $(PKG_STUB_LIB_FILE)
281 | 
282 | #========================================================================
283 | 
284 | gendate:
285 | 	bison --output-file=$(srcdir)/generic/tclDate.c \
286 | 	--name-prefix=TclDate \
287 | 	--no-lines \
288 | 	$(srcdir)/generic/tclGetDate.y
289 | 
290 | #========================================================================
291 | # We need to enumerate the list of .c to .o lines here.
292 | #
293 | # In the following lines, $(srcdir) refers to the toplevel directory
294 | # containing your extension.  If your sources are in a subdirectory,
295 | # you will have to modify the paths to reflect this:
296 | #
297 | # sample.$(OBJEXT): $(srcdir)/generic/sample.c
298 | # 	$(COMPILE) -c `@CYGPATH@ $(srcdir)/generic/sample.c` -o $@
299 | #
300 | # Setting the VPATH variable to a list of paths will cause the makefile
301 | # to look into these paths when resolving .c to .obj dependencies.
302 | # As necessary, add $(srcdir):$(srcdir)/compat:....
303 | #========================================================================
304 | 
305 | VPATH = $(srcdir):$(srcdir)/generic:$(srcdir)/unix:$(srcdir)/win:$(srcdir)/macosx
306 | 
307 | .c.@OBJEXT@:
308 | 	$(COMPILE) -c `@CYGPATH@ $<` -o $@
309 | 
310 | # tclDate.h dependencies:
311 | tclClock.${OBJEXT}: tclClock.c tclDate.h
312 | tclClockFmt.${OBJEXT}: tclClockFmt.c tclDate.h
313 | tclDate.${OBJEXT}: tclDate.c tclDate.h
314 | 
315 | #========================================================================
316 | # Distribution creation
317 | # You may need to tweak this target to make it work correctly.
318 | #========================================================================
319 | 
320 | #COMPRESS	= tar cvf $(PKG_DIR).tar $(PKG_DIR); compress $(PKG_DIR).tar
321 | COMPRESS	= tar zcvf $(PKG_DIR).tar.gz $(PKG_DIR)
322 | DIST_ROOT	= /tmp/dist
323 | DIST_DIR	= $(DIST_ROOT)/$(PKG_DIR)
324 | 
325 | dist-clean:
326 | 	rm -rf $(DIST_DIR) $(DIST_ROOT)/$(PKG_DIR).tar.*
327 | 
328 | dist: dist-clean
329 | 	$(INSTALL_DATA_DIR) $(DIST_DIR)
330 | 	cp -p $(srcdir)/ChangeLog $(srcdir)/README* $(srcdir)/license.terms \
331 | 	$(srcdir)/aclocal.m4 $(srcdir)/configure \
332 |         $(srcdir)/*.in $(srcdir)/configure.ac $(DIST_DIR)/
333 | 	chmod 664 $(DIST_DIR)/Makefile.in $(DIST_DIR)/aclocal.m4
334 | 	chmod 775 $(DIST_DIR)/configure $(DIST_DIR)/configure.ac
335 | 
336 | 	$(INSTALL_DATA_DIR) $(DIST_DIR)/tclconfig
337 | 	cp $(srcdir)/tclconfig/install-sh $(srcdir)/tclconfig/tcl.m4 \
338 | 		$(DIST_DIR)/tclconfig/
339 | 	chmod 664 $(DIST_DIR)/tclconfig/tcl.m4
340 | 	chmod +x $(DIST_DIR)/tclconfig/install-sh
341 | 
342 | 	$(INSTALL_DATA_DIR) $(DIST_DIR)/unix
343 | 	cp $(srcdir)/unix/README $(srcdir)/unix/CONFIG \
344 | 		$(srcdir)/unix/threadUnix.c $(DIST_DIR)/unix/
345 | 
346 | 	$(INSTALL_DATA_DIR) $(DIST_DIR)/win
347 | 	cp $(srcdir)/win/README.txt $(srcdir)/win/CONFIG $(srcdir)/win/thread.rc \
348 | 		$(srcdir)/win/threadWin.c $(srcdir)/win/makefile.vc \
349 | 		$(srcdir)/win/nmakehlp.c $(srcdir)/win/pkg.vc \
350 | 		$(srcdir)/win/rules.vc   $(srcdir)/win/thread_win.dsw \
351 | 		$(srcdir)/win/thread_win.dsp $(DIST_DIR)/win/
352 | 
353 | 	$(INSTALL_DATA_DIR) $(DIST_DIR)/tcl
354 | 	cp $(srcdir)/tcl/README $(DIST_DIR)/tcl/
355 | 
356 | 	list='tests doc doc/man doc/html generic lib tcl/cmdsrv tcl/phttpd tcl/tpool';\
357 | 	for p in $$list; do \
358 | 	    if test -d $(srcdir)/$$p ; then \
359 | 		$(INSTALL_DATA_DIR) $(DIST_DIR)/$$p; \
360 | 		cp -p $(srcdir)/$$p/*.* $(DIST_DIR)/$$p/; \
361 | 	    fi; \
362 | 	done
363 | 
364 | 	(cd $(DIST_ROOT); $(COMPRESS);)
365 | 
366 | #========================================================================
367 | # End of user-definable section
368 | #========================================================================
369 | 
370 | #========================================================================
371 | # Don't modify the file to clean here.  Instead, set the "CLEANFILES"
372 | # variable in configure.ac
373 | #========================================================================
374 | 
375 | clean:
376 | 	-test -z "$(BINARIES)" || rm -f $(BINARIES)
377 | 	-rm -f *.$(OBJEXT) core *.core
378 | 	-test -z "$(CLEANFILES)" || rm -f $(CLEANFILES)
379 | 
380 | distclean: clean
381 | 	-rm -f *.tab.c
382 | 	-rm -f $(CONFIG_CLEAN_FILES)
383 | 	-rm -f config.cache config.log config.status
384 | 
385 | #========================================================================
386 | # Install binary object libraries.  On Windows this includes both .dll and
387 | # .lib files.  Because the .lib files are not explicitly listed anywhere,
388 | # we need to deduce their existence from the .dll file of the same name.
389 | # Library files go into the lib directory.
390 | # In addition, this will generate the pkgIndex.tcl
391 | # file in the install location (assuming it can find a usable tclsh shell)
392 | #
393 | # You should not have to modify this target.
394 | #========================================================================
395 | 
396 | install-lib-binaries: binaries
397 | 	@$(INSTALL_DATA_DIR) $(DESTDIR)$(pkglibdir)
398 | 	@list='$(lib_BINARIES)'; for p in $$list; do \
399 | 	  if test -f $$p; then \
400 | 	    echo " $(INSTALL_LIBRARY) $$p $(DESTDIR)$(pkglibdir)/$$p"; \
401 | 	    $(INSTALL_LIBRARY) $$p $(DESTDIR)$(pkglibdir)/$$p; \
402 | 	    stub=`echo $$p|sed -e "s/.*\(stub\).*/\1/"`; \
403 | 	    if test "x$$stub" = "xstub"; then \
404 | 		echo " $(RANLIB_STUB) $(DESTDIR)$(pkglibdir)/$$p"; \
405 | 		$(RANLIB_STUB) $(DESTDIR)$(pkglibdir)/$$p; \
406 | 	    else \
407 | 		echo " $(RANLIB) $(DESTDIR)$(pkglibdir)/$$p"; \
408 | 		$(RANLIB) $(DESTDIR)$(pkglibdir)/$$p; \
409 | 	    fi; \
410 | 	    ext=`echo $$p|sed -e "s/.*\.//"`; \
411 | 	    if test "x$$ext" = "xdll"; then \
412 | 		lib=`basename $$p|sed -e 's/.[^.]*$$//'`.lib; \
413 | 		if test -f $$lib; then \
414 | 		    echo " $(INSTALL_DATA) $$lib $(DESTDIR)$(pkglibdir)/$$lib"; \
415 | 	            $(INSTALL_DATA) $$lib $(DESTDIR)$(pkglibdir)/$$lib; \
416 | 		fi; \
417 | 	    fi; \
418 | 	  fi; \
419 | 	done
420 | 	@list='$(PKG_TCL_SOURCES)'; for p in $$list; do \
421 | 	  if test -f $(srcdir)/$$p; then \
422 | 	    destp=`basename $$p`; \
423 | 	    echo " Install $$destp $(DESTDIR)$(pkglibdir)/$$destp"; \
424 | 	    $(INSTALL_DATA) $(srcdir)/$$p $(DESTDIR)$(pkglibdir)/$$destp; \
425 | 	  fi; \
426 | 	done
427 | 	@if test "x$(SHARED_BUILD)" = "x1"; then \
428 | 	    echo " Install pkgIndex.tcl $(DESTDIR)$(pkglibdir)"; \
429 | 	    $(INSTALL_DATA) pkgIndex.tcl $(DESTDIR)$(pkglibdir); \
430 | 	fi
431 | 
432 | #========================================================================
433 | # Install binary executables (e.g. .exe files and dependent .dll files)
434 | # This is for files that must go in the bin directory (located next to
435 | # wish and tclsh), like dependent .dll files on Windows.
436 | #
437 | # You should not have to modify this target, except to define bin_BINARIES
438 | # above if necessary.
439 | #========================================================================
440 | 
441 | install-bin-binaries: binaries
442 | 	@$(INSTALL_DATA_DIR) $(DESTDIR)$(bindir)
443 | 	@list='$(bin_BINARIES)'; for p in $$list; do \
444 | 	  if test -f $$p; then \
445 | 	    echo " $(INSTALL_PROGRAM) $$p $(DESTDIR)$(bindir)/$$p"; \
446 | 	    $(INSTALL_PROGRAM) $$p $(DESTDIR)$(bindir)/$$p; \
447 | 	  fi; \
448 | 	done
449 | 
450 | Makefile: $(srcdir)/Makefile.in  $(top_builddir)/config.status
451 | 	cd $(top_builddir) \
452 | 	  && CONFIG_FILES=$@ CONFIG_HEADERS= $(SHELL) ./config.status
453 | 
454 | uninstall-binaries:
455 | 	list='$(lib_BINARIES)'; for p in $$list; do \
456 | 	  rm -f $(DESTDIR)$(pkglibdir)/$$p; \
457 | 	done
458 | 	list='$(PKG_TCL_SOURCES)'; for p in $$list; do \
459 | 	  p=`basename $$p`; \
460 | 	  rm -f $(DESTDIR)$(pkglibdir)/$$p; \
461 | 	done
462 | 	list='$(bin_BINARIES)'; for p in $$list; do \
463 | 	  rm -f $(DESTDIR)$(bindir)/$$p; \
464 | 	done
465 | 
466 | .PHONY: all binaries clean depend distclean doc install libraries test
467 | 
468 | # Tell versions [3.59,3.63) of GNU make to not export all variables.
469 | # Otherwise a system limit (for SysV at least) may be exceeded.
470 | .NOEXPORT:
471 | 


--------------------------------------------------------------------------------
/win/rules.vc:
--------------------------------------------------------------------------------
  1 | #------------------------------------------------------------------------------
  2 | # rules.vc --
  3 | #
  4 | #	Microsoft Visual C++ makefile include for decoding the commandline
  5 | #	macros.  This file does not need editing to build Tcl.
  6 | #
  7 | #	This version is modified from the Tcl source version to support
  8 | #	building extensions using nmake.
  9 | #
 10 | # See the file "license.terms" for information on usage and redistribution
 11 | # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 12 | #
 13 | # Copyright (c) 2001-2002 David Gravereaux.
 14 | # Copyright (c) 2003-2008 Patrick Thoyts
 15 | #------------------------------------------------------------------------------
 16 | 
 17 | !ifndef _RULES_VC
 18 | _RULES_VC = 1
 19 | 
 20 | cc32		= $(CC)   # built-in default.
 21 | link32		= link
 22 | lib32		= lib
 23 | rc32		= $(RC)   # built-in default.
 24 | 
 25 | !ifndef INSTALLDIR
 26 | ### Assume the normal default.
 27 | _INSTALLDIR	= C:\Program Files\Tcl
 28 | !else
 29 | ### Fix the path separators.
 30 | _INSTALLDIR	= $(INSTALLDIR:/=\)
 31 | !endif
 32 | 
 33 | #----------------------------------------------------------
 34 | # Set the proper copy method to avoid overwrite questions
 35 | # to the user when copying files and selecting the right
 36 | # "delete all" method.
 37 | #----------------------------------------------------------
 38 | 
 39 | !if "$(OS)" == "Windows_NT"
 40 | RMDIR	= rmdir /S /Q
 41 | ERRNULL  = 2>NUL
 42 | !if ![ver | find "4.0" > nul]
 43 | CPY	= echo y | xcopy /i >NUL
 44 | COPY	= copy >NUL
 45 | !else
 46 | CPY	= xcopy /i /y >NUL
 47 | COPY	= copy /y >NUL
 48 | !endif
 49 | !else # "$(OS)" != "Windows_NT"
 50 | CPY	= xcopy /i >_JUNK.OUT # On Win98 NUL does not work here.
 51 | COPY	= copy >_JUNK.OUT # On Win98 NUL does not work here.
 52 | RMDIR	= deltree /Y
 53 | NULL    = \NUL # Used in testing directory existence
 54 | ERRNULL = >NUL # Win9x shell cannot redirect stderr
 55 | !endif
 56 | MKDIR   = mkdir
 57 | 
 58 | #------------------------------------------------------------------------------
 59 | # Determine the host and target architectures and compiler version.
 60 | #------------------------------------------------------------------------------
 61 | 
 62 | _HASH=^#
 63 | _VC_MANIFEST_EMBED_EXE=
 64 | _VC_MANIFEST_EMBED_DLL=
 65 | VCVER=0
 66 | !if ![echo VCVERSION=_MSC_VER > vercl.x] \
 67 |     && ![echo $(_HASH)if defined(_M_IX86) >> vercl.x] \
 68 |     && ![echo ARCH=IX86 >> vercl.x] \
 69 |     && ![echo $(_HASH)elif defined(_M_AMD64) >> vercl.x] \
 70 |     && ![echo ARCH=AMD64 >> vercl.x] \
 71 |     && ![echo $(_HASH)endif >> vercl.x] \
 72 |     && ![cl -nologo -TC -P vercl.x $(ERRNULL)]
 73 | !include vercl.i
 74 | !if ![echo VCVER= ^\> vercl.vc] \
 75 |     && ![set /a $(VCVERSION) / 100 - 6 >> vercl.vc]
 76 | !include vercl.vc
 77 | !endif
 78 | !endif
 79 | !if ![del $(ERRNUL) /q/f vercl.x vercl.i vercl.vc]
 80 | !endif
 81 | 
 82 | !if ![reg query HKLM\Hardware\Description\System\CentralProcessor\0 /v Identifier | findstr /i x86]
 83 | NATIVE_ARCH=IX86
 84 | !else
 85 | NATIVE_ARCH=AMD64
 86 | !endif
 87 | 
 88 | # Since MSVC8 we must deal with manifest resources.
 89 | !if $(VCVERSION) >= 1400
 90 | _VC_MANIFEST_EMBED_EXE=if exist $@.manifest mt -nologo -manifest $@.manifest -outputresource:$@;1
 91 | _VC_MANIFEST_EMBED_DLL=if exist $@.manifest mt -nologo -manifest $@.manifest -outputresource:$@;2
 92 | !endif
 93 | 
 94 | !ifndef MACHINE
 95 | MACHINE=$(ARCH)
 96 | !endif
 97 | 
 98 | !ifndef CFG_ENCODING
 99 | CFG_ENCODING	= \"cp1252\"
100 | !endif
101 | 
102 | !message ===============================================================================
103 | 
104 | #----------------------------------------------------------
105 | # build the helper app we need to overcome nmake's limiting
106 | # environment.
107 | #----------------------------------------------------------
108 | 
109 | !if !exist(nmakehlp.exe)
110 | !if [$(cc32) -nologo nmakehlp.c -link -subsystem:console > nul]
111 | !endif
112 | !endif
113 | 
114 | #----------------------------------------------------------
115 | # Test for compiler features
116 | #----------------------------------------------------------
117 | 
118 | ### test for optimizations
119 | !if [nmakehlp -c -Ot]
120 | !message *** Compiler has 'Optimizations'
121 | OPTIMIZING	= 1
122 | !else
123 | !message *** Compiler does not have 'Optimizations'
124 | OPTIMIZING	= 0
125 | !endif
126 | 
127 | OPTIMIZATIONS   =
128 | 
129 | !if [nmakehlp -c -Ot]
130 | OPTIMIZATIONS  = $(OPTIMIZATIONS) -Ot
131 | !endif
132 | 
133 | !if [nmakehlp -c -Oi]
134 | OPTIMIZATIONS  = $(OPTIMIZATIONS) -Oi
135 | !endif
136 | 
137 | !if [nmakehlp -c -Op]
138 | OPTIMIZATIONS  = $(OPTIMIZATIONS) -Op
139 | !endif
140 | 
141 | !if [nmakehlp -c -fp:strict]
142 | OPTIMIZATIONS  = $(OPTIMIZATIONS) -fp:strict
143 | !endif
144 | 
145 | !if [nmakehlp -c -Gs]
146 | OPTIMIZATIONS  = $(OPTIMIZATIONS) -Gs
147 | !endif
148 | 
149 | !if [nmakehlp -c -GS]
150 | OPTIMIZATIONS  = $(OPTIMIZATIONS) -GS
151 | !endif
152 | 
153 | !if [nmakehlp -c -GL]
154 | OPTIMIZATIONS  = $(OPTIMIZATIONS) -GL
155 | !endif
156 | 
157 | DEBUGFLAGS     =
158 | 
159 | !if [nmakehlp -c -RTC1]
160 | DEBUGFLAGS     = $(DEBUGFLAGS) -RTC1
161 | !elseif [nmakehlp -c -GZ]
162 | DEBUGFLAGS     = $(DEBUGFLAGS) -GZ
163 | !endif
164 | 
165 | COMPILERFLAGS  =-W3
166 | 
167 | # In v13 -GL and -YX are incompatible.
168 | !if [nmakehlp -c -YX]
169 | !if ![nmakehlp -c -GL]
170 | OPTIMIZATIONS  = $(OPTIMIZATIONS) -YX
171 | !endif
172 | !endif
173 | 
174 | !if "$(MACHINE)" == "IX86"
175 | ### test for pentium errata
176 | !if [nmakehlp -c -QI0f]
177 | !message *** Compiler has 'Pentium 0x0f fix'
178 | COMPILERFLAGS  = $(COMPILERFLAGS) -QI0f
179 | !else
180 | !message *** Compiler does not have 'Pentium 0x0f fix'
181 | !endif
182 | !endif
183 | 
184 | !if "$(MACHINE)" == "IA64"
185 | ### test for Itanium errata
186 | !if [nmakehlp -c -QIA64_Bx]
187 | !message *** Compiler has 'B-stepping errata workarounds'
188 | COMPILERFLAGS   = $(COMPILERFLAGS) -QIA64_Bx
189 | !else
190 | !message *** Compiler does not have 'B-stepping errata workarounds'
191 | !endif
192 | !endif
193 | 
194 | # Prevents "LNK1561: entry point must be defined" error compiling from VS-IDE:
195 | !ifndef LINKER_TESTFLAGS
196 | LINKER_TESTFLAGS = /DLL /NOENTRY /OUT:nmhlp-out.txt
197 | !endif
198 | 
199 | !if "$(MACHINE)" == "IX86"
200 | ### test for -align:4096, when align:512 will do.
201 | !if [nmakehlp -l -opt:nowin98 $(LINKER_TESTFLAGS)]
202 | !message *** Linker has 'Win98 alignment problem'
203 | ALIGN98_HACK	= 1
204 | !else
205 | !message *** Linker does not have 'Win98 alignment problem'
206 | ALIGN98_HACK	= 0
207 | !endif
208 | !else
209 | ALIGN98_HACK	= 0
210 | !endif
211 | 
212 | LINKERFLAGS     =
213 | 
214 | !if [nmakehlp -l -ltcg $(LINKER_TESTFLAGS)]
215 | LINKERFLAGS     =-ltcg
216 | !endif
217 | 
218 | #----------------------------------------------------------
219 | # Decode the options requested.
220 | #----------------------------------------------------------
221 | 
222 | !if "$(OPTS)" == "" || [nmakehlp -f "$(OPTS)" "none"]
223 | STATIC_BUILD	= 0
224 | TCL_THREADS	= 1
225 | DEBUG		= 0
226 | PROFILE		= 0
227 | MSVCRT		= 0
228 | LOIMPACT	= 0
229 | TCL_USE_STATIC_PACKAGES	= 0
230 | USE_THREAD_ALLOC = 1
231 | USE_THREAD_STORAGE = 1
232 | UNCHECKED       = 0
233 | !else
234 | !if [nmakehlp -f $(OPTS) "static"]
235 | !message *** Doing static
236 | STATIC_BUILD	= 1
237 | !else
238 | STATIC_BUILD	= 0
239 | !endif
240 | !if [nmakehlp -f $(OPTS) "msvcrt"]
241 | !message *** Doing msvcrt
242 | MSVCRT		= 1
243 | !else
244 | MSVCRT		= 0
245 | !endif
246 | !if [nmakehlp -f $(OPTS) "staticpkg"]
247 | !message *** Doing staticpkg
248 | TCL_USE_STATIC_PACKAGES	= 1
249 | !else
250 | TCL_USE_STATIC_PACKAGES	= 0
251 | !endif
252 | !if [nmakehlp -f $(OPTS) "nothreads"]
253 | !message *** Compile explicitly for non-threaded tcl
254 | TCL_THREADS	= 0
255 | !else
256 | TCL_THREADS     = 1
257 | !endif
258 | !if [nmakehlp -f $(OPTS) "symbols"]
259 | !message *** Doing symbols
260 | DEBUG		= 1
261 | !else
262 | DEBUG		= 0
263 | !endif
264 | !if [nmakehlp -f $(OPTS) "profile"]
265 | !message *** Doing profile
266 | PROFILE		= 1
267 | !else
268 | PROFILE		= 0
269 | !endif
270 | !if [nmakehlp -f $(OPTS) "loimpact"]
271 | !message *** Doing loimpact
272 | LOIMPACT	= 1
273 | !else
274 | LOIMPACT	= 0
275 | !endif
276 | !if [nmakehlp -f $(OPTS) "thrdalloc"]
277 | !message *** Doing thrdalloc
278 | USE_THREAD_ALLOC = 1
279 | !else
280 | USE_THREAD_ALLOC = 0
281 | !endif
282 | !if [nmakehlp -f $(OPTS) "thrdstorage"]
283 | !message *** Doing thrdstorage
284 | USE_THREAD_STORAGE = 1
285 | !else
286 | USE_THREAD_STORAGE = 0
287 | !endif
288 | !if [nmakehlp -f $(OPTS) "unchecked"]
289 | !message *** Doing unchecked
290 | UNCHECKED = 1
291 | !else
292 | UNCHECKED = 0
293 | !endif
294 | !endif
295 | 
296 | 
297 | !if !$(STATIC_BUILD)
298 | # Make sure we don't build overly fat DLLs.
299 | MSVCRT		= 1
300 | # We shouldn't statically put the extensions inside the shell when dynamic.
301 | TCL_USE_STATIC_PACKAGES = 0
302 | !endif
303 | 
304 | 
305 | #----------------------------------------------------------
306 | # Figure-out how to name our intermediate and output directories.
307 | # We wouldn't want different builds to use the same .obj files
308 | # by accident.
309 | #----------------------------------------------------------
310 | 
311 | #----------------------------------------
312 | # Naming convention:
313 | #   t = full thread support.
314 | #   s = static library (as opposed to an
315 | #	import library)
316 | #   g = linked to the debug enabled C
317 | #	run-time.
318 | #   x = special static build when it
319 | #	links to the dynamic C run-time.
320 | #----------------------------------------
321 | SUFX	    = sgxt
322 | 
323 | !message *** Debug: '$(DEBUG)'
324 | !if $(DEBUG)
325 | BUILDDIRTOP = Debug
326 | !else
327 | BUILDDIRTOP = Release
328 | !endif
329 | 
330 | !if "$(MACHINE)" != "IX86"
331 | BUILDDIRTOP =$(BUILDDIRTOP)_$(MACHINE)
332 | !endif
333 | !if $(VCVER) > 6
334 | BUILDDIRTOP =$(BUILDDIRTOP)_VC$(VCVER)
335 | !endif
336 | 
337 | !if !$(DEBUG) || $(DEBUG) && $(UNCHECKED)
338 | SUFX	    = $(SUFX:g=)
339 | !endif
340 | 
341 | TMP_DIRFULL = .\$(BUILDDIRTOP)\$(PROJECT)_ThreadedDynamicStaticX
342 | 
343 | !if !$(STATIC_BUILD)
344 | TMP_DIRFULL = $(TMP_DIRFULL:Static=)
345 | SUFX	    = $(SUFX:s=)
346 | EXT	    = dll
347 | !if $(MSVCRT)
348 | TMP_DIRFULL = $(TMP_DIRFULL:X=)
349 | SUFX	    = $(SUFX:x=)
350 | !endif
351 | !else
352 | TMP_DIRFULL = $(TMP_DIRFULL:Dynamic=)
353 | EXT	    = lib
354 | !if !$(MSVCRT)
355 | TMP_DIRFULL = $(TMP_DIRFULL:X=)
356 | SUFX	    = $(SUFX:x=)
357 | !endif
358 | !endif
359 | 
360 | !if !$(TCL_THREADS)
361 | TMP_DIRFULL = $(TMP_DIRFULL:Threaded=)
362 | SUFX	    = $(SUFX:t=)
363 | !endif
364 | 
365 | !ifndef TMP_DIR
366 | TMP_DIR	    = $(TMP_DIRFULL)
367 | !ifndef OUT_DIR
368 | OUT_DIR	    = .\$(BUILDDIRTOP)
369 | !endif
370 | !else
371 | !ifndef OUT_DIR
372 | OUT_DIR	    = $(TMP_DIR)
373 | !endif
374 | !endif
375 | 
376 | 
377 | #----------------------------------------------------------
378 | # Decode the statistics requested.
379 | #----------------------------------------------------------
380 | 
381 | !if "$(STATS)" == "" || [nmakehlp -f "$(STATS)" "none"]
382 | TCL_MEM_DEBUG	    = 0
383 | TCL_COMPILE_DEBUG   = 0
384 | !else
385 | !if [nmakehlp -f $(STATS) "memdbg"]
386 | !message *** Doing memdbg
387 | TCL_MEM_DEBUG	    = 1
388 | !else
389 | TCL_MEM_DEBUG	    = 0
390 | !endif
391 | !if [nmakehlp -f $(STATS) "compdbg"]
392 | !message *** Doing compdbg
393 | TCL_COMPILE_DEBUG   = 1
394 | !else
395 | TCL_COMPILE_DEBUG   = 0
396 | !endif
397 | !endif
398 | 
399 | 
400 | #----------------------------------------------------------
401 | # Decode the checks requested.
402 | #----------------------------------------------------------
403 | 
404 | !if "$(CHECKS)" == "" || [nmakehlp -f "$(CHECKS)" "none"]
405 | TCL_NO_DEPRECATED	    = 0
406 | WARNINGS		    = -W3
407 | !else
408 | !if [nmakehlp -f $(CHECKS) "nodep"]
409 | !message *** Doing nodep check
410 | TCL_NO_DEPRECATED	    = 1
411 | !else
412 | TCL_NO_DEPRECATED	    = 0
413 | !endif
414 | !if [nmakehlp -f $(CHECKS) "fullwarn"]
415 | !message *** Doing full warnings check
416 | WARNINGS		    = -W4
417 | !if [nmakehlp -l -warn:3 $(LINKER_TESTFLAGS)]
418 | LINKERFLAGS		    = $(LINKERFLAGS) -warn:3
419 | !endif
420 | !else
421 | WARNINGS		    = -W3
422 | !endif
423 | !if [nmakehlp -f $(CHECKS) "64bit"] && [nmakehlp -c -Wp64]
424 | !message *** Doing 64bit portability warnings
425 | WARNINGS		    = $(WARNINGS) -Wp64
426 | !endif
427 | !endif
428 | 
429 | 
430 | LINKERFLAGS = $(LINKERFLAGS) $(ADDLINKOPTS)
431 | 
432 | #----------------------------------------------------------
433 | # Set our defines now armed with our options.
434 | #----------------------------------------------------------
435 | 
436 | OPTDEFINES	= -DTCL_CFGVAL_ENCODING=$(CFG_ENCODING) -DSTDC_HEADERS $(ADDOPTDEFINES)
437 | 
438 | !if $(TCL_MEM_DEBUG)
439 | OPTDEFINES	= $(OPTDEFINES) -DTCL_MEM_DEBUG
440 | !endif
441 | !if $(TCL_COMPILE_DEBUG)
442 | OPTDEFINES	= $(OPTDEFINES) -DTCL_COMPILE_DEBUG -DTCL_COMPILE_STATS
443 | !endif
444 | !if $(TCL_THREADS)
445 | OPTDEFINES	= $(OPTDEFINES) -DTCL_THREADS=1
446 | !if $(USE_THREAD_ALLOC)
447 | OPTDEFINES	= $(OPTDEFINES) -DUSE_THREAD_ALLOC=1
448 | !endif
449 | !if $(USE_THREAD_STORAGE)
450 | OPTDEFINES	= $(OPTDEFINES) -DUSE_THREAD_STORAGE=1
451 | !endif
452 | !endif
453 | !if $(STATIC_BUILD)
454 | OPTDEFINES	= $(OPTDEFINES) -DSTATIC_BUILD
455 | !endif
456 | !if $(TCL_NO_DEPRECATED)
457 | OPTDEFINES	= $(OPTDEFINES) -DTCL_NO_DEPRECATED
458 | !endif
459 | 
460 | !if $(DEBUG)
461 | OPTDEFINES	= $(OPTDEFINES) -DTCL_CFG_DEBUG
462 | !elseif $(OPTIMIZING)
463 | OPTDEFINES	= $(OPTDEFINES) -DTCL_CFG_OPTIMIZED
464 | !endif
465 | !if $(PROFILE)
466 | OPTDEFINES	= $(OPTDEFINES) -DTCL_CFG_PROFILED
467 | !endif
468 | !if "$(MACHINE)" == "IA64" || "$(MACHINE)" == "AMD64"
469 | OPTDEFINES	= $(OPTDEFINES) -DTCL_CFG_DO64BIT
470 | !endif
471 | 
472 | 
473 | #----------------------------------------------------------
474 | # Get common info used when building extensions.
475 | #----------------------------------------------------------
476 | 
477 | !if "$(PROJECT)" != "tcl"
478 | 
479 | # If INSTALLDIR set to tcl root dir then reset to the lib dir.
480 | !if exist("$(_INSTALLDIR)\include\tcl.h")
481 | _INSTALLDIR=$(_INSTALLDIR)\lib
482 | !endif
483 | 
484 | !if !defined(TCLDIR)
485 | !if exist("$(_INSTALLDIR)\..\include\tcl.h")
486 | TCLINSTALL	= 1
487 | _TCLDIR		= $(_INSTALLDIR)\..
488 | _TCL_H          = $(_INSTALLDIR)\..\include\tcl.h
489 | TCLDIR          = $(_INSTALLDIR)\..
490 | !else
491 | MSG=^
492 | Failed to find tcl.h.  Set the TCLDIR macro.
493 | !error $(MSG)
494 | !endif
495 | !else
496 | _TCLDIR	= $(TCLDIR:/=\)
497 | !if exist("$(_TCLDIR)\include\tcl.h")
498 | TCLINSTALL	= 1
499 | _TCL_H          = $(_TCLDIR)\include\tcl.h
500 | !elseif exist("$(_TCLDIR)\generic\tcl.h")
501 | TCLINSTALL	= 0
502 | _TCL_H          = $(_TCLDIR)\generic\tcl.h
503 | !else
504 | MSG =^
505 | Failed to find tcl.h.  The TCLDIR macro does not appear correct.
506 | !error $(MSG)
507 | !endif
508 | !endif
509 | 
510 | !if [echo REM = This file is generated from rules.vc > version.vc]
511 | !endif
512 | !if exist("$(_TCL_H)")
513 | !if [echo TCL_DOTVERSION = \>> version.vc] \
514 |    && [nmakehlp -V "$(_TCL_H)" TCL_VERSION >> version.vc]
515 | !endif
516 | !endif
517 | !include version.vc
518 | TCL_VERSION	= $(TCL_DOTVERSION:.=)
519 | 
520 | !message *** Build for tcl$(TCL_VERSION)$(SUFX).dll ***
521 | 
522 | !if $(TCLINSTALL)
523 | TCLSH		= "$(_TCLDIR)\bin\tclsh$(TCL_VERSION)$(SUFX).exe"
524 | !if !exist($(TCLSH)) && $(TCL_THREADS)
525 | TCLSH           = "$(_TCLDIR)\bin\tclsh$(TCL_VERSION)t$(SUFX).exe"
526 | !endif
527 | TCLSTUBLIB	= "$(_TCLDIR)\lib\tclstub$(TCL_VERSION).lib"
528 | TCLIMPLIB	= "$(_TCLDIR)\lib\tcl$(TCL_VERSION)$(SUFX).lib"
529 | TCL_LIBRARY	= $(_TCLDIR)\lib
530 | TCL_INCLUDES    = -I"$(_TCLDIR)\include"
531 | !else
532 | TCLSH		= "$(_TCLDIR)\win\$(BUILDDIRTOP)\tclsh$(TCL_VERSION)$(SUFX).exe"
533 | !if !exist($(TCLSH)) && $(TCL_THREADS)
534 | TCLSH		= "$(_TCLDIR)\win\$(BUILDDIRTOP)\tclsh$(TCL_VERSION)t$(SUFX).exe"
535 | !endif
536 | TCLSTUBLIB	= "$(_TCLDIR)\win\$(BUILDDIRTOP)\tclstub$(TCL_VERSION).lib"
537 | TCLIMPLIB	= "$(_TCLDIR)\win\$(BUILDDIRTOP)\tcl$(TCL_VERSION)$(SUFX).lib"
538 | TCL_LIBRARY	= $(_TCLDIR)\library
539 | TCL_INCLUDES	= -I"$(_TCLDIR)\generic" -I"$(_TCLDIR)\win"
540 | !endif
541 | 
542 | !endif
543 | 
544 | #----------------------------------------------------------
545 | # Optionally check for Tk info for building extensions.
546 | #----------------------------------------------------------
547 | 
548 | !ifdef PROJECT_REQUIRES_TK
549 | !if "$(PROJECT)" != "tcl" && "$(PROJECT)" != "tk"
550 | 
551 | !if !defined(TKDIR)
552 | !if exist("$(_INSTALLDIR)\..\include\tk.h")
553 | TKINSTALL      = 1
554 | _TKDIR         = $(_INSTALLDIR)\..
555 | _TK_H          = $(_TKDIR)\include\tk.h
556 | TKDIR          = $(_TKDIR)
557 | !elseif exist("$(_TCLDIR)\include\tk.h")
558 | TKINSTALL      = 1
559 | _TKDIR         = $(_TCLDIR)
560 | _TK_H          = $(_TKDIR)\include\tk.h
561 | TKDIR          = $(_TKDIR)
562 | !endif
563 | !else
564 | _TKDIR = $(TKDIR:/=\)
565 | !if exist("$(_TKDIR)\include\tk.h")
566 | TKINSTALL      = 1
567 | _TK_H          = $(_TKDIR)\include\tk.h
568 | !elseif exist("$(_TKDIR)\generic\tk.h")
569 | TKINSTALL      = 0
570 | _TK_H          = $(_TKDIR)\generic\tk.h
571 | !else
572 | MSG =^
573 | Failed to find tk.h. The TKDIR macro does not appear correct.
574 | !error $(MSG)
575 | !endif
576 | !endif
577 | 
578 | !if defined(TKDIR)
579 | TK_DOTVERSION = 8.4
580 | !if exist("$(_TK_H)")
581 | !if [echo TK_DOTVERSION = \>> version.vc] \
582 |    && [nmakehlp -V "$(_TK_H)" TK_VERSION >> version.vc]
583 | !endif
584 | !endif
585 | !include version.vc
586 | TK_VERSION = $(TK_DOTVERSION:.=)
587 | 
588 | !if $(TKINSTALL)
589 | WISH		= "$(_TKDIR)\bin\wish$(TK_VERSION)$(SUFX).exe"
590 | !if !exist($(WISH)) && $(TCL_THREADS)
591 | WISH		= "$(_TKDIR)\bin\wish$(TK_VERSION)t$(SUFX).exe"
592 | !endif
593 | TKSTUBLIB	= "$(_TKDIR)\lib\tkstub$(TK_VERSION).lib"
594 | TKIMPLIB	= "$(_TKDIR)\lib\tk$(TK_VERSION)$(SUFX).lib"
595 | TK_INCLUDES     = -I"$(_TKDIR)\include"
596 | TK_LIBRARY	= $(_TKDIR)\lib
597 | !else
598 | WISH		= "$(_TKDIR)\win\$(BUILDDIRTOP)\wish$(TCL_VERSION)$(SUFX).exe"
599 | !if !exist($(WISH)) && $(TCL_THREADS)
600 | WISH		= "$(_TKDIR)\win\$(BUILDDIRTOP)\wish$(TCL_VERSION)t$(SUFX).exe"
601 | !endif
602 | TKSTUBLIB	= "$(_TKDIR)\win\$(BUILDDIRTOP)\tkstub$(TCL_VERSION).lib"
603 | TKIMPLIB	= "$(_TKDIR)\win\$(BUILDDIRTOP)\tk$(TCL_VERSION)$(SUFX).lib"
604 | TK_INCLUDES     = -I"$(_TKDIR)\generic" -I"$(_TKDIR)\win" -I"$(_TKDIR)\xlib"
605 | TK_LIBRARY	= $(_TKDIR)\library
606 | !endif
607 | 
608 | !endif
609 | !endif
610 | !endif
611 | 
612 | 
613 | #----------------------------------------------------------
614 | # Setup the fully qualified OUT_DIR path as OUT_DIR_PATH
615 | #----------------------------------------------------------
616 | !if [echo OUT_DIR_PATH = \>> version.vc] \
617 |     && [nmakehlp -Q "$(OUT_DIR)" >> version.vc]
618 | !endif
619 | !include version.vc
620 | 
621 | 
622 | #----------------------------------------------------------
623 | # Display stats being used.
624 | #----------------------------------------------------------
625 | 
626 | !message *** Intermediate directory will be '$(TMP_DIR)'
627 | !message *** Output directory will be '$(OUT_DIR)'
628 | !message *** Suffix for binaries will be '$(SUFX)'
629 | !message *** Optional defines are '$(OPTDEFINES)'
630 | !message *** Compiler version $(VCVER). Target machine is $(MACHINE)
631 | !message *** Compiler options '$(COMPILERFLAGS) $(OPTIMIZATIONS) $(DEBUGFLAGS) $(WARNINGS)'
632 | !message *** Link options '$(LINKERFLAGS)'
633 | 
634 | !endif
635 | 


--------------------------------------------------------------------------------
/win/nmakehlp.c:
--------------------------------------------------------------------------------
  1 | /*
  2 |  * ----------------------------------------------------------------------------
  3 |  * nmakehlp.c --
  4 |  *
  5 |  *	This is used to fix limitations within nmake and the environment.
  6 |  *
  7 |  * Copyright (c) 2002 by David Gravereaux.
  8 |  * Copyright (c) 2006 by Pat Thoyts
  9 |  *
 10 |  * See the file "license.terms" for information on usage and redistribution of
 11 |  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 12 |  * ----------------------------------------------------------------------------
 13 |  */
 14 | 
 15 | #define _CRT_SECURE_NO_DEPRECATE
 16 | #include <windows.h>
 17 | #define NO_SHLWAPI_GDI
 18 | #define NO_SHLWAPI_STREAM
 19 | #define NO_SHLWAPI_REG
 20 | #include <shlwapi.h>
 21 | #pragma comment (lib, "user32.lib")
 22 | #pragma comment (lib, "kernel32.lib")
 23 | #pragma comment (lib, "shlwapi.lib")
 24 | #include <stdio.h>
 25 | #include <math.h>
 26 | 
 27 | /*
 28 |  * This library is required for x64 builds with _some_ versions of MSVC
 29 |  */
 30 | #if defined(_M_IA64) || defined(_M_AMD64)
 31 | #if _MSC_VER >= 1400 && _MSC_VER < 1500
 32 | #pragma comment(lib, "bufferoverflowU")
 33 | #endif
 34 | #endif
 35 | 
 36 | /* ISO hack for dumb VC++ */
 37 | #ifdef _MSC_VER
 38 | #define   snprintf	_snprintf
 39 | #endif
 40 | 
 41 | 
 42 | 
 43 | /* protos */
 44 | 
 45 | static int CheckForCompilerFeature(const char *option);
 46 | static int CheckForLinkerFeature(const char *option);
 47 | static int IsIn(const char *string, const char *substring);
 48 | static int SubstituteFile(const char *substs, const char *filename);
 49 | static int QualifyPath(const char *path);
 50 | static const char *GetVersionFromFile(const char *filename, const char *match, int numdots);
 51 | static DWORD WINAPI ReadFromPipe(LPVOID args);
 52 | 
 53 | /* globals */
 54 | 
 55 | #define CHUNK	25
 56 | #define STATICBUFFERSIZE    1000
 57 | typedef struct {
 58 |     HANDLE pipe;
 59 |     char buffer[STATICBUFFERSIZE];
 60 | } pipeinfo;
 61 | 
 62 | pipeinfo Out = {INVALID_HANDLE_VALUE, '\0'};
 63 | pipeinfo Err = {INVALID_HANDLE_VALUE, '\0'};
 64 | 
 65 | /*
 66 |  * exitcodes: 0 == no, 1 == yes, 2 == error
 67 |  */
 68 | 
 69 | int
 70 | main(
 71 |     int argc,
 72 |     char *argv[])
 73 | {
 74 |     char msg[300];
 75 |     DWORD dwWritten;
 76 |     int chars;
 77 | 
 78 |     /*
 79 |      * Make sure children (cl.exe and link.exe) are kept quiet.
 80 |      */
 81 | 
 82 |     SetErrorMode(SEM_FAILCRITICALERRORS | SEM_NOOPENFILEERRORBOX);
 83 | 
 84 |     /*
 85 |      * Make sure the compiler and linker aren't effected by the outside world.
 86 |      */
 87 | 
 88 |     SetEnvironmentVariable("CL", "");
 89 |     SetEnvironmentVariable("LINK", "");
 90 | 
 91 |     if (argc > 1 && *argv[1] == '-') {
 92 | 	switch (*(argv[1]+1)) {
 93 | 	case 'c':
 94 | 	    if (argc != 3) {
 95 | 		chars = snprintf(msg, sizeof(msg) - 1,
 96 | 		        "usage: %s -c <compiler option>\n"
 97 | 			"Tests for whether cl.exe supports an option\n"
 98 | 			"exitcodes: 0 == no, 1 == yes, 2 == error\n", argv[0]);
 99 | 		WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars,
100 | 			&dwWritten, NULL);
101 | 		return 2;
102 | 	    }
103 | 	    return CheckForCompilerFeature(argv[2]);
104 | 	case 'l':
105 | 	    if (argc != 3) {
106 | 		chars = snprintf(msg, sizeof(msg) - 1,
107 | 	       		"usage: %s -l <linker option>\n"
108 | 			"Tests for whether link.exe supports an option\n"
109 | 			"exitcodes: 0 == no, 1 == yes, 2 == error\n", argv[0]);
110 | 		WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars,
111 | 			&dwWritten, NULL);
112 | 		return 2;
113 | 	    }
114 | 	    return CheckForLinkerFeature(argv[2]);
115 | 	case 'f':
116 | 	    if (argc == 2) {
117 | 		chars = snprintf(msg, sizeof(msg) - 1,
118 | 			"usage: %s -f <string> <substring>\n"
119 | 			"Find a substring within another\n"
120 | 			"exitcodes: 0 == no, 1 == yes, 2 == error\n", argv[0]);
121 | 		WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars,
122 | 			&dwWritten, NULL);
123 | 		return 2;
124 | 	    } else if (argc == 3) {
125 | 		/*
126 | 		 * If the string is blank, there is no match.
127 | 		 */
128 | 
129 | 		return 0;
130 | 	    } else {
131 | 		return IsIn(argv[2], argv[3]);
132 | 	    }
133 | 	case 's':
134 | 	    if (argc == 2) {
135 | 		chars = snprintf(msg, sizeof(msg) - 1,
136 | 			"usage: %s -s <substitutions file> <file>\n"
137 | 			"Perform a set of string map type substutitions on a file\n"
138 | 			"exitcodes: 0\n",
139 | 			argv[0]);
140 | 		WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars,
141 | 			&dwWritten, NULL);
142 | 		return 2;
143 | 	    }
144 | 	    return SubstituteFile(argv[2], argv[3]);
145 | 	case 'V':
146 | 	    if (argc != 4) {
147 | 		chars = snprintf(msg, sizeof(msg) - 1,
148 | 		    "usage: %s -V filename matchstring\n"
149 | 		    "Extract a version from a file:\n"
150 | 		    "eg: pkgIndex.tcl \"package ifneeded http\"",
151 | 		    argv[0]);
152 | 		WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars,
153 | 		    &dwWritten, NULL);
154 | 		return 0;
155 | 	    }
156 | 	    printf("%s\n", GetVersionFromFile(argv[2], argv[3], *(argv[1]+2) - '0'));
157 | 	    return 0;
158 | 	case 'Q':
159 | 	    if (argc != 3) {
160 | 		chars = snprintf(msg, sizeof(msg) - 1,
161 | 		    "usage: %s -Q path\n"
162 | 		    "Emit the fully qualified path\n"
163 | 		    "exitcodes: 0 == no, 1 == yes, 2 == error\n", argv[0]);
164 | 		WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars,
165 | 		    &dwWritten, NULL);
166 | 		return 2;
167 | 	    }
168 | 	    return QualifyPath(argv[2]);
169 | 	}
170 |     }
171 |     chars = snprintf(msg, sizeof(msg) - 1,
172 | 	    "usage: %s -c|-f|-l|-Q|-s|-V ...\n"
173 | 	    "This is a little helper app to equalize shell differences between WinNT and\n"
174 | 	    "Win9x and get nmake.exe to accomplish its job.\n",
175 | 	    argv[0]);
176 |     WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars, &dwWritten, NULL);
177 |     return 2;
178 | }
179 | 
180 | static int
181 | CheckForCompilerFeature(
182 |     const char *option)
183 | {
184 |     STARTUPINFO si;
185 |     PROCESS_INFORMATION pi;
186 |     SECURITY_ATTRIBUTES sa;
187 |     DWORD threadID;
188 |     char msg[300];
189 |     BOOL ok;
190 |     HANDLE hProcess, h, pipeThreads[2];
191 |     char cmdline[100];
192 | 
193 |     hProcess = GetCurrentProcess();
194 | 
195 |     ZeroMemory(&pi, sizeof(PROCESS_INFORMATION));
196 |     ZeroMemory(&si, sizeof(STARTUPINFO));
197 |     si.cb = sizeof(STARTUPINFO);
198 |     si.dwFlags   = STARTF_USESTDHANDLES;
199 |     si.hStdInput = INVALID_HANDLE_VALUE;
200 | 
201 |     ZeroMemory(&sa, sizeof(SECURITY_ATTRIBUTES));
202 |     sa.nLength = sizeof(SECURITY_ATTRIBUTES);
203 |     sa.lpSecurityDescriptor = NULL;
204 |     sa.bInheritHandle = FALSE;
205 | 
206 |     /*
207 |      * Create a non-inheritible pipe.
208 |      */
209 | 
210 |     CreatePipe(&Out.pipe, &h, &sa, 0);
211 | 
212 |     /*
213 |      * Dupe the write side, make it inheritible, and close the original.
214 |      */
215 | 
216 |     DuplicateHandle(hProcess, h, hProcess, &si.hStdOutput, 0, TRUE,
217 | 	    DUPLICATE_SAME_ACCESS | DUPLICATE_CLOSE_SOURCE);
218 | 
219 |     /*
220 |      * Same as above, but for the error side.
221 |      */
222 | 
223 |     CreatePipe(&Err.pipe, &h, &sa, 0);
224 |     DuplicateHandle(hProcess, h, hProcess, &si.hStdError, 0, TRUE,
225 | 	    DUPLICATE_SAME_ACCESS | DUPLICATE_CLOSE_SOURCE);
226 | 
227 |     /*
228 |      * Base command line.
229 |      */
230 | 
231 |     lstrcpy(cmdline, "cl.exe -nologo -c -TC -Zs -X -Fp.\\_junk.pch ");
232 | 
233 |     /*
234 |      * Append our option for testing
235 |      */
236 | 
237 |     lstrcat(cmdline, option);
238 | 
239 |     /*
240 |      * Filename to compile, which exists, but is nothing and empty.
241 |      */
242 | 
243 |     lstrcat(cmdline, " .\\nul");
244 | 
245 |     ok = CreateProcess(
246 | 	    NULL,	    /* Module name. */
247 | 	    cmdline,	    /* Command line. */
248 | 	    NULL,	    /* Process handle not inheritable. */
249 | 	    NULL,	    /* Thread handle not inheritable. */
250 | 	    TRUE,	    /* yes, inherit handles. */
251 | 	    DETACHED_PROCESS, /* No console for you. */
252 | 	    NULL,	    /* Use parent's environment block. */
253 | 	    NULL,	    /* Use parent's starting directory. */
254 | 	    &si,	    /* Pointer to STARTUPINFO structure. */
255 | 	    &pi);	    /* Pointer to PROCESS_INFORMATION structure. */
256 | 
257 |     if (!ok) {
258 | 	DWORD err = GetLastError();
259 | 	int chars = snprintf(msg, sizeof(msg) - 1,
260 | 		"Tried to launch: \"%s\", but got error [%u]: ", cmdline, err);
261 | 
262 | 	FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM|FORMAT_MESSAGE_IGNORE_INSERTS|
263 | 		FORMAT_MESSAGE_MAX_WIDTH_MASK, 0L, err, 0, (LPVOID)&msg[chars],
264 | 		(300-chars), 0);
265 | 	WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, lstrlen(msg), &err,NULL);
266 | 	return 2;
267 |     }
268 | 
269 |     /*
270 |      * Close our references to the write handles that have now been inherited.
271 |      */
272 | 
273 |     CloseHandle(si.hStdOutput);
274 |     CloseHandle(si.hStdError);
275 | 
276 |     WaitForInputIdle(pi.hProcess, 5000);
277 |     CloseHandle(pi.hThread);
278 | 
279 |     /*
280 |      * Start the pipe reader threads.
281 |      */
282 | 
283 |     pipeThreads[0] = CreateThread(NULL, 0, ReadFromPipe, &Out, 0, &threadID);
284 |     pipeThreads[1] = CreateThread(NULL, 0, ReadFromPipe, &Err, 0, &threadID);
285 | 
286 |     /*
287 |      * Block waiting for the process to end.
288 |      */
289 | 
290 |     WaitForSingleObject(pi.hProcess, INFINITE);
291 |     CloseHandle(pi.hProcess);
292 | 
293 |     /*
294 |      * Wait for our pipe to get done reading, should it be a little slow.
295 |      */
296 | 
297 |     WaitForMultipleObjects(2, pipeThreads, TRUE, 500);
298 |     CloseHandle(pipeThreads[0]);
299 |     CloseHandle(pipeThreads[1]);
300 | 
301 |     /*
302 |      * Look for the commandline warning code in both streams.
303 |      *  - in MSVC 6 & 7 we get D4002, in MSVC 8 we get D9002.
304 |      */
305 | 
306 |     return !(strstr(Out.buffer, "D4002") != NULL
307 |              || strstr(Err.buffer, "D4002") != NULL
308 |              || strstr(Out.buffer, "D9002") != NULL
309 |              || strstr(Err.buffer, "D9002") != NULL
310 |              || strstr(Out.buffer, "D2021") != NULL
311 |              || strstr(Err.buffer, "D2021") != NULL);
312 | }
313 | 
314 | static int
315 | CheckForLinkerFeature(
316 |     const char *option)
317 | {
318 |     STARTUPINFO si;
319 |     PROCESS_INFORMATION pi;
320 |     SECURITY_ATTRIBUTES sa;
321 |     DWORD threadID;
322 |     char msg[300];
323 |     BOOL ok;
324 |     HANDLE hProcess, h, pipeThreads[2];
325 |     char cmdline[100];
326 | 
327 |     hProcess = GetCurrentProcess();
328 | 
329 |     ZeroMemory(&pi, sizeof(PROCESS_INFORMATION));
330 |     ZeroMemory(&si, sizeof(STARTUPINFO));
331 |     si.cb = sizeof(STARTUPINFO);
332 |     si.dwFlags   = STARTF_USESTDHANDLES;
333 |     si.hStdInput = INVALID_HANDLE_VALUE;
334 | 
335 |     ZeroMemory(&sa, sizeof(SECURITY_ATTRIBUTES));
336 |     sa.nLength = sizeof(SECURITY_ATTRIBUTES);
337 |     sa.lpSecurityDescriptor = NULL;
338 |     sa.bInheritHandle = TRUE;
339 | 
340 |     /*
341 |      * Create a non-inheritible pipe.
342 |      */
343 | 
344 |     CreatePipe(&Out.pipe, &h, &sa, 0);
345 | 
346 |     /*
347 |      * Dupe the write side, make it inheritible, and close the original.
348 |      */
349 | 
350 |     DuplicateHandle(hProcess, h, hProcess, &si.hStdOutput, 0, TRUE,
351 | 	    DUPLICATE_SAME_ACCESS | DUPLICATE_CLOSE_SOURCE);
352 | 
353 |     /*
354 |      * Same as above, but for the error side.
355 |      */
356 | 
357 |     CreatePipe(&Err.pipe, &h, &sa, 0);
358 |     DuplicateHandle(hProcess, h, hProcess, &si.hStdError, 0, TRUE,
359 | 	    DUPLICATE_SAME_ACCESS | DUPLICATE_CLOSE_SOURCE);
360 | 
361 |     /*
362 |      * Base command line.
363 |      */
364 | 
365 |     lstrcpy(cmdline, "link.exe -nologo ");
366 | 
367 |     /*
368 |      * Append our option for testing.
369 |      */
370 | 
371 |     lstrcat(cmdline, option);
372 | 
373 |     ok = CreateProcess(
374 | 	    NULL,	    /* Module name. */
375 | 	    cmdline,	    /* Command line. */
376 | 	    NULL,	    /* Process handle not inheritable. */
377 | 	    NULL,	    /* Thread handle not inheritable. */
378 | 	    TRUE,	    /* yes, inherit handles. */
379 | 	    DETACHED_PROCESS, /* No console for you. */
380 | 	    NULL,	    /* Use parent's environment block. */
381 | 	    NULL,	    /* Use parent's starting directory. */
382 | 	    &si,	    /* Pointer to STARTUPINFO structure. */
383 | 	    &pi);	    /* Pointer to PROCESS_INFORMATION structure. */
384 | 
385 |     if (!ok) {
386 | 	DWORD err = GetLastError();
387 | 	int chars = snprintf(msg, sizeof(msg) - 1,
388 | 		"Tried to launch: \"%s\", but got error [%u]: ", cmdline, err);
389 | 
390 | 	FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM|FORMAT_MESSAGE_IGNORE_INSERTS|
391 | 		FORMAT_MESSAGE_MAX_WIDTH_MASK, 0L, err, 0, (LPVOID)&msg[chars],
392 | 		(300-chars), 0);
393 | 	WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, lstrlen(msg), &err,NULL);
394 | 	return 2;
395 |     }
396 | 
397 |     /*
398 |      * Close our references to the write handles that have now been inherited.
399 |      */
400 | 
401 |     CloseHandle(si.hStdOutput);
402 |     CloseHandle(si.hStdError);
403 | 
404 |     WaitForInputIdle(pi.hProcess, 5000);
405 |     CloseHandle(pi.hThread);
406 | 
407 |     /*
408 |      * Start the pipe reader threads.
409 |      */
410 | 
411 |     pipeThreads[0] = CreateThread(NULL, 0, ReadFromPipe, &Out, 0, &threadID);
412 |     pipeThreads[1] = CreateThread(NULL, 0, ReadFromPipe, &Err, 0, &threadID);
413 | 
414 |     /*
415 |      * Block waiting for the process to end.
416 |      */
417 | 
418 |     WaitForSingleObject(pi.hProcess, INFINITE);
419 |     CloseHandle(pi.hProcess);
420 | 
421 |     /*
422 |      * Wait for our pipe to get done reading, should it be a little slow.
423 |      */
424 | 
425 |     WaitForMultipleObjects(2, pipeThreads, TRUE, 500);
426 |     CloseHandle(pipeThreads[0]);
427 |     CloseHandle(pipeThreads[1]);
428 | 
429 |     /*
430 |      * Look for the commandline warning code in the stderr stream.
431 |      */
432 | 
433 |     return !(strstr(Out.buffer, "LNK1117") != NULL ||
434 | 	    strstr(Err.buffer, "LNK1117") != NULL ||
435 | 	    strstr(Out.buffer, "LNK4044") != NULL ||
436 | 	    strstr(Err.buffer, "LNK4044") != NULL);
437 | }
438 | 
439 | static DWORD WINAPI
440 | ReadFromPipe(
441 |     LPVOID args)
442 | {
443 |     pipeinfo *pi = (pipeinfo *) args;
444 |     char *lastBuf = pi->buffer;
445 |     DWORD dwRead;
446 |     BOOL ok;
447 | 
448 |   again:
449 |     if (lastBuf - pi->buffer + CHUNK > STATICBUFFERSIZE) {
450 | 	CloseHandle(pi->pipe);
451 | 	return (DWORD)-1;
452 |     }
453 |     ok = ReadFile(pi->pipe, lastBuf, CHUNK, &dwRead, 0L);
454 |     if (!ok || dwRead == 0) {
455 | 	CloseHandle(pi->pipe);
456 | 	return 0;
457 |     }
458 |     lastBuf += dwRead;
459 |     goto again;
460 | 
461 |     return 0;  /* makes the compiler happy */
462 | }
463 | 
464 | static int
465 | IsIn(
466 |     const char *string,
467 |     const char *substring)
468 | {
469 |     return (strstr(string, substring) != NULL);
470 | }
471 | 
472 | /*
473 |  * GetVersionFromFile --
474 |  * 	Looks for a match string in a file and then returns the version
475 |  * 	following the match where a version is anything acceptable to
476 |  * 	package provide or package ifneeded.
477 |  */
478 | 
479 | static const char *
480 | GetVersionFromFile(
481 |     const char *filename,
482 |     const char *match,
483 |     int numdots)
484 | {
485 |     size_t cbBuffer = 100;
486 |     static char szBuffer[100];
487 |     char *szResult = NULL;
488 |     FILE *fp = fopen(filename, "rt");
489 | 
490 |     if (fp != NULL) {
491 | 	/*
492 | 	 * Read data until we see our match string.
493 | 	 */
494 | 
495 | 	while (fgets(szBuffer, cbBuffer, fp) != NULL) {
496 | 	    LPSTR p, q;
497 | 
498 | 	    p = strstr(szBuffer, match);
499 | 	    if (p != NULL) {
500 | 		/*
501 | 		 * Skip to first digit after the match.
502 | 		 */
503 | 
504 | 		p += strlen(match);
505 | 		while (*p && !isdigit(*p)) {
506 | 		    ++p;
507 | 		}
508 | 
509 | 		/*
510 | 		 * Find ending whitespace.
511 | 		 */
512 | 
513 | 		q = p;
514 | 		while (*q && (strchr("0123456789.ab", *q)) && ((!strchr(".ab", *q)
515 | 			    && (!strchr("ab", q[-1])) || --numdots))) {
516 | 		    ++q;
517 | 		}
518 | 
519 | 		memcpy(szBuffer, p, q - p);
520 | 		szBuffer[q-p] = 0;
521 | 		szResult = szBuffer;
522 | 		break;
523 | 	    }
524 | 	}
525 | 	fclose(fp);
526 |     }
527 |     return szResult;
528 | }
529 | 
530 | /*
531 |  * List helpers for the SubstituteFile function
532 |  */
533 | 
534 | typedef struct list_item_t {
535 |     struct list_item_t *nextPtr;
536 |     char * key;
537 |     char * value;
538 | } list_item_t;
539 | 
540 | /* insert a list item into the list (list may be null) */
541 | static list_item_t *
542 | list_insert(list_item_t **listPtrPtr, const char *key, const char *value)
543 | {
544 |     list_item_t *itemPtr = malloc(sizeof(list_item_t));
545 |     if (itemPtr) {
546 | 	itemPtr->key = strdup(key);
547 | 	itemPtr->value = strdup(value);
548 | 	itemPtr->nextPtr = NULL;
549 | 
550 | 	while(*listPtrPtr) {
551 | 	    listPtrPtr = &(*listPtrPtr)->nextPtr;
552 | 	}
553 | 	*listPtrPtr = itemPtr;
554 |     }
555 |     return itemPtr;
556 | }
557 | 
558 | static void
559 | list_free(list_item_t **listPtrPtr)
560 | {
561 |     list_item_t *tmpPtr, *listPtr = *listPtrPtr;
562 |     while (listPtr) {
563 | 	tmpPtr = listPtr;
564 | 	listPtr = listPtr->nextPtr;
565 | 	free(tmpPtr->key);
566 | 	free(tmpPtr->value);
567 | 	free(tmpPtr);
568 |     }
569 | }
570 | 
571 | /*
572 |  * SubstituteFile --
573 |  *	As windows doesn't provide anything useful like sed and it's unreliable
574 |  *	to use the tclsh you are building against (consider x-platform builds -
575 |  *	eg compiling AMD64 target from IX86) we provide a simple substitution
576 |  *	option here to handle autoconf style substitutions.
577 |  *	The substitution file is whitespace and line delimited. The file should
578 |  *	consist of lines matching the regular expression:
579 |  *	  \s*\S+\s+\S*$
580 |  *
581 |  *	Usage is something like:
582 |  *	  nmakehlp -S << $** > $@
583 |  *        @PACKAGE_NAME@ $(PACKAGE_NAME)
584 |  *        @PACKAGE_VERSION@ $(PACKAGE_VERSION)
585 |  *        <<
586 |  */
587 | 
588 | static int
589 | SubstituteFile(
590 |     const char *substitutions,
591 |     const char *filename)
592 | {
593 |     size_t cbBuffer = 1024;
594 |     static char szBuffer[1024], szCopy[1024];
595 |     char *szResult = NULL;
596 |     list_item_t *substPtr = NULL;
597 |     FILE *fp, *sp;
598 | 
599 |     fp = fopen(filename, "rt");
600 |     if (fp != NULL) {
601 | 
602 | 	/*
603 | 	 * Build a list of substutitions from the first filename
604 | 	 */
605 | 
606 | 	sp = fopen(substitutions, "rt");
607 | 	if (sp != NULL) {
608 | 	    while (fgets(szBuffer, cbBuffer, sp) != NULL) {
609 | 		unsigned char *ks, *ke, *vs, *ve;
610 | 		ks = (unsigned char*)szBuffer;
611 | 		while (ks && *ks && isspace(*ks)) ++ks;
612 | 		ke = ks;
613 | 		while (ke && *ke && !isspace(*ke)) ++ke;
614 | 		vs = ke;
615 | 		while (vs && *vs && isspace(*vs)) ++vs;
616 | 		ve = vs;
617 | 		while (ve && *ve && !(*ve == '\r' || *ve == '\n')) ++ve;
618 | 		*ke = 0, *ve = 0;
619 | 		list_insert(&substPtr, (char*)ks, (char*)vs);
620 | 	    }
621 | 	    fclose(sp);
622 | 	}
623 | 
624 | 	/* debug: dump the list */
625 | #ifdef _DEBUG
626 | 	{
627 | 	    int n = 0;
628 | 	    list_item_t *p = NULL;
629 | 	    for (p = substPtr; p != NULL; p = p->nextPtr, ++n) {
630 | 		fprintf(stderr, "% 3d '%s' => '%s'\n", n, p->key, p->value);
631 | 	    }
632 | 	}
633 | #endif
634 | 
635 | 	/*
636 | 	 * Run the substitutions over each line of the input
637 | 	 */
638 | 
639 | 	while (fgets(szBuffer, cbBuffer, fp) != NULL) {
640 | 	    list_item_t *p = NULL;
641 | 	    for (p = substPtr; p != NULL; p = p->nextPtr) {
642 | 		char *m = strstr(szBuffer, p->key);
643 | 		if (m) {
644 | 		    char *cp, *op, *sp;
645 | 		    cp = szCopy;
646 | 		    op = szBuffer;
647 | 		    while (op != m) *cp++ = *op++;
648 | 		    sp = p->value;
649 | 		    while (sp && *sp) *cp++ = *sp++;
650 | 		    op += strlen(p->key);
651 | 		    while (*op) *cp++ = *op++;
652 | 		    *cp = 0;
653 | 		    memcpy(szBuffer, szCopy, sizeof(szCopy));
654 | 		}
655 | 	    }
656 | 	    printf(szBuffer);
657 | 	}
658 | 
659 | 	list_free(&substPtr);
660 |     }
661 |     fclose(fp);
662 |     return 0;
663 | }
664 | 
665 | /*
666 |  * QualifyPath --
667 |  *
668 |  *	This composes the current working directory with a provided path
669 |  *	and returns the fully qualified and normalized path.
670 |  *	Mostly needed to setup paths for testing.
671 |  */
672 | 
673 | static int
674 | QualifyPath(
675 |     const char *szPath)
676 | {
677 |     char szCwd[MAX_PATH + 1];
678 |     char szTmp[MAX_PATH + 1];
679 |     char *p;
680 |     GetCurrentDirectory(MAX_PATH, szCwd);
681 |     while ((p = strchr(szPath, '/')) && *p)
682 | 	*p = '\\';
683 |     PathCombine(szTmp, szCwd, szPath);
684 |     PathCanonicalize(szCwd, szTmp);
685 |     printf("%s\n", szCwd);
686 |     return 0;
687 | }
688 | 
689 | /*
690 |  * Local variables:
691 |  *   mode: c
692 |  *   c-basic-offset: 4
693 |  *   fill-column: 78
694 |  *   indent-tabs-mode: t
695 |  *   tab-width: 8
696 |  * End:
697 |  */
698 | 


--------------------------------------------------------------------------------
/generic/tclDate.h:
--------------------------------------------------------------------------------
  1 | /*
  2 |  * tclDate.h --
  3 |  *
  4 |  *	This header file handles common usage of clock primitives
  5 |  *	between tclDate.c (yacc), tclClock.c and tclClockFmt.c.
  6 |  *
  7 |  * Copyright (c) 2014 Serg G. Brester (aka sebres)
  8 |  *
  9 |  * See the file "license.terms" for information on usage and redistribution
 10 |  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 11 |  */
 12 | 
 13 | #ifndef _TCLCLOCK_H
 14 | #define _TCLCLOCK_H
 15 | 
 16 | /* Internals compatibilities (tclInt.h) - remove after merge to core */
 17 | #include "tclClockModInt.h"
 18 | #if !TCL_AVAIL_SBMOD
 19 | MODULE_SCOPE Tcl_Obj * Tcl_DictObjSmartRef(Tcl_Interp *interp, Tcl_Obj *dictPtr);
 20 | #ifdef TclListObjGetElements
 21 | #  undef TclListObjGetElements
 22 | #endif
 23 | #  define TclListObjGetElements Tcl_ListObjGetElements
 24 | #ifdef TclGetIntFromObj
 25 | #  undef TclGetIntFromObj
 26 | #endif
 27 | #  define TclGetIntFromObj Tcl_GetIntFromObj
 28 | #ifdef TclGetWideIntFromObj
 29 | #  undef TclGetWideIntFromObj
 30 | #endif
 31 | #  define TclGetWideIntFromObj Tcl_GetWideIntFromObj
 32 | MODULE_SCOPE const Tcl_ObjType* tclIntTypePtr;
 33 | MODULE_SCOPE const Tcl_ObjType* tclWideIntTypePtr;
 34 | MODULE_SCOPE const Tcl_ObjType* tclBignumTypePtr;
 35 | MODULE_SCOPE const Tcl_ObjType* tclListTypePtr;
 36 | 
 37 | /* for tcl-versions before 8.6.7 (without compiled clock seconds/clicks) */
 38 | MODULE_SCOPE int TclCompileClockClicksCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, 
 39 |     struct Command *cmdPtr, struct CompileEnv *compEnvPtr);
 40 | MODULE_SCOPE int TclCompileClockReadingCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, 
 41 |     struct Command *cmdPtr, struct CompileEnv *compEnvPtr);
 42 | 
 43 | MODULE_SCOPE size_t TclEnvEpoch;        /* Epoch of the tcl environment
 44 |                                          * (if changed with tcl-env). */
 45 | 
 46 | #else
 47 | 
 48 | #define tclIntTypePtr     (&tclIntType)
 49 | #define tclWideIntTypePtr (&tclWideIntType)
 50 | #define tclBignumTypePtr  (&tclBignumType)
 51 | #define tclListTypePtr    (&tclListType)
 52 | 
 53 | #endif /* TCL_AVAIL_SBMOD */
 54 | 
 55 | /*
 56 |  * Constants
 57 |  */
 58 | 
 59 | #define JULIAN_DAY_POSIX_EPOCH		2440588
 60 | #define GREGORIAN_CHANGE_DATE		2361222
 61 | #define SECONDS_PER_DAY			86400
 62 | #define JULIAN_SEC_POSIX_EPOCH	      (((Tcl_WideInt) JULIAN_DAY_POSIX_EPOCH) \
 63 | 					* SECONDS_PER_DAY)
 64 | #define FOUR_CENTURIES			146097	/* days */
 65 | #define JDAY_1_JAN_1_CE_JULIAN		1721424
 66 | #define JDAY_1_JAN_1_CE_GREGORIAN	1721426
 67 | #define ONE_CENTURY_GREGORIAN		36524	/* days */
 68 | #define FOUR_YEARS			1461	/* days */
 69 | #define ONE_YEAR			365	/* days */
 70 | 
 71 | #define RODDENBERRY			1946	/* Another epoch (Hi, Jeff!) */
 72 | 
 73 | 
 74 | #define CLF_OPTIONAL	       (1 << 0) /* token is non mandatory */
 75 | #define CLF_POSIXSEC	       (1 << 1)
 76 | #define CLF_LOCALSEC	       (1 << 2)
 77 | #define CLF_JULIANDAY	       (1 << 3)
 78 | #define CLF_TIME	       (1 << 4)
 79 | #define CLF_ZONE	       (1 << 5)
 80 | #define CLF_CENTURY	       (1 << 6)
 81 | #define CLF_DAYOFMONTH	       (1 << 7)
 82 | #define CLF_DAYOFYEAR	       (1 << 8)
 83 | #define CLF_MONTH	       (1 << 9)
 84 | #define CLF_YEAR	       (1 << 10)
 85 | #define CLF_DAYOFWEEK	       (1 << 11)
 86 | #define CLF_ISO8601YEAR	       (1 << 12)
 87 | #define CLF_ISO8601WEEK	       (1 << 13)
 88 | #define CLF_ISO8601CENTURY     (1 << 14)
 89 | 
 90 | #define CLF_SIGNED	       (1 << 15)
 91 | 
 92 | /* extra flags used outside of scan/format-tokens too (int, not a short int) */
 93 | #define CLF_RELCONV	       (1 << 17)
 94 | #define CLF_ORDINALMONTH       (1 << 18)
 95 | #define CLF_TREK	       (1 << 19)
 96 | 
 97 | /* On demand (lazy) assemble flags */
 98 | #define CLF_ASSEMBLE_DATE      (1 << 28) /* assemble year, month, etc. using julianDay */
 99 | #define CLF_ASSEMBLE_JULIANDAY (1 << 29) /* assemble julianDay using year, month, etc. */
100 | #define CLF_ASSEMBLE_SECONDS   (1 << 30) /* assemble localSeconds (and seconds at end) */
101 | 
102 | #define CLF_HAVEDATE	       (CLF_DAYOFMONTH|CLF_MONTH|CLF_YEAR)
103 | #define CLF_DATE	       (CLF_JULIANDAY | CLF_DAYOFMONTH | CLF_DAYOFYEAR | \
104 | 				CLF_MONTH | CLF_YEAR | CLF_ISO8601YEAR | \
105 | 				CLF_DAYOFWEEK | CLF_ISO8601WEEK)
106 | 
107 | #define TCL_MIN_SECONDS			-0x00F0000000000000L
108 | #define TCL_MAX_SECONDS			 0x00F0000000000000L
109 | #define TCL_INV_SECONDS			(TCL_MIN_SECONDS-1)
110 | 
111 | /*
112 |  * Enumeration of the string literals used in [clock]
113 |  */
114 | 
115 | typedef enum ClockLiteral {
116 |     LIT__NIL,
117 |     LIT__DEFAULT_FORMAT,
118 |     LIT_SYSTEM,		LIT_CURRENT,		LIT_C,
119 |     LIT_BCE,		LIT_CE,
120 |     LIT_DAYOFMONTH,	LIT_DAYOFWEEK,		LIT_DAYOFYEAR,
121 |     LIT_ERA,		LIT_GMT,		LIT_GREGORIAN,
122 |     LIT_INTEGER_VALUE_TOO_LARGE,
123 |     LIT_ISO8601WEEK,	LIT_ISO8601YEAR,
124 |     LIT_JULIANDAY,	LIT_LOCALSECONDS,
125 |     LIT_MONTH,
126 |     LIT_SECONDS,	LIT_TZNAME,		LIT_TZOFFSET,
127 |     LIT_YEAR,
128 |     LIT_TZDATA,
129 |     LIT_GETSYSTEMTIMEZONE,
130 |     LIT_SETUPTIMEZONE,
131 |     LIT_MCGET,
132 |     LIT_GETSYSTEMLOCALE, LIT_GETCURRENTLOCALE,
133 |     LIT_LOCALIZE_FORMAT,
134 |     LIT__END
135 | } ClockLiteral;
136 | 
137 | #define CLOCK_LITERAL_ARRAY(litarr) static const char *const litarr[] = { \
138 |     "", \
139 |     "%a %b %d %H:%M:%S %Z %Y", \
140 |     "system",		"current",		"C", \
141 |     "BCE",		"CE", \
142 |     "dayOfMonth",	"dayOfWeek",		"dayOfYear", \
143 |     "era",		":GMT",			"gregorian", \
144 |     "integer value too large to represent", \
145 |     "iso8601Week",	"iso8601Year", \
146 |     "julianDay",	"localSeconds", \
147 |     "month", \
148 |     "seconds",		"tzName",		"tzOffset", \
149 |     "year", \
150 |     "::tcl::clock::TZData", \
151 |     "::tcl::clock::GetSystemTimeZone", \
152 |     "::tcl::clock::SetupTimeZone", \
153 |     "::tcl::clock::mcget", \
154 |     "::tcl::clock::GetSystemLocale", "::tcl::clock::mclocale", \
155 |     "::tcl::clock::LocalizeFormat" \
156 | }
157 | 
158 | /*
159 |  * Enumeration of the msgcat literals used in [clock]
160 |  */
161 | 
162 | typedef enum ClockMsgCtLiteral {
163 |     MCLIT__NIL, /* placeholder */
164 |     MCLIT_MONTHS_FULL,	MCLIT_MONTHS_ABBREV,  MCLIT_MONTHS_COMB,
165 |     MCLIT_DAYS_OF_WEEK_FULL,  MCLIT_DAYS_OF_WEEK_ABBREV,  MCLIT_DAYS_OF_WEEK_COMB,
166 |     MCLIT_AM,  MCLIT_PM,
167 |     MCLIT_LOCALE_ERAS,
168 |     MCLIT_BCE,	 MCLIT_CE,
169 |     MCLIT_BCE2,	 MCLIT_CE2,
170 |     MCLIT_BCE3,	 MCLIT_CE3,
171 |     MCLIT_LOCALE_NUMERALS,
172 |     MCLIT__END
173 | } ClockMsgCtLiteral;
174 | 
175 | #define CLOCK_LOCALE_LITERAL_ARRAY(litarr, pref) static const char *const litarr[] = { \
176 |     pref "", \
177 |     pref "MONTHS_FULL", pref "MONTHS_ABBREV", pref "MONTHS_COMB", \
178 |     pref "DAYS_OF_WEEK_FULL", pref "DAYS_OF_WEEK_ABBREV", pref "DAYS_OF_WEEK_COMB", \
179 |     pref "AM", pref "PM", \
180 |     pref "LOCALE_ERAS", \
181 |     pref "BCE",	   pref "CE", \
182 |     pref "b.c.e.", pref "c.e.", \
183 |     pref "b.c.",   pref "a.d.", \
184 |     pref "LOCALE_NUMERALS", \
185 | }
186 | 
187 | /*
188 |  * Structure containing the fields used in [clock format] and [clock scan]
189 |  */
190 | 
191 | #define CLF_BCE    (1 << 1)
192 | 				/* set if BCE */
193 | #define CLF_BGREG  (1 << 2)
194 | 				/* set if the date is before Gregorian (Julian yet) */
195 | #define CLF_CTZ    (1 << 4)
196 | 				/* (special) revalidate TZ epoch next time used */
197 | 
198 | typedef struct TclDateFields {
199 | 
200 |     /* Cacheable fields:	 */
201 | 
202 |     Tcl_WideInt seconds;	/* Time expressed in seconds from the Posix
203 | 				 * epoch */
204 |     Tcl_WideInt localSeconds;	/* Local time expressed in nominal seconds
205 | 				 * from the Posix epoch */
206 |     int tzOffset;		/* Time zone offset in seconds east of
207 | 				 * Greenwich */
208 |     Tcl_WideInt julianDay;	/* Julian Day Number in local time zone */
209 |     int year;			/* Year of the era */
210 |     int dayOfYear;		/* Day of the year (1 January == 1) */
211 |     int month;			/* Month number */
212 |     int dayOfMonth;		/* Day of the month */
213 |     int iso8601Year;		/* ISO8601 week-based year */
214 |     int iso8601Week;		/* ISO8601 week number */
215 |     int dayOfWeek;		/* Day of the week */
216 |     int hour;			/* Hours of day (in-between time only calculation) */
217 |     int minutes;		/* Minutes of hour (in-between time only calculation) */
218 |     Tcl_WideInt secondOfMin;	/* Seconds of minute (in-between time only calculation) */
219 |     Tcl_WideInt secondOfDay;	/* Seconds of day (in-between time only calculation) */
220 | 
221 |     int flags;			/* 0 or combination of CLF_-flags from above (CLF_BCE, etc). */
222 | 
223 |     /* Non cacheable fields:	 */
224 | 
225 |     Tcl_Obj *tzName;		/* Name (or corresponding DST-abbreviation) of the
226 | 				 * time zone, if set the refCount is incremented */
227 | } TclDateFields;
228 | 
229 | #define ClockCacheableDateFieldsSize \
230 |     TclOffset(TclDateFields, tzName)
231 | 
232 | /*
233 |  * Structure contains return parsed fields.
234 |  */
235 | 
236 | typedef struct DateInfo {
237 |     const char *dateStart;
238 |     const char *dateInput;
239 |     const char *dateEnd;
240 | 
241 |     TclDateFields date;
242 | 
243 |     int		flags;		/* Signals parts of date/time get found */
244 |     int		errFlags;	/* Signals error (part of date/time found twice) */
245 | 
246 |     int dateMeridian;
247 | 
248 |     int dateTimezone;
249 |     int dateDSTmode;
250 | 
251 |     Tcl_WideInt dateRelMonth;
252 |     Tcl_WideInt dateRelDay;
253 |     Tcl_WideInt dateRelSeconds;
254 | 
255 |     int dateMonthOrdinalIncr;
256 |     int dateMonthOrdinal;
257 | 
258 |     int dateDayOrdinal;
259 | 
260 |     Tcl_WideInt *dateRelPointer;
261 | 
262 |     int dateSpaceCount;
263 |     int dateDigitCount;
264 | 
265 |     int dateCentury;
266 | 
267 |     Tcl_Obj* messages;	    /* Error messages */
268 |     const char* separatrix; /* String separating messages */
269 | } DateInfo;
270 | 
271 | #define yydate	    (info->date)  /* Date fields used for converting */
272 | 
273 | #define yyDay	    (info->date.dayOfMonth)
274 | #define yyMonth	    (info->date.month)
275 | #define yyYear	    (info->date.year)
276 | 
277 | #define yyHour	    (info->date.hour)
278 | #define yyMinutes   (info->date.minutes)
279 | #define yySeconds   (info->date.secondOfMin)
280 | #define yySecondOfDay (info->date.secondOfDay)
281 | 
282 | #define yyDSTmode   (info->dateDSTmode)
283 | #define yyDayOrdinal	(info->dateDayOrdinal)
284 | #define yyDayOfWeek (info->date.dayOfWeek)
285 | #define yyMonthOrdinalIncr  (info->dateMonthOrdinalIncr)
286 | #define yyMonthOrdinal	(info->dateMonthOrdinal)
287 | #define yyTimezone  (info->dateTimezone)
288 | #define yyMeridian  (info->dateMeridian)
289 | #define yyRelMonth  (info->dateRelMonth)
290 | #define yyRelDay    (info->dateRelDay)
291 | #define yyRelSeconds	(info->dateRelSeconds)
292 | #define yyRelPointer	(info->dateRelPointer)
293 | #define yyInput	    (info->dateInput)
294 | #define yyDigitCount	(info->dateDigitCount)
295 | #define yySpaceCount	(info->dateSpaceCount)
296 | 
297 | static inline void
298 | ClockInitDateInfo(DateInfo *info) {
299 |     memset(info, 0, sizeof(DateInfo));
300 | }
301 | 
302 | /*
303 |  * Structure containing the command arguments supplied to [clock format] and [clock scan]
304 |  */
305 | 
306 | #define CLF_VALIDATE_S1	(1 << 0)
307 | #define CLF_VALIDATE_S2	(1 << 1)
308 | #define CLF_VALIDATE	(CLF_VALIDATE_S1|CLF_VALIDATE_S2)
309 | #define CLF_EXTENDED	(1 << 4)
310 | #define CLF_STRICT	(1 << 8)
311 | #define CLF_LOCALE_USED (1 << 15)
312 | 
313 | typedef struct ClockFmtScnCmdArgs {
314 |     ClientData clientData;  /* Opaque pointer to literal pool, etc. */
315 |     Tcl_Interp *interp;	    /* Tcl interpreter */
316 | 
317 |     Tcl_Obj *formatObj;	    /* Format */
318 |     Tcl_Obj *localeObj;	    /* Name of the locale where the time will be expressed. */
319 |     Tcl_Obj *timezoneObj;   /* Default time zone in which the time will be expressed */
320 |     Tcl_Obj *baseObj;	    /* Base (scan and add) or clockValue (format) */
321 |     int	     flags;	    /* Flags control scanning */
322 | 
323 |     Tcl_Obj *mcDictObj;	    /* Current dictionary of tcl::clock package for given localeObj*/
324 | } ClockFmtScnCmdArgs;
325 | 
326 | /* Last-period cache for fast UTC to local and backwards conversion */
327 | typedef struct ClockLastTZOffs {
328 |     /* keys */
329 |     Tcl_Obj    *timezoneObj;
330 |     int		changeover;
331 |     Tcl_WideInt localSeconds;
332 |     Tcl_WideInt rangesVal[2];   /* Bounds for cached time zone offset */
333 |     /* values */
334 |     int		tzOffset;
335 |     Tcl_Obj    *tzName;		/* Name (abbreviation) of this area in TZ */
336 | } ClockLastTZOffs;
337 | 
338 | /*
339 |  * Structure containing the client data for [clock]
340 |  */
341 | 
342 | typedef struct ClockClientData {
343 |     size_t    refCount;		/* Number of live references. */
344 |     Tcl_Obj **literals;		/* Pool of object literals (common, locale independent). */
345 |     Tcl_Obj **mcLiterals;	/* Msgcat object literals with mc-keys for search with locale. */
346 |     Tcl_Obj **mcLitIdxs;	/* Msgcat object indices prefixed with _IDX_,
347 | 				 * used for quick dictionary search */
348 | 
349 |     Tcl_Obj *mcDicts;		/* Msgcat collection, contains weak pointers to locale
350 | 				 * catalogs, and owns it references (onetime referenced) */
351 | 
352 |     /* Cache for current clock parameters, imparted via "configure" */
353 |     size_t lastTZEpoch;
354 |     int currentYearCentury;
355 |     int yearOfCenturySwitch;
356 |     int validMinYear;
357 |     int validMaxYear;
358 |     double maxJDN;
359 | 
360 |     Tcl_Obj *systemTimeZone;
361 |     Tcl_Obj *systemSetupTZData;
362 |     Tcl_Obj *gmtSetupTimeZoneUnnorm;
363 |     Tcl_Obj *gmtSetupTimeZone;
364 |     Tcl_Obj *gmtSetupTZData;
365 |     Tcl_Obj *gmtTZName;
366 |     Tcl_Obj *lastSetupTimeZoneUnnorm;
367 |     Tcl_Obj *lastSetupTimeZone;
368 |     Tcl_Obj *lastSetupTZData;
369 |     Tcl_Obj *prevSetupTimeZoneUnnorm;
370 |     Tcl_Obj *prevSetupTimeZone;
371 |     Tcl_Obj *prevSetupTZData;
372 |     
373 |     Tcl_Obj *defaultLocale;
374 |     Tcl_Obj *defaultLocaleDict;
375 |     Tcl_Obj *currentLocale;
376 |     Tcl_Obj *currentLocaleDict;
377 |     Tcl_Obj *lastUsedLocaleUnnorm;
378 |     Tcl_Obj *lastUsedLocale;
379 |     Tcl_Obj *lastUsedLocaleDict;
380 |     Tcl_Obj *prevUsedLocaleUnnorm;
381 |     Tcl_Obj *prevUsedLocale;
382 |     Tcl_Obj *prevUsedLocaleDict;
383 | 
384 |     /* Cache for last base (last-second fast convert if base/tz not changed) */
385 |     struct {
386 | 	Tcl_Obj *timezoneObj;
387 | 	TclDateFields date;
388 |     } lastBase;
389 | 
390 |     /* Last-period cache for fast UTC to Local and backwards conversion */
391 |     ClockLastTZOffs lastTZOffsCache[2];
392 | 
393 |     int defFlags;		    /* Default flags (from configure), ATM
394 | 				     * only CLF_VALIDATE supported */
395 | } ClockClientData;
396 | 
397 | #define ClockDefaultYearCentury 2000
398 | #define ClockDefaultCenturySwitch 38
399 | 
400 | /*
401 |  * Meridian: am, pm, or 24-hour style.
402 |  */
403 | 
404 | typedef enum _MERIDIAN {
405 |     MERam, MERpm, MER24
406 | } MERIDIAN;
407 | 
408 | /*
409 |  * Clock scan and format facilities.
410 |  */
411 | 
412 | #define CLOCK_FMT_SCN_STORAGE_GC_SIZE 32
413 | 
414 | #define CLOCK_MIN_TOK_CHAIN_BLOCK_SIZE 2
415 | 
416 | typedef struct ClockScanToken ClockScanToken;
417 | 
418 | 
419 | typedef int ClockScanTokenProc(
420 | 	ClockFmtScnCmdArgs *opts,
421 | 	DateInfo *info,
422 | 	ClockScanToken *tok);
423 | 
424 | 
425 | typedef enum _CLCKTOK_TYPE {
426 |    CTOKT_INT = 1, CTOKT_WIDE, CTOKT_PARSER, CTOKT_SPACE, CTOKT_WORD, CTOKT_CHAR,
427 |    CFMTT_PROC
428 | } CLCKTOK_TYPE;
429 | 
430 | typedef struct ClockScanTokenMap {
431 |     unsigned short int	type;
432 |     unsigned short int	flags;
433 |     unsigned short int	clearFlags;
434 |     unsigned short int	minSize;
435 |     unsigned short int	maxSize;
436 |     unsigned short int	offs;
437 |     ClockScanTokenProc *parser;
438 |     const void	       *data;
439 | } ClockScanTokenMap;
440 | 
441 | struct ClockScanToken {
442 |     ClockScanTokenMap  *map;
443 |     struct {
444 | 	const char *start;
445 | 	const char *end;
446 |     } tokWord;
447 |     unsigned short int	endDistance;
448 |     unsigned short int	lookAhMin;
449 |     unsigned short int	lookAhMax;
450 |     unsigned short int	lookAhTok;
451 | };
452 | 
453 | 
454 | #define MIN_FMT_RESULT_BLOCK_ALLOC 80
455 | #define MIN_FMT_RESULT_BLOCK_DELTA 0
456 | /* Maximal permitted threshold (buffer size > result size) in percent, 
457 |  * to directly return the buffer without reallocate */
458 | #define MAX_FMT_RESULT_THRESHOLD   2
459 | 
460 | typedef struct DateFormat {
461 |     char *resMem;
462 |     char *resEnd;
463 |     char *output;
464 | 
465 |     TclDateFields date;
466 | 
467 |     Tcl_Obj *localeEra;
468 | } DateFormat;
469 | 
470 | #define CLFMT_INCR	    (1 << 3)
471 | #define CLFMT_DECR	    (1 << 4)
472 | #define CLFMT_CALC	    (1 << 5)
473 | #define CLFMT_LOCALE_INDX   (1 << 8)
474 | 
475 | typedef struct ClockFormatToken ClockFormatToken;
476 | 
477 | typedef int ClockFormatTokenProc(
478 | 	ClockFmtScnCmdArgs *opts,
479 | 	DateFormat *dateFmt,
480 | 	ClockFormatToken *tok,
481 | 	int *val);
482 | 
483 | typedef struct ClockFormatTokenMap {
484 |     unsigned short int	type;
485 |     const char	       *tostr;
486 |     unsigned short int	width;
487 |     unsigned short int	flags;
488 |     unsigned short int	divider;
489 |     unsigned short int	divmod;
490 |     unsigned short int	offs;
491 |     ClockFormatTokenProc *fmtproc;
492 |     void	       *data;
493 | } ClockFormatTokenMap;
494 | 
495 | struct ClockFormatToken {
496 |     ClockFormatTokenMap *map;
497 |     struct {
498 | 	const char *start;
499 | 	const char *end;
500 |     } tokWord;
501 | };
502 | 
503 | 
504 | typedef struct ClockFmtScnStorage ClockFmtScnStorage;
505 | 
506 | struct ClockFmtScnStorage {
507 |     int			 objRefCount;	/* Reference count shared across threads */
508 |     ClockScanToken	*scnTok;
509 |     unsigned int	 scnTokC;
510 |     unsigned int	 scnSpaceCount; /* Count of mandatory spaces used in format */
511 |     ClockFormatToken	*fmtTok;
512 |     unsigned int	 fmtTokC;
513 | #if CLOCK_FMT_SCN_STORAGE_GC_SIZE > 0
514 |     ClockFmtScnStorage	*nextPtr;
515 |     ClockFmtScnStorage	*prevPtr;
516 | #endif
517 |     size_t		 fmtMinAlloc;
518 | #if 0
519 |    +Tcl_HashEntry    hashEntry		/* ClockFmtScnStorage is a derivate of Tcl_HashEntry,
520 | 					 * stored by offset +sizeof(self) */
521 | #endif
522 | };
523 | 
524 | /* 
525 |  * Clock macros.
526 |  */
527 | 
528 | /* 
529 |  * Extracts Julian day and seconds of the day from posix seconds (tm).
530 |  */
531 | #define ClockExtractJDAndSODFromSeconds(jd, sod, tm) \
532 |     if (1) { \
533 | 	jd = (tm + JULIAN_SEC_POSIX_EPOCH); \
534 | 	if (jd >= SECONDS_PER_DAY || jd <= -SECONDS_PER_DAY) { \
535 | 	    jd /= SECONDS_PER_DAY; \
536 | 	    sod = (int)(tm % SECONDS_PER_DAY); \
537 | 	} else { \
538 | 	    sod = (int)jd, jd = 0; \
539 | 	} \
540 | 	if (sod < 0) { \
541 | 	    sod += SECONDS_PER_DAY; \
542 | 	    /* JD is affected, if switched into negative (avoid 24 hours difference) */ \
543 | 	    if (jd <= 0) { \
544 | 		jd--; \
545 | 	    } \
546 | 	} \
547 |     }
548 | 
549 | /*
550 |  * Prototypes of module functions.
551 |  */
552 | 
553 | MODULE_SCOPE int    ToSeconds(int Hours, int Minutes,
554 | 			    int Seconds, MERIDIAN Meridian);
555 | MODULE_SCOPE int    IsGregorianLeapYear(TclDateFields *);
556 | MODULE_SCOPE void
557 | 		    GetJulianDayFromEraYearWeekDay(
558 | 			    TclDateFields *fields, int changeover);
559 | MODULE_SCOPE void
560 | 		    GetJulianDayFromEraYearMonthDay(
561 | 			    TclDateFields *fields, int changeover);
562 | MODULE_SCOPE void
563 | 		    GetJulianDayFromEraYearDay(
564 | 			    TclDateFields *fields, int changeover);
565 | MODULE_SCOPE int    ConvertUTCToLocal(ClientData clientData, Tcl_Interp *,
566 | 			    TclDateFields *, Tcl_Obj *timezoneObj, int);
567 | MODULE_SCOPE Tcl_Obj *
568 | 		    LookupLastTransition(Tcl_Interp *, Tcl_WideInt,
569 | 			    int, Tcl_Obj *const *, Tcl_WideInt *rangesVal);
570 | 
571 | MODULE_SCOPE int    TclClockFreeScan(Tcl_Interp *interp, DateInfo *info);
572 | 
573 | /* tclClock.c module declarations */
574 | 
575 | MODULE_SCOPE Tcl_Obj *
576 | 		    ClockSetupTimeZone(ClientData clientData,
577 | 		Tcl_Interp *interp, Tcl_Obj *timezoneObj);
578 | 
579 | MODULE_SCOPE Tcl_Obj *
580 | 		    ClockMCDict(ClockFmtScnCmdArgs *opts);
581 | MODULE_SCOPE Tcl_Obj *
582 | 		    ClockMCGet(ClockFmtScnCmdArgs *opts, int mcKey);
583 | MODULE_SCOPE Tcl_Obj *
584 | 		    ClockMCGetIdx(ClockFmtScnCmdArgs *opts, int mcKey);
585 | MODULE_SCOPE int    ClockMCSetIdx(ClockFmtScnCmdArgs *opts, int mcKey,
586 | 			Tcl_Obj *valObj);
587 | 
588 | /* tclClockFmt.c module declarations */
589 | 
590 | 
591 | MODULE_SCOPE char *
592 | 	TclItoAw(char *buf, int val, char padchar, unsigned short int width);
593 | MODULE_SCOPE int
594 | 	TclAtoWIe(Tcl_WideInt *out, const char *p, const char *e, int sign);
595 | 
596 | MODULE_SCOPE Tcl_Obj*
597 | 		    ClockFrmObjGetLocFmtKey(Tcl_Interp *interp,
598 | 			Tcl_Obj *objPtr);
599 | 
600 | MODULE_SCOPE ClockFmtScnStorage *
601 | 		    Tcl_GetClockFrmScnFromObj(Tcl_Interp *interp,
602 | 			Tcl_Obj *objPtr);
603 | MODULE_SCOPE Tcl_Obj *
604 | 		    ClockLocalizeFormat(ClockFmtScnCmdArgs *opts);
605 | 
606 | MODULE_SCOPE int    ClockScan(register DateInfo *info,
607 | 			Tcl_Obj *strObj, ClockFmtScnCmdArgs *opts);
608 | 
609 | MODULE_SCOPE int    ClockFormat(register DateFormat *dateFmt,
610 | 			ClockFmtScnCmdArgs *opts);
611 | 
612 | MODULE_SCOPE void   ClockFrmScnClearCaches(void);
613 | MODULE_SCOPE void   ClockFrmScnFinalize();
614 | 
615 | #endif /* _TCLCLOCK_H */
616 | 


--------------------------------------------------------------------------------
/tests-perf/clock.perf.tcl:
--------------------------------------------------------------------------------
  1 | #!/usr/bin/tclsh
  2 | # ------------------------------------------------------------------------
  3 | #
  4 | # test-performance.tcl --
  5 | # 
  6 | #  This file provides common performance tests for comparison of tcl-speed
  7 | #  degradation by switching between branches.
  8 | #  (currently for clock ensemble only)
  9 | #
 10 | # ------------------------------------------------------------------------
 11 | # 
 12 | # Copyright (c) 2014 Serg G. Brester (aka sebres)
 13 | # 
 14 | # See the file "license.terms" for information on usage and redistribution
 15 | # of this file.
 16 | # 
 17 | 
 18 | array set in {-time 500 -load-module 1}
 19 | if {[info exists ::argv0] && [file tail $::argv0] eq [file tail [info script]]} {
 20 |   array set in $argv
 21 | }
 22 | 
 23 | ## load library / tcl-clock-stubs:
 24 | if {$in(-load-module)} {
 25 |   source [file dirname [file dirname [info script]]]/lib/loader.tcl
 26 | }
 27 | 
 28 | ## common test performance framework:
 29 | if {![namespace exists ::tclTestPerf]} {
 30 |   source [file join [file dirname [info script]] test-performance.tcl]
 31 | }
 32 | 
 33 | namespace eval ::tclTestPerf-TclClock {
 34 | 
 35 | namespace path {::tclTestPerf}
 36 | 
 37 | ## set testing defaults:
 38 | set ::env(TCL_TZ) :CET
 39 | 
 40 | # warm-up interpeter compiler env, clock platform-related features:
 41 | 
 42 | ## warm-up test-related features (load clock.tcl, system zones, locales, etc.):
 43 | clock scan "" -gmt 1
 44 | clock scan ""
 45 | clock scan "" -timezone :CET
 46 | clock scan "" -format "" -locale en
 47 | clock scan "" -format "" -locale de
 48 | 
 49 | ## ------------------------------------------
 50 | 
 51 | proc test-format {{reptime 1000}} {
 52 |   _test_run $reptime {
 53 |     # Format : short, week only (in gmt)
 54 |     {clock format 1482525936 -format "%u" -gmt 1}
 55 |     # Format : short, week only (system zone)
 56 |     {clock format 1482525936 -format "%u"}
 57 |     # Format : short, week only (CEST)
 58 |     {clock format 1482525936 -format "%u" -timezone :CET}
 59 |     # Format : date only (in gmt)
 60 |     {clock format 1482525936 -format "%Y-%m-%d" -gmt 1}
 61 |     # Format : date only (system zone)
 62 |     {clock format 1482525936 -format "%Y-%m-%d"}
 63 |     # Format : date only (CEST)
 64 |     {clock format 1482525936 -format "%Y-%m-%d" -timezone :CET}
 65 |     # Format : time only (in gmt)
 66 |     {clock format 1482525936 -format "%H:%M" -gmt 1}
 67 |     # Format : time only (system zone)
 68 |     {clock format 1482525936 -format "%H:%M"}
 69 |     # Format : time only (CEST)
 70 |     {clock format 1482525936 -format "%H:%M" -timezone :CET}
 71 |     # Format : time only (in gmt)
 72 |     {clock format 1482525936 -format "%H:%M:%S" -gmt 1}
 73 |     # Format : time only (system zone)
 74 |     {clock format 1482525936 -format "%H:%M:%S"}
 75 |     # Format : time only (CEST)
 76 |     {clock format 1482525936 -format "%H:%M:%S" -timezone :CET}
 77 |     # Format : default (in gmt)
 78 |     {clock format 1482525936 -gmt 1 -locale en}
 79 |     # Format : default (system zone)
 80 |     {clock format 1482525936 -locale en}
 81 |     # Format : default (CEST)
 82 |     {clock format 1482525936 -timezone :CET -locale en}
 83 |     # Format : ISO date-time (in gmt, numeric zone)
 84 |     {clock format 1246379400 -format "%Y-%m-%dT%H:%M:%S %z" -gmt 1}
 85 |     # Format : ISO date-time (system zone, CEST, numeric zone)
 86 |     {clock format 1246379400 -format "%Y-%m-%dT%H:%M:%S %z"}
 87 |     # Format : ISO date-time (CEST, numeric zone)
 88 |     {clock format 1246379400 -format "%Y-%m-%dT%H:%M:%S %z" -timezone :CET}
 89 |     # Format : ISO date-time (system zone, CEST)
 90 |     {clock format 1246379400 -format "%Y-%m-%dT%H:%M:%S %Z"}
 91 |     # Format : julian day with time (in gmt):
 92 |     {clock format 1246379415 -format "%J %H:%M:%S" -gmt 1}
 93 |     # Format : julian day with time (system zone):
 94 |     {clock format 1246379415 -format "%J %H:%M:%S"}
 95 | 
 96 |     # Format : locale date-time (en):
 97 |     {clock format 1246379415 -format "%x %X" -locale en}
 98 |     # Format : locale date-time (de):
 99 |     {clock format 1246379415 -format "%x %X" -locale de}
100 | 
101 |     # Format : locale lookup table month:
102 |     {clock format 1246379400 -format "%b" -locale en -gmt 1}
103 |     # Format : locale lookup 2 tables - month and day:
104 |     {clock format 1246379400 -format "%b %Od" -locale en -gmt 1}
105 |     # Format : locale lookup 3 tables - week, month and day:
106 |     {clock format 1246379400 -format "%a %b %Od" -locale en -gmt 1}
107 |     # Format : locale lookup 4 tables - week, month, day and year:
108 |     {clock format 1246379400 -format "%a %b %Od %Oy" -locale en -gmt 1}
109 | 
110 |     # Format : dynamic clock value (without converter caches):
111 |     setup {set i 0}
112 |     {clock format [incr i] -format "%Y-%m-%dT%H:%M:%S" -locale en -timezone :CET}
113 |     cleanup {puts [clock format $i -format "%Y-%m-%dT%H:%M:%S" -locale en -timezone :CET]}
114 |     # Format : dynamic clock value (without any converter caches, zone range overflow):
115 |     setup {set i 0}
116 |     {clock format [incr i 86400] -format "%Y-%m-%dT%H:%M:%S" -locale en -timezone :CET}
117 |     cleanup {puts [clock format $i -format "%Y-%m-%dT%H:%M:%S" -locale en -timezone :CET]}
118 | 
119 |     # Format : dynamic format (cacheable)
120 |     {clock format 1246379415 -format [string trim "%d.%m.%Y %H:%M:%S "] -gmt 1}
121 | 
122 |     # Format : all (in gmt, locale en)
123 |     {clock format 1482525936 -format "%%a = %a | %%A = %A | %%b = %b | %%h = %h | %%B = %B | %%C = %C | %%d = %d | %%e = %e | %%g = %g | %%G = %G | %%H = %H | %%I = %I | %%j = %j | %%J = %J | %%k = %k | %%l = %l | %%m = %m | %%M = %M | %%N = %N | %%p = %p | %%P = %P | %%Q = %Q | %%s = %s | %%S = %S | %%t = %t | %%u = %u | %%U = %U | %%V = %V | %%w = %w | %%W = %W | %%y = %y | %%Y = %Y | %%z = %z | %%Z = %Z | %%n = %n | %%EE = %EE | %%EC = %EC | %%Ey = %Ey | %%n = %n | %%Od = %Od | %%Oe = %Oe | %%OH = %OH | %%Ok = %Ok | %%OI = %OI | %%Ol = %Ol | %%Om = %Om | %%OM = %OM | %%OS = %OS | %%Ou = %Ou | %%Ow = %Ow | %%Oy = %Oy" -gmt 1 -locale en}
124 |     # Format : all (in CET, locale de)
125 |     {clock format 1482525936 -format "%%a = %a | %%A = %A | %%b = %b | %%h = %h | %%B = %B | %%C = %C | %%d = %d | %%e = %e | %%g = %g | %%G = %G | %%H = %H | %%I = %I | %%j = %j | %%J = %J | %%k = %k | %%l = %l | %%m = %m | %%M = %M | %%N = %N | %%p = %p | %%P = %P | %%Q = %Q | %%s = %s | %%S = %S | %%t = %t | %%u = %u | %%U = %U | %%V = %V | %%w = %w | %%W = %W | %%y = %y | %%Y = %Y | %%z = %z | %%Z = %Z | %%n = %n | %%EE = %EE | %%EC = %EC | %%Ey = %Ey | %%n = %n | %%Od = %Od | %%Oe = %Oe | %%OH = %OH | %%Ok = %Ok | %%OI = %OI | %%Ol = %Ol | %%Om = %Om | %%OM = %OM | %%OS = %OS | %%Ou = %Ou | %%Ow = %Ow | %%Oy = %Oy" -timezone :CET -locale de}
126 |   }
127 | }
128 | 
129 | proc test-scan {{reptime 1000}} {
130 |   _test_run -convert-result {clock format $_(r) -locale en} $reptime {
131 |     # Scan : date (in gmt)
132 |     {clock scan "25.11.2015" -format "%d.%m.%Y" -base 0 -gmt 1}
133 |     # Scan : date (system time zone, with base)
134 |     {clock scan "25.11.2015" -format "%d.%m.%Y" -base 0}
135 |     # Scan : date (system time zone, without base)
136 |     {clock scan "25.11.2015" -format "%d.%m.%Y"}
137 |     # Scan : greedy match
138 |     {clock scan "111" -format "%d%m%y" -base 0 -gmt 1}
139 |     {clock scan "1111" -format "%d%m%y" -base 0 -gmt 1}
140 |     {clock scan "11111" -format "%d%m%y" -base 0 -gmt 1}
141 |     {clock scan "111111" -format "%d%m%y" -base 0 -gmt 1}
142 |     # Scan : greedy match (space separated)
143 |     {clock scan "1 1 1" -format "%d%m%y" -base 0 -gmt 1}
144 |     {clock scan "111 1" -format "%d%m%y" -base 0 -gmt 1}
145 |     {clock scan "1 111" -format "%d%m%y" -base 0 -gmt 1}
146 |     {clock scan "1 11 1" -format "%d%m%y" -base 0 -gmt 1}
147 |     {clock scan "1 11 11" -format "%d%m%y" -base 0 -gmt 1}
148 |     {clock scan "11 11 11" -format "%d%m%y" -base 0 -gmt 1}
149 | 
150 |     # Scan : time (in gmt)
151 |     {clock scan "10:35:55" -format "%H:%M:%S" -base 1000000000 -gmt 1}
152 |     # Scan : time (system time zone, with base)
153 |     {clock scan "10:35:55" -format "%H:%M:%S" -base 1000000000}
154 |     # Scan : time (gmt, without base)
155 |     {clock scan "10:35:55" -format "%H:%M:%S" -gmt 1}
156 |     # Scan : time (system time zone, without base)
157 |     {clock scan "10:35:55" -format "%H:%M:%S"}
158 | 
159 |     # Scan : date-time (in gmt)
160 |     {clock scan "25.11.2015 10:35:55" -format "%d.%m.%Y %H:%M:%S" -base 0 -gmt 1}
161 |     # Scan : date-time (system time zone with base)
162 |     {clock scan "25.11.2015 10:35:55" -format "%d.%m.%Y %H:%M:%S" -base 0}
163 |     # Scan : date-time (system time zone without base)
164 |     {clock scan "25.11.2015 10:35:55" -format "%d.%m.%Y %H:%M:%S"}
165 | 
166 |     # Scan : julian day in gmt
167 |     {clock scan 2451545 -format %J -gmt 1}
168 |     # Scan : julian day in system TZ
169 |     {clock scan 2451545 -format %J}
170 |     # Scan : julian day in other TZ
171 |     {clock scan 2451545 -format %J -timezone +0200}
172 |     # Scan : julian day with time:
173 |     {clock scan "2451545 10:20:30" -format "%J %H:%M:%S"}
174 |     # Scan : julian day with time (greedy match):
175 |     {clock scan "2451545 102030" -format "%J%H%M%S"}
176 | 
177 |     # Scan : century, lookup table month
178 |     {clock scan {1970 Jan 2} -format {%C%y %b %d} -locale en -gmt 1}
179 |     # Scan : century, lookup table month and day (both entries are first)
180 |     {clock scan {1970 Jan 01} -format {%C%y %b %Od} -locale en -gmt 1}
181 |     # Scan : century, lookup table month and day (list scan: entries with position 12 / 31)
182 |     {clock scan {2016 Dec 31} -format {%C%y %b %Od} -locale en -gmt 1}
183 | 
184 |     # Scan : ISO date-time (CEST)
185 |     {clock scan "2009-06-30T18:30:00+02:00" -format "%Y-%m-%dT%H:%M:%S%z"}
186 |     {clock scan "2009-06-30T18:30:00 CEST" -format "%Y-%m-%dT%H:%M:%S %z"}
187 |     # Scan : ISO date-time (UTC)
188 |     {clock scan "2009-06-30T18:30:00Z" -format "%Y-%m-%dT%H:%M:%S%z"}
189 |     {clock scan "2009-06-30T18:30:00 UTC" -format "%Y-%m-%dT%H:%M:%S %z"}
190 | 
191 |     # Scan : locale date-time (en):
192 |     {clock scan "06/30/2009 18:30:15" -format "%x %X" -gmt 1 -locale en}
193 |     # Scan : locale date-time (de):
194 |     {clock scan "30.06.2009 18:30:15" -format "%x %X" -gmt 1 -locale de}
195 | 
196 |     # Scan : dynamic format (cacheable)
197 |     {clock scan "25.11.2015 10:35:55" -format [string trim "%d.%m.%Y %H:%M:%S "] -base 0 -gmt 1}
198 | 
199 |     break
200 |     # # Scan : long format test (allock chain)
201 |     # {clock scan "25.11.2015" -format "%d.%m.%Y %d.%m.%Y %d.%m.%Y %d.%m.%Y %d.%m.%Y %d.%m.%Y %d.%m.%Y %d.%m.%Y" -base 0 -gmt 1}
202 |     # # Scan : dynamic, very long format test (create obj representation, allock chain, GC, etc):
203 |     # {clock scan "25.11.2015" -format [string repeat "[incr i] %d.%m.%Y %d.%m.%Y" 10] -base 0 -gmt 1}
204 |     # # Scan : again:
205 |     # {clock scan "25.11.2015" -format [string repeat "[incr i -1] %d.%m.%Y %d.%m.%Y" 10] -base 0 -gmt 1}
206 |   }
207 | }
208 | 
209 | proc test-freescan {{reptime 1000}} {
210 |   _test_run -convert-result {clock format $_(r) -locale en}  $reptime {
211 |     # FreeScan : relative date
212 |     {clock scan "5 years 18 months 385 days" -base 0 -gmt 1}
213 |     # FreeScan : relative date with relative weekday
214 |     {clock scan "5 years 18 months 385 days Fri" -base 0 -gmt 1}
215 |     # FreeScan : relative date with ordinal month
216 |     {clock scan "5 years 18 months 385 days next 1 January" -base 0 -gmt 1}
217 |     # FreeScan : relative date with ordinal month and relative weekday
218 |     {clock scan "5 years 18 months 385 days next January Fri" -base 0 -gmt 1}
219 |     # FreeScan : ordinal month
220 |     {clock scan "next January" -base 0 -gmt 1}
221 |     # FreeScan : relative week
222 |     {clock scan "next Fri" -base 0 -gmt 1}
223 |     # FreeScan : relative weekday and week offset 
224 |     {clock scan "next January + 2 week" -base 0 -gmt 1}
225 |     # FreeScan : time only with base
226 |     {clock scan "19:18:30" -base 148863600 -gmt 1}
227 |     # FreeScan : time only without base, gmt
228 |     {clock scan "19:18:30" -gmt 1}
229 |     # FreeScan : time only without base, system
230 |     {clock scan "19:18:30"}
231 |     # FreeScan : date, system time zone
232 |     {clock scan "05/08/2016 20:18:30"}
233 |     # FreeScan : date, supplied time zone
234 |     {clock scan "05/08/2016 20:18:30" -timezone :CET}
235 |     # FreeScan : date, supplied gmt (equivalent -timezone :GMT)
236 |     {clock scan "05/08/2016 20:18:30" -gmt 1}
237 |     # FreeScan : date, supplied time zone gmt
238 |     {clock scan "05/08/2016 20:18:30" -timezone :GMT}
239 |     # FreeScan : time only, numeric zone in string, base time gmt (exchange zones between gmt / -0500)
240 |     {clock scan "20:18:30 -0500" -base 148863600 -gmt 1}
241 |     # FreeScan : time only, zone in string (exchange zones between system / gmt)
242 |     {clock scan "19:18:30 GMT" -base 148863600}
243 |     # FreeScan : fast switch of zones in cycle - GMT, MST, CET (system) and EST
244 |     {clock scan "19:18:30 MST" -base 148863600 -gmt 1
245 |      clock scan "19:18:30 EST" -base 148863600
246 |     }
247 |   }
248 | }
249 | 
250 | proc test-add {{reptime 1000}} {
251 |   set tests {
252 |     # Add : years
253 |     {clock add 1246379415 5 years -gmt 1}
254 |     # Add : months
255 |     {clock add 1246379415 18 months -gmt 1}
256 |     # Add : weeks
257 |     {clock add 1246379415 20 weeks -gmt 1}
258 |     # Add : days
259 |     {clock add 1246379415 385 days -gmt 1}
260 |     # Add : weekdays
261 |     {clock add 1246379415 3 weekdays -gmt 1}
262 | 
263 |     # Add : hours
264 |     {clock add 1246379415 5 hours -gmt 1}
265 |     # Add : minutes
266 |     {clock add 1246379415 55 minutes -gmt 1}
267 |     # Add : seconds
268 |     {clock add 1246379415 100 seconds -gmt 1}
269 | 
270 |     # Add : +/- in gmt
271 |     {clock add 1246379415 -5 years +21 months -20 weeks +386 days -19 hours +30 minutes -10 seconds -gmt 1}
272 |     # Add : +/- in system timezone
273 |     {clock add 1246379415 -5 years +21 months -20 weeks +386 days -19 hours +30 minutes -10 seconds -timezone :CET}
274 | 
275 |     # Add : gmt
276 |     {clock add 1246379415 -5 years 18 months 366 days 5 hours 30 minutes 10 seconds -gmt 1}
277 |     # Add : system timezone
278 |     {clock add 1246379415 -5 years 18 months 366 days 5 hours 30 minutes 10 seconds -timezone :CET}
279 | 
280 |     # Add : all in gmt
281 |     {clock add 1246379415 4 years 18 months 50 weeks 378 days 3 weekdays 5 hours 30 minutes 10 seconds -gmt 1}
282 |     # Add : all in system timezone
283 |     {clock add 1246379415 4 years 18 months 50 weeks 378 days 3 weekdays 5 hours 30 minutes 10 seconds -timezone :CET}
284 | 
285 |   }
286 |   # if does not support add of weekdays:
287 |   if {[catch {clock add 0 3 weekdays -gmt 1}]} {
288 |     regsub -all {\mweekdays\M} $tests "days" tests
289 |   }
290 |   _test_run -convert-result {clock format $_(r) -locale en} $reptime $tests
291 | }
292 | 
293 | proc test-convert {{reptime 1000}} {
294 |   _test_run $reptime {
295 |     # Convert locale (en -> de):
296 |     {clock format [clock scan "Tue May 30 2017" -format "%a %b %d %Y" -gmt 1 -locale en] -format "%a %b %d %Y" -gmt 1 -locale de}
297 |     # Convert locale (de -> en):
298 |     {clock format [clock scan "Di Mai 30 2017" -format "%a %b %d %Y" -gmt 1 -locale de] -format "%a %b %d %Y" -gmt 1 -locale en}
299 | 
300 |     # Convert TZ: direct
301 |     {clock format [clock scan "19:18:30" -base 148863600 -timezone EST] -timezone MST}
302 |     {clock format [clock scan "19:18:30" -base 148863600 -timezone MST] -timezone EST}
303 |     # Convert TZ: included in scan string & format
304 |     {clock format [clock scan "19:18:30 EST" -base 148863600] -format "%H:%M:%S %z" -timezone MST}
305 |     {clock format [clock scan "19:18:30 EST" -base 148863600] -format "%H:%M:%S %z" -timezone EST}
306 | 
307 |     # Format locale 1x: comparison values
308 |     {clock format 0 -gmt 1 -locale en} 
309 |     {clock format 0 -gmt 1 -locale de}
310 |     {clock format 0 -gmt 1 -locale fr}
311 |     # Format locale 2x: without switching locale (en, en)
312 |     {clock format 0 -gmt 1 -locale en; clock format 0 -gmt 1 -locale en}
313 |     # Format locale 2x: with switching locale (en, de)
314 |     {clock format 0 -gmt 1 -locale en; clock format 0 -gmt 1 -locale de}
315 |     # Format locale 3x: without switching locale (en, en, en)
316 |     {clock format 0 -gmt 1 -locale en; clock format 0 -gmt 1 -locale en; clock format 0 -gmt 1 -locale en}
317 |     # Format locale 3x: with switching locale (en, de, fr)
318 |     {clock format 0 -gmt 1 -locale en; clock format 0 -gmt 1 -locale de; clock format 0 -gmt 1 -locale fr}
319 | 
320 |     # Scan locale 2x: without switching locale (en, en) + (de, de)
321 |     {clock scan "Tue May 30 2017" -format "%a %b %d %Y" -gmt 1 -locale en; clock scan "Tue May 30 2017" -format "%a %b %d %Y" -gmt 1 -locale en}
322 |     {clock scan "Di Mai 30 2017" -format "%a %b %d %Y" -gmt 1 -locale de; clock scan "Di Mai 30 2017" -format "%a %b %d %Y" -gmt 1 -locale de}
323 |     # Scan locale 2x: with switching locale (en, de)
324 |     {clock scan "Tue May 30 2017" -format "%a %b %d %Y" -gmt 1 -locale en; clock scan "Di Mai 30 2017" -format "%a %b %d %Y" -gmt 1 -locale de}
325 |     # Scan locale 3x: with switching locale (en, de, fr)
326 |     {clock scan "Tue May 30 2017" -format "%a %b %d %Y" -gmt 1 -locale en; clock scan "Di Mai 30 2017" -format "%a %b %d %Y" -gmt 1 -locale de; clock scan "mar. mai 30 2017" -format "%a %b %d %Y" -gmt 1 -locale fr}
327 | 
328 |     # Format TZ 2x: comparison values
329 |     {clock format 0 -timezone CET -format "%Y-%m-%d %H:%M:%S %z"}
330 |     {clock format 0 -timezone EST -format "%Y-%m-%d %H:%M:%S %z"}
331 |     # Format TZ 2x: without switching
332 |     {clock format 0 -timezone CET -format "%Y-%m-%d %H:%M:%S %z"; clock format 0 -timezone CET -format "%Y-%m-%d %H:%M:%S %z"}
333 |     {clock format 0 -timezone EST -format "%Y-%m-%d %H:%M:%S %z"; clock format 0 -timezone EST -format "%Y-%m-%d %H:%M:%S %z"}
334 |     # Format TZ 2x: with switching
335 |     {clock format 0 -timezone CET -format "%Y-%m-%d %H:%M:%S %z"; clock format 0 -timezone EST -format "%Y-%m-%d %H:%M:%S %z"}
336 |     # Format TZ 3x: with switching (CET, EST, MST)
337 |     {clock format 0 -timezone CET -format "%Y-%m-%d %H:%M:%S %z"; clock format 0 -timezone EST -format "%Y-%m-%d %H:%M:%S %z"; clock format 0 -timezone MST -format "%Y-%m-%d %H:%M:%S %z"}
338 |     # Format TZ 3x: with switching (GMT, EST, MST)
339 |     {clock format 0 -gmt 1 -format "%Y-%m-%d %H:%M:%S %z"; clock format 0 -timezone EST -format "%Y-%m-%d %H:%M:%S %z"; clock format 0 -timezone MST -format "%Y-%m-%d %H:%M:%S %z"}
340 | 
341 |     # FreeScan TZ 2x (+1 system-default): without switching TZ
342 |     {clock scan "19:18:30 MST" -base 148863600; clock scan "19:18:30 MST" -base 148863600}
343 |     {clock scan "19:18:30 EST" -base 148863600; clock scan "19:18:30 EST" -base 148863600}
344 |     # FreeScan TZ 2x (+1 system-default): with switching TZ
345 |     {clock scan "19:18:30 MST" -base 148863600; clock scan "19:18:30 EST" -base 148863600}
346 |     # FreeScan TZ 2x (+1 gmt, +1 system-default)
347 |     {clock scan "19:18:30 MST" -base 148863600 -gmt 1; clock scan "19:18:30 EST" -base 148863600}
348 |     
349 |     # Scan TZ: comparison included in scan string vs. given
350 |     {clock scan "2009-06-30T18:30:00 CEST" -format "%Y-%m-%dT%H:%M:%S %z"}
351 |     {clock scan "2009-06-30T18:30:00 CET" -format "%Y-%m-%dT%H:%M:%S %z"}
352 |     {clock scan "2009-06-30T18:30:00" -timezone CET -format "%Y-%m-%dT%H:%M:%S"}
353 |   }
354 | }
355 | 
356 | proc test-other {{reptime 1000}} {
357 |   _test_run $reptime {
358 |     # Bad zone
359 |     {catch {clock scan "1 day" -timezone BAD_ZONE -locale en}}
360 | 
361 |     # Scan : julian day (overflow)
362 |     {catch {clock scan 5373485 -format %J}}
363 | 
364 |     setup {set _(org-reptime) $_(reptime); lset _(reptime) 1 50}
365 | 
366 |     # Scan : test rotate of GC objects (format is dynamic, so tcl-obj removed with last reference)
367 |     setup {set i -1}
368 |     {clock scan "[incr i] - 25.11.2015" -format "$i - %d.%m.%Y" -base 0 -gmt 1}
369 |     # Scan : test reusability of GC objects (format is dynamic, so tcl-obj removed with last reference)
370 |     setup {incr i; set j $i}
371 |     {clock scan "[incr j -1] - 25.11.2015" -format "$j - %d.%m.%Y" -base 0 -gmt 1}
372 |     setup {set _(reptime) $_(org-reptime); set j $i}
373 |     {clock scan "[incr j -1] - 25.11.2015" -format "$j - %d.%m.%Y" -base 0 -gmt 1; if {!$j} {set j $i}}
374 |   }
375 | }
376 | 
377 | proc test-ensemble-perf {{reptime 1000}} {
378 |   _test_run $reptime {
379 |     # Clock clicks (ensemble)
380 |     {clock clicks}
381 |     # Clock clicks (direct)
382 |     {::tcl::clock::clicks}
383 |     # Clock seconds (ensemble)
384 |     {clock seconds}
385 |     # Clock seconds (direct)
386 |     {::tcl::clock::seconds}
387 |     # Clock microseconds (ensemble)
388 |     {clock microseconds}
389 |     # Clock microseconds (direct)
390 |     {::tcl::clock::microseconds}
391 |     # Clock scan (ensemble)
392 |     {clock scan ""}
393 |     # Clock scan (direct)
394 |     {::tcl::clock::scan ""}
395 |     # Clock format (ensemble)
396 |     {clock format 0 -f %s}
397 |     # Clock format (direct)
398 |     {::tcl::clock::format 0 -f %s}
399 |   }
400 | }
401 | 
402 | proc test {{reptime 1000}} {
403 |   puts ""
404 |   test-ensemble-perf [expr {$reptime / 2}]; #fast enough
405 |   test-format $reptime
406 |   test-scan $reptime
407 |   test-freescan $reptime
408 |   test-add $reptime
409 |   test-convert [expr {$reptime / 2}]; #fast enough
410 |   test-other $reptime
411 | 
412 |   puts \n**OK**
413 | }
414 | 
415 | }; # end of ::tclTestPerf-TclClock
416 | 
417 | # ------------------------------------------------------------------------
418 | 
419 | # if calling direct:
420 | if {[info exists ::argv0] && [file tail $::argv0] eq [file tail [info script]]} {
421 |   ::tclTestPerf-TclClock::test $in(-time)
422 | }
423 | 


--------------------------------------------------------------------------------