Index: .travis.yml ================================================================== --- .travis.yml +++ .travis.yml @@ -2,33 +2,33 @@ language: c matrix: include: - os: linux - dist: trusty + dist: xenial compiler: clang env: - BUILD_DIR=unix - os: linux - dist: trusty + dist: xenial compiler: clang env: - CFGOPT=--disable-shared - BUILD_DIR=unix - os: linux - dist: trusty + dist: xenial compiler: gcc env: - BUILD_DIR=unix - os: linux - dist: trusty + dist: xenial compiler: gcc env: - CFGOPT=--disable-shared - BUILD_DIR=unix - os: linux - dist: trusty + dist: xenial compiler: gcc-4.9 addons: apt: sources: - ubuntu-toolchain-r-test @@ -35,11 +35,11 @@ packages: - g++-4.9 env: - BUILD_DIR=unix - os: linux - dist: trusty + dist: xenial compiler: gcc-5 addons: apt: sources: - ubuntu-toolchain-r-test @@ -46,11 +46,11 @@ packages: - g++-5 env: - BUILD_DIR=unix - os: linux - dist: trusty + dist: xenial compiler: gcc-6 addons: apt: sources: - ubuntu-toolchain-r-test @@ -57,11 +57,11 @@ packages: - g++-6 env: - BUILD_DIR=unix - os: linux - dist: trusty + dist: xenial compiler: gcc-7 addons: apt: sources: - ubuntu-toolchain-r-test @@ -82,11 +82,11 @@ osx_image: xcode9 env: - BUILD_DIR=macosx - NO_DIRECT_CONFIGURE=1 - os: osx - osx_image: xcode10 + osx_image: xcode10.2 env: - BUILD_DIR=macosx - NO_DIRECT_CONFIGURE=1 ### C builds not currently directly supported on Windows instances # - os: windows @@ -93,11 +93,27 @@ # env: # - BUILD_DIR=win ### ... so proxy with a Mingw cross-compile # Test with mingw-w64 (32 bit) - os: linux - dist: trusty + dist: xenial + compiler: i686-w64-mingw32-gcc + addons: + apt: + packages: + - gcc-mingw-w64-base + - binutils-mingw-w64-i686 + - gcc-mingw-w64-i686 + - gcc-mingw-w64 + - gcc-multilib + - wine + env: + - BUILD_DIR=win + - CFGOPT="--host=i686-w64-mingw32 --enable-threads" + - NO_DIRECT_TEST=1 + - os: linux + dist: xenial compiler: i686-w64-mingw32-gcc addons: apt: packages: - gcc-mingw-w64-base @@ -106,15 +122,30 @@ - gcc-mingw-w64 - gcc-multilib - wine env: - BUILD_DIR=win - - CFGOPT=--host=i686-w64-mingw32 + - CFGOPT="--host=i686-w64-mingw32 --disable-shared --enable-threads" - NO_DIRECT_TEST=1 # Test with mingw-w64 (64 bit) - os: linux - dist: trusty + dist: xenial + compiler: x86_64-w64-mingw32-gcc + addons: + apt: + packages: + - gcc-mingw-w64-base + - binutils-mingw-w64-x86-64 + - gcc-mingw-w64-x86-64 + - gcc-mingw-w64 + - wine + env: + - BUILD_DIR=win + - CFGOPT="--host=x86_64-w64-mingw32 --enable-64bit --enable-threads" + - NO_DIRECT_TEST=1 + - os: linux + dist: xenial compiler: x86_64-w64-mingw32-gcc addons: apt: packages: - gcc-mingw-w64-base @@ -122,11 +153,11 @@ - gcc-mingw-w64-x86-64 - gcc-mingw-w64 - wine env: - BUILD_DIR=win - - CFGOPT="--host=x86_64-w64-mingw32 --enable-64bit" + - CFGOPT="--host=x86_64-w64-mingw32 --enable-64bit --enable-threads --disable-shared" - NO_DIRECT_TEST=1 before_install: - export ERROR_ON_FAILURES=1 - cd ${BUILD_DIR} Index: doc/TraceVar.3 ================================================================== --- doc/TraceVar.3 +++ doc/TraceVar.3 @@ -327,15 +327,15 @@ During unset traces, the return value is ignored and all relevant trace procedures will always be invoked. .SH "RESTRICTIONS" .PP A trace procedure can be called at any time, even when there -is a partially formed result in the interpreter's result area. If +are partially formed results stored in the interpreter. If the trace procedure does anything that could damage this result (such -as calling \fBTcl_Eval\fR) then it must save the original values of -the interpreter's \fBresult\fR and \fBfreeProc\fR fields and restore -them before it returns. +as calling \fBTcl_Eval\fR) then it must use the \fBTcl_SaveInterpState\fR +and related routines to save and restore the original state of +the interpreter before it returns. .SH "UNDEFINED VARIABLES" .PP It is legal to set a trace on an undefined variable. The variable will still appear to be undefined until the first time its value is set. Index: doc/timerate.n ================================================================== --- doc/timerate.n +++ doc/timerate.n @@ -7,19 +7,29 @@ .TH timerate n "" Tcl "Tcl Built-In Commands" .so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME -timerate \- Time-related execution resp. performance measurement of a script +timerate \- Calibrated performance measurements of script execution time .SH SYNOPSIS -\fBtimerate \fIscript\fR \fI?time ?max-count??\fR +\fBtimerate \fIscript\fR ?\fItime\fR? ?\fImax-count\fR? .sp -\fBtimerate \fI?-direct?\fR \fI?-overhead double?\fR \fIscript\fR \fI?time ?max-count??\fR +\fBtimerate \fR?\fB\-direct\fR? ?\fB\-overhead\fI double\fR? \fIscript\fR ?\fItime\fR? ?\fImax-count\fR? .sp -\fBtimerate \fI?-calibrate?\fR \fI?-direct?\fR \fIscript\fR \fI?time ?max-count??\fR +\fBtimerate \fR?\fB\-calibrate\fR? ?\fB\-direct\fR? \fIscript\fR ?\fItime\fR? ?\fImax-count\fR? .BE .SH DESCRIPTION +.PP +The \fBtimerate\fR command does calibrated performance measurement of a Tcl +command or script, \fIscript\fR. The \fIscript\fR should be written so that it +can be executed multiple times during the performance measurement process. +Time is measured in elapsed time using the finest timer resolution as possible, +not CPU time; if \fIscript\fR interacts with the OS, the cost of that +interaction is included. +This command may be used to provide information as to how well a script or +Tcl command is performing, and can help determine bottlenecks and fine-tune +application performance. .PP The first and second form will evaluate \fIscript\fR until the interval \fItime\fR given in milliseconds elapses, or for 1000 milliseconds (1 second) if \fItime\fR is not specified. .sp @@ -26,104 +36,111 @@ The parameter \fImax-count\fR could additionally impose a further restriction by the maximal number of iterations to evaluate the script. If \fImax-count\fR is specified, the evalution will stop either this count of iterations is reached or the time is exceeded. .sp -It will then return a canonical tcl-list of the form +It will then return a canonical tcl-list of the form: .PP .CS \fB0.095977 \(mcs/# 52095836 # 10419167 #/sec 5000.000 nett-ms\fR .CE .PP which indicates: -.IP \(bu +.IP \(bu 3 the average amount of time required per iteration, in microseconds ([\fBlindex\fR $result 0]) -.IP \(bu +.IP \(bu 3 the count how many times it was executed ([\fBlindex\fR $result 2]) -.IP \(bu +.IP \(bu 3 the estimated rate per second ([\fBlindex\fR $result 4]) -.IP \(bu +.IP \(bu 3 the estimated real execution time without measurement overhead ([\fBlindex\fR $result 6]) .PP -Time is measured in elapsed time using the finest timer resolution as possible, -not CPU time. -This command may be used to provide information as to how well the script or a -tcl-command is performing and can help determine bottlenecks and fine-tune -application performance. +The following options may be supplied to the \fBtimerate\fR command: .TP -\fI-calibrate\fR +\fB\-calibrate\fR . -To measure very fast scripts as exact as posible the calibration process +To measure very fast scripts as exactly as possible, a calibration process may be required. - -The \fI-calibrate\fR option is used to calibrate timerate, calculating the -estimated overhead of the given script as the default overhead for future -invocations of the \fBtimerate\fR command. If the \fItime\fR parameter is not -specified, the calibrate procedure runs for up to 10 seconds. +The \fB\-calibrate\fR option is used to calibrate \fBtimerate\fR itself, +calculating the estimated overhead of the given script as the default overhead +for future invocations of the \fBtimerate\fR command. If the \fItime\fR +parameter is not specified, the calibrate procedure runs for up to 10 seconds. +.RS +.PP +Note that calibration is not thread safe in the current implementation. +.RE .TP -\fI-overhead double\fR +\fB\-overhead \fIdouble\fR . -The \fI-overhead\fR parameter supplies an estimate (in microseconds) of the +The \fB\-overhead\fR parameter supplies an estimate (in microseconds) of the measurement overhead of each iteration of the tested script. This quantity -will be subtracted from the measured time prior to reporting results. +will be subtracted from the measured time prior to reporting results. This can +be useful for removing the cost of interpreter state reset commands from the +script being measured. .TP -\fI-direct\fR +\fB\-direct\fR . -The \fI-direct\fR option causes direct execution of the supplied script, +The \fB-direct\fR option causes direct execution of the supplied script, without compilation, in a manner similar to the \fBtime\fR command. It can be used to measure the cost of \fBTcl_EvalObjEx\fR, of the invocation of canonical lists, and of the uncompiled versions of bytecoded commands. .PP As opposed to the \fBtime\fR commmand, which runs the tested script for a fixed number of iterations, the timerate command runs it for a fixed time. Additionally, the compiled variant of the script will be used during the entire -measurement, as if the script were part of a compiled procedure, if the \fI-direct\fR +measurement, as if the script were part of a compiled procedure, if the \fB\-direct\fR option is not specified. The fixed time period and possibility of compilation allow for more precise results and prevent very long execution times by slow scripts, making it practical for measuring scripts with highly uncertain execution times. - -.SH EXAMPLE +.SH EXAMPLES Estimate how fast it takes for a simple Tcl \fBfor\fR loop (including -operations on variable \fIi\fR) to count to a ten: +operations on variable \fIi\fR) to count to ten: .PP .CS -# calibrate: -timerate -calibrate {} -# measure: -timerate { for {set i 0} {$i<10} {incr i} {} } 5000 +\fI# calibrate\fR +\fBtimerate\fR -calibrate {} + +\fI# measure\fR +\fBtimerate\fR { for {set i 0} {$i<10} {incr i} {} } 5000 .CE .PP Estimate how fast it takes for a simple Tcl \fBfor\fR loop, ignoring the -overhead for to perform ten iterations, ignoring the overhead of the management -of the variable that controls the loop: +overhead of the management of the variable that controls the loop: .PP .CS -# calibrate for overhead of variable operations: -set i 0; timerate -calibrate {expr {$i<10}; incr i} 1000 -# measure: -timerate { for {set i 0} {$i<10} {incr i} {} } 5000 +\fI# calibrate for overhead of variable operations\fR +set i 0; \fBtimerate\fR -calibrate {expr {$i<10}; incr i} 1000 + +\fI# measure\fR +\fBtimerate\fR { + for {set i 0} {$i<10} {incr i} {} +} 5000 .CE .PP Estimate the speed of calculating the hour of the day using \fBclock format\fR only, ignoring overhead of the portion of the script that prepares the time for it to calculate: .PP .CS -# calibrate: -timerate -calibrate {} -# estimate overhead: -set tm 0 -set ovh [lindex [timerate { incr tm [expr {24*60*60}] }] 0] -# measure using esimated overhead: -set tm 0 -timerate -overhead $ovh { +\fI# calibrate\fR +\fBtimerate\fR -calibrate {} + +\fI# estimate overhead\fR +set tm 0 +set ovh [lindex [\fBtimerate\fR { + incr tm [expr {24*60*60}] +}] 0] + +\fI# measure using estimated overhead\fR +set tm 0 +\fBtimerate\fR -overhead $ovh { clock format $tm -format %H incr tm [expr {24*60*60}]; # overhead for this is ignored } 5000 .CE .SH "SEE ALSO" time(n) .SH KEYWORDS -script, timerate, time +performance measurement, script, time .\" Local Variables: .\" mode: nroff .\" End: Index: generic/regc_locale.c ================================================================== --- generic/regc_locale.c +++ generic/regc_locale.c @@ -151,50 +151,50 @@ {0xbae, 0xbb9}, {0xc05, 0xc0c}, {0xc0e, 0xc10}, {0xc12, 0xc28}, {0xc2a, 0xc39}, {0xc58, 0xc5a}, {0xc85, 0xc8c}, {0xc8e, 0xc90}, {0xc92, 0xca8}, {0xcaa, 0xcb3}, {0xcb5, 0xcb9}, {0xd05, 0xd0c}, {0xd0e, 0xd10}, {0xd12, 0xd3a}, {0xd54, 0xd56}, {0xd5f, 0xd61}, {0xd7a, 0xd7f}, {0xd85, 0xd96}, {0xd9a, 0xdb1}, {0xdb3, 0xdbb}, - {0xdc0, 0xdc6}, {0xe01, 0xe30}, {0xe40, 0xe46}, {0xe94, 0xe97}, - {0xe99, 0xe9f}, {0xea1, 0xea3}, {0xead, 0xeb0}, {0xec0, 0xec4}, - {0xedc, 0xedf}, {0xf40, 0xf47}, {0xf49, 0xf6c}, {0xf88, 0xf8c}, - {0x1000, 0x102a}, {0x1050, 0x1055}, {0x105a, 0x105d}, {0x106e, 0x1070}, - {0x1075, 0x1081}, {0x10a0, 0x10c5}, {0x10d0, 0x10fa}, {0x10fc, 0x1248}, - {0x124a, 0x124d}, {0x1250, 0x1256}, {0x125a, 0x125d}, {0x1260, 0x1288}, - {0x128a, 0x128d}, {0x1290, 0x12b0}, {0x12b2, 0x12b5}, {0x12b8, 0x12be}, - {0x12c2, 0x12c5}, {0x12c8, 0x12d6}, {0x12d8, 0x1310}, {0x1312, 0x1315}, - {0x1318, 0x135a}, {0x1380, 0x138f}, {0x13a0, 0x13f5}, {0x13f8, 0x13fd}, - {0x1401, 0x166c}, {0x166f, 0x167f}, {0x1681, 0x169a}, {0x16a0, 0x16ea}, - {0x16f1, 0x16f8}, {0x1700, 0x170c}, {0x170e, 0x1711}, {0x1720, 0x1731}, - {0x1740, 0x1751}, {0x1760, 0x176c}, {0x176e, 0x1770}, {0x1780, 0x17b3}, - {0x1820, 0x1878}, {0x1880, 0x1884}, {0x1887, 0x18a8}, {0x18b0, 0x18f5}, - {0x1900, 0x191e}, {0x1950, 0x196d}, {0x1970, 0x1974}, {0x1980, 0x19ab}, - {0x19b0, 0x19c9}, {0x1a00, 0x1a16}, {0x1a20, 0x1a54}, {0x1b05, 0x1b33}, - {0x1b45, 0x1b4b}, {0x1b83, 0x1ba0}, {0x1bba, 0x1be5}, {0x1c00, 0x1c23}, - {0x1c4d, 0x1c4f}, {0x1c5a, 0x1c7d}, {0x1c80, 0x1c88}, {0x1c90, 0x1cba}, - {0x1cbd, 0x1cbf}, {0x1ce9, 0x1cec}, {0x1cee, 0x1cf1}, {0x1d00, 0x1dbf}, - {0x1e00, 0x1f15}, {0x1f18, 0x1f1d}, {0x1f20, 0x1f45}, {0x1f48, 0x1f4d}, - {0x1f50, 0x1f57}, {0x1f5f, 0x1f7d}, {0x1f80, 0x1fb4}, {0x1fb6, 0x1fbc}, - {0x1fc2, 0x1fc4}, {0x1fc6, 0x1fcc}, {0x1fd0, 0x1fd3}, {0x1fd6, 0x1fdb}, - {0x1fe0, 0x1fec}, {0x1ff2, 0x1ff4}, {0x1ff6, 0x1ffc}, {0x2090, 0x209c}, - {0x210a, 0x2113}, {0x2119, 0x211d}, {0x212a, 0x212d}, {0x212f, 0x2139}, - {0x213c, 0x213f}, {0x2145, 0x2149}, {0x2c00, 0x2c2e}, {0x2c30, 0x2c5e}, - {0x2c60, 0x2ce4}, {0x2ceb, 0x2cee}, {0x2d00, 0x2d25}, {0x2d30, 0x2d67}, - {0x2d80, 0x2d96}, {0x2da0, 0x2da6}, {0x2da8, 0x2dae}, {0x2db0, 0x2db6}, - {0x2db8, 0x2dbe}, {0x2dc0, 0x2dc6}, {0x2dc8, 0x2dce}, {0x2dd0, 0x2dd6}, - {0x2dd8, 0x2dde}, {0x3031, 0x3035}, {0x3041, 0x3096}, {0x309d, 0x309f}, - {0x30a1, 0x30fa}, {0x30fc, 0x30ff}, {0x3105, 0x312f}, {0x3131, 0x318e}, - {0x31a0, 0x31ba}, {0x31f0, 0x31ff}, {0x3400, 0x4db5}, {0x4e00, 0x9fef}, - {0xa000, 0xa48c}, {0xa4d0, 0xa4fd}, {0xa500, 0xa60c}, {0xa610, 0xa61f}, - {0xa640, 0xa66e}, {0xa67f, 0xa69d}, {0xa6a0, 0xa6e5}, {0xa717, 0xa71f}, - {0xa722, 0xa788}, {0xa78b, 0xa7b9}, {0xa7f7, 0xa801}, {0xa803, 0xa805}, + {0xdc0, 0xdc6}, {0xe01, 0xe30}, {0xe40, 0xe46}, {0xe86, 0xe8a}, + {0xe8c, 0xea3}, {0xea7, 0xeb0}, {0xec0, 0xec4}, {0xedc, 0xedf}, + {0xf40, 0xf47}, {0xf49, 0xf6c}, {0xf88, 0xf8c}, {0x1000, 0x102a}, + {0x1050, 0x1055}, {0x105a, 0x105d}, {0x106e, 0x1070}, {0x1075, 0x1081}, + {0x10a0, 0x10c5}, {0x10d0, 0x10fa}, {0x10fc, 0x1248}, {0x124a, 0x124d}, + {0x1250, 0x1256}, {0x125a, 0x125d}, {0x1260, 0x1288}, {0x128a, 0x128d}, + {0x1290, 0x12b0}, {0x12b2, 0x12b5}, {0x12b8, 0x12be}, {0x12c2, 0x12c5}, + {0x12c8, 0x12d6}, {0x12d8, 0x1310}, {0x1312, 0x1315}, {0x1318, 0x135a}, + {0x1380, 0x138f}, {0x13a0, 0x13f5}, {0x13f8, 0x13fd}, {0x1401, 0x166c}, + {0x166f, 0x167f}, {0x1681, 0x169a}, {0x16a0, 0x16ea}, {0x16f1, 0x16f8}, + {0x1700, 0x170c}, {0x170e, 0x1711}, {0x1720, 0x1731}, {0x1740, 0x1751}, + {0x1760, 0x176c}, {0x176e, 0x1770}, {0x1780, 0x17b3}, {0x1820, 0x1878}, + {0x1880, 0x1884}, {0x1887, 0x18a8}, {0x18b0, 0x18f5}, {0x1900, 0x191e}, + {0x1950, 0x196d}, {0x1970, 0x1974}, {0x1980, 0x19ab}, {0x19b0, 0x19c9}, + {0x1a00, 0x1a16}, {0x1a20, 0x1a54}, {0x1b05, 0x1b33}, {0x1b45, 0x1b4b}, + {0x1b83, 0x1ba0}, {0x1bba, 0x1be5}, {0x1c00, 0x1c23}, {0x1c4d, 0x1c4f}, + {0x1c5a, 0x1c7d}, {0x1c80, 0x1c88}, {0x1c90, 0x1cba}, {0x1cbd, 0x1cbf}, + {0x1ce9, 0x1cec}, {0x1cee, 0x1cf3}, {0x1d00, 0x1dbf}, {0x1e00, 0x1f15}, + {0x1f18, 0x1f1d}, {0x1f20, 0x1f45}, {0x1f48, 0x1f4d}, {0x1f50, 0x1f57}, + {0x1f5f, 0x1f7d}, {0x1f80, 0x1fb4}, {0x1fb6, 0x1fbc}, {0x1fc2, 0x1fc4}, + {0x1fc6, 0x1fcc}, {0x1fd0, 0x1fd3}, {0x1fd6, 0x1fdb}, {0x1fe0, 0x1fec}, + {0x1ff2, 0x1ff4}, {0x1ff6, 0x1ffc}, {0x2090, 0x209c}, {0x210a, 0x2113}, + {0x2119, 0x211d}, {0x212a, 0x212d}, {0x212f, 0x2139}, {0x213c, 0x213f}, + {0x2145, 0x2149}, {0x2c00, 0x2c2e}, {0x2c30, 0x2c5e}, {0x2c60, 0x2ce4}, + {0x2ceb, 0x2cee}, {0x2d00, 0x2d25}, {0x2d30, 0x2d67}, {0x2d80, 0x2d96}, + {0x2da0, 0x2da6}, {0x2da8, 0x2dae}, {0x2db0, 0x2db6}, {0x2db8, 0x2dbe}, + {0x2dc0, 0x2dc6}, {0x2dc8, 0x2dce}, {0x2dd0, 0x2dd6}, {0x2dd8, 0x2dde}, + {0x3031, 0x3035}, {0x3041, 0x3096}, {0x309d, 0x309f}, {0x30a1, 0x30fa}, + {0x30fc, 0x30ff}, {0x3105, 0x312f}, {0x3131, 0x318e}, {0x31a0, 0x31ba}, + {0x31f0, 0x31ff}, {0x3400, 0x4db5}, {0x4e00, 0x9fef}, {0xa000, 0xa48c}, + {0xa4d0, 0xa4fd}, {0xa500, 0xa60c}, {0xa610, 0xa61f}, {0xa640, 0xa66e}, + {0xa67f, 0xa69d}, {0xa6a0, 0xa6e5}, {0xa717, 0xa71f}, {0xa722, 0xa788}, + {0xa78b, 0xa7bf}, {0xa7c2, 0xa7c6}, {0xa7f7, 0xa801}, {0xa803, 0xa805}, {0xa807, 0xa80a}, {0xa80c, 0xa822}, {0xa840, 0xa873}, {0xa882, 0xa8b3}, {0xa8f2, 0xa8f7}, {0xa90a, 0xa925}, {0xa930, 0xa946}, {0xa960, 0xa97c}, {0xa984, 0xa9b2}, {0xa9e0, 0xa9e4}, {0xa9e6, 0xa9ef}, {0xa9fa, 0xa9fe}, {0xaa00, 0xaa28}, {0xaa40, 0xaa42}, {0xaa44, 0xaa4b}, {0xaa60, 0xaa76}, {0xaa7e, 0xaaaf}, {0xaab9, 0xaabd}, {0xaadb, 0xaadd}, {0xaae0, 0xaaea}, {0xaaf2, 0xaaf4}, {0xab01, 0xab06}, {0xab09, 0xab0e}, {0xab11, 0xab16}, - {0xab20, 0xab26}, {0xab28, 0xab2e}, {0xab30, 0xab5a}, {0xab5c, 0xab65}, + {0xab20, 0xab26}, {0xab28, 0xab2e}, {0xab30, 0xab5a}, {0xab5c, 0xab67}, {0xab70, 0xabe2}, {0xac00, 0xd7a3}, {0xd7b0, 0xd7c6}, {0xd7cb, 0xd7fb}, {0xf900, 0xfa6d}, {0xfa70, 0xfad9}, {0xfb00, 0xfb06}, {0xfb13, 0xfb17}, {0xfb1f, 0xfb28}, {0xfb2a, 0xfb36}, {0xfb38, 0xfb3c}, {0xfb46, 0xfbb1}, {0xfbd3, 0xfd3d}, {0xfd50, 0xfd8f}, {0xfd92, 0xfdc7}, {0xfdf0, 0xfdfb}, {0xfe70, 0xfe74}, {0xfe76, 0xfefc}, {0xff21, 0xff3a}, {0xff41, 0xff5a}, @@ -211,38 +211,40 @@ {0x108e0, 0x108f2}, {0x10900, 0x10915}, {0x10920, 0x10939}, {0x10980, 0x109b7}, {0x10a10, 0x10a13}, {0x10a15, 0x10a17}, {0x10a19, 0x10a35}, {0x10a60, 0x10a7c}, {0x10a80, 0x10a9c}, {0x10ac0, 0x10ac7}, {0x10ac9, 0x10ae4}, {0x10b00, 0x10b35}, {0x10b40, 0x10b55}, {0x10b60, 0x10b72}, {0x10b80, 0x10b91}, {0x10c00, 0x10c48}, {0x10c80, 0x10cb2}, {0x10cc0, 0x10cf2}, {0x10d00, 0x10d23}, {0x10f00, 0x10f1c}, - {0x10f30, 0x10f45}, {0x11003, 0x11037}, {0x11083, 0x110af}, {0x110d0, 0x110e8}, - {0x11103, 0x11126}, {0x11150, 0x11172}, {0x11183, 0x111b2}, {0x111c1, 0x111c4}, - {0x11200, 0x11211}, {0x11213, 0x1122b}, {0x11280, 0x11286}, {0x1128a, 0x1128d}, - {0x1128f, 0x1129d}, {0x1129f, 0x112a8}, {0x112b0, 0x112de}, {0x11305, 0x1130c}, - {0x11313, 0x11328}, {0x1132a, 0x11330}, {0x11335, 0x11339}, {0x1135d, 0x11361}, - {0x11400, 0x11434}, {0x11447, 0x1144a}, {0x11480, 0x114af}, {0x11580, 0x115ae}, - {0x115d8, 0x115db}, {0x11600, 0x1162f}, {0x11680, 0x116aa}, {0x11700, 0x1171a}, - {0x11800, 0x1182b}, {0x118a0, 0x118df}, {0x11a0b, 0x11a32}, {0x11a5c, 0x11a83}, - {0x11a86, 0x11a89}, {0x11ac0, 0x11af8}, {0x11c00, 0x11c08}, {0x11c0a, 0x11c2e}, - {0x11c72, 0x11c8f}, {0x11d00, 0x11d06}, {0x11d0b, 0x11d30}, {0x11d60, 0x11d65}, - {0x11d6a, 0x11d89}, {0x11ee0, 0x11ef2}, {0x12000, 0x12399}, {0x12480, 0x12543}, - {0x13000, 0x1342e}, {0x14400, 0x14646}, {0x16800, 0x16a38}, {0x16a40, 0x16a5e}, - {0x16ad0, 0x16aed}, {0x16b00, 0x16b2f}, {0x16b40, 0x16b43}, {0x16b63, 0x16b77}, - {0x16b7d, 0x16b8f}, {0x16e40, 0x16e7f}, {0x16f00, 0x16f44}, {0x16f93, 0x16f9f}, - {0x17000, 0x187f1}, {0x18800, 0x18af2}, {0x1b000, 0x1b11e}, {0x1b170, 0x1b2fb}, + {0x10f30, 0x10f45}, {0x10fe0, 0x10ff6}, {0x11003, 0x11037}, {0x11083, 0x110af}, + {0x110d0, 0x110e8}, {0x11103, 0x11126}, {0x11150, 0x11172}, {0x11183, 0x111b2}, + {0x111c1, 0x111c4}, {0x11200, 0x11211}, {0x11213, 0x1122b}, {0x11280, 0x11286}, + {0x1128a, 0x1128d}, {0x1128f, 0x1129d}, {0x1129f, 0x112a8}, {0x112b0, 0x112de}, + {0x11305, 0x1130c}, {0x11313, 0x11328}, {0x1132a, 0x11330}, {0x11335, 0x11339}, + {0x1135d, 0x11361}, {0x11400, 0x11434}, {0x11447, 0x1144a}, {0x11480, 0x114af}, + {0x11580, 0x115ae}, {0x115d8, 0x115db}, {0x11600, 0x1162f}, {0x11680, 0x116aa}, + {0x11700, 0x1171a}, {0x11800, 0x1182b}, {0x118a0, 0x118df}, {0x119a0, 0x119a7}, + {0x119aa, 0x119d0}, {0x11a0b, 0x11a32}, {0x11a5c, 0x11a89}, {0x11ac0, 0x11af8}, + {0x11c00, 0x11c08}, {0x11c0a, 0x11c2e}, {0x11c72, 0x11c8f}, {0x11d00, 0x11d06}, + {0x11d0b, 0x11d30}, {0x11d60, 0x11d65}, {0x11d6a, 0x11d89}, {0x11ee0, 0x11ef2}, + {0x12000, 0x12399}, {0x12480, 0x12543}, {0x13000, 0x1342e}, {0x14400, 0x14646}, + {0x16800, 0x16a38}, {0x16a40, 0x16a5e}, {0x16ad0, 0x16aed}, {0x16b00, 0x16b2f}, + {0x16b40, 0x16b43}, {0x16b63, 0x16b77}, {0x16b7d, 0x16b8f}, {0x16e40, 0x16e7f}, + {0x16f00, 0x16f4a}, {0x16f93, 0x16f9f}, {0x17000, 0x187f7}, {0x18800, 0x18af2}, + {0x1b000, 0x1b11e}, {0x1b150, 0x1b152}, {0x1b164, 0x1b167}, {0x1b170, 0x1b2fb}, {0x1bc00, 0x1bc6a}, {0x1bc70, 0x1bc7c}, {0x1bc80, 0x1bc88}, {0x1bc90, 0x1bc99}, {0x1d400, 0x1d454}, {0x1d456, 0x1d49c}, {0x1d4a9, 0x1d4ac}, {0x1d4ae, 0x1d4b9}, {0x1d4bd, 0x1d4c3}, {0x1d4c5, 0x1d505}, {0x1d507, 0x1d50a}, {0x1d50d, 0x1d514}, {0x1d516, 0x1d51c}, {0x1d51e, 0x1d539}, {0x1d53b, 0x1d53e}, {0x1d540, 0x1d544}, {0x1d54a, 0x1d550}, {0x1d552, 0x1d6a5}, {0x1d6a8, 0x1d6c0}, {0x1d6c2, 0x1d6da}, {0x1d6dc, 0x1d6fa}, {0x1d6fc, 0x1d714}, {0x1d716, 0x1d734}, {0x1d736, 0x1d74e}, {0x1d750, 0x1d76e}, {0x1d770, 0x1d788}, {0x1d78a, 0x1d7a8}, {0x1d7aa, 0x1d7c2}, - {0x1d7c4, 0x1d7cb}, {0x1e800, 0x1e8c4}, {0x1e900, 0x1e943}, {0x1ee00, 0x1ee03}, - {0x1ee05, 0x1ee1f}, {0x1ee29, 0x1ee32}, {0x1ee34, 0x1ee37}, {0x1ee4d, 0x1ee4f}, - {0x1ee67, 0x1ee6a}, {0x1ee6c, 0x1ee72}, {0x1ee74, 0x1ee77}, {0x1ee79, 0x1ee7c}, - {0x1ee80, 0x1ee89}, {0x1ee8b, 0x1ee9b}, {0x1eea1, 0x1eea3}, {0x1eea5, 0x1eea9}, - {0x1eeab, 0x1eebb}, {0x20000, 0x2a6d6}, {0x2a700, 0x2b734}, {0x2b740, 0x2b81d}, - {0x2b820, 0x2cea1}, {0x2ceb0, 0x2ebe0}, {0x2f800, 0x2fa1d} + {0x1d7c4, 0x1d7cb}, {0x1e100, 0x1e12c}, {0x1e137, 0x1e13d}, {0x1e2c0, 0x1e2eb}, + {0x1e800, 0x1e8c4}, {0x1e900, 0x1e943}, {0x1ee00, 0x1ee03}, {0x1ee05, 0x1ee1f}, + {0x1ee29, 0x1ee32}, {0x1ee34, 0x1ee37}, {0x1ee4d, 0x1ee4f}, {0x1ee67, 0x1ee6a}, + {0x1ee6c, 0x1ee72}, {0x1ee74, 0x1ee77}, {0x1ee79, 0x1ee7c}, {0x1ee80, 0x1ee89}, + {0x1ee8b, 0x1ee9b}, {0x1eea1, 0x1eea3}, {0x1eea5, 0x1eea9}, {0x1eeab, 0x1eebb}, + {0x20000, 0x2a6d6}, {0x2a700, 0x2b734}, {0x2b740, 0x2b81d}, {0x2b820, 0x2cea1}, + {0x2ceb0, 0x2ebe0}, {0x2f800, 0x2fa1d} #endif }; #define NUM_ALPHA_RANGE (sizeof(alphaRangeTable)/sizeof(crange)) @@ -255,28 +257,28 @@ 0xa38, 0xa39, 0xa5e, 0xab2, 0xab3, 0xabd, 0xad0, 0xae0, 0xae1, 0xaf9, 0xb0f, 0xb10, 0xb32, 0xb33, 0xb3d, 0xb5c, 0xb5d, 0xb71, 0xb83, 0xb99, 0xb9a, 0xb9c, 0xb9e, 0xb9f, 0xba3, 0xba4, 0xbd0, 0xc3d, 0xc60, 0xc61, 0xc80, 0xcbd, 0xcde, 0xce0, 0xce1, 0xcf1, 0xcf2, 0xd3d, 0xd4e, 0xdbd, 0xe32, 0xe33, 0xe81, 0xe82, 0xe84, - 0xe87, 0xe88, 0xe8a, 0xe8d, 0xea5, 0xea7, 0xeaa, 0xeab, 0xeb2, - 0xeb3, 0xebd, 0xec6, 0xf00, 0x103f, 0x1061, 0x1065, 0x1066, 0x108e, - 0x10c7, 0x10cd, 0x1258, 0x12c0, 0x17d7, 0x17dc, 0x18aa, 0x1aa7, 0x1bae, - 0x1baf, 0x1cf5, 0x1cf6, 0x1f59, 0x1f5b, 0x1f5d, 0x1fbe, 0x2071, 0x207f, - 0x2102, 0x2107, 0x2115, 0x2124, 0x2126, 0x2128, 0x214e, 0x2183, 0x2184, - 0x2cf2, 0x2cf3, 0x2d27, 0x2d2d, 0x2d6f, 0x2e2f, 0x3005, 0x3006, 0x303b, - 0x303c, 0xa62a, 0xa62b, 0xa8fb, 0xa8fd, 0xa8fe, 0xa9cf, 0xaa7a, 0xaab1, - 0xaab5, 0xaab6, 0xaac0, 0xaac2, 0xfb1d, 0xfb3e, 0xfb40, 0xfb41, 0xfb43, - 0xfb44 + 0xea5, 0xeb2, 0xeb3, 0xebd, 0xec6, 0xf00, 0x103f, 0x1061, 0x1065, + 0x1066, 0x108e, 0x10c7, 0x10cd, 0x1258, 0x12c0, 0x17d7, 0x17dc, 0x18aa, + 0x1aa7, 0x1bae, 0x1baf, 0x1cf5, 0x1cf6, 0x1cfa, 0x1f59, 0x1f5b, 0x1f5d, + 0x1fbe, 0x2071, 0x207f, 0x2102, 0x2107, 0x2115, 0x2124, 0x2126, 0x2128, + 0x214e, 0x2183, 0x2184, 0x2cf2, 0x2cf3, 0x2d27, 0x2d2d, 0x2d6f, 0x2e2f, + 0x3005, 0x3006, 0x303b, 0x303c, 0xa62a, 0xa62b, 0xa8fb, 0xa8fd, 0xa8fe, + 0xa9cf, 0xaa7a, 0xaab1, 0xaab5, 0xaab6, 0xaac0, 0xaac2, 0xfb1d, 0xfb3e, + 0xfb40, 0xfb41, 0xfb43, 0xfb44 #if CHRBITS > 16 ,0x1003c, 0x1003d, 0x10808, 0x10837, 0x10838, 0x1083c, 0x108f4, 0x108f5, 0x109be, 0x109bf, 0x10a00, 0x10f27, 0x11144, 0x11176, 0x111da, 0x111dc, 0x11288, 0x1130f, - 0x11310, 0x11332, 0x11333, 0x1133d, 0x11350, 0x114c4, 0x114c5, 0x114c7, 0x11644, - 0x118ff, 0x11a00, 0x11a3a, 0x11a50, 0x11a9d, 0x11c40, 0x11d08, 0x11d09, 0x11d46, - 0x11d67, 0x11d68, 0x11d98, 0x16f50, 0x16fe0, 0x16fe1, 0x1d49e, 0x1d49f, 0x1d4a2, - 0x1d4a5, 0x1d4a6, 0x1d4bb, 0x1d546, 0x1ee21, 0x1ee22, 0x1ee24, 0x1ee27, 0x1ee39, - 0x1ee3b, 0x1ee42, 0x1ee47, 0x1ee49, 0x1ee4b, 0x1ee51, 0x1ee52, 0x1ee54, 0x1ee57, - 0x1ee59, 0x1ee5b, 0x1ee5d, 0x1ee5f, 0x1ee61, 0x1ee62, 0x1ee64, 0x1ee7e + 0x11310, 0x11332, 0x11333, 0x1133d, 0x11350, 0x1145f, 0x114c4, 0x114c5, 0x114c7, + 0x11644, 0x116b8, 0x118ff, 0x119e1, 0x119e3, 0x11a00, 0x11a3a, 0x11a50, 0x11a9d, + 0x11c40, 0x11d08, 0x11d09, 0x11d46, 0x11d67, 0x11d68, 0x11d98, 0x16f50, 0x16fe0, + 0x16fe1, 0x16fe3, 0x1d49e, 0x1d49f, 0x1d4a2, 0x1d4a5, 0x1d4a6, 0x1d4bb, 0x1d546, + 0x1e14e, 0x1e94b, 0x1ee21, 0x1ee22, 0x1ee24, 0x1ee27, 0x1ee39, 0x1ee3b, 0x1ee42, + 0x1ee47, 0x1ee49, 0x1ee4b, 0x1ee51, 0x1ee52, 0x1ee54, 0x1ee57, 0x1ee59, 0x1ee5b, + 0x1ee5d, 0x1ee5f, 0x1ee61, 0x1ee62, 0x1ee64, 0x1ee7e #endif }; #define NUM_ALPHA_CHAR (sizeof(alphaCharTable)/sizeof(chr)) @@ -287,12 +289,12 @@ static const crange controlRangeTable[] = { {0x0, 0x1f}, {0x7f, 0x9f}, {0x600, 0x605}, {0x200b, 0x200f}, {0x202a, 0x202e}, {0x2060, 0x2064}, {0x2066, 0x206f}, {0xe000, 0xf8ff}, {0xfff9, 0xfffb} #if CHRBITS > 16 - ,{0x1bca0, 0x1bca3}, {0x1d173, 0x1d17a}, {0xe0020, 0xe007f}, {0xf0000, 0xffffd}, - {0x100000, 0x10fffd} + ,{0x13430, 0x13438}, {0x1bca0, 0x1bca3}, {0x1d173, 0x1d17a}, {0xe0020, 0xe007f}, + {0xf0000, 0xffffd}, {0x100000, 0x10fffd} #endif }; #define NUM_CONTROL_RANGE (sizeof(controlRangeTable)/sizeof(crange)) @@ -323,11 +325,12 @@ #if CHRBITS > 16 ,{0x104a0, 0x104a9}, {0x10d30, 0x10d39}, {0x11066, 0x1106f}, {0x110f0, 0x110f9}, {0x11136, 0x1113f}, {0x111d0, 0x111d9}, {0x112f0, 0x112f9}, {0x11450, 0x11459}, {0x114d0, 0x114d9}, {0x11650, 0x11659}, {0x116c0, 0x116c9}, {0x11730, 0x11739}, {0x118e0, 0x118e9}, {0x11c50, 0x11c59}, {0x11d50, 0x11d59}, {0x11da0, 0x11da9}, - {0x16a60, 0x16a69}, {0x16b50, 0x16b59}, {0x1d7ce, 0x1d7ff}, {0x1e950, 0x1e959} + {0x16a60, 0x16a69}, {0x16b50, 0x16b59}, {0x1d7ce, 0x1d7ff}, {0x1e140, 0x1e149}, + {0x1e2f0, 0x1e2f9}, {0x1e950, 0x1e959} #endif }; #define NUM_DIGIT_RANGE (sizeof(digitRangeTable)/sizeof(crange)) @@ -346,11 +349,11 @@ {0x104a, 0x104f}, {0x1360, 0x1368}, {0x16eb, 0x16ed}, {0x17d4, 0x17d6}, {0x17d8, 0x17da}, {0x1800, 0x180a}, {0x1aa0, 0x1aa6}, {0x1aa8, 0x1aad}, {0x1b5a, 0x1b60}, {0x1bfc, 0x1bff}, {0x1c3b, 0x1c3f}, {0x1cc0, 0x1cc7}, {0x2010, 0x2027}, {0x2030, 0x2043}, {0x2045, 0x2051}, {0x2053, 0x205e}, {0x2308, 0x230b}, {0x2768, 0x2775}, {0x27e6, 0x27ef}, {0x2983, 0x2998}, - {0x29d8, 0x29db}, {0x2cf9, 0x2cfc}, {0x2e00, 0x2e2e}, {0x2e30, 0x2e4e}, + {0x29d8, 0x29db}, {0x2cf9, 0x2cfc}, {0x2e00, 0x2e2e}, {0x2e30, 0x2e4f}, {0x3001, 0x3003}, {0x3008, 0x3011}, {0x3014, 0x301f}, {0xa60d, 0xa60f}, {0xa6f2, 0xa6f7}, {0xa874, 0xa877}, {0xa8f8, 0xa8fa}, {0xa9c1, 0xa9cd}, {0xaa5c, 0xaa5f}, {0xfe10, 0xfe19}, {0xfe30, 0xfe52}, {0xfe54, 0xfe61}, {0xff01, 0xff03}, {0xff05, 0xff0a}, {0xff0c, 0xff0f}, {0xff3b, 0xff3d}, {0xff5f, 0xff65} @@ -370,12 +373,12 @@ static const chr punctCharTable[] = { 0x3a, 0x3b, 0x3f, 0x40, 0x5f, 0x7b, 0x7d, 0xa1, 0xa7, 0xab, 0xb6, 0xb7, 0xbb, 0xbf, 0x37e, 0x387, 0x589, 0x58a, 0x5be, 0x5c0, 0x5c3, 0x5c6, 0x5f3, 0x5f4, 0x609, 0x60a, 0x60c, 0x60d, 0x61b, 0x61e, 0x61f, 0x6d4, 0x85e, 0x964, 0x965, 0x970, - 0x9fd, 0xa76, 0xaf0, 0xc84, 0xdf4, 0xe4f, 0xe5a, 0xe5b, 0xf14, - 0xf85, 0xfd9, 0xfda, 0x10fb, 0x1400, 0x166d, 0x166e, 0x169b, 0x169c, + 0x9fd, 0xa76, 0xaf0, 0xc77, 0xc84, 0xdf4, 0xe4f, 0xe5a, 0xe5b, + 0xf14, 0xf85, 0xfd9, 0xfda, 0x10fb, 0x1400, 0x166e, 0x169b, 0x169c, 0x1735, 0x1736, 0x1944, 0x1945, 0x1a1e, 0x1a1f, 0x1c7e, 0x1c7f, 0x1cd3, 0x207d, 0x207e, 0x208d, 0x208e, 0x2329, 0x232a, 0x27c5, 0x27c6, 0x29fc, 0x29fd, 0x2cfe, 0x2cff, 0x2d70, 0x3030, 0x303d, 0x30a0, 0x30fb, 0xa4fe, 0xa4ff, 0xa673, 0xa67e, 0xa8ce, 0xa8cf, 0xa8fc, 0xa92e, 0xa92f, 0xa95f, 0xa9de, 0xa9df, 0xaade, 0xaadf, 0xaaf0, 0xaaf1, 0xabeb, 0xfd3e, 0xfd3f, @@ -382,12 +385,12 @@ 0xfe63, 0xfe68, 0xfe6a, 0xfe6b, 0xff1a, 0xff1b, 0xff1f, 0xff20, 0xff3f, 0xff5b, 0xff5d #if CHRBITS > 16 ,0x1039f, 0x103d0, 0x1056f, 0x10857, 0x1091f, 0x1093f, 0x10a7f, 0x110bb, 0x110bc, 0x11174, 0x11175, 0x111cd, 0x111db, 0x112a9, 0x1145b, 0x1145d, 0x114c6, 0x1183b, - 0x11c70, 0x11c71, 0x11ef7, 0x11ef8, 0x16a6e, 0x16a6f, 0x16af5, 0x16b44, 0x1bc9f, - 0x1e95e, 0x1e95f + 0x119e2, 0x11c70, 0x11c71, 0x11ef7, 0x11ef8, 0x11fff, 0x16a6e, 0x16a6f, 0x16af5, + 0x16b44, 0x16fe2, 0x1bc9f, 0x1e95e, 0x1e95f #endif }; #define NUM_PUNCT_CHAR (sizeof(punctCharTable)/sizeof(chr)) @@ -422,11 +425,11 @@ {0x1f10, 0x1f15}, {0x1f20, 0x1f27}, {0x1f30, 0x1f37}, {0x1f40, 0x1f45}, {0x1f50, 0x1f57}, {0x1f60, 0x1f67}, {0x1f70, 0x1f7d}, {0x1f80, 0x1f87}, {0x1f90, 0x1f97}, {0x1fa0, 0x1fa7}, {0x1fb0, 0x1fb4}, {0x1fc2, 0x1fc4}, {0x1fd0, 0x1fd3}, {0x1fe0, 0x1fe7}, {0x1ff2, 0x1ff4}, {0x2146, 0x2149}, {0x2c30, 0x2c5e}, {0x2c76, 0x2c7b}, {0x2d00, 0x2d25}, {0xa72f, 0xa731}, - {0xa771, 0xa778}, {0xa793, 0xa795}, {0xab30, 0xab5a}, {0xab60, 0xab65}, + {0xa771, 0xa778}, {0xa793, 0xa795}, {0xab30, 0xab5a}, {0xab60, 0xab67}, {0xab70, 0xabbf}, {0xfb00, 0xfb06}, {0xfb13, 0xfb17}, {0xff41, 0xff5a} #if CHRBITS > 16 ,{0x10428, 0x1044f}, {0x104d8, 0x104fb}, {0x10cc0, 0x10cf2}, {0x118c0, 0x118df}, {0x16e60, 0x16e7f}, {0x1d41a, 0x1d433}, {0x1d44e, 0x1d454}, {0x1d456, 0x1d467}, {0x1d482, 0x1d49b}, {0x1d4b6, 0x1d4b9}, {0x1d4bd, 0x1d4c3}, {0x1d4c5, 0x1d4cf}, @@ -502,11 +505,11 @@ 0xa73f, 0xa741, 0xa743, 0xa745, 0xa747, 0xa749, 0xa74b, 0xa74d, 0xa74f, 0xa751, 0xa753, 0xa755, 0xa757, 0xa759, 0xa75b, 0xa75d, 0xa75f, 0xa761, 0xa763, 0xa765, 0xa767, 0xa769, 0xa76b, 0xa76d, 0xa76f, 0xa77a, 0xa77c, 0xa77f, 0xa781, 0xa783, 0xa785, 0xa787, 0xa78c, 0xa78e, 0xa791, 0xa797, 0xa799, 0xa79b, 0xa79d, 0xa79f, 0xa7a1, 0xa7a3, 0xa7a5, 0xa7a7, 0xa7a9, - 0xa7af, 0xa7b5, 0xa7b7, 0xa7b9, 0xa7fa + 0xa7af, 0xa7b5, 0xa7b7, 0xa7b9, 0xa7bb, 0xa7bd, 0xa7bf, 0xa7c3, 0xa7fa #if CHRBITS > 16 ,0x1d4bb, 0x1d7cb #endif }; @@ -525,11 +528,11 @@ {0x1f18, 0x1f1d}, {0x1f28, 0x1f2f}, {0x1f38, 0x1f3f}, {0x1f48, 0x1f4d}, {0x1f68, 0x1f6f}, {0x1fb8, 0x1fbb}, {0x1fc8, 0x1fcb}, {0x1fd8, 0x1fdb}, {0x1fe8, 0x1fec}, {0x1ff8, 0x1ffb}, {0x210b, 0x210d}, {0x2110, 0x2112}, {0x2119, 0x211d}, {0x212a, 0x212d}, {0x2130, 0x2133}, {0x2c00, 0x2c2e}, {0x2c62, 0x2c64}, {0x2c6d, 0x2c70}, {0x2c7e, 0x2c80}, {0xa7aa, 0xa7ae}, - {0xa7b0, 0xa7b4}, {0xff21, 0xff3a} + {0xa7b0, 0xa7b4}, {0xa7c4, 0xa7c6}, {0xff21, 0xff3a} #if CHRBITS > 16 ,{0x10400, 0x10427}, {0x104b0, 0x104d3}, {0x10c80, 0x10cb2}, {0x118a0, 0x118bf}, {0x16e40, 0x16e5f}, {0x1d400, 0x1d419}, {0x1d434, 0x1d44d}, {0x1d468, 0x1d481}, {0x1d4a9, 0x1d4ac}, {0x1d4ae, 0x1d4b5}, {0x1d4d0, 0x1d4e9}, {0x1d507, 0x1d50a}, {0x1d50d, 0x1d514}, {0x1d516, 0x1d51c}, {0x1d53b, 0x1d53e}, {0x1d540, 0x1d544}, @@ -604,11 +607,11 @@ 0xa744, 0xa746, 0xa748, 0xa74a, 0xa74c, 0xa74e, 0xa750, 0xa752, 0xa754, 0xa756, 0xa758, 0xa75a, 0xa75c, 0xa75e, 0xa760, 0xa762, 0xa764, 0xa766, 0xa768, 0xa76a, 0xa76c, 0xa76e, 0xa779, 0xa77b, 0xa77d, 0xa77e, 0xa780, 0xa782, 0xa784, 0xa786, 0xa78b, 0xa78d, 0xa790, 0xa792, 0xa796, 0xa798, 0xa79a, 0xa79c, 0xa79e, 0xa7a0, 0xa7a2, 0xa7a4, 0xa7a6, 0xa7a8, 0xa7b6, - 0xa7b8 + 0xa7b8, 0xa7ba, 0xa7bc, 0xa7be, 0xa7c2 #if CHRBITS > 16 ,0x1d49c, 0x1d49e, 0x1d49f, 0x1d4a2, 0x1d4a5, 0x1d4a6, 0x1d504, 0x1d505, 0x1d538, 0x1d539, 0x1d546, 0x1d7ca #endif }; @@ -638,58 +641,57 @@ {0xb3c, 0xb44}, {0xb4b, 0xb4d}, {0xb5f, 0xb63}, {0xb66, 0xb77}, {0xb85, 0xb8a}, {0xb8e, 0xb90}, {0xb92, 0xb95}, {0xba8, 0xbaa}, {0xbae, 0xbb9}, {0xbbe, 0xbc2}, {0xbc6, 0xbc8}, {0xbca, 0xbcd}, {0xbe6, 0xbfa}, {0xc00, 0xc0c}, {0xc0e, 0xc10}, {0xc12, 0xc28}, {0xc2a, 0xc39}, {0xc3d, 0xc44}, {0xc46, 0xc48}, {0xc4a, 0xc4d}, - {0xc58, 0xc5a}, {0xc60, 0xc63}, {0xc66, 0xc6f}, {0xc78, 0xc8c}, + {0xc58, 0xc5a}, {0xc60, 0xc63}, {0xc66, 0xc6f}, {0xc77, 0xc8c}, {0xc8e, 0xc90}, {0xc92, 0xca8}, {0xcaa, 0xcb3}, {0xcb5, 0xcb9}, {0xcbc, 0xcc4}, {0xcc6, 0xcc8}, {0xcca, 0xccd}, {0xce0, 0xce3}, {0xce6, 0xcef}, {0xd00, 0xd03}, {0xd05, 0xd0c}, {0xd0e, 0xd10}, {0xd12, 0xd44}, {0xd46, 0xd48}, {0xd4a, 0xd4f}, {0xd54, 0xd63}, {0xd66, 0xd7f}, {0xd85, 0xd96}, {0xd9a, 0xdb1}, {0xdb3, 0xdbb}, {0xdc0, 0xdc6}, {0xdcf, 0xdd4}, {0xdd8, 0xddf}, {0xde6, 0xdef}, - {0xdf2, 0xdf4}, {0xe01, 0xe3a}, {0xe3f, 0xe5b}, {0xe94, 0xe97}, - {0xe99, 0xe9f}, {0xea1, 0xea3}, {0xead, 0xeb9}, {0xebb, 0xebd}, - {0xec0, 0xec4}, {0xec8, 0xecd}, {0xed0, 0xed9}, {0xedc, 0xedf}, - {0xf00, 0xf47}, {0xf49, 0xf6c}, {0xf71, 0xf97}, {0xf99, 0xfbc}, - {0xfbe, 0xfcc}, {0xfce, 0xfda}, {0x1000, 0x10c5}, {0x10d0, 0x1248}, - {0x124a, 0x124d}, {0x1250, 0x1256}, {0x125a, 0x125d}, {0x1260, 0x1288}, - {0x128a, 0x128d}, {0x1290, 0x12b0}, {0x12b2, 0x12b5}, {0x12b8, 0x12be}, - {0x12c2, 0x12c5}, {0x12c8, 0x12d6}, {0x12d8, 0x1310}, {0x1312, 0x1315}, - {0x1318, 0x135a}, {0x135d, 0x137c}, {0x1380, 0x1399}, {0x13a0, 0x13f5}, - {0x13f8, 0x13fd}, {0x1400, 0x167f}, {0x1681, 0x169c}, {0x16a0, 0x16f8}, - {0x1700, 0x170c}, {0x170e, 0x1714}, {0x1720, 0x1736}, {0x1740, 0x1753}, - {0x1760, 0x176c}, {0x176e, 0x1770}, {0x1780, 0x17dd}, {0x17e0, 0x17e9}, - {0x17f0, 0x17f9}, {0x1800, 0x180d}, {0x1810, 0x1819}, {0x1820, 0x1878}, - {0x1880, 0x18aa}, {0x18b0, 0x18f5}, {0x1900, 0x191e}, {0x1920, 0x192b}, - {0x1930, 0x193b}, {0x1944, 0x196d}, {0x1970, 0x1974}, {0x1980, 0x19ab}, - {0x19b0, 0x19c9}, {0x19d0, 0x19da}, {0x19de, 0x1a1b}, {0x1a1e, 0x1a5e}, - {0x1a60, 0x1a7c}, {0x1a7f, 0x1a89}, {0x1a90, 0x1a99}, {0x1aa0, 0x1aad}, - {0x1ab0, 0x1abe}, {0x1b00, 0x1b4b}, {0x1b50, 0x1b7c}, {0x1b80, 0x1bf3}, - {0x1bfc, 0x1c37}, {0x1c3b, 0x1c49}, {0x1c4d, 0x1c88}, {0x1c90, 0x1cba}, - {0x1cbd, 0x1cc7}, {0x1cd0, 0x1cf9}, {0x1d00, 0x1df9}, {0x1dfb, 0x1f15}, - {0x1f18, 0x1f1d}, {0x1f20, 0x1f45}, {0x1f48, 0x1f4d}, {0x1f50, 0x1f57}, - {0x1f5f, 0x1f7d}, {0x1f80, 0x1fb4}, {0x1fb6, 0x1fc4}, {0x1fc6, 0x1fd3}, - {0x1fd6, 0x1fdb}, {0x1fdd, 0x1fef}, {0x1ff2, 0x1ff4}, {0x1ff6, 0x1ffe}, - {0x2010, 0x2027}, {0x2030, 0x205e}, {0x2074, 0x208e}, {0x2090, 0x209c}, - {0x20a0, 0x20bf}, {0x20d0, 0x20f0}, {0x2100, 0x218b}, {0x2190, 0x2426}, - {0x2440, 0x244a}, {0x2460, 0x2b73}, {0x2b76, 0x2b95}, {0x2b98, 0x2bc8}, - {0x2bca, 0x2bfe}, {0x2c00, 0x2c2e}, {0x2c30, 0x2c5e}, {0x2c60, 0x2cf3}, + {0xdf2, 0xdf4}, {0xe01, 0xe3a}, {0xe3f, 0xe5b}, {0xe86, 0xe8a}, + {0xe8c, 0xea3}, {0xea7, 0xebd}, {0xec0, 0xec4}, {0xec8, 0xecd}, + {0xed0, 0xed9}, {0xedc, 0xedf}, {0xf00, 0xf47}, {0xf49, 0xf6c}, + {0xf71, 0xf97}, {0xf99, 0xfbc}, {0xfbe, 0xfcc}, {0xfce, 0xfda}, + {0x1000, 0x10c5}, {0x10d0, 0x1248}, {0x124a, 0x124d}, {0x1250, 0x1256}, + {0x125a, 0x125d}, {0x1260, 0x1288}, {0x128a, 0x128d}, {0x1290, 0x12b0}, + {0x12b2, 0x12b5}, {0x12b8, 0x12be}, {0x12c2, 0x12c5}, {0x12c8, 0x12d6}, + {0x12d8, 0x1310}, {0x1312, 0x1315}, {0x1318, 0x135a}, {0x135d, 0x137c}, + {0x1380, 0x1399}, {0x13a0, 0x13f5}, {0x13f8, 0x13fd}, {0x1400, 0x167f}, + {0x1681, 0x169c}, {0x16a0, 0x16f8}, {0x1700, 0x170c}, {0x170e, 0x1714}, + {0x1720, 0x1736}, {0x1740, 0x1753}, {0x1760, 0x176c}, {0x176e, 0x1770}, + {0x1780, 0x17dd}, {0x17e0, 0x17e9}, {0x17f0, 0x17f9}, {0x1800, 0x180d}, + {0x1810, 0x1819}, {0x1820, 0x1878}, {0x1880, 0x18aa}, {0x18b0, 0x18f5}, + {0x1900, 0x191e}, {0x1920, 0x192b}, {0x1930, 0x193b}, {0x1944, 0x196d}, + {0x1970, 0x1974}, {0x1980, 0x19ab}, {0x19b0, 0x19c9}, {0x19d0, 0x19da}, + {0x19de, 0x1a1b}, {0x1a1e, 0x1a5e}, {0x1a60, 0x1a7c}, {0x1a7f, 0x1a89}, + {0x1a90, 0x1a99}, {0x1aa0, 0x1aad}, {0x1ab0, 0x1abe}, {0x1b00, 0x1b4b}, + {0x1b50, 0x1b7c}, {0x1b80, 0x1bf3}, {0x1bfc, 0x1c37}, {0x1c3b, 0x1c49}, + {0x1c4d, 0x1c88}, {0x1c90, 0x1cba}, {0x1cbd, 0x1cc7}, {0x1cd0, 0x1cfa}, + {0x1d00, 0x1df9}, {0x1dfb, 0x1f15}, {0x1f18, 0x1f1d}, {0x1f20, 0x1f45}, + {0x1f48, 0x1f4d}, {0x1f50, 0x1f57}, {0x1f5f, 0x1f7d}, {0x1f80, 0x1fb4}, + {0x1fb6, 0x1fc4}, {0x1fc6, 0x1fd3}, {0x1fd6, 0x1fdb}, {0x1fdd, 0x1fef}, + {0x1ff2, 0x1ff4}, {0x1ff6, 0x1ffe}, {0x2010, 0x2027}, {0x2030, 0x205e}, + {0x2074, 0x208e}, {0x2090, 0x209c}, {0x20a0, 0x20bf}, {0x20d0, 0x20f0}, + {0x2100, 0x218b}, {0x2190, 0x2426}, {0x2440, 0x244a}, {0x2460, 0x2b73}, + {0x2b76, 0x2b95}, {0x2b98, 0x2c2e}, {0x2c30, 0x2c5e}, {0x2c60, 0x2cf3}, {0x2cf9, 0x2d25}, {0x2d30, 0x2d67}, {0x2d7f, 0x2d96}, {0x2da0, 0x2da6}, {0x2da8, 0x2dae}, {0x2db0, 0x2db6}, {0x2db8, 0x2dbe}, {0x2dc0, 0x2dc6}, - {0x2dc8, 0x2dce}, {0x2dd0, 0x2dd6}, {0x2dd8, 0x2dde}, {0x2de0, 0x2e4e}, + {0x2dc8, 0x2dce}, {0x2dd0, 0x2dd6}, {0x2dd8, 0x2dde}, {0x2de0, 0x2e4f}, {0x2e80, 0x2e99}, {0x2e9b, 0x2ef3}, {0x2f00, 0x2fd5}, {0x2ff0, 0x2ffb}, {0x3001, 0x303f}, {0x3041, 0x3096}, {0x3099, 0x30ff}, {0x3105, 0x312f}, {0x3131, 0x318e}, {0x3190, 0x31ba}, {0x31c0, 0x31e3}, {0x31f0, 0x321e}, - {0x3220, 0x32fe}, {0x3300, 0x4db5}, {0x4dc0, 0x9fef}, {0xa000, 0xa48c}, - {0xa490, 0xa4c6}, {0xa4d0, 0xa62b}, {0xa640, 0xa6f7}, {0xa700, 0xa7b9}, + {0x3220, 0x4db5}, {0x4dc0, 0x9fef}, {0xa000, 0xa48c}, {0xa490, 0xa4c6}, + {0xa4d0, 0xa62b}, {0xa640, 0xa6f7}, {0xa700, 0xa7bf}, {0xa7c2, 0xa7c6}, {0xa7f7, 0xa82b}, {0xa830, 0xa839}, {0xa840, 0xa877}, {0xa880, 0xa8c5}, {0xa8ce, 0xa8d9}, {0xa8e0, 0xa953}, {0xa95f, 0xa97c}, {0xa980, 0xa9cd}, {0xa9cf, 0xa9d9}, {0xa9de, 0xa9fe}, {0xaa00, 0xaa36}, {0xaa40, 0xaa4d}, {0xaa50, 0xaa59}, {0xaa5c, 0xaac2}, {0xaadb, 0xaaf6}, {0xab01, 0xab06}, {0xab09, 0xab0e}, {0xab11, 0xab16}, {0xab20, 0xab26}, {0xab28, 0xab2e}, - {0xab30, 0xab65}, {0xab70, 0xabed}, {0xabf0, 0xabf9}, {0xac00, 0xd7a3}, + {0xab30, 0xab67}, {0xab70, 0xabed}, {0xabf0, 0xabf9}, {0xac00, 0xd7a3}, {0xd7b0, 0xd7c6}, {0xd7cb, 0xd7fb}, {0xf900, 0xfa6d}, {0xfa70, 0xfad9}, {0xfb00, 0xfb06}, {0xfb13, 0xfb17}, {0xfb1d, 0xfb36}, {0xfb38, 0xfb3c}, {0xfb46, 0xfbc1}, {0xfbd3, 0xfd3f}, {0xfd50, 0xfd8f}, {0xfd92, 0xfdc7}, {0xfdf0, 0xfdfd}, {0xfe00, 0xfe19}, {0xfe20, 0xfe52}, {0xfe54, 0xfe66}, {0xfe68, 0xfe6b}, {0xfe70, 0xfe74}, {0xfe76, 0xfefc}, {0xff01, 0xffbe}, @@ -709,57 +711,61 @@ {0x10a0c, 0x10a13}, {0x10a15, 0x10a17}, {0x10a19, 0x10a35}, {0x10a38, 0x10a3a}, {0x10a3f, 0x10a48}, {0x10a50, 0x10a58}, {0x10a60, 0x10a9f}, {0x10ac0, 0x10ae6}, {0x10aeb, 0x10af6}, {0x10b00, 0x10b35}, {0x10b39, 0x10b55}, {0x10b58, 0x10b72}, {0x10b78, 0x10b91}, {0x10b99, 0x10b9c}, {0x10ba9, 0x10baf}, {0x10c00, 0x10c48}, {0x10c80, 0x10cb2}, {0x10cc0, 0x10cf2}, {0x10cfa, 0x10d27}, {0x10d30, 0x10d39}, - {0x10e60, 0x10e7e}, {0x10f00, 0x10f27}, {0x10f30, 0x10f59}, {0x11000, 0x1104d}, - {0x11052, 0x1106f}, {0x1107f, 0x110bc}, {0x110be, 0x110c1}, {0x110d0, 0x110e8}, - {0x110f0, 0x110f9}, {0x11100, 0x11134}, {0x11136, 0x11146}, {0x11150, 0x11176}, - {0x11180, 0x111cd}, {0x111d0, 0x111df}, {0x111e1, 0x111f4}, {0x11200, 0x11211}, - {0x11213, 0x1123e}, {0x11280, 0x11286}, {0x1128a, 0x1128d}, {0x1128f, 0x1129d}, - {0x1129f, 0x112a9}, {0x112b0, 0x112ea}, {0x112f0, 0x112f9}, {0x11300, 0x11303}, - {0x11305, 0x1130c}, {0x11313, 0x11328}, {0x1132a, 0x11330}, {0x11335, 0x11339}, - {0x1133b, 0x11344}, {0x1134b, 0x1134d}, {0x1135d, 0x11363}, {0x11366, 0x1136c}, - {0x11370, 0x11374}, {0x11400, 0x11459}, {0x11480, 0x114c7}, {0x114d0, 0x114d9}, - {0x11580, 0x115b5}, {0x115b8, 0x115dd}, {0x11600, 0x11644}, {0x11650, 0x11659}, - {0x11660, 0x1166c}, {0x11680, 0x116b7}, {0x116c0, 0x116c9}, {0x11700, 0x1171a}, - {0x1171d, 0x1172b}, {0x11730, 0x1173f}, {0x11800, 0x1183b}, {0x118a0, 0x118f2}, - {0x11a00, 0x11a47}, {0x11a50, 0x11a83}, {0x11a86, 0x11aa2}, {0x11ac0, 0x11af8}, + {0x10e60, 0x10e7e}, {0x10f00, 0x10f27}, {0x10f30, 0x10f59}, {0x10fe0, 0x10ff6}, + {0x11000, 0x1104d}, {0x11052, 0x1106f}, {0x1107f, 0x110bc}, {0x110be, 0x110c1}, + {0x110d0, 0x110e8}, {0x110f0, 0x110f9}, {0x11100, 0x11134}, {0x11136, 0x11146}, + {0x11150, 0x11176}, {0x11180, 0x111cd}, {0x111d0, 0x111df}, {0x111e1, 0x111f4}, + {0x11200, 0x11211}, {0x11213, 0x1123e}, {0x11280, 0x11286}, {0x1128a, 0x1128d}, + {0x1128f, 0x1129d}, {0x1129f, 0x112a9}, {0x112b0, 0x112ea}, {0x112f0, 0x112f9}, + {0x11300, 0x11303}, {0x11305, 0x1130c}, {0x11313, 0x11328}, {0x1132a, 0x11330}, + {0x11335, 0x11339}, {0x1133b, 0x11344}, {0x1134b, 0x1134d}, {0x1135d, 0x11363}, + {0x11366, 0x1136c}, {0x11370, 0x11374}, {0x11400, 0x11459}, {0x1145d, 0x1145f}, + {0x11480, 0x114c7}, {0x114d0, 0x114d9}, {0x11580, 0x115b5}, {0x115b8, 0x115dd}, + {0x11600, 0x11644}, {0x11650, 0x11659}, {0x11660, 0x1166c}, {0x11680, 0x116b8}, + {0x116c0, 0x116c9}, {0x11700, 0x1171a}, {0x1171d, 0x1172b}, {0x11730, 0x1173f}, + {0x11800, 0x1183b}, {0x118a0, 0x118f2}, {0x119a0, 0x119a7}, {0x119aa, 0x119d7}, + {0x119da, 0x119e4}, {0x11a00, 0x11a47}, {0x11a50, 0x11aa2}, {0x11ac0, 0x11af8}, {0x11c00, 0x11c08}, {0x11c0a, 0x11c36}, {0x11c38, 0x11c45}, {0x11c50, 0x11c6c}, {0x11c70, 0x11c8f}, {0x11c92, 0x11ca7}, {0x11ca9, 0x11cb6}, {0x11d00, 0x11d06}, {0x11d0b, 0x11d36}, {0x11d3f, 0x11d47}, {0x11d50, 0x11d59}, {0x11d60, 0x11d65}, {0x11d6a, 0x11d8e}, {0x11d93, 0x11d98}, {0x11da0, 0x11da9}, {0x11ee0, 0x11ef8}, - {0x12000, 0x12399}, {0x12400, 0x1246e}, {0x12470, 0x12474}, {0x12480, 0x12543}, - {0x13000, 0x1342e}, {0x14400, 0x14646}, {0x16800, 0x16a38}, {0x16a40, 0x16a5e}, - {0x16a60, 0x16a69}, {0x16ad0, 0x16aed}, {0x16af0, 0x16af5}, {0x16b00, 0x16b45}, - {0x16b50, 0x16b59}, {0x16b5b, 0x16b61}, {0x16b63, 0x16b77}, {0x16b7d, 0x16b8f}, - {0x16e40, 0x16e9a}, {0x16f00, 0x16f44}, {0x16f50, 0x16f7e}, {0x16f8f, 0x16f9f}, - {0x17000, 0x187f1}, {0x18800, 0x18af2}, {0x1b000, 0x1b11e}, {0x1b170, 0x1b2fb}, + {0x11fc0, 0x11ff1}, {0x11fff, 0x12399}, {0x12400, 0x1246e}, {0x12470, 0x12474}, + {0x12480, 0x12543}, {0x13000, 0x1342e}, {0x14400, 0x14646}, {0x16800, 0x16a38}, + {0x16a40, 0x16a5e}, {0x16a60, 0x16a69}, {0x16ad0, 0x16aed}, {0x16af0, 0x16af5}, + {0x16b00, 0x16b45}, {0x16b50, 0x16b59}, {0x16b5b, 0x16b61}, {0x16b63, 0x16b77}, + {0x16b7d, 0x16b8f}, {0x16e40, 0x16e9a}, {0x16f00, 0x16f4a}, {0x16f4f, 0x16f87}, + {0x16f8f, 0x16f9f}, {0x16fe0, 0x16fe3}, {0x17000, 0x187f7}, {0x18800, 0x18af2}, + {0x1b000, 0x1b11e}, {0x1b150, 0x1b152}, {0x1b164, 0x1b167}, {0x1b170, 0x1b2fb}, {0x1bc00, 0x1bc6a}, {0x1bc70, 0x1bc7c}, {0x1bc80, 0x1bc88}, {0x1bc90, 0x1bc99}, {0x1bc9c, 0x1bc9f}, {0x1d000, 0x1d0f5}, {0x1d100, 0x1d126}, {0x1d129, 0x1d172}, {0x1d17b, 0x1d1e8}, {0x1d200, 0x1d245}, {0x1d2e0, 0x1d2f3}, {0x1d300, 0x1d356}, {0x1d360, 0x1d378}, {0x1d400, 0x1d454}, {0x1d456, 0x1d49c}, {0x1d4a9, 0x1d4ac}, {0x1d4ae, 0x1d4b9}, {0x1d4bd, 0x1d4c3}, {0x1d4c5, 0x1d505}, {0x1d507, 0x1d50a}, {0x1d50d, 0x1d514}, {0x1d516, 0x1d51c}, {0x1d51e, 0x1d539}, {0x1d53b, 0x1d53e}, {0x1d540, 0x1d544}, {0x1d54a, 0x1d550}, {0x1d552, 0x1d6a5}, {0x1d6a8, 0x1d7cb}, {0x1d7ce, 0x1da8b}, {0x1da9b, 0x1da9f}, {0x1daa1, 0x1daaf}, {0x1e000, 0x1e006}, - {0x1e008, 0x1e018}, {0x1e01b, 0x1e021}, {0x1e026, 0x1e02a}, {0x1e800, 0x1e8c4}, - {0x1e8c7, 0x1e8d6}, {0x1e900, 0x1e94a}, {0x1e950, 0x1e959}, {0x1ec71, 0x1ecb4}, - {0x1ee00, 0x1ee03}, {0x1ee05, 0x1ee1f}, {0x1ee29, 0x1ee32}, {0x1ee34, 0x1ee37}, - {0x1ee4d, 0x1ee4f}, {0x1ee67, 0x1ee6a}, {0x1ee6c, 0x1ee72}, {0x1ee74, 0x1ee77}, - {0x1ee79, 0x1ee7c}, {0x1ee80, 0x1ee89}, {0x1ee8b, 0x1ee9b}, {0x1eea1, 0x1eea3}, - {0x1eea5, 0x1eea9}, {0x1eeab, 0x1eebb}, {0x1f000, 0x1f02b}, {0x1f030, 0x1f093}, - {0x1f0a0, 0x1f0ae}, {0x1f0b1, 0x1f0bf}, {0x1f0c1, 0x1f0cf}, {0x1f0d1, 0x1f0f5}, - {0x1f100, 0x1f10c}, {0x1f110, 0x1f16b}, {0x1f170, 0x1f1ac}, {0x1f1e6, 0x1f202}, - {0x1f210, 0x1f23b}, {0x1f240, 0x1f248}, {0x1f260, 0x1f265}, {0x1f300, 0x1f6d4}, - {0x1f6e0, 0x1f6ec}, {0x1f6f0, 0x1f6f9}, {0x1f700, 0x1f773}, {0x1f780, 0x1f7d8}, - {0x1f800, 0x1f80b}, {0x1f810, 0x1f847}, {0x1f850, 0x1f859}, {0x1f860, 0x1f887}, - {0x1f890, 0x1f8ad}, {0x1f900, 0x1f90b}, {0x1f910, 0x1f93e}, {0x1f940, 0x1f970}, - {0x1f973, 0x1f976}, {0x1f97c, 0x1f9a2}, {0x1f9b0, 0x1f9b9}, {0x1f9c0, 0x1f9c2}, - {0x1f9d0, 0x1f9ff}, {0x1fa60, 0x1fa6d}, {0x20000, 0x2a6d6}, {0x2a700, 0x2b734}, - {0x2b740, 0x2b81d}, {0x2b820, 0x2cea1}, {0x2ceb0, 0x2ebe0}, {0x2f800, 0x2fa1d}, - {0xe0100, 0xe01ef} + {0x1e008, 0x1e018}, {0x1e01b, 0x1e021}, {0x1e026, 0x1e02a}, {0x1e100, 0x1e12c}, + {0x1e130, 0x1e13d}, {0x1e140, 0x1e149}, {0x1e2c0, 0x1e2f9}, {0x1e800, 0x1e8c4}, + {0x1e8c7, 0x1e8d6}, {0x1e900, 0x1e94b}, {0x1e950, 0x1e959}, {0x1ec71, 0x1ecb4}, + {0x1ed01, 0x1ed3d}, {0x1ee00, 0x1ee03}, {0x1ee05, 0x1ee1f}, {0x1ee29, 0x1ee32}, + {0x1ee34, 0x1ee37}, {0x1ee4d, 0x1ee4f}, {0x1ee67, 0x1ee6a}, {0x1ee6c, 0x1ee72}, + {0x1ee74, 0x1ee77}, {0x1ee79, 0x1ee7c}, {0x1ee80, 0x1ee89}, {0x1ee8b, 0x1ee9b}, + {0x1eea1, 0x1eea3}, {0x1eea5, 0x1eea9}, {0x1eeab, 0x1eebb}, {0x1f000, 0x1f02b}, + {0x1f030, 0x1f093}, {0x1f0a0, 0x1f0ae}, {0x1f0b1, 0x1f0bf}, {0x1f0c1, 0x1f0cf}, + {0x1f0d1, 0x1f0f5}, {0x1f100, 0x1f10c}, {0x1f110, 0x1f16c}, {0x1f170, 0x1f1ac}, + {0x1f1e6, 0x1f202}, {0x1f210, 0x1f23b}, {0x1f240, 0x1f248}, {0x1f260, 0x1f265}, + {0x1f300, 0x1f6d5}, {0x1f6e0, 0x1f6ec}, {0x1f6f0, 0x1f6fa}, {0x1f700, 0x1f773}, + {0x1f780, 0x1f7d8}, {0x1f7e0, 0x1f7eb}, {0x1f800, 0x1f80b}, {0x1f810, 0x1f847}, + {0x1f850, 0x1f859}, {0x1f860, 0x1f887}, {0x1f890, 0x1f8ad}, {0x1f900, 0x1f90b}, + {0x1f90d, 0x1f971}, {0x1f973, 0x1f976}, {0x1f97a, 0x1f9a2}, {0x1f9a5, 0x1f9aa}, + {0x1f9ae, 0x1f9ca}, {0x1f9cd, 0x1fa53}, {0x1fa60, 0x1fa6d}, {0x1fa70, 0x1fa73}, + {0x1fa78, 0x1fa7a}, {0x1fa80, 0x1fa82}, {0x1fa90, 0x1fa95}, {0x20000, 0x2a6d6}, + {0x2a700, 0x2b734}, {0x2b740, 0x2b81d}, {0x2b820, 0x2cea1}, {0x2ceb0, 0x2ebe0}, + {0x2f800, 0x2fa1d}, {0xe0100, 0xe01ef} #endif }; #define NUM_GRAPH_RANGE (sizeof(graphRangeTable)/sizeof(crange)) @@ -768,25 +774,24 @@ 0x9dd, 0xa0f, 0xa10, 0xa32, 0xa33, 0xa35, 0xa36, 0xa38, 0xa39, 0xa3c, 0xa47, 0xa48, 0xa51, 0xa5e, 0xab2, 0xab3, 0xad0, 0xb0f, 0xb10, 0xb32, 0xb33, 0xb47, 0xb48, 0xb56, 0xb57, 0xb5c, 0xb5d, 0xb82, 0xb83, 0xb99, 0xb9a, 0xb9c, 0xb9e, 0xb9f, 0xba3, 0xba4, 0xbd0, 0xbd7, 0xc55, 0xc56, 0xcd5, 0xcd6, 0xcde, 0xcf1, 0xcf2, - 0xd82, 0xd83, 0xdbd, 0xdca, 0xdd6, 0xe81, 0xe82, 0xe84, 0xe87, - 0xe88, 0xe8a, 0xe8d, 0xea5, 0xea7, 0xeaa, 0xeab, 0xec6, 0x10c7, - 0x10cd, 0x1258, 0x12c0, 0x1772, 0x1773, 0x1940, 0x1f59, 0x1f5b, 0x1f5d, - 0x2070, 0x2071, 0x2d27, 0x2d2d, 0x2d6f, 0x2d70, 0xfb3e, 0xfb40, 0xfb41, - 0xfb43, 0xfb44, 0xfffc, 0xfffd + 0xd82, 0xd83, 0xdbd, 0xdca, 0xdd6, 0xe81, 0xe82, 0xe84, 0xea5, + 0xec6, 0x10c7, 0x10cd, 0x1258, 0x12c0, 0x1772, 0x1773, 0x1940, 0x1f59, + 0x1f5b, 0x1f5d, 0x2070, 0x2071, 0x2d27, 0x2d2d, 0x2d6f, 0x2d70, 0xfb3e, + 0xfb40, 0xfb41, 0xfb43, 0xfb44, 0xfffc, 0xfffd #if CHRBITS > 16 ,0x1003c, 0x1003d, 0x101a0, 0x1056f, 0x10808, 0x10837, 0x10838, 0x1083c, 0x108f4, 0x108f5, 0x1093f, 0x10a05, 0x10a06, 0x11288, 0x1130f, 0x11310, 0x11332, 0x11333, - 0x11347, 0x11348, 0x11350, 0x11357, 0x1145b, 0x1145d, 0x1145e, 0x118ff, 0x11d08, - 0x11d09, 0x11d3a, 0x11d3c, 0x11d3d, 0x11d67, 0x11d68, 0x11d90, 0x11d91, 0x16a6e, - 0x16a6f, 0x16fe0, 0x16fe1, 0x1d49e, 0x1d49f, 0x1d4a2, 0x1d4a5, 0x1d4a6, 0x1d4bb, - 0x1d546, 0x1e023, 0x1e024, 0x1e95e, 0x1e95f, 0x1ee21, 0x1ee22, 0x1ee24, 0x1ee27, - 0x1ee39, 0x1ee3b, 0x1ee42, 0x1ee47, 0x1ee49, 0x1ee4b, 0x1ee51, 0x1ee52, 0x1ee54, - 0x1ee57, 0x1ee59, 0x1ee5b, 0x1ee5d, 0x1ee5f, 0x1ee61, 0x1ee62, 0x1ee64, 0x1ee7e, - 0x1eef0, 0x1eef1, 0x1f250, 0x1f251, 0x1f97a + 0x11347, 0x11348, 0x11350, 0x11357, 0x1145b, 0x118ff, 0x11d08, 0x11d09, 0x11d3a, + 0x11d3c, 0x11d3d, 0x11d67, 0x11d68, 0x11d90, 0x11d91, 0x16a6e, 0x16a6f, 0x1d49e, + 0x1d49f, 0x1d4a2, 0x1d4a5, 0x1d4a6, 0x1d4bb, 0x1d546, 0x1e023, 0x1e024, 0x1e14e, + 0x1e14f, 0x1e2ff, 0x1e95e, 0x1e95f, 0x1ee21, 0x1ee22, 0x1ee24, 0x1ee27, 0x1ee39, + 0x1ee3b, 0x1ee42, 0x1ee47, 0x1ee49, 0x1ee4b, 0x1ee51, 0x1ee52, 0x1ee54, 0x1ee57, + 0x1ee59, 0x1ee5b, 0x1ee5d, 0x1ee5f, 0x1ee61, 0x1ee62, 0x1ee64, 0x1ee7e, 0x1eef0, + 0x1eef1, 0x1f250, 0x1f251 #endif }; #define NUM_GRAPH_CHAR (sizeof(graphCharTable)/sizeof(chr)) Index: generic/tcl.h ================================================================== --- generic/tcl.h +++ generic/tcl.h @@ -708,10 +708,11 @@ int flags)); typedef void (Tcl_PanicProc) _ANSI_ARGS_((CONST char *format, ...)); typedef void (Tcl_TcpAcceptProc) _ANSI_ARGS_((ClientData callbackData, Tcl_Channel chan, char *address, int port)); typedef void (Tcl_TimerProc) _ANSI_ARGS_((ClientData clientData)); +typedef void (Tcl_TimerDeleteProc) _ANSI_ARGS_((ClientData clientData)); typedef int (Tcl_SetFromAnyProc) _ANSI_ARGS_((Tcl_Interp *interp, struct Tcl_Obj *objPtr)); typedef void (Tcl_UpdateStringProc) _ANSI_ARGS_((struct Tcl_Obj *objPtr)); typedef char *(Tcl_VarTraceProc) _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, CONST84 char *part1, CONST84 char *part2, @@ -1294,10 +1295,11 @@ /* * Flag values to pass to Tcl_DoOneEvent to disable searches for some kinds of * events: */ +#define TCL_ASYNC_EVENTS (1<<0) #define TCL_DONT_WAIT (1<<1) #define TCL_WINDOW_EVENTS (1<<2) #define TCL_FILE_EVENTS (1<<3) #define TCL_TIMER_EVENTS (1<<4) #define TCL_IDLE_EVENTS (1<<5) /* WAS 0x10 ???? */ @@ -1320,11 +1322,11 @@ /* * Positions to pass to Tcl_QueueEvent: */ typedef enum { - TCL_QUEUE_TAIL, TCL_QUEUE_HEAD, TCL_QUEUE_MARK + TCL_QUEUE_TAIL, TCL_QUEUE_HEAD, TCL_QUEUE_MARK, TCL_QUEUE_RETARDED } Tcl_QueuePosition; /* * Values to pass to Tcl_SetServiceMode to specify the behavior of notifier * event routines. Index: generic/tclClock.c ================================================================== --- generic/tclClock.c +++ generic/tclClock.c @@ -182,10 +182,13 @@ ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int ClockMillisecondsObjCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); +static int ClockMonotonicObjCmd( + ClientData clientData, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]); static int ClockParseformatargsObjCmd( ClientData clientData, Tcl_Interp* interp, int objc, Tcl_Obj *const objv[]); static int ClockSecondsObjCmd( ClientData clientData, Tcl_Interp *interp, @@ -210,10 +213,11 @@ static const struct ClockCommand clockCommands[] = { { "clicks", ClockClicksObjCmd }, { "getenv", ClockGetenvObjCmd }, { "microseconds", ClockMicrosecondsObjCmd }, { "milliseconds", ClockMillisecondsObjCmd }, + { "monotonic", ClockMonotonicObjCmd }, { "seconds", ClockSecondsObjCmd }, { "Oldscan", TclClockOldscanObjCmd }, { "ConvertLocalToUTC", ClockConvertlocaltoutcObjCmd }, { "GetDateFields", ClockGetdatefieldsObjCmd }, { "GetJulianDayFromEraYearMonthDay", @@ -1813,10 +1817,44 @@ return TCL_ERROR; } Tcl_SetObjResult(interp, Tcl_NewWideIntObj(TclpGetMicroseconds())); return TCL_OK; } + +/*---------------------------------------------------------------------- + * + * ClockMonotonicObjCmd - + * + * Returns a count of microseconds since some starting point. + * This represents monotonic time not affected from the time-jumps. + * + * Results: + * Returns a standard Tcl result. + * + * Side effects: + * None. + * + * This function implements the 'clock monotonic' Tcl command. Refer to the + * user documentation for details on what it does. + * + *---------------------------------------------------------------------- + */ + +int +ClockMonotonicObjCmd( + ClientData clientData, /* Client data is unused */ + Tcl_Interp* interp, /* Tcl interpreter */ + int objc, /* Parameter count */ + Tcl_Obj* const* objv) /* Parameter values */ +{ + if (objc != 1) { + Tcl_WrongNumArgs(interp, 1, objv, NULL); + return TCL_ERROR; + } + Tcl_SetObjResult(interp, Tcl_NewWideIntObj(TclpGetUTimeMonotonic())); + return TCL_OK; +} /* *----------------------------------------------------------------------------- * * ClockParseformatargsObjCmd -- Index: generic/tclCmdMZ.c ================================================================== --- generic/tclCmdMZ.c +++ generic/tclCmdMZ.c @@ -3954,16 +3954,17 @@ *---------------------------------------------------------------------- * * Tcl_TimeRateObjCmd -- * * This object-based procedure is invoked to process the "timerate" Tcl - * command. - * This is similar to command "time", except the execution limited by + * command. + * + * This is similar to command "time", except the execution limited by * given time (in milliseconds) instead of repetition count. * * Example: - * timerate {after 5} 1000 ; # equivalent for `time {after 5} [expr 1000/5]` + * timerate {after 5} 1000; # equivalent to: time {after 5} [expr 1000/5] * * Results: * A standard Tcl object result. * * Side effects: @@ -3977,43 +3978,44 @@ ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - static - double measureOverhead = 0; /* global measure-overhead */ + static double measureOverhead = 0; + /* global measure-overhead */ double overhead = -1; /* given measure-overhead */ register Tcl_Obj *objPtr; register int result, i; Tcl_Obj *calibrate = NULL, *direct = NULL; Tcl_WideUInt count = 0; /* Holds repetition count */ - Tcl_WideInt maxms = WIDE_MIN; + Tcl_WideInt maxms = WIDE_MIN; /* Maximal running time (in milliseconds) */ Tcl_WideUInt maxcnt = WIDE_MAX; /* Maximal count of iterations. */ Tcl_WideUInt threshold = 1; /* Current threshold for check time (faster * repeat count without time check) */ - Tcl_WideUInt maxIterTm = 1; /* Max time of some iteration as max threshold - * additionally avoid divide to zero (never < 1) */ + Tcl_WideUInt maxIterTm = 1; /* Max time of some iteration as max + * threshold, additionally avoiding divide to + * zero (i.e., never < 1) */ unsigned short factor = 50; /* Factor (4..50) limiting threshold to avoid * growth of execution time. */ register Tcl_WideInt start, middle, stop; #ifndef TCL_WIDE_CLICKS Tcl_Time now; -#endif - +#endif /* !TCL_WIDE_CLICKS */ static const char *const options[] = { "-direct", "-overhead", "-calibrate", "--", NULL }; enum options { TMRT_EV_DIRECT, TMRT_OVERHEAD, TMRT_CALIBRATE, TMRT_LAST }; - - ByteCode *codePtr = NULL; + ByteCode *codePtr = NULL; + int codeOptimized = 0; for (i = 1; i < objc - 1; i++) { - int index; + int index; + if (Tcl_GetIndexFromObj(NULL, objv[i], options, "option", TCL_EXACT, &index) != TCL_OK) { break; } if (index == TMRT_LAST) { @@ -4036,13 +4038,15 @@ calibrate = objv[i]; break; } } - if (i >= objc || i < objc-3) { -usage: - Tcl_WrongNumArgs(interp, 1, objv, "?-direct? ?-calibrate? ?-overhead double? command ?time ?max-count??"); + if (i >= objc || i < objc - 3) { + usage: + Tcl_WrongNumArgs(interp, 1, objv, + "?-direct? ?-calibrate? ?-overhead double? " + "command ?time ?max-count??"); return TCL_ERROR; } objPtr = objv[i++]; if (i < objc) { /* max-time */ result = Tcl_GetWideIntFromObj(interp, objv[i++], &maxms); @@ -4049,287 +4053,454 @@ if (result != TCL_OK) { return result; } if (i < objc) { /* max-count*/ Tcl_WideInt v; + result = Tcl_GetWideIntFromObj(interp, objv[i], &v); if (result != TCL_OK) { return result; } maxcnt = (v > 0) ? v : 0; } } - /* if calibrate */ + /* + * If we are doing calibration. + */ + if (calibrate) { + /* + * If no time specified for the calibration. + */ - /* if no time specified for the calibration */ if (maxms == WIDE_MIN) { Tcl_Obj *clobjv[6]; Tcl_WideInt maxCalTime = 5000; double lastMeasureOverhead = measureOverhead; - - clobjv[0] = objv[0]; + + clobjv[0] = objv[0]; i = 1; if (direct) { - clobjv[i++] = direct; - } - clobjv[i++] = objPtr; - - /* reset last measurement overhead */ - measureOverhead = (double)0; - - /* self-call with 100 milliseconds to warm-up, - * before entering the calibration cycle */ + clobjv[i++] = direct; + } + clobjv[i++] = objPtr; + + /* + * Reset last measurement overhead. + */ + + measureOverhead = (double) 0; + + /* + * Self-call with 100 milliseconds to warm-up, before entering the + * calibration cycle. + */ + TclNewLongObj(clobjv[i], 100); Tcl_IncrRefCount(clobjv[i]); - result = Tcl_TimeRateObjCmd(dummy, interp, i+1, clobjv); + result = Tcl_TimeRateObjCmd(NULL, interp, i + 1, clobjv); Tcl_DecrRefCount(clobjv[i]); if (result != TCL_OK) { return result; } i--; clobjv[i++] = calibrate; - clobjv[i++] = objPtr; + clobjv[i++] = objPtr; - /* set last measurement overhead to max */ - measureOverhead = (double)UWIDE_MAX; + /* + * Set last measurement overhead to max. + */ - /* calibration cycle until it'll be preciser */ + measureOverhead = (double) UWIDE_MAX; + + /* + * Run the calibration cycle until it is more precise. + */ + maxms = -1000; do { lastMeasureOverhead = measureOverhead; - TclNewLongObj(clobjv[i], (int)maxms); + TclNewLongObj(clobjv[i], (int) maxms); Tcl_IncrRefCount(clobjv[i]); - result = Tcl_TimeRateObjCmd(dummy, interp, i+1, clobjv); + result = Tcl_TimeRateObjCmd(NULL, interp, i + 1, clobjv); Tcl_DecrRefCount(clobjv[i]); if (result != TCL_OK) { return result; } maxCalTime += maxms; - /* increase maxms for preciser calibration */ - maxms -= (-maxms / 4); - /* as long as new value more as 0.05% better */ - } while ( (measureOverhead >= lastMeasureOverhead + + /* + * Increase maxms for more precise calibration. + */ + + maxms -= -maxms / 4; + + /* + * As long as new value more as 0.05% better + */ + } while ((measureOverhead >= lastMeasureOverhead || measureOverhead / lastMeasureOverhead <= 0.9995) - && maxCalTime > 0 - ); + && maxCalTime > 0); return result; } if (maxms == 0) { - /* reset last measurement overhead */ + /* + * Reset last measurement overhead + */ + measureOverhead = 0; Tcl_SetObjResult(interp, Tcl_NewLongObj(0)); return TCL_OK; } - /* if time is negative - make current overhead more precise */ + /* + * If time is negative, make current overhead more precise. + */ + if (maxms > 0) { - /* set last measurement overhead to max */ - measureOverhead = (double)UWIDE_MAX; + /* + * Set last measurement overhead to max. + */ + + measureOverhead = (double) UWIDE_MAX; } else { maxms = -maxms; } - } if (maxms == WIDE_MIN) { - maxms = 1000; + maxms = 1000; } if (overhead == -1) { overhead = measureOverhead; } - /* be sure that resetting of result will not smudge the further measurement */ + /* + * Ensure that resetting of result will not smudge the further + * measurement. + */ + Tcl_ResetResult(interp); - /* compile object */ + /* + * Compile object if needed. + */ + if (!direct) { if (TclInterpReady(interp) != TCL_OK) { return TCL_ERROR; } codePtr = TclCompileObj(interp, objPtr, NULL, 0); TclPreserveByteCode(codePtr); + /* + * Replace last compiled done instruction with continue: it's a part of + * iteration, this way evaluation will be more similar to a cycle (also + * avoids extra overhead to set result to interp, etc.) + */ + if (codePtr->codeStart[codePtr->numCodeBytes-1] == INST_DONE) { + codePtr->codeStart[codePtr->numCodeBytes-1] = INST_CONTINUE; + codeOptimized = 1; + } } - /* get start and stop time */ + /* + * Get start and stop time. + */ + #ifdef TCL_WIDE_CLICKS start = middle = TclpGetWideClicks(); - /* time to stop execution (in wide clicks) */ + + /* + * Time to stop execution (in wide clicks). + */ + stop = start + (maxms * 1000 / TclpWideClickInMicrosec()); #else Tcl_GetTime(&now); - start = now.sec; start *= 1000000; start += now.usec; + start = now.sec; + start *= 1000000; + start += now.usec; middle = start; - /* time to stop execution (in microsecs) */ + + /* + * Time to stop execution (in microsecs). + */ + stop = start + maxms * 1000; -#endif - - /* start measurement */ - if (maxcnt > 0) - while (1) { - /* eval single iteration */ - count++; - - if (!direct) { - /* precompiled */ - result = TclExecuteByteCode(interp, codePtr); - } else { - /* eval */ - result = TclEvalObjEx(interp, objPtr, 0, NULL, 0); - } - if (result != TCL_OK) { - /* allow break from measurement cycle (used for conditional stop) */ - if (result != TCL_BREAK) { - goto done; - } - /* force stop immediately */ - threshold = 1; - maxcnt = 0; - result = TCL_OK; - } - - /* don't check time up to threshold */ - if (--threshold > 0) continue; - - /* check stop time reached, estimate new threshold */ - #ifdef TCL_WIDE_CLICKS - middle = TclpGetWideClicks(); - #else - Tcl_GetTime(&now); - middle = now.sec; middle *= 1000000; middle += now.usec; - #endif - if (middle >= stop || count >= maxcnt) { - break; - } - - /* don't calculate threshold by few iterations, because sometimes first - * iteration(s) can be too fast or slow (cached, delayed clean up, etc) */ - if (count < 10) { - threshold = 1; continue; - } - - /* average iteration time in microsecs */ - threshold = (middle - start) / count; - if (threshold > maxIterTm) { - maxIterTm = threshold; - /* interations seems to be longer */ - if (threshold > (maxIterTm * 2)) { - if ((factor *= 2) > 50) factor = 50; - } else { - if (factor < 50) factor++; - } - } else if (factor > 4) { - /* interations seems to be shorter */ - if (threshold < (maxIterTm / 2)) { - if ((factor /= 2) < 4) factor = 4; - } else { - factor--; - } - } - /* as relation between remaining time and time since last check, - * maximal some % of time (by factor), so avoid growing of the execution time - * if iterations are not consistent, e. g. wax continuously on time) */ - threshold = ((stop - middle) / maxIterTm) / factor + 1; - if (threshold > 100000) { /* fix for too large threshold */ - threshold = 100000; - } - /* consider max-count */ - if (threshold > maxcnt - count) { - threshold = maxcnt - count; +#endif /* TCL_WIDE_CLICKS */ + + /* + * Start measurement. + */ + + if (maxcnt > 0) { + while (1) { + /* + * Evaluate a single iteration. + */ + + count++; + if (!direct) { /* precompiled */ + result = TclExecuteByteCode(interp, codePtr); + } else { /* eval */ + result = TclEvalObjEx(interp, objPtr, 0, NULL, 0); + } + /* + * Allow break and continue from measurement cycle (used for + * conditional stop and flow control of iterations). + */ + + switch (result) { + case TCL_OK: + break; + case TCL_BREAK: + /* + * Force stop immediately. + */ + threshold = 1; + maxcnt = 0; + case TCL_CONTINUE: + result = TCL_OK; + break; + default: + goto done; + } + + /* + * Don't check time up to threshold. + */ + + if (--threshold > 0) { + continue; + } + + /* + * Check stop time reached, estimate new threshold. + */ + +#ifdef TCL_WIDE_CLICKS + middle = TclpGetWideClicks(); +#else + Tcl_GetTime(&now); + middle = now.sec; + middle *= 1000000; + middle += now.usec; +#endif /* TCL_WIDE_CLICKS */ + + if (middle >= stop || count >= maxcnt) { + break; + } + + /* + * Don't calculate threshold by few iterations, because sometimes + * first iteration(s) can be too fast or slow (cached, delayed + * clean up, etc). + */ + + if (count < 10) { + threshold = 1; + continue; + } + + /* + * Average iteration time in microsecs. + */ + + threshold = (middle - start) / count; + if (threshold > maxIterTm) { + maxIterTm = threshold; + /* + * Iterations seem to be longer. + */ + if (threshold > maxIterTm * 2) { + factor *= 2; + if (factor > 50) { + factor = 50; + } + } else { + if (factor < 50) { + factor++; + } + } + } else if (factor > 4) { + /* + * Iterations seem to be shorter. + */ + + if (threshold < (maxIterTm / 2)) { + factor /= 2; + if (factor < 4) { + factor = 4; + } + } else { + factor--; + } + } + + /* + * As relation between remaining time and time since last check, + * maximal some % of time (by factor), so avoid growing of the + * execution time if iterations are not consistent, e.g. was + * continuously on time). + */ + + threshold = ((stop - middle) / maxIterTm) / factor + 1; + if (threshold > 100000) { /* fix for too large threshold */ + threshold = 100000; + } + + /* + * Consider max-count + */ + + if (threshold > maxcnt - count) { + threshold = maxcnt - count; + } } } { Tcl_Obj *objarr[8], **objs = objarr; - Tcl_WideInt val; - const char *fmt; - - middle -= start; /* execution time in microsecs */ - - #ifdef TCL_WIDE_CLICKS - /* convert execution time in wide clicks to microsecs */ - middle *= TclpWideClickInMicrosec(); - #endif - - /* if not calibrate */ - if (!calibrate) { - /* minimize influence of measurement overhead */ - if (overhead > 0) { - /* estimate the time of overhead (microsecs) */ - Tcl_WideUInt curOverhead = overhead * count; - if (middle > curOverhead) { - middle -= curOverhead; - } else { - middle = 0; - } - } - } else { - /* calibration - obtaining new measurement overhead */ - if (measureOverhead > (double)middle / count) { - measureOverhead = (double)middle / count; + Tcl_WideUInt usec, val; + int digits; + + /* + * Absolute execution time in microseconds or in wide clicks. + */ + usec = (Tcl_WideUInt)(middle - start); + +#ifdef TCL_WIDE_CLICKS + /* + * convert execution time (in wide clicks) to microsecs. + */ + + usec *= TclpWideClickInMicrosec(); +#endif /* TCL_WIDE_CLICKS */ + + if (!count) { /* no iterations - avoid divide by zero */ + objs[0] = objs[2] = objs[4] = Tcl_NewWideIntObj(0); + goto retRes; + } + + /* + * If not calibrating... + */ + + if (!calibrate) { + /* + * Minimize influence of measurement overhead. + */ + + if (overhead > 0) { + /* + * Estimate the time of overhead (microsecs). + */ + + Tcl_WideUInt curOverhead = overhead * count; + + if (usec > curOverhead) { + usec -= curOverhead; + } else { + usec = 0; + } + } + } else { + /* + * Calibration: obtaining new measurement overhead. + */ + + if (measureOverhead > ((double) usec) / count) { + measureOverhead = ((double) usec) / count; } objs[0] = Tcl_NewDoubleObj(measureOverhead); TclNewLiteralStringObj(objs[1], "\xC2\xB5s/#-overhead"); /* mics */ objs += 2; } - val = middle / count; /* microsecs per iteration */ + val = usec / count; /* microsecs per iteration */ if (val >= 1000000) { objs[0] = Tcl_NewWideIntObj(val); } else { - if (val < 10) { fmt = "%.6f"; } else - if (val < 100) { fmt = "%.4f"; } else - if (val < 1000) { fmt = "%.3f"; } else - if (val < 10000) { fmt = "%.2f"; } else - { fmt = "%.1f"; }; - objs[0] = Tcl_ObjPrintf(fmt, ((double)middle)/count); + if (val < 10) { + digits = 6; + } else if (val < 100) { + digits = 4; + } else if (val < 1000) { + digits = 3; + } else if (val < 10000) { + digits = 2; + } else { + digits = 1; + } + objs[0] = Tcl_ObjPrintf("%.*f", digits, ((double) usec)/count); } objs[2] = Tcl_NewWideIntObj(count); /* iterations */ - - /* calculate speed as rate (count) per sec */ - if (!middle) middle++; /* +1 ms, just to avoid divide by zero */ + + /* + * Calculate speed as rate (count) per sec + */ + + if (!usec) { + usec++; /* Avoid divide by zero. */ + } if (count < (WIDE_MAX / 1000000)) { - val = (count * 1000000) / middle; + val = (count * 1000000) / usec; if (val < 100000) { - if (val < 100) { fmt = "%.3f"; } else - if (val < 1000) { fmt = "%.2f"; } else - { fmt = "%.1f"; }; - objs[4] = Tcl_ObjPrintf(fmt, ((double)(count * 1000000)) / middle); + if (val < 100) { + digits = 3; + } else if (val < 1000) { + digits = 2; + } else { + digits = 1; + } + objs[4] = Tcl_ObjPrintf("%.*f", + digits, ((double) (count * 1000000)) / usec); } else { objs[4] = Tcl_NewWideIntObj(val); } } else { - objs[4] = Tcl_NewWideIntObj((count / middle) * 1000000); + objs[4] = Tcl_NewWideIntObj((count / usec) * 1000000); } - /* estimated net execution time (in millisecs) */ + retRes: + /* + * Estimated net execution time (in millisecs). + */ + if (!calibrate) { - objs[6] = Tcl_ObjPrintf("%.3f", (double)middle / 1000); + if (usec >= 1) { + objs[6] = Tcl_ObjPrintf("%.3f", (double)usec / 1000); + } else { + objs[6] = Tcl_NewWideIntObj(0); + } TclNewLiteralStringObj(objs[7], "nett-ms"); } /* - * Construct the result as a list because many programs have always parsed - * as such (extracting the first element, typically). - */ + * Construct the result as a list because many programs have always + * parsed as such (extracting the first element, typically). + */ TclNewLiteralStringObj(objs[1], "\xC2\xB5s/#"); /* mics/# */ TclNewLiteralStringObj(objs[3], "#"); TclNewLiteralStringObj(objs[5], "#/sec"); Tcl_SetObjResult(interp, Tcl_NewListObj(8, objarr)); } -done: - + done: if (codePtr != NULL) { + if ( codeOptimized + && codePtr->codeStart[codePtr->numCodeBytes-1] == INST_CONTINUE + ) { + codePtr->codeStart[codePtr->numCodeBytes-1] = INST_DONE; + } TclReleaseByteCode(codePtr); } - return result; } /* *---------------------------------------------------------------------- Index: generic/tclEvent.c ================================================================== --- generic/tclEvent.c +++ generic/tclEvent.c @@ -1296,10 +1296,66 @@ return 0; } else { return tsdPtr->inExit; } } + + +static CONST char *updateEventOptions[] = { + "-idle", "-noidle", /* new options */ + "-timer", "-notimer", + "-file", "-nofile", + "-window", "-nowindow", + "-async", "-noasync", + "-nowait", "-wait", + "idletasks", /* backwards compat. */ + NULL +}; + +static int +GetEventFlagsFromOpts( + Tcl_Interp *interp, /* Used for error reporting if not NULL. */ + int objc, /* Number of arguments. */ + Tcl_Obj *CONST objv[], /* Arguments containing the option to lookup. */ + int *flagsPtr) /* Input and resulting flags. */ +{ + int i, optionIndex, result = TCL_ERROR; + int flags = *flagsPtr; /* default flags */ + static CONST struct { + int mask; + int flags; + } *updateFlag, updateFlags[] = { + {0, TCL_IDLE_EVENTS}, {TCL_IDLE_EVENTS, 0}, /* -idle, -noidle */ + {0, TCL_TIMER_EVENTS}, {TCL_TIMER_EVENTS, 0}, /* -timer, -notimer */ + {0, TCL_FILE_EVENTS}, {TCL_FILE_EVENTS, 0}, /* -file, -nofile */ + {0, TCL_WINDOW_EVENTS}, {TCL_WINDOW_EVENTS, 0}, /* -window, -nowindow */ + {0, TCL_ASYNC_EVENTS}, {TCL_ASYNC_EVENTS, 0}, /* -async, -noasync */ + {0, TCL_DONT_WAIT}, {TCL_DONT_WAIT, 0}, /* -nowait, -wait */ + {TCL_ALL_EVENTS, TCL_WINDOW_EVENTS|TCL_IDLE_EVENTS}, /* idletasks */ + {0, 0} /* dummy / place holder */ + }; + + for (i = 0; i < objc; i++) { + if (Tcl_GetIndexFromObj(interp, objv[i], updateEventOptions, + "option", 0, &optionIndex) != TCL_OK) { + goto done; + } + updateFlag = &updateFlags[optionIndex]; + /* pure positive option and still default, + * reset all events (only this flag) */ + if (!updateFlag->mask && flags == *flagsPtr) { + flags &= ~TCL_ALL_EVENTS; + } + flags &= ~updateFlag->mask; + flags |= updateFlag->flags; + } + result = TCL_OK; + + done: + *flagsPtr = flags; + return result; +} /* *---------------------------------------------------------------------- * * Tcl_VwaitObjCmd -- @@ -1322,50 +1378,153 @@ ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *CONST objv[]) /* Argument objects. */ { - int done, foundEvent; - char *nameString; + int done = 0, foundEvent = 1, checktime = 0; + int flags = TCL_ALL_EVENTS; /* default flags */ + const char *nameString; + int optc = objc - 2; /* options count without cmd and varname */ + Tcl_WideInt usec = -1; + Tcl_WideInt now = 0, wakeup = 0; - if (objc != 2) { - Tcl_WrongNumArgs(interp, 1, objv, "name"); + if (objc < 2) { + Tcl_WrongNumArgs(interp, 1, objv, "?options? ?timeout? name"); return TCL_ERROR; } - nameString = Tcl_GetString(objv[1]); - if (Tcl_TraceVar(interp, nameString, + + /* if arguments available - wrap options to flags */ + if (objc >= 3) { + /* first try to recognize options up to the possible end, thereby + * we assume that option is not an integer, try to get numeric timeout + */ + if (!TclObjIsIndexOfTable(objv[optc], updateEventOptions) + && TclpGetUTimeFromObj(NULL, objv[optc], &usec, 1000) == TCL_OK) { + if (usec < 0) { usec = 0; }; + optc--; + } + + /* now try to parse options (if available) */ + if ( optc > 0 + && GetEventFlagsFromOpts(interp, optc, objv+1, &flags) != TCL_OK + ) { + return TCL_ERROR; + } + } + + /* + * If timeout specified - create timer event or no-wait by 0ms. + * Note the time can be switched (time-jump), so use monotonic time here. + */ + if (usec != -1) { + if (usec > 0) { + now = TclpGetUTimeMonotonic(); + wakeup = now + usec; + } else { + flags |= TCL_DONT_WAIT; + } + } + + nameString = Tcl_GetString(objv[objc-1]); + if (Tcl_TraceVar2(interp, nameString, NULL, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, VwaitVarProc, (ClientData) &done) != TCL_OK) { return TCL_ERROR; }; - done = 0; - foundEvent = 1; - while (!done && foundEvent) { - foundEvent = Tcl_DoOneEvent(TCL_ALL_EVENTS); + + do { + /* if wait - set blocking time */ + if (usec > 0) { + Tcl_Time blockTime; + Tcl_WideInt diff; + + now = TclpGetUTimeMonotonic(); + + /* calculate blocking time */ + diff = wakeup - now; + diff -= 1; /* overhead for this code (e. g. Tcl_TraceVar/Tcl_UntraceVar) */ + /* be sure process at least one event */ + if (diff <= 0) { + /* timeout occurs */ + if (checktime) { + done = -1; + break; + } + /* expired, be sure non-negative values here */ + diff = 0; + checktime = 1; + } + blockTime.sec = diff / 1000000; + blockTime.usec = diff % 1000000; + Tcl_SetMaxBlockTime(&blockTime); + } + if ((foundEvent = Tcl_DoOneEvent(flags)) <= 0) { + /* + * If don't wait flag set - no error, and two cases: + * option -nowait for vwait means - we don't wait for events; + * if no timeout (0) - just stop waiting (no more events) + */ + if (foundEvent == 0 && (flags & TCL_DONT_WAIT || usec != -1)) { + foundEvent = 1; + if (usec == 0) { /* timeout occurs */ + done = -1; + break; + } + } + /* don't stop wait - no event expected here + * (stop only on error case foundEvent <= 0). */ + if (foundEvent < 0) { + done = -2; + } + } + /* check interpreter limit exceeded */ if (Tcl_LimitExceeded(interp)) { + Tcl_SetObjResult(interp, Tcl_NewStringObj("limit exceeded", -1)); + done = -4; break; } - } - Tcl_UntraceVar(interp, nameString, + } while (!done); + + Tcl_UntraceVar2(interp, nameString, NULL, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, VwaitVarProc, (ClientData) &done); + + /* if some error */ + if (done <= -2) { + + if (done == -2) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't wait for variable \"%s\": would wait forever", + nameString)); + Tcl_SetErrorCode(interp, "TCL", "EVENT", "NO_SOURCES", NULL); + return TCL_ERROR; + } + + /* + * The interpreter's result was already set to the right error message + * prior to exiting the loop above. + */ + + return TCL_ERROR; + } + + /* if timeout specified (and no errors) */ + if (usec != -1) { + Tcl_Obj *objPtr; + + /* done - true, timeout false */ + TclNewLongObj(objPtr, (done > 0)); + Tcl_SetObjResult(interp, objPtr); + return TCL_OK; + } /* * Clear out the interpreter's result, since it may have been set by event * handlers. */ Tcl_ResetResult(interp); - if (!foundEvent) { - Tcl_AppendResult(interp, "can't wait for variable \"", nameString, - "\": would wait forever", NULL); - return TCL_ERROR; - } - if (!done) { - Tcl_AppendResult(interp, "limit exceeded", NULL); - return TCL_ERROR; - } return TCL_OK; } /* ARGSUSED */ static char * @@ -1407,40 +1566,28 @@ ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *CONST objv[]) /* Argument objects. */ { - int optionIndex; - int flags = 0; /* Initialized to avoid compiler warning. */ - static CONST char *updateOptions[] = {"idletasks", NULL}; - enum updateOptions {REGEXP_IDLETASKS}; - - if (objc == 1) { - flags = TCL_ALL_EVENTS|TCL_DONT_WAIT; - } else if (objc == 2) { - if (Tcl_GetIndexFromObj(interp, objv[1], updateOptions, - "option", 0, &optionIndex) != TCL_OK) { - return TCL_ERROR; - } - switch ((enum updateOptions) optionIndex) { - case REGEXP_IDLETASKS: - flags = TCL_WINDOW_EVENTS|TCL_IDLE_EVENTS|TCL_DONT_WAIT; - break; - default: - Tcl_Panic("Tcl_UpdateObjCmd: bad option index to UpdateOptions"); - } - } else { - Tcl_WrongNumArgs(interp, 1, objv, "?idletasks?"); - return TCL_ERROR; + int flags = TCL_ALL_EVENTS|TCL_DONT_WAIT; /* default flags */ + + /* if arguments available - wrap options to flags */ + if (objc > 1) { + if (GetEventFlagsFromOpts(interp, objc-1, objv+1, &flags) != TCL_OK) { + return TCL_ERROR; + } } while (Tcl_DoOneEvent(flags) != 0) { if (Tcl_LimitExceeded(interp)) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, "limit exceeded", NULL); return TCL_ERROR; } + + /* be sure not to produce infinite wait (wait only once) */ + flags |= TCL_DONT_WAIT; } /* * Must clear the interpreter's result because event handlers could have * executed commands. Index: generic/tclHash.c ================================================================== --- generic/tclHash.c +++ generic/tclHash.c @@ -322,11 +322,14 @@ #if TCL_HASH_KEY_STORE_HASH if (hash != PTR2UINT(hPtr->hash)) { continue; } #endif - if (compareKeysProc((VOID *) key, hPtr)) { + /* if keys pointers or values are equal */ + if ((key == hPtr->key.oneWordValue) + || compareKeysProc((VOID *) key, hPtr) + ) { if (newPtr) { *newPtr = 0; } return hPtr; } Index: generic/tclIO.c ================================================================== --- generic/tclIO.c +++ generic/tclIO.c @@ -165,11 +165,11 @@ static ChannelBuffer * AllocChannelBuffer(int length); static void PreserveChannelBuffer(ChannelBuffer *bufPtr); static void ReleaseChannelBuffer(ChannelBuffer *bufPtr); static int IsShared(ChannelBuffer *bufPtr); static void ChannelFree(Channel *chanPtr); -static void ChannelTimerProc(ClientData clientData); +static int ChannelScheduledProc(Tcl_Event *evPtr, int flags); static int ChanRead(Channel *chanPtr, char *dst, int dstSize); static int CheckChannelErrors(ChannelState *statePtr, int direction); static int CheckForDeadChannel(Tcl_Interp *interp, ChannelState *statePtr); @@ -1588,11 +1588,11 @@ statePtr->inQueueTail = NULL; statePtr->chPtr = NULL; statePtr->interestMask = 0; statePtr->scriptRecordPtr = NULL; statePtr->bufSize = CHANNELBUFFER_DEFAULT_SIZE; - statePtr->timer = NULL; + statePtr->schedEvent = NULL; statePtr->csPtrR = NULL; statePtr->csPtrW = NULL; statePtr->outputStage = NULL; /* @@ -2967,14 +2967,21 @@ Tcl_SetErrno(errorCode); } } /* - * Cancel any outstanding timer. + * Cancel any outstanding scheduled event. */ - Tcl_DeleteTimerHandler(statePtr->timer); + if (statePtr->schedEvent) { + /* reset channel in event (cancel delayed) */ + *(Channel**)(statePtr->schedEvent+1) = NULL; +#if 0 + TclpCancelEvent(statePtr->schedEvent); +#endif + statePtr->schedEvent = NULL; + } /* * Mark the channel as deleted by clearing the type structure. */ @@ -3449,14 +3456,21 @@ chanPtr = (Channel *) channel; statePtr = chanPtr->state; chanPtr = statePtr->topChanPtr; /* - * Cancel any outstanding timer. + * Cancel any outstanding scheduled event. */ - Tcl_DeleteTimerHandler(statePtr->timer); + if (statePtr->schedEvent) { + /* reset channel in event (cancel delayed) */ + *(Channel**)(statePtr->schedEvent+1) = NULL; +#if 0 + TclpCancelEvent(statePtr->schedEvent); +#endif + statePtr->schedEvent = NULL; + } /* * Remove any references to channel handlers for this channel that may be * about to be invoked. */ @@ -4386,11 +4400,11 @@ Tcl_SetObjLength(objPtr, oldLength); /* * We didn't get a complete line so we need to indicate to UpdateInterest * that the gets blocked. It will wait for more data instead of firing a - * timer, avoiding a busy wait. This is where we are assuming that the + * event, avoiding a busy wait. This is where we are assuming that the * next operation is a gets. No more file events will be delivered on this * channel until new data arrives or some operation is performed on the * channel (e.g. gets, read, fconfigure) that changes the blocking state. * Note that this means a file event will not be delivered even though a * read would be able to consume the buffered data. @@ -4667,11 +4681,11 @@ byteArray = Tcl_SetByteArrayLength(objPtr, oldLength); /* * We didn't get a complete line so we need to indicate to UpdateInterest * that the gets blocked. It will wait for more data instead of firing a - * timer, avoiding a busy wait. This is where we are assuming that the + * event, avoiding a busy wait. This is where we are assuming that the * next operation is a gets. No more file events will be delivered on this * channel until new data arrives or some operation is performed on the * channel (e.g. gets, read, fconfigure) that changes the blocking state. * Note that this means a file event will not be delivered even though a * read would be able to consume the buffered data. @@ -7971,10 +7985,25 @@ Tcl_Release(statePtr); TclChannelRelease(channel); tsdPtr->nestedHandlerPtr = nh.nestedHandlerPtr; } + +static inline Tcl_Event * +CreateChannelScheduledEvent( + Channel *chanPtr) +{ +#ifdef SYNTHETIC_EVENT_TIME + Tcl_Time blckTime; + + blckTime.sec = SYNTHETIC_EVENT_TIME / 1000000; + blckTime.usec = SYNTHETIC_EVENT_TIME % 1000000; + Tcl_SetMaxBlockTime(&blckTime); +#endif + return TclpQueueEventClientData(ChannelScheduledProc, chanPtr, + TCL_QUEUE_RETARDED); +} /* *---------------------------------------------------------------------- * * UpdateInterest -- @@ -7984,11 +8013,11 @@ * * Results: * None. * * Side effects: - * May schedule a timer or driver handler. + * May schedule a event or driver handler. * *---------------------------------------------------------------------- */ static void @@ -8013,11 +8042,11 @@ mask |= TCL_WRITABLE; } /* * If there is data in the input queue, and we aren't waiting for more - * data, then we need to schedule a timer so we don't block in the + * data, then we need to schedule an event so we don't block in the * notifier. Also, cancel the read interest so we don't get duplicate * events. */ if (mask & TCL_READABLE) { @@ -8042,11 +8071,11 @@ * * In that case we can get into a situation where * * - Tcl drops READABLE here, because it has data in its own * buffers waiting to be read by the extension. - * - A READABLE event is syntesized via timer. + * - A READABLE event is syntesized via tcl-event (on queue tail). * - The OS still reports the EXCEPTION condition on the file. * - And the extension gets the EXCPTION event first, and handles * this as EOF. * * End result ==> Premature end of reading from a file. @@ -8064,25 +8093,24 @@ * testsuite on all of them. */ mask &= ~TCL_EXCEPTION; - if (!statePtr->timer) { - statePtr->timer = Tcl_CreateTimerHandler(0, ChannelTimerProc, - chanPtr); + if (!statePtr->schedEvent) { + statePtr->schedEvent = CreateChannelScheduledEvent(chanPtr); } } } (chanPtr->typePtr->watchProc)(chanPtr->instanceData, mask); } /* *---------------------------------------------------------------------- * - * ChannelTimerProc -- + * ChannelScheduledProc -- * - * Timer handler scheduled by UpdateInterest to monitor the channel + * Event handler scheduled by UpdateInterest to monitor the channel * buffers until they are empty. * * Results: * None. * @@ -8090,35 +8118,45 @@ * May invoke channel handlers. * *---------------------------------------------------------------------- */ -static void -ChannelTimerProc( - ClientData clientData) +static int +ChannelScheduledProc( + Tcl_Event *evPtr, int flags) { - Channel *chanPtr = clientData; - ChannelState *statePtr = chanPtr->state; - /* State info for channel */ + Channel *chanPtr = *(Channel**)(evPtr+1); + ChannelState *statePtr; /* State info for channel */ + + if (!chanPtr) { /* channel deleted */ + return 1; + } + + statePtr = chanPtr->state; if (!GotFlag(statePtr, CHANNEL_NEED_MORE_DATA) && (statePtr->interestMask & TCL_READABLE) && (statePtr->inQueueHead != NULL) && IsBufferReady(statePtr->inQueueHead)) { + /* - * Restart the timer in case a channel handler reenters the event loop + * Prolong the event in case a channel handler reenters the event loop * before UpdateInterest gets called by Tcl_NotifyChannel. */ - statePtr->timer = Tcl_CreateTimerHandler(0, ChannelTimerProc,chanPtr); + statePtr->schedEvent = CreateChannelScheduledEvent(chanPtr); + Tcl_Preserve(statePtr); Tcl_NotifyChannel((Tcl_Channel) chanPtr, TCL_READABLE); Tcl_Release(statePtr); - } else { - statePtr->timer = NULL; - UpdateInterest(chanPtr); + + return 1; /* next cycle */ } + + statePtr->schedEvent = NULL; /* event done. */ + UpdateInterest(chanPtr); + return 1; } /* *---------------------------------------------------------------------- * @@ -8567,13 +8605,13 @@ } /* *---------------------------------------------------------------------- * - * ZeroTransferTimerProc -- + * ZeroTransferEventProc -- * - * Timer handler scheduled by TclCopyChannel so that -command is + * Event handler scheduled by TclCopyChannel so that -command is * called asynchronously even when -size is 0. * * Results: * None. * @@ -8581,18 +8619,21 @@ * Calls CopyData for -command invocation. * *---------------------------------------------------------------------- */ -static void -ZeroTransferTimerProc( - ClientData clientData) +static int +ZeroTransferEventProc( + Tcl_Event *evPtr, int flags) { /* calling CopyData with mask==0 still implies immediate invocation of the * -command callback, and completion of the fcopy. */ + ClientData clientData = *(ClientData*)(evPtr+1); CopyData(clientData, 0); + + return 1; } /* *---------------------------------------------------------------------- * @@ -8705,11 +8746,11 @@ * Special handling of -size 0 async transfers, so that the -command is * still called asynchronously. */ if ((nonBlocking == CHANNEL_NONBLOCKING) && (toRead == 0)) { - Tcl_CreateTimerHandler(0, ZeroTransferTimerProc, csPtr); + TclpQueueEventClientData(ZeroTransferEventProc, csPtr, TCL_QUEUE_TAIL); return 0; } /* * Start copying data between the channels. Index: generic/tclIO.h ================================================================== --- generic/tclIO.h +++ generic/tclIO.h @@ -185,11 +185,11 @@ * handlers for. */ EventScriptRecord *scriptRecordPtr; /* Chain of all scripts registered for event * handlers ("fileevent") on this channel. */ int bufSize; /* What size buffers to allocate? */ - Tcl_TimerToken timer; /* Handle to wakeup timer for this channel. */ + Tcl_Event *schedEvent; /* Scheduler event to wakeup this channel. */ struct CopyState *csPtrR; /* State of background copy for which channel * is input, or NULL. */ struct CopyState *csPtrW; /* State of background copy for which channel * is output, or NULL. */ Channel *topChanPtr; /* Refers to topmost channel in a stack. Never Index: generic/tclIndexObj.c ================================================================== --- generic/tclIndexObj.c +++ generic/tclIndexObj.c @@ -25,11 +25,11 @@ /* * The structure below defines the index Tcl object type by means of functions * that can be invoked by generic object code. */ -static Tcl_ObjType indexType = { +Tcl_ObjType tclIndexType = { "index", /* name */ FreeIndex, /* freeIntRepProc */ DupIndex, /* dupIntRepProc */ UpdateStringOfIndex, /* updateStringProc */ SetIndexFromAny /* setFromAnyProc */ @@ -57,10 +57,47 @@ (*((const char *const *)(((char *)(table)) + (offset)))) #define NEXT_ENTRY(table, offset) \ (&(STRING_AT(table, offset))) #define EXPAND_OF(indexRep) \ STRING_AT((indexRep)->tablePtr, (indexRep)->offset*(indexRep)->index) + +/* + *---------------------------------------------------------------------- + * + * TclObjIsIndexOfStruct -- + * + * This function looks up an object's is a index of given table. + * + * Used for fast lookup by dynamic options count to check for other + * object types. + * + * Results: + * 1 if object is an option of table, otherwise 0. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ +int +TclObjIsIndexOfStruct( + Tcl_Obj *objPtr, /* Object containing the string to lookup. */ + const void *tablePtr) /* Array of strings to compare against the + * value of objPtr; last entry must be NULL + * and there must not be duplicate entries. */ +{ + IndexRep *indexRep; + if (objPtr->typePtr != &tclIndexType) { + return 0; + } + indexRep = objPtr->internalRep.twoPtrValue.ptr1; + + if (indexRep->tablePtr != (void *) tablePtr) { + return 0; + } + return 1; +} /* *---------------------------------------------------------------------- * * Tcl_GetIndexFromObj -- @@ -103,11 +140,11 @@ * See if there is a valid cached result from a previous lookup (doing the * check here saves the overhead of calling Tcl_GetIndexFromObjStruct in * the common case where the result is cached). */ - if (objPtr->typePtr == &indexType) { + if (objPtr->typePtr == &tclIndexType) { IndexRep *indexRep = objPtr->internalRep.twoPtrValue.ptr1; /* * Here's hoping we don't get hit by unfortunate packing constraints * on odd platforms like a Cray PVP... @@ -177,11 +214,11 @@ } /* * See if there is a valid cached result from a previous lookup. */ - if (objPtr->typePtr == &indexType) { + if (objPtr->typePtr == &tclIndexType) { indexRep = objPtr->internalRep.twoPtrValue.ptr1; if (indexRep->tablePtr==tablePtr && indexRep->offset==offset) { *indexPtr = indexRep->index; return TCL_OK; } @@ -238,17 +275,17 @@ * Cache the found representation. Note that we want to avoid allocating a * new internal-rep if at all possible since that is potentially a slow * operation. */ - if (objPtr->typePtr == &indexType) { + if (objPtr->typePtr == &tclIndexType) { indexRep = objPtr->internalRep.twoPtrValue.ptr1; } else { TclFreeIntRep(objPtr); indexRep = (IndexRep *) ckalloc(sizeof(IndexRep)); objPtr->internalRep.twoPtrValue.ptr1 = indexRep; - objPtr->typePtr = &indexType; + objPtr->typePtr = &tclIndexType; } indexRep->tablePtr = (void *) tablePtr; indexRep->offset = offset; indexRep->index = index; @@ -380,11 +417,11 @@ IndexRep *srcIndexRep = srcPtr->internalRep.twoPtrValue.ptr1; IndexRep *dupIndexRep = (IndexRep *) ckalloc(sizeof(IndexRep)); memcpy(dupIndexRep, srcIndexRep, sizeof(IndexRep)); dupPtr->internalRep.twoPtrValue.ptr1 = dupIndexRep; - dupPtr->typePtr = &indexType; + dupPtr->typePtr = &tclIndexType; } /* *---------------------------------------------------------------------- * @@ -530,11 +567,11 @@ for (i=0 ; itypePtr == &indexType) { + if (origObjv[i]->typePtr == &tclIndexType) { register IndexRep *indexRep = origObjv[i]->internalRep.twoPtrValue.ptr1; elementStr = EXPAND_OF(indexRep); elemLen = strlen(elementStr); @@ -586,11 +623,11 @@ * If the object is an index type use the index table which allows for * the correct error message even if the subcommand was abbreviated. * Otherwise, just use the string rep. */ - if (objv[i]->typePtr == &indexType) { + if (objv[i]->typePtr == &tclIndexType) { register IndexRep *indexRep = objv[i]->internalRep.twoPtrValue.ptr1; Tcl_AppendStringsToObj(objPtr, EXPAND_OF(indexRep), NULL); } else if (objv[i]->typePtr == &tclEnsembleCmdType) { register EnsembleCmdRep *ecrPtr = Index: generic/tclInt.h ================================================================== --- generic/tclInt.h +++ generic/tclInt.h @@ -52,10 +52,20 @@ || defined(__cplusplus) || defined(_MSC_VER) #include #else typedef int ptrdiff_t; #endif + +/* + * [MSVC] fallback to replace C++ keyword "inline" with C keyword "__inline" + * Otherwise depending on the VC-version, context, include-order it can cause: + * error C2054: expected '(' to follow 'inline' + */ +#if defined(_MSC_VER) && !defined(inline) +# define inline __inline +#endif + /* * Ensure WORDS_BIGENDIAN is defined correctly: * Needs to happen here in addition to configure to work with fat compiles on * Darwin (where configure runs only once for multiple architectures). @@ -125,10 +135,62 @@ # define UINT2PTR(p) ((void *)(p)) # define PTR2UINT(p) ((unsigned int)(p)) # endif #endif +/* + *---------------------------------------------------------------- + * Data structures related to timer / idle events. + *---------------------------------------------------------------- + */ + +#define TCL_TMREV_PROMPT (1 << 0) /* Mark immediate event (0 microseconds) */ +#define TCL_TMREV_AT (1 << 1) /* Mark timer event to execute verbatim + * at the due-time (regardless any + * time-jumps). */ +#define TCL_TMREV_IDLE (1 << 3) /* Mark idle event */ +#define TCL_TMREV_LISTED (1 << 5) /* Event listed (attached to queue). */ +#define TCL_TMREV_DELETE (1 << 7) /* Event will be deleted. */ + +/* + * This structure used for handling of timer events (with or without time to + * invoke, e. g. created with "after 0") or declared in a call to Tcl_DoWhenIdle + * (created with "after idle"). All of the currently-active handlers are linked + * together into corresponding list. + * + * For each timer callback that's pending there is one record of the following + * type. The normal handlers (created by Tcl_CreateTimerHandler) are chained + * together in a list via TclTimerEvent sorted by time (earliest event first). + */ + +typedef struct TclTimerEvent { + Tcl_TimerProc *proc; /* Function to call timer/idle event */ + Tcl_TimerDeleteProc *deleteProc; /* Function to cleanup idle event */ + ClientData clientData; /* Argument to pass to proc and deleteProc */ + int flags; /* Flags, OR-ed combination of flags/states + * TCL_TMREV_PROMPT ... TCL_TMREV_DELETE */ + + Tcl_WideInt time; /* When timer is to fire (absolute/relative). */ + Tcl_TimerToken token; /* Identifies handler so it can be deleted. */ + + size_t generation; /* Used to distinguish older handlers from + * recently-created ones. */ + size_t refCount; /* Used to preserve for deletion (nested exec + * resp. prolongation). */ + struct TclTimerEvent *nextPtr;/* Next and prev event in idle queue, */ + struct TclTimerEvent *prevPtr;/* or NULL for end/start of the queue. */ + /* variable ExtraData */ /* If extraDataSize supplied to create event. */ +} TclTimerEvent; + +/* + * Macros to wrap ExtraData and TclTimerEvent (and vice versa) + */ +#define TclpTimerEvent2ExtraData(ptr) \ + ( (ClientData)(((TclTimerEvent *)(ptr))+1) ) +#define TclpExtraData2TimerEvent(ptr) \ + ( ((TclTimerEvent *)(ptr))-1 ) + /* * The following procedures allow namespaces to be customized to support * special name resolution rules for commands/variables. */ @@ -1795,12 +1857,11 @@ LimitHandler *timeHandlers; /* Handlers to execute when the limit is * reached. */ int timeGranularity; /* Mod factor used to determine how often to * evaluate the limit check. */ - Tcl_TimerToken timeEvent; - /* Handle for a timer callback that will occur + TclTimerEvent *timeEvent;/* Handle for a timer callback that will occur * when the time-limit is exceeded. */ Tcl_HashTable callbacks;/* Mapping from (interp,type) pair to data * used to install a limit handler callback to * run in _this_ interp when the limit is @@ -1944,21 +2005,40 @@ /* * Macros for splicing into and out of doubly linked lists. They assume * existence of struct items 'prevPtr' and 'nextPtr'. * * a = element to add or remove. - * b = list head. + * b = list head (points to the first element). + * e = list tail (points to the last element). * * TclSpliceIn adds to the head of the list. + * TclSpliceTail adds to the tail of the list. */ #define TclSpliceIn(a,b) \ - (a)->nextPtr = (b); \ - if ((b) != NULL) { \ + if (((a)->nextPtr = (b)) != NULL) { \ (b)->prevPtr = (a); \ } \ (a)->prevPtr = NULL, (b) = (a); + +#define TclSpliceInEx(a,b,e) \ + TclSpliceIn(a,b); \ + if ((e) == NULL) { \ + (e) = (a); \ + } + +#define TclSpliceTail(a,e) \ + if (((a)->prevPtr = (e)) != NULL) { \ + (e)->nextPtr = (a); \ + } \ + (a)->nextPtr = NULL, (e) = (a); + +#define TclSpliceTailEx(a,b,e) \ + TclSpliceTail(a,e); \ + if ((b) == NULL) { \ + (b) = (a); \ + } #define TclSpliceOut(a,b) \ if ((a)->prevPtr != NULL) { \ (a)->prevPtr->nextPtr = (a)->nextPtr; \ } else { \ @@ -1965,10 +2045,15 @@ (b) = (a)->nextPtr; \ } \ if ((a)->nextPtr != NULL) { \ (a)->nextPtr->prevPtr = (a)->prevPtr; \ } + +#define TclSpliceOutEx(a,b,e) \ + TclSpliceOut(a,b) else { \ + (e) = (e)->prevPtr; \ + } /* * EvalFlag bits for Interp structures: * * TCL_ALLOW_EXCEPTIONS 1 means it's OK for the script to terminate with a @@ -2404,10 +2489,11 @@ MODULE_SCOPE Tcl_ObjType tclByteArrayType; MODULE_SCOPE Tcl_ObjType tclByteCodeType; MODULE_SCOPE Tcl_ObjType tclDoubleType; MODULE_SCOPE Tcl_ObjType tclEndOffsetType; MODULE_SCOPE Tcl_ObjType tclIntType; +MODULE_SCOPE Tcl_ObjType tclIndexType; MODULE_SCOPE Tcl_ObjType tclListType; MODULE_SCOPE Tcl_ObjType tclDictType; MODULE_SCOPE Tcl_ObjType tclProcBodyType; MODULE_SCOPE Tcl_ObjType tclStringType; MODULE_SCOPE Tcl_ObjType tclArraySearchType; @@ -2472,16 +2558,23 @@ /* Mask to isolate the conversion type */ #define TCL_DD_STEELE0 0x1 /* 'Steele&White' after masking */ #define TCL_DD_SHORTEST0 0x0 /* 'Shortest possible' after masking */ + /* *---------------------------------------------------------------- * Procedures shared among Tcl modules but not used by the outside world: *---------------------------------------------------------------- */ + +MODULE_SCOPE int TclObjIsIndexOfStruct(Tcl_Obj *objPtr, + const void *tablePtr); +#define TclObjIsIndexOfTable(objPtr, tablePtr) \ + ((objPtr->typePtr == &tclIndexType) \ + && TclObjIsIndexOfStruct(objPtr, tablePtr)) MODULE_SCOPE void TclAppendBytesToByteArray(Tcl_Obj *objPtr, const unsigned char *bytes, int len); MODULE_SCOPE void TclAdvanceContinuations(int* line, int** next, int loc); MODULE_SCOPE void TclAdvanceLines(int *line, const char *start, @@ -2636,10 +2729,12 @@ CONST char **endPtr); MODULE_SCOPE int TclMergeReturnOptions(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], Tcl_Obj **optionsPtrPtr, int *codePtr, int *levelPtr); MODULE_SCOPE int TclNokia770Doubles(); +MODULE_SCOPE void TclNsDecrRefCount(Namespace *nsPtr); +MODULE_SCOPE int TclNamespaceDeleted(Namespace *nsPtr); MODULE_SCOPE void TclObjVarErrMsg(Tcl_Interp *interp, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, const char *operation, const char *reason, int index); MODULE_SCOPE int TclObjInvokeNamespace(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], @@ -2780,13 +2875,74 @@ # define TCL_WIDE_CLICKS 1 MODULE_SCOPE Tcl_WideInt TclpGetWideClicks(void); MODULE_SCOPE double TclpWideClickInMicrosec(void); # define TclpWideClicksToNanoseconds(clicks) \ ((double)(clicks) * TclpWideClickInMicrosec() * 1000) + /* Tolerance (in percent), prevents entering busy wait, but has fewer accuracy + * because can wait a bit shorter as wanted. Currently experimental value + * (4.5% equivalent to 15600 / 15000 with small overhead) */ +# ifndef TMR_RES_TOLERANCE +# define TMR_RES_TOLERANCE 4.5 +# endif # endif #endif MODULE_SCOPE Tcl_WideInt TclpGetMicroseconds(void); +MODULE_SCOPE Tcl_WideInt TclpGetUTimeMonotonic(void); + +MODULE_SCOPE int TclpGetUTimeFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, + Tcl_WideInt *timePtr, int factor); +MODULE_SCOPE void TclpScaleUTime(Tcl_WideInt *usec); + +MODULE_SCOPE void TclpUSleep(Tcl_WideInt usec); +/* + * Helper macros for working with times. TCL_TIME_BEFORE encodes how to write + * the ordering relation on (normalized) times, and TCL_TIME_DIFF_MS resp. + * TCL_TIME_DIFF_US compute the number of milliseconds or microseconds difference + * between two times. Both macros use both of their arguments multiple times, + * so make sure they are cheap and side-effect free. + * Macro TCL_TIME_TO_USEC converts Tcl_Time to microseconds. + * The "prototypes" for these macros are: + * + * static int TCL_TIME_BEFORE(Tcl_Time t1, Tcl_Time t2); + * static Tcl_WideInt TCL_TIME_DIFF_MS(Tcl_Time t1, Tcl_Time t2); + * static Tcl_WideInt TCL_TIME_DIFF_US(Tcl_Time t1, Tcl_Time t2); + * static Tcl_WideInt TCL_TIME_TO_USEC(Tcl_Time t) + */ + +#define TCL_TIME_BEFORE(t1, t2) \ + (((t1).sec<(t2).sec) || ((t1).sec==(t2).sec && (t1).usec<(t2).usec)) + +#define TCL_TIME_DIFF_MS(t1, t2) \ + (1000*((Tcl_WideInt)(t1).sec - (Tcl_WideInt)(t2).sec) + \ + ((long)(t1).usec - (long)(t2).usec)/1000) +#define TCL_TIME_DIFF_US(t1, t2) \ + (1000000*((Tcl_WideInt)(t1).sec - (Tcl_WideInt)(t2).sec) + \ + ((long)(t1).usec - (long)(t2).usec)) +#define TCL_TIME_TO_USEC(t) \ + (((Tcl_WideInt)(t).sec)*1000000 + (t).usec) + +static inline void +TclTimeSetMilliseconds( + register Tcl_Time *timePtr, + register double ms +) { + timePtr->sec = (long)(ms / 1000); + timePtr->usec = (((long)ms) % 1000) * 1000 + (((long)(ms*1000)) % 1000); +} + +static inline void +TclTimeAddMilliseconds( + register Tcl_Time *timePtr, + register double ms +) { + timePtr->sec += (long)(ms / 1000); + timePtr->usec += (((long)ms) % 1000) * 1000 + (((long)(ms*1000)) % 1000); + if (timePtr->usec > 1000000) { + timePtr->usec -= 1000000; + timePtr->sec++; + } +} MODULE_SCOPE Tcl_Obj * TclDisassembleByteCodeObj(Tcl_Obj *objPtr); MODULE_SCOPE int TclUtfCasecmp(CONST char *cs, CONST char *ct); /* @@ -2840,13 +2996,57 @@ Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_ContinueObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); +MODULE_SCOPE void TclSetTimerEventMarker(int flags); +MODULE_SCOPE int TclServiceTimerEvents(void); +MODULE_SCOPE int TclServiceIdleEx(int flags, int count); +MODULE_SCOPE void TclpCancelEvent(Tcl_Event *evPtr); +static inline Tcl_Event* +TclpQueueEventEx( + Tcl_EventProc *proc, /* Event function to call if it servicing. */ + ClientData extraData, /* Event extra data to be included and its */ + size_t extraDataSize, /* extra size (to allocate and copy into). */ + Tcl_QueuePosition position) /* One of TCL_QUEUE_TAIL, TCL_QUEUE_HEAD, + * TCL_QUEUE_MARK or TCL_QUEUE_RETARDED. */ +{ + Tcl_Event *evPtr = (Tcl_Event*)ckalloc(sizeof(Tcl_Event) + extraDataSize); + evPtr->proc = proc; + memcpy((evPtr+1), extraData, extraDataSize); + Tcl_QueueEvent(evPtr, position); + return evPtr; +} +static inline Tcl_Event* +TclpQueueEventClientData( + Tcl_EventProc *proc, /* Event function to call if it servicing. */ + ClientData clientData, /* Event extra data to be included. */ + Tcl_QueuePosition position) /* One of TCL_QUEUE_TAIL, TCL_QUEUE_HEAD, + * TCL_QUEUE_MARK or TCL_QUEUE_RETARDED. */ +{ + Tcl_Event *evPtr = (Tcl_Event*)ckalloc(sizeof(Tcl_Event) + sizeof(clientData)); + evPtr->proc = proc; + *(ClientData*)(evPtr+1) = clientData; + Tcl_QueueEvent(evPtr, position); + return evPtr; +} +MODULE_SCOPE TclTimerEvent* TclpCreateTimerEvent(Tcl_WideInt usec, + Tcl_TimerProc *proc, Tcl_TimerDeleteProc *delProc, + size_t extraDataSize, int flags); +MODULE_SCOPE TclTimerEvent* TclpCreatePromptTimerEvent( + Tcl_TimerProc *proc, Tcl_TimerDeleteProc *delProc, + size_t extraDataSize, int flags); +MODULE_SCOPE Tcl_TimerToken TclCreateTimerHandler( + Tcl_Time *timePtr, Tcl_TimerProc *proc, + ClientData clientData, int flags); MODULE_SCOPE Tcl_TimerToken TclCreateAbsoluteTimerHandler( Tcl_Time *timePtr, Tcl_TimerProc *proc, ClientData clientData); +MODULE_SCOPE void TclpDeleteTimerEvent(TclTimerEvent *tmrEvent); +MODULE_SCOPE TclTimerEvent* TclpProlongTimerEvent(TclTimerEvent *tmrEvent, + Tcl_WideInt usec, int flags); +MODULE_SCOPE int TclPeekEventQueued(int flags); MODULE_SCOPE int TclDefaultBgErrorHandlerObjCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE Tcl_Command TclInitDictCmd(Tcl_Interp *interp); MODULE_SCOPE int Tcl_DisassembleObjCmd(ClientData clientData, @@ -3959,10 +4159,21 @@ * to the non-inline version. */ #define TclLimitExceeded(limit) ((limit).exceeded != 0) +static inline int +TclInlLimitExceeded( + register Tcl_Interp *interp) +{ + return (((Interp *)interp)->limit.exceeded != 0); +} +#ifdef Tcl_LimitExceeded +# undef Tcl_LimitExceeded +#endif +#define Tcl_LimitExceeded(interp) TclInlLimitExceeded(interp) + #define TclLimitReady(limit) \ (((limit).active == 0) ? 0 : \ (++(limit).granularityTicker, \ ((((limit).active & TCL_LIMIT_COMMANDS) && \ (((limit).cmdGranularity == 1) || \ Index: generic/tclInterp.c ================================================================== --- generic/tclInterp.c +++ generic/tclInterp.c @@ -3040,10 +3040,12 @@ * If you change this function, you MUST also update TclLimitExceeded() in * tclInt.h. *---------------------------------------------------------------------- */ +#undef Tcl_LimitExceeded + int Tcl_LimitExceeded( Tcl_Interp *interp) { register Interp *iPtr = (Interp *) interp; @@ -3509,11 +3511,11 @@ * Delete the timer callback that is used to trap limits that occur in * [vwait]s... */ if (iPtr->limit.timeEvent != NULL) { - Tcl_DeleteTimerHandler(iPtr->limit.timeEvent); + TclpDeleteTimerEvent(iPtr->limit.timeEvent); iPtr->limit.timeEvent = NULL; } } /* @@ -3679,18 +3681,29 @@ { Interp *iPtr = (Interp *) interp; return iPtr->limit.cmdCount; } + +static void +TimeLimitDeleteCallback( + ClientData clientData) +{ + Interp *iPtr = clientData; + iPtr->limit.timeEvent = NULL; +} /* *---------------------------------------------------------------------- * - * Tcl_LimitSetTime -- + * Tcl_LimitSetTime --, TclpLimitSetTimeOffs -- * * Set the time limit for an interpreter by copying it from the value * pointed to by the timeLimitPtr argument. + * + * TclpLimitSetTimeOffs opposite to Tcl_LimitSetTime set the limit as + * relative time. * * Results: * None. * * Side effects: @@ -3705,26 +3718,56 @@ Tcl_LimitSetTime( Tcl_Interp *interp, Tcl_Time *timeLimitPtr) { Interp *iPtr = (Interp *) interp; - Tcl_Time nextMoment; + Tcl_WideInt nextMoment; memcpy(&iPtr->limit.time, timeLimitPtr, sizeof(Tcl_Time)); + nextMoment = TCL_TIME_TO_USEC(*timeLimitPtr) + 10; + if (iPtr->limit.timeEvent != NULL) { + iPtr->limit.timeEvent = TclpProlongTimerEvent(iPtr->limit.timeEvent, + nextMoment, TCL_TMREV_AT); + if (iPtr->limit.timeEvent) { + return; + } + } + iPtr->limit.timeEvent = TclpCreateTimerEvent(nextMoment, + TimeLimitCallback, TimeLimitDeleteCallback, 0, TCL_TMREV_AT); + iPtr->limit.timeEvent->clientData = interp; + iPtr->limit.exceeded &= ~TCL_LIMIT_TIME; +} +#if 0 +void +TclpLimitSetTimeOffs( + Tcl_Interp *interp, + Tcl_WideInt timeOffs) +{ + Interp *iPtr = (Interp *) interp; + + Tcl_GetTime(&iPtr->limit.time); + iPtr->limit.time.sec += timeOffs / 1000000; + iPtr->limit.time.usec += timeOffs % 1000000; + if (iPtr->limit.time.usec > 1000000) { + iPtr->limit.time.usec -= 1000000; + iPtr->limit.time.sec++; + } + timeOffs += 10; + /* we should use relative time (because of the timeout meaning) */ if (iPtr->limit.timeEvent != NULL) { - Tcl_DeleteTimerHandler(iPtr->limit.timeEvent); - } - nextMoment.sec = timeLimitPtr->sec; - nextMoment.usec = timeLimitPtr->usec+10; - if (nextMoment.usec >= 1000000) { - nextMoment.sec++; - nextMoment.usec -= 1000000; - } - iPtr->limit.timeEvent = TclCreateAbsoluteTimerHandler(&nextMoment, - TimeLimitCallback, interp); + iPtr->limit.timeEvent = TclpProlongTimerEvent(iPtr->limit.timeEvent, + timeOffs, 0); + if (iPtr->limit.timeEvent) { + return; + } + } + iPtr->limit.timeEvent = TclpCreateTimerEvent(timeOffs, + TimeLimitCallback, TimeLimitDeleteCallback, 0, 0); + iPtr->limit.timeEvent->clientData = interp; iPtr->limit.exceeded &= ~TCL_LIMIT_TIME; } +#endif /* *---------------------------------------------------------------------- * * TimeLimitCallback -- Index: generic/tclLink.c ================================================================== --- generic/tclLink.c +++ generic/tclLink.c @@ -21,10 +21,11 @@ * variable. */ typedef struct Link { Tcl_Interp *interp; /* Interpreter containing Tcl variable. */ + Namespace *nsPtr; /* Namespace containing Tcl variable */ Tcl_Obj *varName; /* Name of variable (must be global). This is * needed during trace callbacks, since the * actual variable may be aliased at that time * via upvar. */ char *addr; /* Location of C variable. */ @@ -112,10 +113,12 @@ int type) /* Type of C variable: TCL_LINK_INT, etc. Also * may have TCL_LINK_READ_ONLY OR'ed in. */ { Tcl_Obj *objPtr; Link *linkPtr; + Namespace *dummy; + const char *name; int code; linkPtr = (Link *) Tcl_VarTraceInfo(interp, varName, TCL_GLOBAL_ONLY, LinkTraceProc, (ClientData) NULL); if (linkPtr != NULL) { @@ -124,10 +127,11 @@ return TCL_ERROR; } linkPtr = (Link *) ckalloc(sizeof(Link)); linkPtr->interp = interp; + linkPtr->nsPtr = NULL; linkPtr->varName = Tcl_NewStringObj(varName, -1); Tcl_IncrRefCount(linkPtr->varName); linkPtr->addr = addr; linkPtr->type = type & ~TCL_LINK_READ_ONLY; if (type & TCL_LINK_READ_ONLY) { @@ -140,15 +144,21 @@ TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) { Tcl_DecrRefCount(linkPtr->varName); ckfree((char *) linkPtr); return TCL_ERROR; } + + TclGetNamespaceForQualName(interp, varName, NULL, TCL_GLOBAL_ONLY, + &(linkPtr->nsPtr), &dummy, &dummy, &name); + linkPtr->nsPtr->refCount++; + code = Tcl_TraceVar(interp, varName, TCL_GLOBAL_ONLY|TCL_TRACE_READS |TCL_TRACE_WRITES|TCL_TRACE_UNSETS, LinkTraceProc, (ClientData) linkPtr); if (code != TCL_OK) { Tcl_DecrRefCount(linkPtr->varName); + TclNsDecrRefCount(linkPtr->nsPtr); ckfree((char *) linkPtr); } return code; } @@ -184,10 +194,13 @@ } Tcl_UntraceVar(interp, varName, TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, LinkTraceProc, (ClientData) linkPtr); Tcl_DecrRefCount(linkPtr->varName); + if (linkPtr->nsPtr) { + TclNsDecrRefCount(linkPtr->nsPtr); + } ckfree((char *) linkPtr); } /* *---------------------------------------------------------------------- @@ -277,12 +290,15 @@ * If the variable is being unset, then just re-create it (with a trace) * unless the whole interpreter is going away. */ if (flags & TCL_TRACE_UNSETS) { - if (Tcl_InterpDeleted(interp)) { + if (Tcl_InterpDeleted(interp) || TclNamespaceDeleted(linkPtr->nsPtr)) { Tcl_DecrRefCount(linkPtr->varName); + if (linkPtr->nsPtr) { + TclNsDecrRefCount(linkPtr->nsPtr); + } ckfree((char *) linkPtr); } else if (flags & TCL_TRACE_DESTROYED) { Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), TCL_GLOBAL_ONLY); Tcl_TraceVar(interp, Tcl_GetString(linkPtr->varName), Index: generic/tclNamesp.c ================================================================== --- generic/tclNamesp.c +++ generic/tclNamesp.c @@ -1058,10 +1058,17 @@ nsPtr->flags &= ~(NS_DYING|NS_KILLED); } } } + +int +TclNamespaceDeleted( + Namespace *nsPtr) +{ + return (nsPtr->flags & NS_DYING) ? 1 : 0; +} /* *---------------------------------------------------------------------- * * TclTeardownNamespace -- @@ -1234,10 +1241,37 @@ ckfree(nsPtr->name); ckfree(nsPtr->fullName); ckfree((char *) nsPtr); } + +/* + *---------------------------------------------------------------------- + * + * TclNsDecrRefCount -- + * + * Drops a reference to a namespace and frees it if the namespace has + * been deleted and the last reference has just been dropped. + * + * Results: + * None. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +void +TclNsDecrRefCount( + Namespace *nsPtr) +{ + nsPtr->refCount--; + if ((nsPtr->refCount == 0) && (nsPtr->flags & NS_DEAD)) { + NamespaceFree(nsPtr); + } +} /* *---------------------------------------------------------------------- * * Tcl_Export -- Index: generic/tclNotify.c ================================================================== --- generic/tclNotify.c +++ generic/tclNotify.c @@ -29,10 +29,19 @@ Tcl_EventCheckProc *checkProc; ClientData clientData; struct EventSource *nextPtr; } EventSource; +/* + * Used for performance purposes, threshold to bypass check source (if don't wait) + * Value should be approximately correspond 100-ns ranges, if the wide-clicks + * supported, it is more precise so e. g. 5 is ca. 0.5 microseconds (500-ns). + */ +#ifndef TCL_CHECK_EVENT_SOURCE_THRESHOLD + #define TCL_CHECK_EVENT_SOURCE_THRESHOLD 5 +#endif + /* * The following structure keeps track of the state of the notifier on a * per-thread basis. The first three elements keep track of the event queue. * In addition to the first (next to be serviced) and last events in the * queue, we keep track of a "marker" event. This provides a simple priority @@ -47,14 +56,22 @@ typedef struct ThreadSpecificData { Tcl_Event *firstEventPtr; /* First pending event, or NULL if none. */ Tcl_Event *lastEventPtr; /* Last pending event, or NULL if none. */ Tcl_Event *markerEventPtr; /* Last high-priority event in queue, or NULL * if none. */ + Tcl_Event *timerMarkerPtr; /* Weak pointer to last event in the queue, + * before timer event generation */ + Tcl_Event *firstRetardEv; /* First retarded event, or NULL if none. */ + Tcl_Event *lastRetardEv; /* Last retarded event, or NULL if none. */ Tcl_Mutex queueMutex; /* Mutex to protect access to the previous * three fields. */ + size_t queueEpoch; /* Epoch of the queue (incremented if changed + * using TCL_QUEUE_HEAD or TCL_QUEUE_MARK). */ int serviceMode; /* One of TCL_SERVICE_NONE or * TCL_SERVICE_ALL. */ + size_t serviceLevel; /* Current (nested) level of event cycle. */ + size_t blockTimeServLev; /* Level of the event cycle block time was set. */ int blockTimeSet; /* 0 means there is no maximum block time: * block forever. */ Tcl_Time blockTime; /* If blockTimeSet is 1, gives the maximum * elapsed time for the next block. */ int inTraversal; /* 1 if Tcl_SetMaxBlockTime is being called @@ -68,10 +85,19 @@ int initialized; /* 1 if notifier has been initialized. */ struct ThreadSpecificData *nextPtr; /* Next notifier in global list of notifiers. * Access is controlled by the listLock global * mutex. */ +#if TCL_CHECK_EVENT_SOURCE_THRESHOLD + /* Last "time" source checked, used as threshold + * to avoid checking for events too often */ + #ifndef TCL_WIDE_CLICKS + unsigned long lastCheckClicks; + #else + Tcl_WideInt lastCheckClicks; + #endif +#endif } ThreadSpecificData; static Tcl_ThreadDataKey dataKey; /* @@ -117,11 +143,11 @@ for (tsdPtr = firstNotifierPtr; tsdPtr && tsdPtr->threadId != threadId; tsdPtr = tsdPtr->nextPtr) { /* Empty loop body. */ } - if (NULL == tsdPtr) { + if (NULL == tsdPtr || !tsdPtr->initialized) { /* * Notifier not yet initialized in this thread. */ tsdPtr = TCL_TSD_INIT(&dataKey); @@ -173,13 +199,22 @@ Tcl_MutexLock(&(tsdPtr->queueMutex)); for (evPtr = tsdPtr->firstEventPtr; evPtr != NULL; ) { hold = evPtr; evPtr = evPtr->nextPtr; ckfree((char *) hold); + } + for (evPtr = tsdPtr->firstRetardEv; evPtr != NULL; ) { + hold = evPtr; + evPtr = evPtr->nextPtr; + ckfree((char *) hold); } tsdPtr->firstEventPtr = NULL; tsdPtr->lastEventPtr = NULL; + tsdPtr->markerEventPtr = NULL; + tsdPtr->timerMarkerPtr = NULL; + tsdPtr->firstRetardEv = NULL; + tsdPtr->lastRetardEv = NULL; Tcl_MutexUnlock(&(tsdPtr->queueMutex)); Tcl_MutexLock(&listLock); if (tclStubs.tcl_FinalizeNotifier) { @@ -362,11 +397,11 @@ * must have been allocated the caller with * malloc (ckalloc), and it becomes the * property of the event queue. It will be * freed after the event has been handled. */ Tcl_QueuePosition position) /* One of TCL_QUEUE_TAIL, TCL_QUEUE_HEAD, - * TCL_QUEUE_MARK. */ + * TCL_QUEUE_MARK or TCL_QUEUE_RETARDED. */ { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); QueueEvent(tsdPtr, evPtr, position); } @@ -393,11 +428,11 @@ * must have been allocated the caller with * malloc (ckalloc), and it becomes the * property of the event queue. It will be * freed after the event has been handled. */ Tcl_QueuePosition position) /* One of TCL_QUEUE_TAIL, TCL_QUEUE_HEAD, - * TCL_QUEUE_MARK. */ + * TCL_QUEUE_MARK or TCL_QUEUE_RETARDED. */ { ThreadSpecificData *tsdPtr; /* * Find the notifier associated with the specified thread. @@ -418,10 +453,43 @@ } else { ckfree((char *) evPtr); } Tcl_MutexUnlock(&listLock); } + +static inline void +SpliceEventTail( + Tcl_Event *evPtr, + Tcl_Event **firstEvPtr, + Tcl_Event **lastEvPtr) +{ + evPtr->nextPtr = NULL; + if (*firstEvPtr == NULL) { + *firstEvPtr = evPtr; + } else { + (*lastEvPtr)->nextPtr = evPtr; + } + *lastEvPtr = evPtr; +} + +static inline void +LinkEvent( + ThreadSpecificData *tsdPtr, + Tcl_Event *evPtr, + Tcl_Event *prevPtr) +{ + if (prevPtr) { + evPtr->nextPtr = prevPtr->nextPtr; + prevPtr->nextPtr = evPtr; + } else { + evPtr->nextPtr = tsdPtr->firstEventPtr; + tsdPtr->firstEventPtr = evPtr; + } + if (evPtr->nextPtr == NULL) { + tsdPtr->lastEventPtr = evPtr; + } +} /* *---------------------------------------------------------------------- * * QueueEvent -- @@ -450,55 +518,163 @@ * must have been allocated the caller with * malloc (ckalloc), and it becomes the * property of the event queue. It will be * freed after the event has been handled. */ Tcl_QueuePosition position) /* One of TCL_QUEUE_TAIL, TCL_QUEUE_HEAD, - * TCL_QUEUE_MARK. */ + * TCL_QUEUE_MARK or TCL_QUEUE_RETARDED. */ { Tcl_MutexLock(&(tsdPtr->queueMutex)); - if (position == TCL_QUEUE_TAIL) { + switch (position) { + case TCL_QUEUE_TAIL: /* * Append the event on the end of the queue. */ - evPtr->nextPtr = NULL; - if (tsdPtr->firstEventPtr == NULL) { - tsdPtr->firstEventPtr = evPtr; - } else { - tsdPtr->lastEventPtr->nextPtr = evPtr; - } - tsdPtr->lastEventPtr = evPtr; - } else if (position == TCL_QUEUE_HEAD) { + SpliceEventTail(evPtr, &tsdPtr->firstEventPtr, &tsdPtr->lastEventPtr); + + break; + case TCL_QUEUE_HEAD: /* * Push the event on the head of the queue. */ evPtr->nextPtr = tsdPtr->firstEventPtr; if (tsdPtr->firstEventPtr == NULL) { tsdPtr->lastEventPtr = evPtr; } tsdPtr->firstEventPtr = evPtr; - } else if (position == TCL_QUEUE_MARK) { + + /* move timer event hereafter */ + if (tsdPtr->timerMarkerPtr == INT2PTR(-1)) { + tsdPtr->timerMarkerPtr = evPtr; + } + + tsdPtr->queueEpoch++; /* queue may be changed in the middle */ + + break; + case TCL_QUEUE_MARK: /* * Insert the event after the current marker event and advance the * marker to the new event. */ - if (tsdPtr->markerEventPtr == NULL) { - evPtr->nextPtr = tsdPtr->firstEventPtr; - tsdPtr->firstEventPtr = evPtr; - } else { - evPtr->nextPtr = tsdPtr->markerEventPtr->nextPtr; - tsdPtr->markerEventPtr->nextPtr = evPtr; - } - tsdPtr->markerEventPtr = evPtr; - if (evPtr->nextPtr == NULL) { - tsdPtr->lastEventPtr = evPtr; - } + LinkEvent(tsdPtr, evPtr, tsdPtr->markerEventPtr); + tsdPtr->markerEventPtr = evPtr; + + /* move timer event hereafter */ + if (tsdPtr->timerMarkerPtr == INT2PTR(-1)) { + tsdPtr->timerMarkerPtr = evPtr; + } + + tsdPtr->queueEpoch++; /* queue may be changed in the middle */ + break; + case TCL_QUEUE_RETARDED: + /* + * Append the event on the end of the retarded list. + * This guarantees the service earliest at the next event-cycle. + */ + + SpliceEventTail(evPtr, &tsdPtr->firstRetardEv, &tsdPtr->lastRetardEv); + break; } Tcl_MutexUnlock(&(tsdPtr->queueMutex)); } + +static Tcl_Event * +SearchEventInQueue( + Tcl_Event *firstEvPtr, + Tcl_Event *evPtr, + Tcl_Event **prevEvPtr) +{ + Tcl_Event *prevPtr = NULL; + + /* + * Search event in the queue (if not first one). + */ + + if (evPtr != firstEvPtr) { + + for (prevPtr = firstEvPtr; + prevPtr && prevPtr->nextPtr != evPtr; + prevPtr = prevPtr->nextPtr) { + /* Empty loop body. */ + } + if (!prevPtr) { + /* not in queue */ + evPtr = NULL; + } + } + if (prevEvPtr) { + *prevEvPtr = prevPtr; + } + return evPtr; +} + +static void +UnlinkEvent( + ThreadSpecificData *tsdPtr, + Tcl_Event *evPtr, + Tcl_Event *prevPtr) +{ + /* + * Unlink it. + */ + + if (prevPtr == NULL) { + tsdPtr->firstEventPtr = evPtr->nextPtr; + } else { + prevPtr->nextPtr = evPtr->nextPtr; + } + if (evPtr->nextPtr == NULL) { + tsdPtr->lastEventPtr = prevPtr; + } + + /* queue may be changed in the middle */ + tsdPtr->queueEpoch++; + + /* + * Update 'marker' events if either has been deleted. + */ + + if (tsdPtr->markerEventPtr == evPtr) { + tsdPtr->markerEventPtr = prevPtr; + } + if (tsdPtr->timerMarkerPtr == evPtr) { + tsdPtr->timerMarkerPtr = prevPtr ? prevPtr : INT2PTR(-1); + } +} + +static void +InvolveRetardedEvents( + ThreadSpecificData *tsdPtr) +{ + /* move retarded events at end of the queue */ + if (tsdPtr->firstEventPtr == NULL) { + tsdPtr->firstEventPtr = tsdPtr->firstRetardEv; + } else { + tsdPtr->lastEventPtr->nextPtr = tsdPtr->firstRetardEv; + } + tsdPtr->lastEventPtr = tsdPtr->lastRetardEv; + /* reset retarded list */ + tsdPtr->lastRetardEv = tsdPtr->firstRetardEv = NULL; +} + +static void +UnlinkRetardedEvent( + ThreadSpecificData *tsdPtr, + Tcl_Event *evPtr, + Tcl_Event *prevPtr) +{ + if (prevPtr == NULL) { + tsdPtr->firstRetardEv = evPtr->nextPtr; + } else { + prevPtr->nextPtr = evPtr->nextPtr; + } + if (evPtr->nextPtr == NULL) { + tsdPtr->lastRetardEv = prevPtr; + } +} /* *---------------------------------------------------------------------- * * Tcl_DeleteEvents -- @@ -524,62 +700,80 @@ { Tcl_Event *evPtr; /* Pointer to the event being examined */ Tcl_Event *prevPtr; /* Pointer to evPtr's predecessor, or NULL if * evPtr designates the first event in the * queue for the thread. */ - Tcl_Event* hold; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); Tcl_MutexLock(&(tsdPtr->queueMutex)); /* * Walk the queue of events for the thread, applying 'proc' to each to * decide whether to eliminate the event. */ - prevPtr = NULL; evPtr = tsdPtr->firstEventPtr; while (evPtr != NULL) { - if ((*proc)(evPtr, clientData) == 1) { - /* - * This event should be deleted. Unlink it. - */ - - if (prevPtr == NULL) { - tsdPtr->firstEventPtr = evPtr->nextPtr; - } else { - prevPtr->nextPtr = evPtr->nextPtr; - } - - /* - * Update 'last' and 'marker' events if either has been deleted. - */ - - if (evPtr->nextPtr == NULL) { - tsdPtr->lastEventPtr = prevPtr; - } - if (tsdPtr->markerEventPtr == evPtr) { - tsdPtr->markerEventPtr = prevPtr; - } - - /* - * Delete the event data structure. - */ - - hold = evPtr; - evPtr = evPtr->nextPtr; - ckfree((char *) hold); - } else { - /* - * Event is to be retained. - */ - - prevPtr = evPtr; - evPtr = evPtr->nextPtr; - } - } + Tcl_Event *nextPtr = evPtr->nextPtr; + if ((*proc)(evPtr, clientData) == 1) { + + /* This event should be deleted. Unlink and delete it. */ + UnlinkEvent(tsdPtr, evPtr, prevPtr); + ckfree((char *) evPtr); + } else { + /* Event is to be retained. */ + prevPtr = evPtr; + } + evPtr = nextPtr; + } + + /* + * Do the same for the retarded list. + */ + prevPtr = NULL; + evPtr = tsdPtr->firstRetardEv; + while (evPtr != NULL) { + Tcl_Event *nextPtr = evPtr->nextPtr; + if (proc(evPtr, clientData) == 1) { + /* This event should be deleted. Unlink and delete it. */ + UnlinkRetardedEvent(tsdPtr, evPtr, prevPtr); + ckfree((char *) evPtr); + } else { + /* Event is to be retained. */ + prevPtr = evPtr; + } + evPtr = nextPtr; + } + + Tcl_MutexUnlock(&(tsdPtr->queueMutex)); +} + +void +TclpCancelEvent( + Tcl_Event *evPtr) /* Event to remove from queue. */ +{ + Tcl_Event *prevPtr = NULL; + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + + Tcl_MutexLock(&(tsdPtr->queueMutex)); + + /* + * Search event to unlink from queue and delete it. + * Note the event can be in retarded list. + */ + + if (SearchEventInQueue(tsdPtr->firstEventPtr, evPtr, &prevPtr)) { + UnlinkEvent(tsdPtr, evPtr, prevPtr); + ckfree((char *) evPtr); + } + else + if (!SearchEventInQueue(tsdPtr->firstRetardEv, evPtr, &prevPtr)) { + UnlinkRetardedEvent(tsdPtr, evPtr, prevPtr); + ckfree((char *) evPtr); + } + Tcl_MutexUnlock(&(tsdPtr->queueMutex)); } /* *---------------------------------------------------------------------- @@ -611,39 +805,71 @@ * processing later. */ { Tcl_Event *evPtr, *prevPtr; Tcl_EventProc *proc; int result; + size_t queueEpoch; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - /* - * Asynchronous event handlers are considered to be the highest priority - * events, and so must be invoked before we process events on the event - * queue. - */ - - if (Tcl_AsyncReady()) { - (void) Tcl_AsyncInvoke(NULL, 0); - return 1; - } - /* * No event flags is equivalent to TCL_ALL_EVENTS. */ if ((flags & TCL_ALL_EVENTS) == 0) { flags |= TCL_ALL_EVENTS; } + /* + * Asynchronous event handlers are considered to be the highest priority + * events, and so must be invoked before we process events on the event + * queue. + */ + + if ((flags & TCL_ASYNC_EVENTS)) { + if (Tcl_AsyncReady()) { + (void) Tcl_AsyncInvoke(NULL, 0); + return 1; + } + /* Async only */ + if ((flags & TCL_ALL_EVENTS) == TCL_ASYNC_EVENTS) { + return 0; + } + } + + /* Fast bypass case */ + if ( !tsdPtr->firstEventPtr /* no other events */ + || ((flags & TCL_ALL_EVENTS) == TCL_TIMER_EVENTS) /* timers only */ + ) { + goto timer; + } + + /* + * If timer marker reached, process timer events now. + */ + if ((flags & TCL_TIMER_EVENTS) && (tsdPtr->timerMarkerPtr == INT2PTR(-1))) { + goto processTimer; + } + + /* Lock queue to process events */ + Tcl_MutexLock(&(tsdPtr->queueMutex)); + /* * Loop through all the events in the queue until we find one that can * actually be handled. */ - Tcl_MutexLock(&(tsdPtr->queueMutex)); - for (evPtr = tsdPtr->firstEventPtr; evPtr != NULL; - evPtr = evPtr->nextPtr) { + for (prevPtr = NULL, evPtr = tsdPtr->firstEventPtr; + evPtr != NULL && tsdPtr->timerMarkerPtr != INT2PTR(-1); + prevPtr = evPtr, evPtr = evPtr->nextPtr + ) { + + repeatCycle: + + if (tsdPtr->timerMarkerPtr == evPtr) { + tsdPtr->timerMarkerPtr = INT2PTR(-1); /* timer marker reached */ + } + /* * Call the handler for the event. If it actually handles the event * then free the storage for the event. There are two tricky things * here, both stemming from the fact that the event code may be * re-entered while servicing the event: @@ -662,10 +888,13 @@ if (proc == NULL) { continue; } evPtr->proc = NULL; + /* Save current queue epoch (if unchanged - the same prevPtr) */ + queueEpoch = tsdPtr->queueEpoch; + /* * Release the lock before calling the event function. This allows * other threads to post events if we enter a recursive event loop in * this thread. Note that we are making the assumption that if the * proc returns 0, the event is still in the list. @@ -673,58 +902,334 @@ Tcl_MutexUnlock(&(tsdPtr->queueMutex)); result = (*proc)(evPtr, flags); Tcl_MutexLock(&(tsdPtr->queueMutex)); - if (result) { - /* - * The event was processed, so remove it from the queue. - */ - - if (tsdPtr->firstEventPtr == evPtr) { - tsdPtr->firstEventPtr = evPtr->nextPtr; - if (evPtr->nextPtr == NULL) { - tsdPtr->lastEventPtr = NULL; - } - if (tsdPtr->markerEventPtr == evPtr) { - tsdPtr->markerEventPtr = NULL; - } - } else { - for (prevPtr = tsdPtr->firstEventPtr; - prevPtr && prevPtr->nextPtr != evPtr; - prevPtr = prevPtr->nextPtr) { - /* Empty loop body. */ - } - if (prevPtr) { - prevPtr->nextPtr = evPtr->nextPtr; - if (evPtr->nextPtr == NULL) { - tsdPtr->lastEventPtr = prevPtr; - } - if (tsdPtr->markerEventPtr == evPtr) { - tsdPtr->markerEventPtr = prevPtr; - } - } else { - evPtr = NULL; - } - } - if (evPtr) { + /* If event processed or scheduled to be executed later (retarding) */ + if (result || evPtr->proc) { + + /* + * Check the queue was changed. + */ + + if (queueEpoch != tsdPtr->queueEpoch) { + /* queue may be changed in the middle */ + queueEpoch = tsdPtr->queueEpoch; + /* try to find event */ + evPtr = SearchEventInQueue(tsdPtr->firstEventPtr, + evPtr, &prevPtr); + } + + /* + * If the handler set another function to process it later, + * do retarding of the event. + */ + if (evPtr && evPtr->proc) { + /* + * Reattach the event on the end of the retarded list. + */ + UnlinkEvent(tsdPtr, evPtr, prevPtr); + SpliceEventTail(evPtr, + &tsdPtr->firstRetardEv, &tsdPtr->lastRetardEv); + + /* next event to service */ + if (prevPtr == NULL) { + /* we stood on begin of list - just repeat from new begin */ + evPtr = tsdPtr->firstEventPtr; + } else { + /* continue from next of previous event */ + evPtr = prevPtr->nextPtr; + } + goto repeatCycle; + } + + /* + * The event was processed, so remove it. + */ + if (evPtr) { + /* Detach event from queue */ + UnlinkEvent(tsdPtr, evPtr, prevPtr); + + /* Free event */ ckfree((char *) evPtr); } + + /* event processed - return with 1 */ Tcl_MutexUnlock(&(tsdPtr->queueMutex)); return 1; + } else { /* * The event wasn't actually handled, so we have to restore the * proc field to allow the event to be attempted again. */ - evPtr->proc = proc; } } Tcl_MutexUnlock(&(tsdPtr->queueMutex)); + + timer: + /* + * Process timer queue, if alloved and timers are enabled. + */ + + if (flags & TCL_TIMER_EVENTS) { + + /* If available pending timer-events of new generation */ + if (tsdPtr->timerMarkerPtr == INT2PTR(-2)) { /* pending */ + /* no other events - process timer-events (next cycle) */ + if (!(tsdPtr->timerMarkerPtr = tsdPtr->lastEventPtr)) { /* no other events */ + tsdPtr->timerMarkerPtr = INT2PTR(-1); + } + return 0; + } + + if (tsdPtr->timerMarkerPtr == INT2PTR(-1)) { + + processTimer: + /* reset marker */ + tsdPtr->timerMarkerPtr = NULL; + + result = TclServiceTimerEvents(); + if (result < 0) { + /* + * Events processed, but still pending timers (of new generation) + * set marker to process timer, if setup- resp. check-proc will + * not generate new events. + */ + if (tsdPtr->timerMarkerPtr == NULL) { + /* marker to last event in the queue */ + if (!(tsdPtr->timerMarkerPtr = tsdPtr->lastEventPtr)) { + /* + * Marker as "pending" - queue is empty, so timers events are first, + * if setup-proc resp. check-proc will not generate new events. + */ + tsdPtr->timerMarkerPtr = INT2PTR(-2); + }; + } + result = 1; + } + return result; + } + } + + return 0; +} + +#if TCL_CHECK_EVENT_SOURCE_THRESHOLD +/* + *---------------------------------------------------------------------- + * + * CheckSourceThreshold -- + * + * Check whether we should iterate over event sources for availability. + * + * This is used to avoid too unneeded overhead (too often call checkProc). + * + * Results: + * Returns 1 if threshold reached (check event sources), 0 otherwise. + * + *---------------------------------------------------------------------- + */ + +static inline int +CheckSourceThreshold( + ThreadSpecificData *tsdPtr) +{ + /* don't need to wait/check for events too often */ +#ifndef TCL_WIDE_CLICKS + unsigned long clickdiff, clicks = TclpGetClicks(); +#else + Tcl_WideInt clickdiff, clicks; + /* in 100-ns */ + clicks = TclpGetWideClicks() * (TclpWideClickInMicrosec() * 10); +#endif + /* considering possible clicks-jump */ + if ( (clickdiff = (clicks - tsdPtr->lastCheckClicks)) >= 0 + && clickdiff <= TCL_CHECK_EVENT_SOURCE_THRESHOLD) { + return 0; + } + tsdPtr->lastCheckClicks = clicks; + return 1; +} +#endif + +static int +SetUpEventSources( + ThreadSpecificData *tsdPtr, + int flags) +{ + int res = 0; + EventSource *sourcePtr; + + /* + * Set up all the event sources for new events. This will cause the + * block time to be updated if necessary. + */ + tsdPtr->inTraversal++; + for (sourcePtr = tsdPtr->firstEventSourcePtr; + sourcePtr != NULL; + sourcePtr = sourcePtr->nextPtr + ) { + if (sourcePtr->checkProc) { + sourcePtr->setupProc(sourcePtr->clientData, flags); + res++; + } + } + tsdPtr->inTraversal--; + + /* + * If we've some retarded events (from last event-cycle), wait non-blocking. + */ + if ( tsdPtr->firstRetardEv + && ( !tsdPtr->blockTimeSet + || tsdPtr->blockTimeServLev < tsdPtr->serviceLevel ) + ) { + tsdPtr->blockTime.sec = 0; + tsdPtr->blockTime.usec = 0; + tsdPtr->blockTimeSet = 1; + } + + return res; +} + +static int +CheckEventSources( + ThreadSpecificData *tsdPtr, + int flags) +{ + int res = 0; + EventSource *sourcePtr; + + /* + * Check all the event sources for new events. + */ + for (sourcePtr = tsdPtr->firstEventSourcePtr; + sourcePtr != NULL; + sourcePtr = sourcePtr->nextPtr + ) { + if (sourcePtr->checkProc) { + sourcePtr->checkProc(sourcePtr->clientData, flags); + res++; + } + } + + /* + * If we've some retarded events (from last event-cycle), attach they here + * to the tail of the event queue (new event-cycle). + */ + if (tsdPtr->firstRetardEv) { + Tcl_MutexLock(&(tsdPtr->queueMutex)); + if (tsdPtr->firstRetardEv) { + InvolveRetardedEvents(tsdPtr); + res++; + } + Tcl_MutexUnlock(&(tsdPtr->queueMutex)); + } + + return res; +} + +/* + *---------------------------------------------------------------------- + * + * TclPeekEventQueued -- + * + * Check whether some event (except idle) available (async, queued, timer). + * + * This will be used e. g. in TclServiceIdle to stop the processing of the + * the idle events if some "normal" event occurred. + * + * Results: + * Returns 1 if some event queued, 0 otherwise. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +int +TclPeekEventQueued( + int flags) +{ + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + int repeat = 1; + + do { + /* + * Events already pending ? + */ + if ( Tcl_AsyncReady() + || (tsdPtr->firstEventPtr) + || ((flags & TCL_TIMER_EVENTS) && tsdPtr->timerMarkerPtr) + ) { + return 1; + } + + /* once from here */ + if (!repeat) { + break; + } + + if (flags & TCL_DONT_WAIT) { + /* don't need to wait/check for events too often */ + #if TCL_CHECK_EVENT_SOURCE_THRESHOLD + if (!CheckSourceThreshold(tsdPtr)) { + return 0; + } + #endif + } + + /* + * Check all the event sources for new events. + */ + if (!CheckEventSources(tsdPtr, flags)) { + return 0; /* no sources - no events could be created at all */ + } + + } while (repeat--); + return 0; } + +/* + *---------------------------------------------------------------------- + * + * TclSetTimerEventMarker -- + * + * Set timer event marker to the last pending event in the queue. + * + * Results: + * None. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +void +TclSetTimerEventMarker( + int flags) +{ + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + + if (tsdPtr->timerMarkerPtr == NULL || tsdPtr->timerMarkerPtr == INT2PTR(-2)) { + /* marker to last event in the queue */ + if ( !(tsdPtr->timerMarkerPtr = tsdPtr->lastEventPtr) /* no other events */ + || ((flags & TCL_ALL_EVENTS) == TCL_TIMER_EVENTS) /* timers only */ + ) { + /* + * Marker as "pending" - queue is empty, so timers events are first, + * if setup-proc resp. check-proc will not generate new events. + * Force timer execution if flags specified (from checkProc). + */ + tsdPtr->timerMarkerPtr = flags ? INT2PTR(-1) : INT2PTR(-2); + }; + } +} /* *---------------------------------------------------------------------- * * Tcl_GetServiceMode -- @@ -818,10 +1323,14 @@ * If we are called outside an event source traversal, set the timeout * immediately. */ if (!tsdPtr->inTraversal) { + if (tsdPtr->blockTimeServLev < tsdPtr->serviceLevel) { + /* avoid resetting the blockTime set outside of traversal. */ + tsdPtr->blockTimeServLev = tsdPtr->serviceLevel; + } Tcl_SetTimer(&tsdPtr->blockTime); } } /* @@ -833,18 +1342,22 @@ * for an event to occur, then process it. * * Results: * The return value is 1 if the function actually found an event to * process. If no processing occurred, then 0 is returned (this can - * happen if the TCL_DONT_WAIT flag is set or if there are no event - * handlers to wait for in the set specified by flags). + * happen if the TCL_DONT_WAIT flag is set or block time was set using + * Tcl_SetMaxBlockTime before or if there are no event handlers to wait + * for in the set specified by flags). * * Side effects: * May delay execution of process while waiting for an event, unless * TCL_DONT_WAIT is set in the flags argument. Event sources are invoked * to check for and queue events. Event handlers may produce arbitrary * side effects. + * If block time was set (Tcl_SetMaxBlockTime) but another event occurs + * and interrupt wait, the function can return early, thereby it resets + * the block time (caller should use Tcl_SetMaxBlockTime again). * *---------------------------------------------------------------------- */ int @@ -854,59 +1367,72 @@ * TCL_WINDOW_EVENTS, TCL_FILE_EVENTS, * TCL_TIMER_EVENTS, TCL_IDLE_EVENTS, or * others defined by event sources. */ { int result = 0, oldMode; - EventSource *sourcePtr; Tcl_Time *timePtr; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - - /* - * The first thing we do is to service any asynchronous event handlers. - */ - - if (Tcl_AsyncReady()) { - (void) Tcl_AsyncInvoke(NULL, 0); - return 1; - } + int blockTimeWasSet; /* * No event flags is equivalent to TCL_ALL_EVENTS. */ if ((flags & TCL_ALL_EVENTS) == 0) { flags |= TCL_ALL_EVENTS; } + /* Block time was set outside an event source traversal, caller has specified a waittime */ + blockTimeWasSet = tsdPtr->blockTimeSet; + /* * Set the service mode to none so notifier event routines won't try to * service events recursively. */ oldMode = tsdPtr->serviceMode; tsdPtr->serviceMode = TCL_SERVICE_NONE; + tsdPtr->serviceLevel++; + + /* + * Asynchronous event handlers are considered to be the highest priority + * events, and so must be invoked before we process events on the event + * queue. + */ + + if (flags & TCL_ASYNC_EVENTS) { + if (Tcl_AsyncReady()) { + (void) Tcl_AsyncInvoke(NULL, 0); + result = 1; + goto done; + } + + /* Async only and don't wait - return */ + if ( (flags & (TCL_ALL_EVENTS|TCL_DONT_WAIT)) + == (TCL_ASYNC_EVENTS|TCL_DONT_WAIT) ) { + goto done; + } + } /* - * The core of this function is an infinite loop, even though we only - * service one event. The reason for this is that we may be processing - * events that don't do anything inside of Tcl. + * Main loop until servicing exact one event or block time resp. + * TCL_DONT_WAIT specified (infinite loop otherwise). */ - - while (1) { + do { /* * If idle events are the only things to service, skip the main part * of the loop and go directly to handle idle events (i.e. don't wait * even if TCL_DONT_WAIT isn't set). */ if ((flags & TCL_ALL_EVENTS) == TCL_IDLE_EVENTS) { - flags = TCL_IDLE_EVENTS | TCL_DONT_WAIT; goto idleEvents; } /* - * Ask Tcl to service a queued event, if there are any. + * Ask Tcl to service any asynchronous event handlers or + * queued event, if there are any. */ if (Tcl_ServiceEvent(flags)) { result = 1; break; @@ -916,58 +1442,54 @@ * If TCL_DONT_WAIT is set, be sure to poll rather than blocking, * otherwise reset the block time to infinity. */ if (flags & TCL_DONT_WAIT) { + + /* don't need to wait/check for events too often */ + #if TCL_CHECK_EVENT_SOURCE_THRESHOLD + if (!CheckSourceThreshold(tsdPtr)) { + goto idleEvents; + } + #endif tsdPtr->blockTime.sec = 0; tsdPtr->blockTime.usec = 0; tsdPtr->blockTimeSet = 1; - } else { - tsdPtr->blockTimeSet = 0; + timePtr = &tsdPtr->blockTime; + goto wait; /* for notifier resp. system events */ } /* * Set up all the event sources for new events. This will cause the * block time to be updated if necessary. */ - - tsdPtr->inTraversal = 1; - for (sourcePtr = tsdPtr->firstEventSourcePtr; sourcePtr != NULL; - sourcePtr = sourcePtr->nextPtr) { - if (sourcePtr->setupProc) { - (sourcePtr->setupProc)(sourcePtr->clientData, flags); - } - } - tsdPtr->inTraversal = 0; - - if ((flags & TCL_DONT_WAIT) || tsdPtr->blockTimeSet) { + SetUpEventSources(tsdPtr, flags); + + if (tsdPtr->blockTimeSet) { timePtr = &tsdPtr->blockTime; } else { timePtr = NULL; } /* * Wait for a new event or a timeout. If Tcl_WaitForEvent returns -1, * we should abort Tcl_DoOneEvent. */ - + wait: result = Tcl_WaitForEvent(timePtr); + tsdPtr->blockTimeServLev = 0; /* reset block-time level (processed). */ if (result < 0) { - result = 0; + if (blockTimeWasSet) { + result = 0; + } break; } /* * Check all the event sources for new events. */ - - for (sourcePtr = tsdPtr->firstEventSourcePtr; sourcePtr != NULL; - sourcePtr = sourcePtr->nextPtr) { - if (sourcePtr->checkProc) { - (sourcePtr->checkProc)(sourcePtr->clientData, flags); - } - } + CheckEventSources(tsdPtr, flags); /* * Check for events queued by the notifier or event sources. */ @@ -982,38 +1504,53 @@ * back to the top and try again. */ idleEvents: if (flags & TCL_IDLE_EVENTS) { - if (TclServiceIdle()) { + if (TclServiceIdleEx(flags, INT_MAX)) { result = 1; break; } } - if (flags & TCL_DONT_WAIT) { - break; - } /* * If Tcl_WaitForEvent has returned 1, indicating that one system * event has been dispatched (and thus that some Tcl code might have * been indirectly executed), we break out of the loop. We do this to * give VwaitCmd for instance a chance to check if that system event * had the side effect of changing the variable (so the vwait can * return and unwind properly). * - * NB: We will process idle events if any first, because otherwise we - * might never do the idle events if the notifier always gets - * system events. + * We can stop also if works in block to event mode (e. g. block time was + * set outside an event source, that means timeout was set so exit loop + * also without event/result). */ - if (result) { + result = 0; + if ((flags & TCL_DONT_WAIT) || blockTimeWasSet) { break; } - } + + /* + * Reset block time before continue event-cycle. + */ + if (tsdPtr->blockTimeServLev < tsdPtr->serviceLevel) { + tsdPtr->blockTimeSet = 0; + tsdPtr->blockTimeServLev = 0; + } + } while (1); +done: + /* + * Reset block time earliest at the end of event cycle and restore mode. + */ + if (tsdPtr->blockTimeServLev < tsdPtr->serviceLevel) { + tsdPtr->blockTimeSet = 0; + tsdPtr->blockTimeServLev = 0; + } tsdPtr->serviceMode = oldMode; + tsdPtr->serviceLevel--; return result; } /* *---------------------------------------------------------------------- @@ -1037,11 +1574,10 @@ int Tcl_ServiceAll(void) { int result = 0; - EventSource *sourcePtr; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); if (tsdPtr->serviceMode == TCL_SERVICE_NONE) { return result; } @@ -1049,10 +1585,11 @@ /* * We need to turn off event servicing like we to in Tcl_DoOneEvent, to * avoid recursive calls. */ + tsdPtr->serviceLevel++; tsdPtr->serviceMode = TCL_SERVICE_NONE; /* * Check async handlers first. */ @@ -1065,39 +1602,33 @@ * Make a single pass through all event sources, queued events, and idle * handlers. Note that we wait to update the notifier timer until the end * so we can avoid multiple changes. */ - tsdPtr->inTraversal = 1; + tsdPtr->inTraversal++; tsdPtr->blockTimeSet = 0; - - for (sourcePtr = tsdPtr->firstEventSourcePtr; sourcePtr != NULL; - sourcePtr = sourcePtr->nextPtr) { - if (sourcePtr->setupProc) { - (sourcePtr->setupProc)(sourcePtr->clientData, TCL_ALL_EVENTS); - } - } - for (sourcePtr = tsdPtr->firstEventSourcePtr; sourcePtr != NULL; - sourcePtr = sourcePtr->nextPtr) { - if (sourcePtr->checkProc) { - (sourcePtr->checkProc)(sourcePtr->clientData, TCL_ALL_EVENTS); - } - } - - while (Tcl_ServiceEvent(0)) { + tsdPtr->blockTimeServLev = 0; + + SetUpEventSources(tsdPtr, TCL_ALL_EVENTS); + CheckEventSources(tsdPtr, TCL_ALL_EVENTS); + + if (Tcl_ServiceEvent(0)) { + while (Tcl_ServiceEvent(0)) {}; result = 1; } if (TclServiceIdle()) { result = 1; } - if (!tsdPtr->blockTimeSet) { - Tcl_SetTimer(NULL); - } else { - Tcl_SetTimer(&tsdPtr->blockTime); + if (tsdPtr->inTraversal-- <= 1) { + if (!tsdPtr->blockTimeSet) { + Tcl_SetTimer(NULL); + } else { + Tcl_SetTimer(&tsdPtr->blockTime); + } } - tsdPtr->inTraversal = 0; + tsdPtr->serviceLevel--; tsdPtr->serviceMode = TCL_SERVICE_ALL; return result; } /* @@ -1138,13 +1669,36 @@ break; } } Tcl_MutexUnlock(&listLock); } + +/* + *---------------------------------------------------------------------- + * + * Tcl_Sleep -- + * + * Delay execution for the specified number of milliseconds. + * + * Results: + * None. + * + * Side effects: + * Time passes. + * + *---------------------------------------------------------------------- + */ + +void +Tcl_Sleep( + int ms) /* Number of milliseconds to sleep. */ +{ + TclpUSleep((Tcl_WideInt)ms * 1000); +} /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ Index: generic/tclObj.c ================================================================== --- generic/tclObj.c +++ generic/tclObj.c @@ -2776,12 +2776,12 @@ */ mp_int big; UNPACK_BIGNUM(objPtr, big); - if ((size_t)(big.used) <= (CHAR_BIT * sizeof(long) + DIGIT_BIT - 1) - / DIGIT_BIT) { + if ((size_t)(big.used) <= (CHAR_BIT * sizeof(long) + MP_DIGIT_BIT - 1) + / MP_DIGIT_BIT) { unsigned long value = 0, numBytes = sizeof(long); long scratch; unsigned char *bytes = (unsigned char *)&scratch; if (mp_to_unsigned_bin_n(&big, bytes, &numBytes) == MP_OKAY) { while (numBytes-- > 0) { @@ -3077,11 +3077,11 @@ mp_int big; UNPACK_BIGNUM(objPtr, big); if ((size_t)(big.used) <= (CHAR_BIT * sizeof(Tcl_WideInt) - + DIGIT_BIT - 1) / DIGIT_BIT) { + + MP_DIGIT_BIT - 1) / MP_DIGIT_BIT) { Tcl_WideUInt value = 0; unsigned long numBytes = sizeof(Tcl_WideInt); Tcl_WideInt scratch; unsigned char *bytes = (unsigned char *) &scratch; @@ -3496,11 +3496,11 @@ { if (Tcl_IsShared(objPtr)) { Tcl_Panic("%s called with shared object", "Tcl_SetBignumObj"); } if ((size_t)(bignumValue->used) - <= (CHAR_BIT * sizeof(long) + DIGIT_BIT - 1) / DIGIT_BIT) { + <= (CHAR_BIT * sizeof(long) + MP_DIGIT_BIT - 1) / MP_DIGIT_BIT) { unsigned long value = 0, numBytes = sizeof(long); long scratch; unsigned char *bytes = (unsigned char *)&scratch; if (mp_to_unsigned_bin_n(bignumValue, bytes, &numBytes) != MP_OKAY) { goto tooLargeForLong; @@ -3520,11 +3520,11 @@ return; } tooLargeForLong: #ifndef NO_WIDE_TYPE if ((size_t)(bignumValue->used) - <= (CHAR_BIT * sizeof(Tcl_WideInt) + DIGIT_BIT - 1) / DIGIT_BIT) { + <= (CHAR_BIT * sizeof(Tcl_WideInt) + MP_DIGIT_BIT - 1) / MP_DIGIT_BIT) { Tcl_WideUInt value = 0; unsigned long numBytes = sizeof(Tcl_WideInt); Tcl_WideInt scratch; unsigned char *bytes = (unsigned char *)&scratch; if (mp_to_unsigned_bin_n(bignumValue, bytes, &numBytes) != MP_OKAY) { @@ -3919,15 +3919,14 @@ register CONST char *p1, *p2; register int l1, l2; /* * If the object pointers are the same then they match. - */ + * OPT: this comparison was moved to the caller - if (objPtr1 == objPtr2) { - return 1; - } + if (objPtr1 == objPtr2) return 1; + */ /* * Don't use Tcl_GetStringFromObj as it would prevent l1 and l2 being * in a register. */ Index: generic/tclStrToD.c ================================================================== --- generic/tclStrToD.c +++ generic/tclStrToD.c @@ -1831,19 +1831,19 @@ * that quantity, then convert the significand to a large integer, scaled * appropriately. Then multiply by the appropriate power of 5. */ msb = binExponent + M2; /* 1008 */ - nDigits = msb / DIGIT_BIT + 1; + nDigits = msb / MP_DIGIT_BIT + 1; mp_init_size(&twoMv, nDigits); - i = (msb % DIGIT_BIT + 1); + i = (msb % MP_DIGIT_BIT + 1); twoMv.used = nDigits; significand *= SafeLdExp(1.0, i); while (--nDigits >= 0) { twoMv.dp[nDigits] = (mp_digit) significand; significand -= (mp_digit) significand; - significand = SafeLdExp(significand, DIGIT_BIT); + significand = SafeLdExp(significand, MP_DIGIT_BIT); } for (i = 0; i <= 8; ++i) { if (M5 & (1 << i)) { mp_mul(&twoMv, pow5+i, &twoMv); } @@ -3115,11 +3115,11 @@ int sd, /* Denominator is 2**(sd*DIGIT_BIT) */ int isodd) /* 1 if the digit is odd, 0 if even */ { int i; - static const mp_digit topbit = (1<<(DIGIT_BIT-1)); + static const mp_digit topbit = (1<<(MP_DIGIT_BIT-1)); if (b->used < sd || (b->dp[sd-1] & topbit) == 0) { return 0; } if (b->dp[sd-1] != topbit) { return 1; @@ -4236,20 +4236,20 @@ * by digit shifts. First we round up s2 to a multiple of * DIGIT_BIT, and adjust m2 and b2 accordingly. Then we launch * into a version of the comparison that's specialized for * the 'power of mp_digit in the denominator' case. */ - if (s2 % DIGIT_BIT != 0) { - int delta = DIGIT_BIT - (s2 % DIGIT_BIT); + if (s2 % MP_DIGIT_BIT != 0) { + int delta = MP_DIGIT_BIT - (s2 % MP_DIGIT_BIT); b2 += delta; m2plus += delta; m2minus += delta; s2 += delta; } return ShorteningBignumConversionPowD(&d, convType, bw, b2, b5, m2plus, m2minus, m5, - s2/DIGIT_BIT, k, len, + s2/MP_DIGIT_BIT, k, len, ilim, ilim1, decpt, endPtr); } else { /* * Alas, there's no helpful special case; use full-up @@ -4296,17 +4296,17 @@ * by digit shifts. First we round up s2 to a multiple of * DIGIT_BIT, and adjust m2 and b2 accordingly. Then we launch * into a version of the comparison that's specialized for * the 'power of mp_digit in the denominator' case. */ - if (s2 % DIGIT_BIT != 0) { - int delta = DIGIT_BIT - (s2 % DIGIT_BIT); + if (s2 % MP_DIGIT_BIT != 0) { + int delta = MP_DIGIT_BIT - (s2 % MP_DIGIT_BIT); b2 += delta; s2 += delta; } return StrictBignumConversionPowD(&d, convType, bw, b2, b5, - s2/DIGIT_BIT, k, len, + s2/MP_DIGIT_BIT, k, len, ilim, ilim1, decpt, endPtr); } else { /* * There are no helpful special cases, but at least we know * in advance how many digits we will convert. We can run the @@ -4431,11 +4431,11 @@ maxDigits = (int) ((DBL_MAX_EXP * log((double) FLT_RADIX) + 0.5 * log(10.)) / log(10.)); minDigits = (int) floor((DBL_MIN_EXP - DBL_MANT_DIG) * log((double) FLT_RADIX) / log(10.)); - log10_DIGIT_MAX = (int) floor(DIGIT_BIT * log(2.) / log(10.)); + log10_DIGIT_MAX = (int) floor(MP_DIGIT_BIT * log(2.) / log(10.)); /* * Nokia 770's software-emulated floating point is "middle endian": the * bytes within a 32-bit word are little-endian (like the native * integers), but the two words of a 'double' are presented most @@ -4632,11 +4632,11 @@ * Accumulate the result, one mp_digit at a time. */ r = 0.0; for (i=b.used-1 ; i>=0 ; --i) { - r = ldexp(r, DIGIT_BIT) + b.dp[i]; + r = ldexp(r, MP_DIGIT_BIT) + b.dp[i]; } mp_clear(&b); /* * Scale the result to the correct number of bits. @@ -4701,11 +4701,11 @@ } if (!exact) { mp_add_d(&b, 1, &b); } for (i=b.used-1 ; i>=0 ; --i) { - r = ldexp(r, DIGIT_BIT) + b.dp[i]; + r = ldexp(r, MP_DIGIT_BIT) + b.dp[i]; } r = ldexp(r, bits - mantBits); } } mp_clear(&b); @@ -4751,11 +4751,11 @@ mp_div_2d(a, -shift, &b, NULL); } else { mp_copy(a, &b); } for (i=b.used-1 ; i>=0 ; --i) { - r = ldexp(r, DIGIT_BIT) + b.dp[i]; + r = ldexp(r, MP_DIGIT_BIT) + b.dp[i]; } r = ldexp(r, bits - mantBits); } } mp_clear(&b); @@ -4813,11 +4813,11 @@ * Accumulate the result, one mp_digit at a time. */ r = 0.0; for (i=b.used-1; i>=0; --i) { - r = ldexp(r, DIGIT_BIT) + b.dp[i]; + r = ldexp(r, MP_DIGIT_BIT) + b.dp[i]; } mp_clear(&b); /* * Return the result with the appropriate sign. Index: generic/tclStringObj.c ================================================================== --- generic/tclStringObj.c +++ generic/tclStringObj.c @@ -2249,15 +2249,15 @@ while (uw) { numDigits++; uw /= base; } } else if (useBig && big.used) { - int leftover = (big.used * DIGIT_BIT) % numBits; - mp_digit mask = (~(mp_digit)0) << (DIGIT_BIT-leftover); + int leftover = (big.used * MP_DIGIT_BIT) % numBits; + mp_digit mask = (~(mp_digit)0) << (MP_DIGIT_BIT-leftover); numDigits = 1 + - (((Tcl_WideInt)big.used * DIGIT_BIT) / numBits); + (((Tcl_WideInt)big.used * MP_DIGIT_BIT) / numBits); while ((mask & big.dp[big.used-1]) == 0) { numDigits--; mask >>= numBits; } if (numDigits > INT_MAX) { @@ -2288,13 +2288,13 @@ while (numDigits--) { int digitOffset; if (useBig && big.used) { if (index < big.used && (size_t) shift < - CHAR_BIT*sizeof(Tcl_WideUInt) - DIGIT_BIT) { + CHAR_BIT*sizeof(Tcl_WideUInt) - MP_DIGIT_BIT) { bits |= (((Tcl_WideUInt)big.dp[index++]) < 9) { Index: generic/tclTest.c ================================================================== --- generic/tclTest.c +++ generic/tclTest.c @@ -4324,11 +4324,11 @@ /* *---------------------------------------------------------------------- * * TestupvarCmd -- * - * This procedure implements the "testupvar2" command. It is used + * This procedure implements the "testupvar" command. It is used * to test Tcl_UpVar and Tcl_UpVar2. * * Results: * A standard Tcl result. * Index: generic/tclTimer.c ================================================================== --- generic/tclTimer.c +++ generic/tclTimer.c @@ -10,26 +10,10 @@ * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" -/* - * For each timer callback that's pending there is one record of the following - * type. The normal handlers (created by Tcl_CreateTimerHandler) are chained - * together in a list sorted by time (earliest event first). - */ - -typedef struct TimerHandler { - Tcl_Time time; /* When timer is to fire. */ - Tcl_TimerProc *proc; /* Function to call. */ - ClientData clientData; /* Argument to pass to proc. */ - Tcl_TimerToken token; /* Identifies handler so it can be deleted. */ - struct TimerHandler *nextPtr; - /* Next event in queue, or NULL for end of - * queue. */ -} TimerHandler; - /* * The data structure below is used by the "after" command to remember the * command to be executed later. All of the pending "after" commands for an * interpreter are linked together in a list. */ @@ -38,18 +22,15 @@ struct AfterAssocData *assocPtr; /* Pointer to the "tclAfter" assocData for the * interp in which command will be * executed. */ Tcl_Obj *commandPtr; /* Command to execute. */ - int id; /* Integer identifier for command; used to - * cancel it. */ - Tcl_TimerToken token; /* Used to cancel the "after" command. NULL - * means that the command is run as an idle - * handler rather than as a timer handler. - * NULL means this is an "after idle" handler - * rather than a timer handler. */ + Tcl_Obj *selfPtr; /* Points to the handle object (self) */ + unsigned int id; /* Integer identifier for command */ struct AfterInfo *nextPtr; /* Next in list of all "after" commands for + * this interpreter. */ + struct AfterInfo *prevPtr; /* Prev in list of all "after" commands for * this interpreter. */ } AfterInfo; /* * One of the following structures is associated with each interpreter for @@ -61,26 +42,13 @@ Tcl_Interp *interp; /* The interpreter for which this data is * registered. */ AfterInfo *firstAfterPtr; /* First in list of all "after" commands still * pending for this interpreter, or NULL if * none. */ + AfterInfo *lastAfterPtr; /* Last in list of all "after" commands. */ } AfterAssocData; -/* - * There is one of the following structures for each of the handlers declared - * in a call to Tcl_DoWhenIdle. All of the currently-active handlers are - * linked together into a list. - */ - -typedef struct IdleHandler { - Tcl_IdleProc (*proc); /* Function to call. */ - ClientData clientData; /* Value to pass to proc. */ - int generation; /* Used to distinguish older handlers from - * recently-created ones. */ - struct IdleHandler *nextPtr;/* Next in list of active handlers. */ -} IdleHandler; - /* * The timer and idle queues are per-thread because they are associated with * the notifier, which is also per-thread. * * All static variables used in this file are collected into a single instance @@ -89,62 +57,173 @@ * * Notice that different structures with the same name appear in other files. * The structure defined below is used in this file only. */ -typedef struct ThreadSpecificData { - TimerHandler *firstTimerHandlerPtr; /* First event in queue. */ +typedef struct { + Tcl_WideInt relTimerBase; /* Time base of the first known relative */ + /* timer, used to revert all events to the new + * base after possible time-jump (adjustment).*/ + TclTimerEvent *promptList; /* First immediate event in queue. */ + TclTimerEvent *promptTail; /* Last immediate event in queue. */ + TclTimerEvent *relTimerList;/* First event in queue of relative timers. */ + TclTimerEvent *relTimerTail;/* Last event in queue of relative timers. */ + TclTimerEvent *absTimerList;/* First event in queue of absolute timers. */ + TclTimerEvent *absTimerTail;/* Last event in queue of absolute timers. */ + size_t timerListEpoch; /* Used for safe process of event queue (stop + * the cycle after modifying of event queue) */ int lastTimerId; /* Timer identifier of most recently created - * timer. */ + * timer event. */ int timerPending; /* 1 if a timer event is in the queue. */ - IdleHandler *idleList; /* First in list of all idle handlers. */ - IdleHandler *lastIdlePtr; /* Last in list (or NULL for empty list). */ - int idleGeneration; /* Used to fill in the "generation" fields of - * IdleHandler structures. Increments each - * time Tcl_DoOneEvent starts calling idle - * handlers, so that all old handlers can be + TclTimerEvent *idleList; /* First in list of all idle handlers. */ + TclTimerEvent *idleTail; /* Last in list (or NULL for empty list). */ + size_t timerGeneration; /* Used to fill in the "generation" fields of */ + size_t idleGeneration; /* timer or idle structures. Increments each + * time we place a new handler to queue inside, + * a new loop, so that all old handlers can be * called without calling any of the new ones * created by old ones. */ - int afterId; /* For unique identifiers of after events. */ + unsigned int afterId; /* For unique identifiers of after events. */ } ThreadSpecificData; static Tcl_ThreadDataKey dataKey; /* - * Helper macros for working with times. TCL_TIME_BEFORE encodes how to write - * the ordering relation on (normalized) times, and TCL_TIME_DIFF_MS computes - * the number of milliseconds difference between two times. Both macros use - * both of their arguments multiple times, so make sure they are cheap and - * side-effect free. The "prototypes" for these macros are: - * - * static int TCL_TIME_BEFORE(Tcl_Time t1, Tcl_Time t2); - * static long TCL_TIME_DIFF_MS(Tcl_Time t1, Tcl_Time t2); + * Helper macros to wrap AfterInfo and handlers (and vice versa) */ -#define TCL_TIME_BEFORE(t1, t2) \ - (((t1).sec<(t2).sec) || ((t1).sec==(t2).sec && (t1).usec<(t2).usec)) - -#define TCL_TIME_DIFF_MS(t1, t2) \ - (1000*((Tcl_WideInt)(t1).sec - (Tcl_WideInt)(t2).sec) + \ - ((long)(t1).usec - (long)(t2).usec)/1000) +#define TclpTimerEvent2AfterInfo(ptr) \ + ( (AfterInfo*)TclpTimerEvent2ExtraData(ptr) ) +#define TclpAfterInfo2TimerEvent(ptr) \ + TclpExtraData2TimerEvent(ptr) /* * Prototypes for functions referenced only in this file: */ static void AfterCleanupProc(ClientData clientData, Tcl_Interp *interp); -static int AfterDelay(Tcl_Interp *interp, Tcl_WideInt ms); +static int AfterDelay(Tcl_Interp *interp, Tcl_WideInt usec, + int absolute); static void AfterProc(ClientData clientData); -static void FreeAfterPtr(AfterInfo *afterPtr); -static AfterInfo * GetAfterEvent(AfterAssocData *assocPtr, - Tcl_Obj *commandPtr); +static void FreeAfterPtr(ClientData clientData); +static AfterInfo * GetAfterEvent(AfterAssocData *assocPtr, Tcl_Obj *objPtr); static ThreadSpecificData *InitTimer(void); static void TimerExitProc(ClientData clientData); -static int TimerHandlerEventProc(Tcl_Event *evPtr, int flags); static void TimerCheckProc(ClientData clientData, int flags); static void TimerSetupProc(ClientData clientData, int flags); + +static void AfterObj_DupInternalRep(Tcl_Obj *, Tcl_Obj *); +static void AfterObj_FreeInternalRep(Tcl_Obj *); +static void AfterObj_UpdateString(Tcl_Obj *); + +/* + * Type definition. + */ + +Tcl_ObjType afterObjType = { + "after", /* name */ + AfterObj_FreeInternalRep, /* freeIntRepProc */ + AfterObj_DupInternalRep, /* dupIntRepProc */ + AfterObj_UpdateString, /* updateStringProc */ + NULL /* setFromAnyProc */ +}; + +/* + *---------------------------------------------------------------------- + */ +static void +AfterObj_DupInternalRep(srcPtr, dupPtr) + Tcl_Obj *srcPtr; + Tcl_Obj *dupPtr; +{ + /* + * Because we should have only a single reference to the after event, + * we'll copy string representation only. + */ + if (dupPtr->bytes == NULL) { + if (srcPtr->bytes == NULL) { + AfterObj_UpdateString(srcPtr); + } + if (srcPtr->bytes != tclEmptyStringRep) { + TclInitStringRep(dupPtr, srcPtr->bytes, srcPtr->length); + } else { + dupPtr->bytes = tclEmptyStringRep; + } + } +} +/* + *---------------------------------------------------------------------- + */ +static void +AfterObj_FreeInternalRep(objPtr) + Tcl_Obj *objPtr; +{ + /* + * Because we should always have a reference by active after event, + * so it is a triggered / canceled event - just reset type and pointers + */ + objPtr->internalRep.twoPtrValue.ptr1 = NULL; + objPtr->internalRep.twoPtrValue.ptr2 = NULL; + objPtr->typePtr = NULL; + + /* prevent no string representation bug */ + if (objPtr->bytes == NULL) { + objPtr->length = 0; + objPtr->bytes = tclEmptyStringRep; + } +} +/* + *---------------------------------------------------------------------- + */ +static void +AfterObj_UpdateString(objPtr) + Tcl_Obj *objPtr; +{ + char buf[16 + TCL_INTEGER_SPACE]; + int len; + + AfterInfo *afterPtr = (AfterInfo*)objPtr->internalRep.twoPtrValue.ptr1; + + /* if already triggered / canceled - equivalent not found, we can use empty */ + if (!afterPtr) { + objPtr->length = 0; + objPtr->bytes = tclEmptyStringRep; + return; + } + + len = sprintf(buf, "after#%u", afterPtr->id); + + objPtr->length = len; + objPtr->bytes = ckalloc((size_t)++len); + if (objPtr->bytes) + memcpy(objPtr->bytes, buf, len); + +} +/* + *---------------------------------------------------------------------- + */ +Tcl_Obj* +GetAfterObj( + AfterInfo *afterPtr) +{ + Tcl_Obj * objPtr = afterPtr->selfPtr; + + if (objPtr != NULL) { + return objPtr; + } + + TclNewObj(objPtr); + objPtr->typePtr = &afterObjType; + objPtr->bytes = NULL; + objPtr->internalRep.twoPtrValue.ptr1 = afterPtr; + objPtr->internalRep.twoPtrValue.ptr2 = NULL; + Tcl_IncrRefCount(objPtr); + afterPtr->selfPtr = objPtr; + + return objPtr; +}; /* *---------------------------------------------------------------------- * * InitTimer -- @@ -166,15 +245,143 @@ ThreadSpecificData *tsdPtr = (ThreadSpecificData *) TclThreadDataKeyGet(&dataKey); if (tsdPtr == NULL) { tsdPtr = TCL_TSD_INIT(&dataKey); - Tcl_CreateEventSource(TimerSetupProc, TimerCheckProc, NULL); + Tcl_CreateEventSource(TimerSetupProc, TimerCheckProc, tsdPtr); Tcl_CreateThreadExitHandler(TimerExitProc, NULL); } return tsdPtr; } + +static void +AttachTimerEvent( + ThreadSpecificData *tsdPtr, + TclTimerEvent *tmrEvent) +{ + TclTimerEvent **tmrList, **tmrTail; + + tmrEvent->flags |= TCL_TMREV_LISTED; + if (tmrEvent->flags & TCL_TMREV_PROMPT) { + /* use timer generation, because usually no differences between + * call of "after 0" and "after 1" */ + tmrEvent->generation = tsdPtr->timerGeneration; + /* attach to the prompt queue */ + TclSpliceTailEx(tmrEvent, tsdPtr->promptList, tsdPtr->promptTail); + /* execute immediately: signal pending and set timer marker */ + tsdPtr->timerPending = 1; + TclSetTimerEventMarker(0); + return; + } + + if (tmrEvent->flags & TCL_TMREV_IDLE) { + /* idle generation */ + tmrEvent->generation = tsdPtr->idleGeneration; + /* attach to the idle queue */ + TclSpliceTailEx(tmrEvent, tsdPtr->idleList, tsdPtr->idleTail); + return; + } + + /* current timer generation */ + tmrEvent->generation = tsdPtr->timerGeneration; + + /* + * Add the event to the queue in the correct position + * (ordered by event firing time). + */ + + tsdPtr->timerListEpoch++; /* signal - timer list was changed */ + + if (!(tmrEvent->flags & TCL_TMREV_AT)) { + tmrList = &tsdPtr->relTimerList; + tmrTail = &tsdPtr->relTimerTail; + } else { + tmrList = &tsdPtr->absTimerList; + tmrTail = &tsdPtr->absTimerTail; + } + /* if before current first (e. g. "after 1" before first "after 1000") */ + if ( !(*tmrList) || tmrEvent->time < (*tmrList)->time) { + /* splice to the head */ + TclSpliceInEx(tmrEvent, *tmrList, *tmrTail); + } else { + TclTimerEvent *tmrEventPos; + Tcl_WideInt usec = tmrEvent->time; + /* search from end as long as one with time before not found */ + for (tmrEventPos = *tmrTail; tmrEventPos != NULL; + tmrEventPos = tmrEventPos->prevPtr) { + if (usec >= tmrEventPos->time) { + break; + } + } + /* normally it should be always true, because checked above, but ... */ + if (tmrEventPos != NULL) { + /* insert after found element (with time before new) */ + tmrEvent->prevPtr = tmrEventPos; + if ((tmrEvent->nextPtr = tmrEventPos->nextPtr)) { + tmrEventPos->nextPtr->prevPtr = tmrEvent; + } else { + *tmrTail = tmrEvent; + } + tmrEventPos->nextPtr = tmrEvent; + } else { + /* unexpected case, but ... splice to the head */ + TclSpliceInEx(tmrEvent, *tmrList, *tmrTail); + } + } +} + +static void +DetachTimerEvent( + ThreadSpecificData *tsdPtr, + TclTimerEvent *tmrEvent) +{ + tmrEvent->flags &= ~TCL_TMREV_LISTED; + if (tmrEvent->flags & TCL_TMREV_PROMPT) { + /* prompt handler */ + TclSpliceOutEx(tmrEvent, tsdPtr->promptList, tsdPtr->promptTail); + return; + } + if (tmrEvent->flags & TCL_TMREV_IDLE) { + /* idle handler */ + TclSpliceOutEx(tmrEvent, tsdPtr->idleList, tsdPtr->idleTail); + return; + } + /* timer event-handler */ + tsdPtr->timerListEpoch++; /* signal - timer list was changed */ + if (!(tmrEvent->flags & TCL_TMREV_AT)) { + TclSpliceOutEx(tmrEvent, tsdPtr->relTimerList, tsdPtr->relTimerTail); + } else { + TclSpliceOutEx(tmrEvent, tsdPtr->absTimerList, tsdPtr->absTimerTail); + } +} + +static Tcl_WideInt +TimerMakeRelativeTime( + ThreadSpecificData *tsdPtr, + Tcl_WideInt usec) +{ + Tcl_WideInt now = TclpGetUTimeMonotonic(); + + /* + * We should have the ability to ajust end-time of relative events, + * for possible time-jumps. + */ + if (tsdPtr->relTimerList) { + /* + * end-time = now + usec + * Adjust value of usec relative current base (to now), so + * end-time = base + relative event-time, which corresponds + * original end-time. + */ + usec += now - tsdPtr->relTimerBase; + } else { + /* first event here - initial values (base/epoch) */ + tsdPtr->relTimerBase = now; + } + + return usec; +} /* *---------------------------------------------------------------------- * * TimerExitProc -- @@ -196,19 +403,24 @@ ClientData clientData) /* Not used. */ { ThreadSpecificData *tsdPtr = (ThreadSpecificData *) TclThreadDataKeyGet(&dataKey); - Tcl_DeleteEventSource(TimerSetupProc, TimerCheckProc, NULL); if (tsdPtr != NULL) { - register TimerHandler *timerHandlerPtr; + Tcl_DeleteEventSource(TimerSetupProc, TimerCheckProc, tsdPtr); - timerHandlerPtr = tsdPtr->firstTimerHandlerPtr; - while (timerHandlerPtr != NULL) { - tsdPtr->firstTimerHandlerPtr = timerHandlerPtr->nextPtr; - ckfree((char *) timerHandlerPtr); - timerHandlerPtr = tsdPtr->firstTimerHandlerPtr; + while ((tsdPtr->promptTail) != NULL) { + TclpDeleteTimerEvent(tsdPtr->promptTail); + } + while ((tsdPtr->relTimerTail) != NULL) { + TclpDeleteTimerEvent(tsdPtr->relTimerTail); + } + while ((tsdPtr->absTimerTail) != NULL) { + TclpDeleteTimerEvent(tsdPtr->absTimerTail); + } + while ((tsdPtr->idleTail) != NULL) { + TclpDeleteTimerEvent(tsdPtr->idleTail); } } } /* @@ -234,37 +446,168 @@ int milliseconds, /* How many milliseconds to wait before * invoking proc. */ Tcl_TimerProc *proc, /* Function to invoke. */ ClientData clientData) /* Arbitrary data to pass to proc. */ { - Tcl_Time time; + register TclTimerEvent *tmrEvent; + Tcl_WideInt usec; + + /* + * Compute when the event should fire (avoid overflow). + */ + + if (milliseconds < 0x7FFFFFFFFFFFFFFFL / 1000) { + usec = (Tcl_WideInt)milliseconds*1000; + } else { + usec = 0x7FFFFFFFFFFFFFFFL; + } + + tmrEvent = TclpCreateTimerEvent(usec, proc, NULL, 0, 0); + if (tmrEvent == NULL) { + return NULL; + } + tmrEvent->clientData = clientData; + + return tmrEvent->token; +} + +/* + *-------------------------------------------------------------- + * + * TclpCreateTimerEvent -- + * + * Arrange for a given function to be invoked at or in a particular time + * in the future (microseconds). + * + * Results: + * The return value is a handler entry of the timer event, which may be + * used to access the event entry, e. g. delete the event before it fires. + * + * Side effects: + * When the time or offset in timePtr has been reached, proc will be invoked + * exactly once. + * + *-------------------------------------------------------------- + */ + +TclTimerEvent* +TclpCreateTimerEvent( + Tcl_WideInt usec, /* Time to be invoked (absolute/relative) */ + Tcl_TimerProc *proc, /* Function to invoke */ + Tcl_TimerDeleteProc *deleteProc,/* Function to cleanup */ + size_t extraDataSize, /* Size of extra data to allocate */ + int flags) /* Flags corresponding type of event */ +{ + register TclTimerEvent *tmrEvent; + ThreadSpecificData *tsdPtr; + + tsdPtr = InitTimer(); + tmrEvent = (TclTimerEvent *)ckalloc( + sizeof(TclTimerEvent) + extraDataSize); + if (tmrEvent == NULL) { + return NULL; + } + + if (usec <= 0 && !(flags & (TCL_TMREV_AT|TCL_TMREV_PROMPT|TCL_TMREV_IDLE))) { + usec = 0; + flags |= TCL_TMREV_PROMPT; + } + + /* + * Fill in fields for the event. + */ + + tmrEvent->proc = proc; + tmrEvent->deleteProc = deleteProc; + tmrEvent->clientData = TclpTimerEvent2ExtraData(tmrEvent); + tmrEvent->flags = flags & (TCL_TMREV_AT|TCL_TMREV_PROMPT|TCL_TMREV_IDLE); + tsdPtr->lastTimerId++; + tmrEvent->token = (Tcl_TimerToken) INT2PTR(tsdPtr->lastTimerId); + + /* + * If TCL_TMREV_AT (and TCL_TMREV_PROMPT) are not specified, event observes + * due-time considering possible time-jump. + */ + if (!(flags & (TCL_TMREV_AT|TCL_TMREV_PROMPT|TCL_TMREV_IDLE))) { + /* relative event - realign time using current relative base */ + usec = TimerMakeRelativeTime(tsdPtr, usec); + } + + tmrEvent->time = usec; + tmrEvent->refCount = 0; /* - * Compute when the event should fire. + * Attach the event to the corresponding queue in the correct position + * (ordered by event firing time, if time specified). */ - Tcl_GetTime(&time); - time.sec += milliseconds/1000; - time.usec += (milliseconds%1000)*1000; - if (time.usec >= 1000000) { - time.usec -= 1000000; - time.sec += 1; - } - return TclCreateAbsoluteTimerHandler(&time, proc, clientData); + AttachTimerEvent(tsdPtr, tmrEvent); + + return tmrEvent; +} + +/* + *-------------------------------------------------------------- + * + * TclpCreatePromptTimerEvent -- + * + * Arrange for proc to be invoked delayed (but prompt) as timer event, + * without time ("after 0"). + * Or as idle event (the next time the system is idle i.e., just + * before the next time that Tcl_DoOneEvent would have to wait for + * something to happen). + * + * Providing the flag TCL_TMREV_PROMPT ensures that timer event-handler + * will be queued immediately to guarantee the execution of timer-event + * as soon as possible + * + * Results: + * Returns the created timer entry. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + +TclTimerEvent * +TclpCreatePromptTimerEvent( + Tcl_TimerProc *proc, /* Function to invoke. */ + Tcl_TimerDeleteProc *deleteProc, /* Function to cleanup */ + size_t extraDataSize, + int flags) +{ + register TclTimerEvent *tmrEvent; + ThreadSpecificData *tsdPtr = InitTimer(); + + tmrEvent = (TclTimerEvent *) ckalloc(sizeof(TclTimerEvent) + extraDataSize); + if (tmrEvent == NULL) { + return NULL; + } + tmrEvent->proc = proc; + tmrEvent->deleteProc = deleteProc; + tmrEvent->clientData = TclpTimerEvent2ExtraData(tmrEvent); + tmrEvent->flags = flags; + tmrEvent->time = 0; + tmrEvent->refCount = 0; + + AttachTimerEvent(tsdPtr, tmrEvent); + + return tmrEvent; } /* *-------------------------------------------------------------- * * TclCreateAbsoluteTimerHandler -- * * Arrange for a given function to be invoked at a particular time in the - * future. + * future (absolute time). * * Results: - * The return value is a token for the timer event, which may be used to - * delete the event before it fires. + * The return value is a token of the timer event, which + * may be used to delete the event before it fires. * * Side effects: * When the time in timePtr has been reached, proc will be invoked * exactly once. * @@ -275,47 +618,77 @@ TclCreateAbsoluteTimerHandler( Tcl_Time *timePtr, Tcl_TimerProc *proc, ClientData clientData) { - register TimerHandler *timerHandlerPtr, *tPtr2, *prevPtr; - ThreadSpecificData *tsdPtr; - - tsdPtr = InitTimer(); - timerHandlerPtr = (TimerHandler *) ckalloc(sizeof(TimerHandler)); - - /* - * Fill in fields for the event. - */ - - memcpy((void *)&timerHandlerPtr->time, (void *)timePtr, sizeof(Tcl_Time)); - timerHandlerPtr->proc = proc; - timerHandlerPtr->clientData = clientData; - tsdPtr->lastTimerId++; - timerHandlerPtr->token = (Tcl_TimerToken) INT2PTR(tsdPtr->lastTimerId); - - /* - * Add the event to the queue in the correct position - * (ordered by event firing time). - */ - - for (tPtr2 = tsdPtr->firstTimerHandlerPtr, prevPtr = NULL; tPtr2 != NULL; - prevPtr = tPtr2, tPtr2 = tPtr2->nextPtr) { - if (TCL_TIME_BEFORE(timerHandlerPtr->time, tPtr2->time)) { - break; - } - } - timerHandlerPtr->nextPtr = tPtr2; - if (prevPtr == NULL) { - tsdPtr->firstTimerHandlerPtr = timerHandlerPtr; + register TclTimerEvent *tmrEvent; + Tcl_WideInt usec; + + /* + * Compute when the event should fire (avoid overflow). + */ + + if (timePtr->sec < 0x7FFFFFFFFFFFFFFFL / 1000000) { + usec = (((Tcl_WideInt)timePtr->sec) * 1000000) + timePtr->usec; + } else { + usec = 0x7FFFFFFFFFFFFFFFL; + } + + tmrEvent = TclpCreateTimerEvent(usec, proc, NULL, 0, TCL_TMREV_AT); + if (tmrEvent == NULL) { + return NULL; + } + tmrEvent->clientData = clientData; + + return tmrEvent->token; +} + +/* + *-------------------------------------------------------------- + * + * TclCreateRelativeTimerHandler -- + * + * Arrange for a given function to be invoked in a particular time offset + * in the future. + * + * Results: + * The return value is token of the timer event, which + * may be used to delete the event before it fires. + * + * Side effects: + * In contrary to absolute timer functions operate on relative time. + * + *-------------------------------------------------------------- + */ + +Tcl_TimerToken +TclCreateTimerHandler( + Tcl_Time *timePtr, + Tcl_TimerProc *proc, + ClientData clientData, + int flags) +{ + register TclTimerEvent *tmrEvent; + Tcl_WideInt usec; + + /* + * Compute when the event should fire (avoid overflow). + */ + + if (timePtr->sec < 0x7FFFFFFFFFFFFFFFL / 1000000) { + usec = (((Tcl_WideInt)timePtr->sec) * 1000000) + timePtr->usec; } else { - prevPtr->nextPtr = timerHandlerPtr; + usec = 0x7FFFFFFFFFFFFFFFL; + } + + tmrEvent = TclpCreateTimerEvent(usec, proc, NULL, 0, flags); + if (tmrEvent == NULL) { + return NULL; } + tmrEvent->clientData = clientData; - TimerSetupProc(NULL, TCL_ALL_EVENTS); - - return timerHandlerPtr->token; + return tmrEvent->token; } /* *-------------------------------------------------------------- * @@ -335,35 +708,186 @@ */ void Tcl_DeleteTimerHandler( Tcl_TimerToken token) /* Result previously returned by - * Tcl_DeleteTimerHandler. */ + * Tcl_CreateTimerHandler. */ { - register TimerHandler *timerHandlerPtr, *prevPtr; + register TclTimerEvent *tmrEvent; ThreadSpecificData *tsdPtr = InitTimer(); if (token == NULL) { return; } - for (timerHandlerPtr = tsdPtr->firstTimerHandlerPtr, prevPtr = NULL; - timerHandlerPtr != NULL; prevPtr = timerHandlerPtr, - timerHandlerPtr = timerHandlerPtr->nextPtr) { - if (timerHandlerPtr->token != token) { + for (tmrEvent = tsdPtr->relTimerTail; + tmrEvent != NULL; + tmrEvent = tmrEvent->prevPtr + ) { + if (tmrEvent->token != token) { + continue; + } + + TclpDeleteTimerEvent(tmrEvent); + return; + } + + for (tmrEvent = tsdPtr->absTimerTail; + tmrEvent != NULL; + tmrEvent = tmrEvent->prevPtr + ) { + if (tmrEvent->token != token) { continue; } - if (prevPtr == NULL) { - tsdPtr->firstTimerHandlerPtr = timerHandlerPtr->nextPtr; - } else { - prevPtr->nextPtr = timerHandlerPtr->nextPtr; - } - ckfree((char *) timerHandlerPtr); + + TclpDeleteTimerEvent(tmrEvent); + return; + } +} + + +/* + *-------------------------------------------------------------- + * + * TclpDeleteTimerEvent -- + * + * Delete a previously-registered prompt, timer or idle handler. + * + * Results: + * None. + * + * Side effects: + * Destroy the timer callback, so that its associated function will + * not be called. If the callback has already fired this will be executed + * internally. + * + *-------------------------------------------------------------- + */ + +void +TclpDeleteTimerEvent( + TclTimerEvent *tmrEvent) /* Result previously returned by */ + /* TclpCreateTimerEvent or derivatives. */ +{ + ThreadSpecificData *tsdPtr; + + if (tmrEvent == NULL) { + return; + } + + tsdPtr = InitTimer(); + + /* detach from list */ + if (tmrEvent->flags & TCL_TMREV_LISTED) { + DetachTimerEvent(tsdPtr, tmrEvent); + } + + /* free it via deleteProc and ckfree */ + if (tmrEvent->deleteProc && !(tmrEvent->flags & TCL_TMREV_DELETE)) { + /* + * Mark this entry will be deleted, so it can avoid double delete and + * caller can check in delete callback, the time entry handle is still + * the same (was not overriden in some recursive async-envent). + */ + tmrEvent->flags |= TCL_TMREV_DELETE; + (*tmrEvent->deleteProc)(tmrEvent->clientData); + } + + /* if frozen somewhere (nested service cycle) */ + if (tmrEvent->refCount > 0) { + /* do nothing - event will be automatically deleted hereafter */ return; } + + ckfree((char *)tmrEvent); +} + +TclTimerEvent * +TclpProlongTimerEvent( + TclTimerEvent *tmrEvent, + Tcl_WideInt usec, + int flags) +{ +#if 0 + return NULL; +#else + ThreadSpecificData *tsdPtr = InitTimer(); + + if (tmrEvent->flags & TCL_TMREV_DELETE) { + return NULL; + } + /* if still belong to the queue, detach it from corresponding list */ + if (tmrEvent->flags & TCL_TMREV_LISTED) { + DetachTimerEvent(tsdPtr, tmrEvent); + } + /* set wanted flags and prolong */ + tmrEvent->flags |= (flags & (TCL_TMREV_AT|TCL_TMREV_PROMPT|TCL_TMREV_IDLE)); + /* new firing time */ + if (!(flags & (TCL_TMREV_PROMPT|TCL_TMREV_IDLE))) { + /* if relative event - realign time using current relative base */ + if (!(flags & TCL_TMREV_AT)) { + usec = TimerMakeRelativeTime(tsdPtr, usec); + } + tmrEvent->time = usec; + } + /* attach to the queue again (new generation) */ + AttachTimerEvent(tsdPtr, tmrEvent); + return tmrEvent; +#endif } +/* + *-------------------------------------------------------------- + * + * TimerGetDueTime -- + * + * Find the execution time offset of first relative or absolute timer + * starting from given heads. + * + * Results: + * A wide integer representing the due time (as microseconds) of first + * timer event to execute. + * + * Side effects: + * If time-jump recognized, may adjust the base for relative timers. + * + *-------------------------------------------------------------- + */ + +static Tcl_WideInt +TimerGetDueTime( + ThreadSpecificData *tsdPtr, + TclTimerEvent *relTimerList, + TclTimerEvent *absTimerList, + TclTimerEvent **dueEventPtr) +{ + TclTimerEvent *tmrEvent; + Tcl_WideInt timeOffs = 0x7FFFFFFFFFFFFFFFL; + + /* find shortest due-time */ + if ((tmrEvent = relTimerList) != NULL) { + /* offset to now (monotonic base) */ + timeOffs = tsdPtr->relTimerBase + tmrEvent->time + - TclpGetUTimeMonotonic(); + } + if (absTimerList) { + Tcl_WideInt absOffs; + /* offset to now (real-time base) */ + absOffs = absTimerList->time - TclpGetMicroseconds(); + if (!tmrEvent || absOffs < timeOffs) { + tmrEvent = absTimerList; + timeOffs = absOffs; + } + } + + if (dueEventPtr) { + *dueEventPtr = tmrEvent; + } + return timeOffs; +} + + /* *---------------------------------------------------------------------- * * TimerSetupProc -- * @@ -380,42 +904,70 @@ *---------------------------------------------------------------------- */ static void TimerSetupProc( - ClientData data, /* Not used. */ + ClientData data, /* Specific data. */ int flags) /* Event flags as passed to Tcl_DoOneEvent. */ { Tcl_Time blockTime; - ThreadSpecificData *tsdPtr = InitTimer(); + ThreadSpecificData *tsdPtr = (ThreadSpecificData *)data; - if (((flags & TCL_IDLE_EVENTS) && tsdPtr->idleList) - || ((flags & TCL_TIMER_EVENTS) && tsdPtr->timerPending)) { + if (tsdPtr == NULL) { tsdPtr = InitTimer(); }; + + if ( ((flags & TCL_TIMER_EVENTS) && (tsdPtr->timerPending || tsdPtr->promptList)) + || ((flags & TCL_IDLE_EVENTS) && tsdPtr->idleList ) + ) { /* - * There is an idle handler or a pending timer event, so just poll. + * There is a pending timer event or an idle handler, so just poll. */ blockTime.sec = 0; blockTime.usec = 0; - } else if ((flags & TCL_TIMER_EVENTS) && tsdPtr->firstTimerHandlerPtr) { + } else if ( + (flags & TCL_TIMER_EVENTS) + && (tsdPtr->relTimerList || tsdPtr->absTimerList) + ) { /* * Compute the timeout for the next timer on the list. */ - - Tcl_GetTime(&blockTime); - blockTime.sec = tsdPtr->firstTimerHandlerPtr->time.sec - blockTime.sec; - blockTime.usec = tsdPtr->firstTimerHandlerPtr->time.usec - - blockTime.usec; - if (blockTime.usec < 0) { - blockTime.sec -= 1; - blockTime.usec += 1000000; - } - if (blockTime.sec < 0) { + Tcl_WideInt timeOffs; + + timeOffs = TimerGetDueTime(tsdPtr, + tsdPtr->relTimerList, tsdPtr->absTimerList, NULL); + + #ifdef TMR_RES_TOLERANCE + /* consider timer resolution tolerance (avoid busy wait) */ + timeOffs -= ((timeOffs <= 1000000) ? timeOffs : 1000000) * + TMR_RES_TOLERANCE / 100; + #endif + + if (timeOffs > 0) { + blockTime.sec = 0; + if (timeOffs >= 1000000) { + /* + * Note we use monotonic time by all wait functions, so to + * avoid too long wait by the absolute timers (to be able + * to trigger it) if time jumped to the expected time, just + * let block for maximal 1s if absolute timers available. + */ + if (tsdPtr->absTimerList) { + /* we've some absolute timers - won't wait longer as 1s. */ + timeOffs = 1000000; + } + blockTime.sec = (long) (timeOffs / 1000000); + blockTime.usec = (unsigned long)(timeOffs % 1000000); + } else { + blockTime.sec = 0; + blockTime.usec = (unsigned long)timeOffs; + } + } else { blockTime.sec = 0; blockTime.usec = 0; } + } else { return; } Tcl_SetMaxBlockTime(&blockTime); @@ -425,12 +977,11 @@ *---------------------------------------------------------------------- * * TimerCheckProc -- * * This function is called by Tcl_DoOneEvent to check the timer event - * source for events. This routine checks both the idle and after timer - * lists. + * source for events. This routine checks the first timer in the list. * * Results: * None. * * Side effects: @@ -439,100 +990,96 @@ *---------------------------------------------------------------------- */ static void TimerCheckProc( - ClientData data, /* Not used. */ + ClientData data, /* Specific data. */ int flags) /* Event flags as passed to Tcl_DoOneEvent. */ { - Tcl_Event *timerEvPtr; - Tcl_Time blockTime; - ThreadSpecificData *tsdPtr = InitTimer(); - - if ((flags & TCL_TIMER_EVENTS) && tsdPtr->firstTimerHandlerPtr) { - /* - * Compute the timeout for the next timer on the list. - */ - - Tcl_GetTime(&blockTime); - blockTime.sec = tsdPtr->firstTimerHandlerPtr->time.sec - blockTime.sec; - blockTime.usec = tsdPtr->firstTimerHandlerPtr->time.usec - - blockTime.usec; - if (blockTime.usec < 0) { - blockTime.sec -= 1; - blockTime.usec += 1000000; - } - if (blockTime.sec < 0) { - blockTime.sec = 0; - blockTime.usec = 0; - } - - /* - * If the first timer has expired, stick an event on the queue. - */ - - if (blockTime.sec == 0 && blockTime.usec == 0 && - !tsdPtr->timerPending) { - tsdPtr->timerPending = 1; - timerEvPtr = (Tcl_Event *) ckalloc(sizeof(Tcl_Event)); - timerEvPtr->proc = TimerHandlerEventProc; - Tcl_QueueEvent(timerEvPtr, TCL_QUEUE_TAIL); - } + Tcl_WideInt timeOffs = 0; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *)data; + + if (!(flags & TCL_TIMER_EVENTS)) { + return; + } + + if (tsdPtr == NULL) { tsdPtr = InitTimer(); }; + + /* If already pending (or prompt-events) */ + if (tsdPtr->timerPending || tsdPtr->promptList) { + goto mark; + } + + /* + * Verify the first timer on the queue. + */ + + if (!tsdPtr->relTimerList && !tsdPtr->absTimerList) { + return; + } + + timeOffs = TimerGetDueTime(tsdPtr, + tsdPtr->relTimerList, tsdPtr->absTimerList, NULL); + +#ifdef TMR_RES_TOLERANCE + /* consider timer resolution tolerance (avoid busy wait) */ + timeOffs -= ((timeOffs <= 1000000) ? timeOffs : 1000000) * + TMR_RES_TOLERANCE / 100; +#endif + + /* + * If the first timer has expired, stick an event on the queue. + */ + if (timeOffs <= 0) { + mark: + TclSetTimerEventMarker(flags); /* force timer execution */ + tsdPtr->timerPending = 1; } } /* *---------------------------------------------------------------------- * - * TimerHandlerEventProc -- + * TclServiceTimerEvents -- * - * This function is called by Tcl_ServiceEvent when a timer event reaches - * the front of the event queue. This function handles the event by + * This function is called by Tcl_ServiceEvent when a timer events should + * be processed. This function handles the event by * invoking the callbacks for all timers that are ready. * * Results: * Returns 1 if the event was handled, meaning it should be removed from - * the queue. Returns 0 if the event was not handled, meaning it should - * stay on the queue. The only time the event isn't handled is if the - * TCL_TIMER_EVENTS flag bit isn't set. + * the queue. + * Returns 0 if the event was not handled (no timer events). + * Returns -1 if pending timer events available, meaning the marker should + * stay on the head of queue. * * Side effects: * Whatever the timer handler callback functions do. * *---------------------------------------------------------------------- */ -static int -TimerHandlerEventProc( - Tcl_Event *evPtr, /* Event to service. */ - int flags) /* Flags that indicate what events to handle, - * such as TCL_FILE_EVENTS. */ -{ - TimerHandler *timerHandlerPtr, **nextPtrPtr; - Tcl_Time time; - int currentTimerId; +int +TclServiceTimerEvents(void) +{ + TclTimerEvent *tmrEvent, *relTimerList, *absTimerList; + size_t currentGeneration, currentEpoch; + int result = 0; + int prevTmrPending; ThreadSpecificData *tsdPtr = InitTimer(); - /* - * Do nothing if timers aren't enabled. This leaves the event on the - * queue, so we will get to it as soon as ServiceEvents() is called with - * timers enabled. - */ - - if (!(flags & TCL_TIMER_EVENTS)) { - return 0; + if (!tsdPtr->timerPending) { + return 0; /* no timer events */ } /* * The code below is trickier than it may look, for the following reasons: * * 1. New handlers can get added to the list while the current one is * being processed. If new ones get added, we don't want to process * them during this pass through the list to avoid starving other event - * sources. This is implemented using the token number in the handler: - * new handlers will have a newer token than any of the ones currently - * on the list. + * sources. This is implemented using check of the generation epoch. * 2. The handler can call Tcl_DoOneEvent, so we have to remove the * handler from the list before calling it. Otherwise an infinite loop * could result. * 3. Tcl_DeleteTimerHandler can be called to remove an element from the * list while a handler is executing, so the list could change @@ -545,43 +1092,143 @@ * most recently created handler appearing after earlier ones with the * same expiration time, we don't have to worry about newer generation * timers appearing before later ones. */ - tsdPtr->timerPending = 0; - currentTimerId = tsdPtr->lastTimerId; - Tcl_GetTime(&time); - while (1) { - nextPtrPtr = &tsdPtr->firstTimerHandlerPtr; - timerHandlerPtr = tsdPtr->firstTimerHandlerPtr; - if (timerHandlerPtr == NULL) { - break; - } - - if (TCL_TIME_BEFORE(time, timerHandlerPtr->time)) { - break; - } - - /* - * Bail out if the next timer is of a newer generation. - */ - - if ((currentTimerId - PTR2INT(timerHandlerPtr->token)) < 0) { - break; - } - + currentGeneration = tsdPtr->timerGeneration++; + tsdPtr->timerPending = 0; + + /* First process all prompt (immediate) events */ + while ((tmrEvent = tsdPtr->promptList) != NULL + && tmrEvent->generation <= currentGeneration + ) { + /* freeze / detach entry from the owner's list */ + tmrEvent->refCount++; + tmrEvent->flags &= ~TCL_TMREV_LISTED; + TclSpliceOutEx(tmrEvent, tsdPtr->promptList, tsdPtr->promptTail); + /* reset current timer pending (correct process nested wait event) */ + prevTmrPending = tsdPtr->timerPending; + tsdPtr->timerPending = 0; + /* execute event */ + (*tmrEvent->proc)(tmrEvent->clientData); + result = 1; + /* restore current timer pending */ + tsdPtr->timerPending += prevTmrPending; + /* unfreeze / if used somewhere else (nested) or prolongation (reattached) */ + if (tmrEvent->refCount-- > 1 || (tmrEvent->flags & TCL_TMREV_LISTED)) { + continue; + }; + /* free it via deleteProc and ckfree */ + if (tmrEvent->deleteProc && !(tmrEvent->flags & TCL_TMREV_DELETE)) { + tmrEvent->flags |= TCL_TMREV_DELETE; + (*tmrEvent->deleteProc)(tmrEvent->clientData); + } + ckfree((char *) tmrEvent); + } + + /* if stil pending prompt events (new generation) - repeat event cycle as + * soon as possible */ + if (tsdPtr->promptList) { + tsdPtr->timerPending = 1; + return -1; + } + + /* Hereafter all relative and absolute timer events with time before now */ + relTimerList = tsdPtr->relTimerList; + absTimerList = tsdPtr->absTimerList; + while (relTimerList || absTimerList) { + Tcl_WideInt timeOffs; + + /* find timer (absolute/relative) with shortest due-time */ + timeOffs = TimerGetDueTime(tsdPtr, + relTimerList, absTimerList, &tmrEvent); + /* the same tolerance logic as in TimerSetupProc/TimerCheckProc */ + #ifdef TMR_RES_TOLERANCE + timeOffs -= ((timeOffs <= 1000000) ? timeOffs : 1000000) * + TMR_RES_TOLERANCE / 100; + #endif + /* still not reached */ + if (timeOffs > 0) { + break; + } + + /* for the next iteration */ + if (tmrEvent == relTimerList) { + relTimerList = tmrEvent->nextPtr; + } else { + absTimerList = tmrEvent->nextPtr; + } + + /* + * Bypass timers of newer generation. + */ + + if (tmrEvent->generation > currentGeneration) { + /* increase pending to signal repeat */ + tsdPtr->timerPending++; + continue; + } + + tsdPtr->timerListEpoch++; /* signal - timer list was changed */ + currentEpoch = tsdPtr->timerListEpoch; /* save it to compare */ + /* * Remove the handler from the queue before invoking it, to avoid * potential reentrancy problems. */ + tmrEvent->refCount++; /* freeze */ + tmrEvent->flags &= ~TCL_TMREV_LISTED; + if (!(tmrEvent->flags & TCL_TMREV_AT)) { + TclSpliceOutEx(tmrEvent, + tsdPtr->relTimerList, tsdPtr->relTimerTail); + } else { + TclSpliceOutEx(tmrEvent, + tsdPtr->absTimerList, tsdPtr->absTimerTail); + } - (*nextPtrPtr) = timerHandlerPtr->nextPtr; - (*timerHandlerPtr->proc)(timerHandlerPtr->clientData); - ckfree((char *) timerHandlerPtr); + /* reset current timer pending (correct process nested wait event) */ + prevTmrPending = tsdPtr->timerPending; + tsdPtr->timerPending = 0; + /* invoke timer proc */ + (*tmrEvent->proc)(tmrEvent->clientData); + result = 1; + /* restore current timer pending */ + tsdPtr->timerPending += prevTmrPending; + /* unfreeze / if used somewhere else (nested) or prolongation (reattached) */ + if (tmrEvent->refCount-- > 1 || (tmrEvent->flags & TCL_TMREV_LISTED)) { + goto nextEvent; + }; + /* free it via deleteProc and ckfree */ + if (tmrEvent->deleteProc && !(tmrEvent->flags & TCL_TMREV_DELETE)) { + tmrEvent->flags |= TCL_TMREV_DELETE; + (*tmrEvent->deleteProc)(tmrEvent->clientData); + } + ckfree((char *) tmrEvent); + + nextEvent: + /* be sure that timer-list was not changed inside the proc call */ + if (currentEpoch != tsdPtr->timerListEpoch) { + /* timer-list was changed - stop processing */ + break; + } + } + + /* pending timer events, so mark (queue) timer events */ + if (tsdPtr->timerPending >= 1) { + tsdPtr->timerPending = 1; + return -1; + } + + /* Reset generation if both timer queue are empty */ + if (!tsdPtr->promptList && !tsdPtr->relTimerList && !tsdPtr->absTimerList) { + tsdPtr->timerGeneration = 0; } - TimerSetupProc(NULL, TCL_TIMER_EVENTS); - return 1; + + /* Compute the next timeout (later via TimerSetupProc using the first timer). */ + tsdPtr->timerPending = 0; + + return result; /* processing done, again later via TimerCheckProc */ } /* *-------------------------------------------------------------- * @@ -598,35 +1245,20 @@ * Proc will eventually be called, with clientData as argument. See the * manual entry for details. * *-------------------------------------------------------------- */ - void Tcl_DoWhenIdle( Tcl_IdleProc *proc, /* Function to invoke. */ ClientData clientData) /* Arbitrary value to pass to proc. */ { - register IdleHandler *idlePtr; - Tcl_Time blockTime; - ThreadSpecificData *tsdPtr = InitTimer(); - - idlePtr = (IdleHandler *) ckalloc(sizeof(IdleHandler)); - idlePtr->proc = proc; - idlePtr->clientData = clientData; - idlePtr->generation = tsdPtr->idleGeneration; - idlePtr->nextPtr = NULL; - if (tsdPtr->lastIdlePtr == NULL) { - tsdPtr->idleList = idlePtr; - } else { - tsdPtr->lastIdlePtr->nextPtr = idlePtr; - } - tsdPtr->lastIdlePtr = idlePtr; - - blockTime.sec = 0; - blockTime.usec = 0; - Tcl_SetMaxBlockTime(&blockTime); + TclTimerEvent *idlePtr = TclpCreatePromptTimerEvent(proc, NULL, 0, TCL_TMREV_IDLE); + + if (idlePtr) { + idlePtr->clientData = clientData; + } } /* *---------------------------------------------------------------------- * @@ -648,38 +1280,38 @@ void Tcl_CancelIdleCall( Tcl_IdleProc *proc, /* Function that was previously registered. */ ClientData clientData) /* Arbitrary value to pass to proc. */ { - register IdleHandler *idlePtr, *prevPtr; - IdleHandler *nextPtr; + register TclTimerEvent *idlePtr, *nextPtr; ThreadSpecificData *tsdPtr = InitTimer(); - for (prevPtr = NULL, idlePtr = tsdPtr->idleList; idlePtr != NULL; - prevPtr = idlePtr, idlePtr = idlePtr->nextPtr) { - while ((idlePtr->proc == proc) + for (idlePtr = tsdPtr->idleList; + idlePtr != NULL; + idlePtr = nextPtr + ) { + nextPtr = idlePtr->nextPtr; + if ((idlePtr->proc == proc) && (idlePtr->clientData == clientData)) { - nextPtr = idlePtr->nextPtr; + /* detach entry from the owner list */ + idlePtr->flags &= ~TCL_TMREV_LISTED; + TclSpliceOutEx(idlePtr, tsdPtr->idleList, tsdPtr->idleTail); + + /* free it via deleteProc and ckfree */ + if (idlePtr->deleteProc && !(idlePtr->flags & TCL_TMREV_DELETE)) { + idlePtr->flags |= TCL_TMREV_DELETE; + (*idlePtr->deleteProc)(idlePtr->clientData); + } ckfree((char *) idlePtr); - idlePtr = nextPtr; - if (prevPtr == NULL) { - tsdPtr->idleList = idlePtr; - } else { - prevPtr->nextPtr = idlePtr; - } - if (idlePtr == NULL) { - tsdPtr->lastIdlePtr = prevPtr; - return; - } } } } /* *---------------------------------------------------------------------- * - * TclServiceIdle -- + * TclServiceIdle -- , TclServiceIdleEx -- * * This function is invoked by the notifier when it becomes idle. It will * invoke all idle handlers that are present at the time the call is * invoked, but not those added during idle processing. * @@ -692,23 +1324,23 @@ * *---------------------------------------------------------------------- */ int -TclServiceIdle(void) +TclServiceIdleEx( + int flags, + int count) { - IdleHandler *idlePtr; - int oldGeneration; - Tcl_Time blockTime; + TclTimerEvent *idlePtr; + size_t currentGeneration; ThreadSpecificData *tsdPtr = InitTimer(); - if (tsdPtr->idleList == NULL) { + if ((idlePtr = tsdPtr->idleList) == NULL) { return 0; } - oldGeneration = tsdPtr->idleGeneration; - tsdPtr->idleGeneration++; + currentGeneration = tsdPtr->idleGeneration++; /* * The code below is trickier than it may look, for the following reasons: * * 1. New handlers can get added to the list while the current one is @@ -723,28 +1355,117 @@ * 3. Tcl_CancelIdleCall can be called to remove an element from the list * while a handler is executing, so the list could change structure * during the call. */ - for (idlePtr = tsdPtr->idleList; - ((idlePtr != NULL) - && ((oldGeneration - idlePtr->generation) >= 0)); - idlePtr = tsdPtr->idleList) { - tsdPtr->idleList = idlePtr->nextPtr; - if (tsdPtr->idleList == NULL) { - tsdPtr->lastIdlePtr = NULL; - } + while (idlePtr->generation <= currentGeneration) { + /* freeze / detach entry from the owner's list */ + idlePtr->refCount++; + idlePtr->flags &= ~TCL_TMREV_LISTED; + TclSpliceOutEx(idlePtr, tsdPtr->idleList, tsdPtr->idleTail); + + /* execute event */ (*idlePtr->proc)(idlePtr->clientData); + /* unfreeze / if used somewhere else (nested) or prolongation (reattached) */ + if (idlePtr->refCount-- > 1 || (idlePtr->flags & TCL_TMREV_LISTED)) { + goto nextEvent; + }; + /* free it via deleteProc and ckfree */ + if (idlePtr->deleteProc && !(idlePtr->flags & TCL_TMREV_DELETE)) { + idlePtr->flags |= TCL_TMREV_DELETE; + (*idlePtr->deleteProc)(idlePtr->clientData); + } ckfree((char *) idlePtr); + + nextEvent: + /* + * Stop processing idle if idle queue empty, count reached or other + * events queued (only if not idle events only to service). + */ + if ( (idlePtr = tsdPtr->idleList) == NULL + || !--count + || ((flags & TCL_ALL_EVENTS) != TCL_IDLE_EVENTS + && TclPeekEventQueued(flags)) + ) { + break; + } } - if (tsdPtr->idleList) { - blockTime.sec = 0; - blockTime.usec = 0; - Tcl_SetMaxBlockTime(&blockTime); + + /* Reset generation */ + if (!tsdPtr->idleList) { + tsdPtr->idleGeneration = 0; } return 1; } + +int +TclServiceIdle(void) +{ + return TclServiceIdleEx(TCL_ALL_EVENTS, INT_MAX); +} + +/* + *---------------------------------------------------------------------- + * + * TclGetTimeFromObj -- + * + * This function converts numeric tcl-object contains decimal milliseconds, + * (using milliseconds base) to time offset in microseconds, + * + * If input object contains double, the return time has microsecond + * precision. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * If possible leaves internal representation unchanged (e. g. integer). + * + *---------------------------------------------------------------------- + */ + +int +TclpGetUTimeFromObj( + Tcl_Interp *interp, /* Current interpreter or NULL. */ + Tcl_Obj *objPtr, /* Object to read numeric time (in units + * corresponding given factor). */ + Tcl_WideInt *timePtr, /* Resulting time if converted (in microseconds). */ + int factor) /* Current factor of the time-object: + * 1 - microseconds, + * 1000 - milliseconds, + * 1000000 - seconds */ +{ + if (objPtr->typePtr != &tclDoubleType) { + Tcl_WideInt tm; + if (Tcl_GetWideIntFromObj(NULL, objPtr, &tm) == TCL_OK) { + if (tm < 0x7FFFFFFFFFFFFFFFL / factor) { /* avoid overflow */ + *timePtr = (tm * factor); + return TCL_OK; + } + *timePtr = 0x7FFFFFFFFFFFFFFFL; + return TCL_OK; + } + } + if (1) { + double tm; + if (Tcl_GetDoubleFromObj(interp, objPtr, &tm) == TCL_OK) { + if (tm < 0x7FFFFFFFFFFFFFFFL / factor) { /* avoid overflow */ + /* use precise as possible calculation by double (microseconds) */ + if (factor == 1) { + *timePtr = (Tcl_WideInt)tm; + } else { + *timePtr = ((Tcl_WideInt)tm * factor) + + (((Tcl_WideInt)(tm*factor)) % factor); + } + return TCL_OK; + } + *timePtr = 0x7FFFFFFFFFFFFFFFL; + return TCL_OK; + } + } + return TCL_ERROR; +} /* *---------------------------------------------------------------------- * * Tcl_AfterObjCmd -- @@ -767,21 +1488,21 @@ ClientData clientData, /* Unused */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *CONST objv[]) /* Argument objects. */ { - Tcl_WideInt ms; /* Number of milliseconds to wait */ - Tcl_Time wakeup; + Tcl_WideInt usec; /* Number of microseconds to wait (or time to wakeup) */ AfterInfo *afterPtr; AfterAssocData *assocPtr; int length; int index; - char buf[16 + TCL_INTEGER_SPACE]; static CONST char *afterSubCmds[] = { - "cancel", "idle", "info", NULL + "at", "cancel", "idle", "info", NULL }; - enum afterSubCmds {AFTER_CANCEL, AFTER_IDLE, AFTER_INFO}; + enum afterSubCmds { + AFTER_AT, AFTER_CANCEL, AFTER_IDLE, AFTER_INFO + }; ThreadSpecificData *tsdPtr = InitTimer(); if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?"); return TCL_ERROR; @@ -795,50 +1516,90 @@ assocPtr = Tcl_GetAssocData(interp, "tclAfter", NULL); if (assocPtr == NULL) { assocPtr = (AfterAssocData *) ckalloc(sizeof(AfterAssocData)); assocPtr->interp = interp; assocPtr->firstAfterPtr = NULL; + assocPtr->lastAfterPtr = NULL; Tcl_SetAssocData(interp, "tclAfter", AfterCleanupProc, (ClientData) assocPtr); } /* * First lets see if the command was passed a number as the first argument. */ - if (objv[1]->typePtr == &tclIntType -#ifndef NO_WIDE_TYPE - || objv[1]->typePtr == &tclWideIntType -#endif - || objv[1]->typePtr == &tclBignumType - || ( Tcl_GetIndexFromObj(NULL, objv[1], afterSubCmds, "", 0, - &index) != TCL_OK )) { - index = -1; - if (Tcl_GetWideIntFromObj(NULL, objv[1], &ms) != TCL_OK) { - Tcl_AppendResult(interp, "bad argument \"", - Tcl_GetString(objv[1]), - "\": must be cancel, idle, info, or an integer", - NULL); - return TCL_ERROR; - } + index = -1; + if ( ( TclObjIsIndexOfTable(objv[1], afterSubCmds) + || TclpGetUTimeFromObj(NULL, objv[1], &usec, 1000) != TCL_OK + ) + && Tcl_GetIndexFromObj(NULL, objv[1], afterSubCmds, "", 0, + &index) != TCL_OK + ) { + Tcl_AppendResult(interp, "bad argument \"", + Tcl_GetString(objv[1]), + "\": must be at, cancel, idle, info or a time", NULL); + return TCL_ERROR; } /* - * At this point, either index = -1 and ms contains the number of ms + * At this point, either index = -1 and usec contains the time * to wait, or else index is the index of a subcommand. */ switch (index) { - case -1: { - if (ms < 0) { - ms = 0; + case -1: + /* usec already contains time-offset from objv[1] */ + /* relative time offset should be positive */ + if (usec < 0) { + usec = 0; } if (objc == 2) { - return AfterDelay(interp, ms); + /* after */ + return AfterDelay(interp, usec, 0); + } + case AFTER_AT: { + TclTimerEvent *tmrEvent; + int flags = 0; + if (index == AFTER_AT) { + flags = TCL_TMREV_AT; + objc--; + objv++; + if (objc < 2) { + Tcl_WrongNumArgs(interp, 1, objv, "?option? time"); + return TCL_ERROR; + } + /* get time from object, default factor for "at" - 1000000 (s) */ + if (TclpGetUTimeFromObj(interp, objv[1], &usec, 1000000) != TCL_OK) { + return TCL_ERROR; + } + if (objc == 2) { + /* after at