Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
Comment: | merge 8.7 (TIP#527, New measurement facilities in TCL: New command timerate, performance test suite) |
---|---|
Downloads: | Tarball | ZIP archive |
Timelines: | family | ancestors | descendants | both | trunk |
Files: | files | file ages | folders |
SHA3-256: |
e41cbd042af0e394e4931de8c3c4bd99 |
User & Date: | sebres 2019-03-05 18:23:26.642 |
Context
2019-03-05
| ||
19:46 | integrate/close sebres-trunk-timerate branch (no functional changes, simple merge-point) check-in: 1cbf574661 user: sebres tags: trunk | |
18:23 | merge 8.7 (TIP#527, New measurement facilities in TCL: New command timerate, performance test suite) check-in: e41cbd042a user: sebres tags: trunk | |
18:02 | integrate dgp-sebres-timerate-review: no functional changes (already backported) check-in: 61fe0670ed user: sebres tags: core-8-branch | |
2019-03-02
| ||
16:53 | Merge 8.7 check-in: e766d23655 user: jan.nijtmans tags: trunk | |
Changes
Changes to .travis.yml.
︙ | ︙ | |||
65 66 67 68 69 70 71 72 73 74 75 76 77 78 | apt: sources: - ubuntu-toolchain-r-test packages: - g++-7 env: - BUILD_DIR=unix - os: osx osx_image: xcode8 env: - BUILD_DIR=unix - os: osx osx_image: xcode8 env: | > > > > > > > > > > > > | 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 | apt: sources: - ubuntu-toolchain-r-test packages: - g++-7 env: - BUILD_DIR=unix - os: linux dist: xenial compiler: gcc-7 addons: apt: sources: - ubuntu-toolchain-r-test packages: - g++-7 env: - BUILD_DIR=unix - CFGOPT=CFLAGS="-DTCL_UTF_MAX=6" - os: osx osx_image: xcode8 env: - BUILD_DIR=unix - os: osx osx_image: xcode8 env: |
︙ | ︙ |
Added doc/timerate.n.
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 | '\" '\" Copyright (c) 2005 Sergey Brester aka sebres. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" .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 .SH SYNOPSIS \fBtimerate \fIscript\fR \fI?time ?max-count??\fR .sp \fBtimerate \fI?-direct?\fR \fI?-overhead double?\fR \fIscript\fR \fI?time ?max-count??\fR .sp \fBtimerate \fI?-calibrate?\fR \fI?-direct?\fR \fIscript\fR \fI?time ?max-count??\fR .BE .SH DESCRIPTION .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 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 .PP .CS \fB0.095977 \(mcs/# 52095836 # 10419167 #/sec 5000.000 nett-ms\fR .CE .PP which indicates: .IP \(bu the average amount of time required per iteration, in microseconds ([\fBlindex\fR $result 0]) .IP \(bu the count how many times it was executed ([\fBlindex\fR $result 2]) .IP \(bu the estimated rate per second ([\fBlindex\fR $result 4]) .IP \(bu 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. .TP \fI-calibrate\fR . To measure very fast scripts as exact as posible the 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. .TP \fI-overhead double\fR . The \fI-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. .TP \fI-direct\fR . The \fI-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 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 Estimate how fast it takes for a simple Tcl \fBfor\fR loop (including operations on variable \fIi\fR) to count to a ten: .PP .CS # calibrate: timerate -calibrate {} # measure: timerate { 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: .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 .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 { 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 .\" Local Variables: .\" mode: nroff .\" End: |
Changes to generic/tclBasic.c.
︙ | ︙ | |||
296 297 298 299 300 301 302 303 304 305 306 307 308 309 | {"pwd", Tcl_PwdObjCmd, NULL, NULL, 0}, {"read", Tcl_ReadObjCmd, NULL, NULL, CMD_IS_SAFE}, {"seek", Tcl_SeekObjCmd, NULL, NULL, CMD_IS_SAFE}, {"socket", Tcl_SocketObjCmd, NULL, NULL, 0}, {"source", Tcl_SourceObjCmd, NULL, TclNRSourceObjCmd, 0}, {"tell", Tcl_TellObjCmd, NULL, NULL, CMD_IS_SAFE}, {"time", Tcl_TimeObjCmd, NULL, NULL, CMD_IS_SAFE}, {"unload", Tcl_UnloadObjCmd, NULL, NULL, 0}, {"update", Tcl_UpdateObjCmd, NULL, NULL, CMD_IS_SAFE}, {"vwait", Tcl_VwaitObjCmd, NULL, NULL, CMD_IS_SAFE}, {NULL, NULL, NULL, NULL, 0} }; /* | > | 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 | {"pwd", Tcl_PwdObjCmd, NULL, NULL, 0}, {"read", Tcl_ReadObjCmd, NULL, NULL, CMD_IS_SAFE}, {"seek", Tcl_SeekObjCmd, NULL, NULL, CMD_IS_SAFE}, {"socket", Tcl_SocketObjCmd, NULL, NULL, 0}, {"source", Tcl_SourceObjCmd, NULL, TclNRSourceObjCmd, 0}, {"tell", Tcl_TellObjCmd, NULL, NULL, CMD_IS_SAFE}, {"time", Tcl_TimeObjCmd, NULL, NULL, CMD_IS_SAFE}, {"timerate", Tcl_TimeRateObjCmd, NULL, NULL, CMD_IS_SAFE}, {"unload", Tcl_UnloadObjCmd, NULL, NULL, 0}, {"update", Tcl_UpdateObjCmd, NULL, NULL, CMD_IS_SAFE}, {"vwait", Tcl_VwaitObjCmd, NULL, NULL, CMD_IS_SAFE}, {NULL, NULL, NULL, NULL, 0} }; /* |
︙ | ︙ | |||
536 537 538 539 540 541 542 | { Interp *iPtr; Tcl_Interp *interp; Command *cmdPtr; const BuiltinFuncDef *builtinFuncPtr; const OpCmdInfo *opcmdInfoPtr; const CmdInfo *cmdInfoPtr; | | | 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 | { Interp *iPtr; Tcl_Interp *interp; Command *cmdPtr; const BuiltinFuncDef *builtinFuncPtr; const OpCmdInfo *opcmdInfoPtr; const CmdInfo *cmdInfoPtr; Tcl_Namespace *nsPtr; Tcl_HashEntry *hPtr; int isNew; CancelInfo *cancelInfo; union { char c[sizeof(short)]; short s; } order; |
︙ | ︙ | |||
946 947 948 949 950 951 952 | Tcl_CreateObjCommand(interp, "::tcl::dtrace", DTraceObjCmd, NULL, NULL); #endif /* USE_DTRACE */ /* * Register the builtin math functions. */ | | | | | | | | 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 | Tcl_CreateObjCommand(interp, "::tcl::dtrace", DTraceObjCmd, NULL, NULL); #endif /* USE_DTRACE */ /* * Register the builtin math functions. */ nsPtr = Tcl_CreateNamespace(interp, "::tcl::mathfunc", NULL,NULL); if (nsPtr == NULL) { Tcl_Panic("Can't create math function namespace"); } #define MATH_FUNC_PREFIX_LEN 17 /* == strlen("::tcl::mathfunc::") */ memcpy(mathFuncName, "::tcl::mathfunc::", MATH_FUNC_PREFIX_LEN); for (builtinFuncPtr = BuiltinFuncTable; builtinFuncPtr->name != NULL; builtinFuncPtr++) { strcpy(mathFuncName+MATH_FUNC_PREFIX_LEN, builtinFuncPtr->name); Tcl_CreateObjCommand(interp, mathFuncName, builtinFuncPtr->objCmdProc, builtinFuncPtr->clientData, NULL); Tcl_Export(interp, nsPtr, builtinFuncPtr->name, 0); } /* * Register the mathematical "operator" commands. [TIP #174] */ nsPtr = Tcl_CreateNamespace(interp, "::tcl::mathop", NULL, NULL); if (nsPtr == NULL) { Tcl_Panic("can't create math operator namespace"); } Tcl_Export(interp, nsPtr, "*", 1); #define MATH_OP_PREFIX_LEN 15 /* == strlen("::tcl::mathop::") */ memcpy(mathFuncName, "::tcl::mathop::", MATH_OP_PREFIX_LEN); for (opcmdInfoPtr=mathOpCmds ; opcmdInfoPtr->name!=NULL ; opcmdInfoPtr++){ TclOpCmdClientData *occdPtr = Tcl_Alloc(sizeof(TclOpCmdClientData)); occdPtr->op = opcmdInfoPtr->name; occdPtr->i.numArgs = opcmdInfoPtr->i.numArgs; |
︙ | ︙ | |||
6817 6818 6819 6820 6821 6822 6823 | } } break; case TCL_NUMBER_BIG: if (Tcl_GetBignumFromObj(interp, objv[1], &big) != TCL_OK) { return TCL_ERROR; } | | | 6818 6819 6820 6821 6822 6823 6824 6825 6826 6827 6828 6829 6830 6831 6832 | } } break; case TCL_NUMBER_BIG: if (Tcl_GetBignumFromObj(interp, objv[1], &big) != TCL_OK) { return TCL_ERROR; } if (mp_isneg(&big)) { mp_clear(&big); goto negarg; } break; default: if (TclGetWideIntFromObj(interp, objv[1], &w) != TCL_OK) { return TCL_ERROR; |
︙ | ︙ |
Changes to generic/tclClock.c.
︙ | ︙ | |||
1768 1769 1770 1771 1772 1773 1774 | #ifdef TCL_WIDE_CLICKS clicks = TclpGetWideClicks(); #else clicks = (Tcl_WideInt) TclpGetClicks(); #endif break; case CLICKS_MICROS: | < | | 1768 1769 1770 1771 1772 1773 1774 1775 1776 1777 1778 1779 1780 1781 1782 | #ifdef TCL_WIDE_CLICKS clicks = TclpGetWideClicks(); #else clicks = (Tcl_WideInt) TclpGetClicks(); #endif break; case CLICKS_MICROS: clicks = TclpGetMicroseconds(); break; } Tcl_SetObjResult(interp, Tcl_NewWideIntObj(clicks)); return TCL_OK; } |
︙ | ︙ | |||
1839 1840 1841 1842 1843 1844 1845 | int ClockMicrosecondsObjCmd( ClientData clientData, /* Client data is unused */ Tcl_Interp *interp, /* Tcl interpreter */ int objc, /* Parameter count */ Tcl_Obj *const *objv) /* Parameter values */ { | < < < | < | 1838 1839 1840 1841 1842 1843 1844 1845 1846 1847 1848 1849 1850 1851 1852 1853 1854 1855 1856 | int ClockMicrosecondsObjCmd( 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(TclpGetMicroseconds())); return TCL_OK; } /* *----------------------------------------------------------------------------- * * ClockParseformatargsObjCmd -- |
︙ | ︙ |
Changes to generic/tclCmdMZ.c.
︙ | ︙ | |||
13 14 15 16 17 18 19 20 21 22 23 24 25 26 | * Copyright (c) 2003-2009 Donal K. Fellows. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #include "tclRegexp.h" #include "tclStringTrim.h" static inline Tcl_Obj * During(Tcl_Interp *interp, int resultCode, Tcl_Obj *oldOptions, Tcl_Obj *errorInfo); static Tcl_NRPostProc SwitchPostProc; static Tcl_NRPostProc TryPostBody; | > | 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 | * Copyright (c) 2003-2009 Donal K. Fellows. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #include "tclCompile.h" #include "tclRegexp.h" #include "tclStringTrim.h" static inline Tcl_Obj * During(Tcl_Interp *interp, int resultCode, Tcl_Obj *oldOptions, Tcl_Obj *errorInfo); static Tcl_NRPostProc SwitchPostProc; static Tcl_NRPostProc TryPostBody; |
︙ | ︙ | |||
4038 4039 4040 4041 4042 4043 4044 | i = count; #ifndef TCL_WIDE_CLICKS Tcl_GetTime(&start); #else start = TclpGetWideClicks(); #endif while (i-- > 0) { | | | 4039 4040 4041 4042 4043 4044 4045 4046 4047 4048 4049 4050 4051 4052 4053 | i = count; #ifndef TCL_WIDE_CLICKS Tcl_GetTime(&start); #else start = TclpGetWideClicks(); #endif while (i-- > 0) { result = TclEvalObjEx(interp, objPtr, 0, NULL, 0); if (result != TCL_OK) { return result; } } #ifndef TCL_WIDE_CLICKS Tcl_GetTime(&stop); totalMicroSec = ((double) (stop.sec - start.sec)) * 1.0e6 |
︙ | ︙ | |||
4074 4075 4076 4077 4078 4079 4080 4081 4082 4083 4084 4085 4086 4087 | TclNewLiteralStringObj(objs[1], "microseconds"); TclNewLiteralStringObj(objs[2], "per"); TclNewLiteralStringObj(objs[3], "iteration"); Tcl_SetObjResult(interp, Tcl_NewListObj(4, objs)); return TCL_OK; } /* *---------------------------------------------------------------------- * * Tcl_TryObjCmd, TclNRTryObjCmd -- * * This procedure is invoked to process the "try" Tcl command. See the | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 4075 4076 4077 4078 4079 4080 4081 4082 4083 4084 4085 4086 4087 4088 4089 4090 4091 4092 4093 4094 4095 4096 4097 4098 4099 4100 4101 4102 4103 4104 4105 4106 4107 4108 4109 4110 4111 4112 4113 4114 4115 4116 4117 4118 4119 4120 4121 4122 4123 4124 4125 4126 4127 4128 4129 4130 4131 4132 4133 4134 4135 4136 4137 4138 4139 4140 4141 4142 4143 4144 4145 4146 4147 4148 4149 4150 4151 4152 4153 4154 4155 4156 4157 4158 4159 4160 4161 4162 4163 4164 4165 4166 4167 4168 4169 4170 4171 4172 4173 4174 4175 4176 4177 4178 4179 4180 4181 4182 4183 4184 4185 4186 4187 4188 4189 4190 4191 4192 4193 4194 4195 4196 4197 4198 4199 4200 4201 4202 4203 4204 4205 4206 4207 4208 4209 4210 4211 4212 4213 4214 4215 4216 4217 4218 4219 4220 4221 4222 4223 4224 4225 4226 4227 4228 4229 4230 4231 4232 4233 4234 4235 4236 4237 4238 4239 4240 4241 4242 4243 4244 4245 4246 4247 4248 4249 4250 4251 4252 4253 4254 4255 4256 4257 4258 4259 4260 4261 4262 4263 4264 4265 4266 4267 4268 4269 4270 4271 4272 4273 4274 4275 4276 4277 4278 4279 4280 4281 4282 4283 4284 4285 4286 4287 4288 4289 4290 4291 4292 4293 4294 4295 4296 4297 4298 4299 4300 4301 4302 4303 4304 4305 4306 4307 4308 4309 4310 4311 4312 4313 4314 4315 4316 4317 4318 4319 4320 4321 4322 4323 4324 4325 4326 4327 4328 4329 4330 4331 4332 4333 4334 4335 4336 4337 4338 4339 4340 4341 4342 4343 4344 4345 4346 4347 4348 4349 4350 4351 4352 4353 4354 4355 4356 4357 4358 4359 4360 4361 4362 4363 4364 4365 4366 4367 4368 4369 4370 4371 4372 4373 4374 4375 4376 4377 4378 4379 4380 4381 4382 4383 4384 4385 4386 4387 4388 4389 4390 4391 4392 4393 4394 4395 4396 4397 4398 4399 4400 4401 4402 4403 4404 4405 4406 4407 4408 4409 4410 4411 4412 4413 4414 4415 4416 4417 4418 4419 4420 4421 4422 4423 4424 4425 4426 4427 4428 4429 4430 4431 4432 4433 4434 4435 4436 4437 4438 4439 4440 4441 4442 4443 4444 4445 4446 4447 4448 4449 4450 4451 4452 4453 4454 4455 4456 4457 4458 4459 4460 4461 4462 4463 4464 4465 4466 4467 4468 4469 4470 4471 4472 | TclNewLiteralStringObj(objs[1], "microseconds"); TclNewLiteralStringObj(objs[2], "per"); TclNewLiteralStringObj(objs[3], "iteration"); Tcl_SetObjResult(interp, Tcl_NewListObj(4, objs)); return TCL_OK; } /* *---------------------------------------------------------------------- * * 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 * given time (in milliseconds) instead of repetition count. * * Example: * timerate {after 5} 1000 ; # equivalent for `time {after 5} [expr 1000/5]` * * Results: * A standard Tcl object result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ int Tcl_TimeRateObjCmd( 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 */ 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; /* 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) */ 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 static const char *const options[] = { "-direct", "-overhead", "-calibrate", "--", NULL }; enum options { TMRT_EV_DIRECT, TMRT_OVERHEAD, TMRT_CALIBRATE, TMRT_LAST }; NRE_callback *rootPtr; ByteCode *codePtr = NULL; for (i = 1; i < objc - 1; i++) { int index; if (Tcl_GetIndexFromObj(NULL, objv[i], options, "option", TCL_EXACT, &index) != TCL_OK) { break; } if (index == TMRT_LAST) { i++; break; } switch (index) { case TMRT_EV_DIRECT: direct = objv[i]; break; case TMRT_OVERHEAD: if (++i >= objc - 1) { goto usage; } if (Tcl_GetDoubleFromObj(interp, objv[i], &overhead) != TCL_OK) { return TCL_ERROR; } break; case TMRT_CALIBRATE: calibrate = objv[i]; break; } } 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); 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 (calibrate) { /* 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]; 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 */ TclNewIntObj(clobjv[i], 100); Tcl_IncrRefCount(clobjv[i]); result = Tcl_TimeRateObjCmd(dummy, interp, i+1, clobjv); Tcl_DecrRefCount(clobjv[i]); if (result != TCL_OK) { return result; } i--; clobjv[i++] = calibrate; clobjv[i++] = objPtr; /* set last measurement overhead to max */ measureOverhead = (double)UWIDE_MAX; /* calibration cycle until it'll be preciser */ maxms = -1000; do { lastMeasureOverhead = measureOverhead; TclNewIntObj(clobjv[i], (int)maxms); Tcl_IncrRefCount(clobjv[i]); result = Tcl_TimeRateObjCmd(dummy, 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 || measureOverhead / lastMeasureOverhead <= 0.9995) && maxCalTime > 0 ); return result; } if (maxms == 0) { /* 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 (maxms > 0) { /* set last measurement overhead to max */ measureOverhead = (double)UWIDE_MAX; } else { maxms = -maxms; } } if (maxms == WIDE_MIN) { maxms = 1000; } if (overhead == -1) { overhead = measureOverhead; } /* be sure that resetting of result will not smudge the further measurement */ Tcl_ResetResult(interp); /* compile object */ if (!direct) { if (TclInterpReady(interp) != TCL_OK) { return TCL_ERROR; } codePtr = TclCompileObj(interp, objPtr, NULL, 0); TclPreserveByteCode(codePtr); } /* get start and stop time */ #ifdef TCL_WIDE_CLICKS start = middle = TclpGetWideClicks(); /* time to stop execution (in wide clicks) */ stop = start + (maxms * 1000 / TclpWideClickInMicrosec()); #else Tcl_GetTime(&now); start = now.sec; start *= 1000000; start += now.usec; middle = start; /* 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 */ rootPtr = TOP_CB(interp); result = TclNRExecuteByteCode(interp, codePtr); result = TclNRRunCallbacks(interp, result, rootPtr); } 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; } } { 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 > (Tcl_WideInt)curOverhead) { middle -= curOverhead; } else { middle = 0; } } } else { /* calibration - obtaining new measurement overhead */ if (measureOverhead > (double)middle / count) { measureOverhead = (double)middle / count; } objs[0] = Tcl_NewDoubleObj(measureOverhead); TclNewLiteralStringObj(objs[1], "\xC2\xB5s/#-overhead"); /* mics */ objs += 2; } val = middle / 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); } objs[2] = Tcl_NewWideIntObj(count); /* iterations */ /* calculate speed as rate (count) per sec */ if (!middle) middle++; /* +1 ms, just to avoid divide by zero */ if (count < (WIDE_MAX / 1000000)) { val = (count * 1000000) / middle; 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); } else { objs[4] = Tcl_NewWideIntObj(val); } } else { objs[4] = Tcl_NewWideIntObj((count / middle) * 1000000); } /* estimated net execution time (in millisecs) */ if (!calibrate) { objs[6] = Tcl_ObjPrintf("%.3f", (double)middle / 1000); TclNewLiteralStringObj(objs[7], "nett-ms"); } /* * 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: if (codePtr != NULL) { TclReleaseByteCode(codePtr); } return result; } /* *---------------------------------------------------------------------- * * Tcl_TryObjCmd, TclNRTryObjCmd -- * * This procedure is invoked to process the "try" Tcl command. See the |
︙ | ︙ |
Changes to generic/tclInt.h.
︙ | ︙ | |||
2803 2804 2805 2806 2807 2808 2809 | /* Procedure that unloads a loaded module */ }; /* Flags for conversion of doubles to digit strings */ #define TCL_DD_SHORTEST 0x4 /* Use the shortest possible string */ | < < < < < < | 2803 2804 2805 2806 2807 2808 2809 2810 2811 2812 2813 2814 2815 2816 2817 2818 2819 2820 2821 2822 2823 2824 2825 2826 2827 2828 2829 2830 2831 | /* Procedure that unloads a loaded module */ }; /* Flags for conversion of doubles to digit strings */ #define TCL_DD_SHORTEST 0x4 /* Use the shortest possible string */ #define TCL_DD_E_FORMAT 0x2 /* Use a fixed-length string of digits, * suitable for E format*/ #define TCL_DD_F_FORMAT 0x3 /* Use a fixed number of digits after the * decimal point, suitable for F format */ #define TCL_DD_SHORTEN_FLAG 0x4 /* Allow return of a shorter digit string * if it converts losslessly */ #define TCL_DD_NO_QUICK 0x8 /* Debug flag: forbid quick FP conversion */ #define TCL_DD_CONVERSION_TYPE_MASK 0x3 /* Mask to isolate the conversion type */ /* *---------------------------------------------------------------- * Procedures shared among Tcl modules but not used by the outside world: *---------------------------------------------------------------- */ |
︙ | ︙ | |||
3190 3191 3192 3193 3194 3195 3196 3197 3198 3199 3200 3201 3202 3203 3204 3205 3206 3207 | MODULE_SCOPE int TclpLoadMemory(Tcl_Interp *interp, void *buffer, int size, int codeSize, Tcl_LoadHandle *loadHandle, Tcl_FSUnloadFileProc **unloadProcPtr, int flags); #endif MODULE_SCOPE void TclInitThreadStorage(void); MODULE_SCOPE void TclFinalizeThreadDataThread(void); MODULE_SCOPE void TclFinalizeThreadStorage(void); #ifdef TCL_WIDE_CLICKS MODULE_SCOPE Tcl_WideInt TclpGetWideClicks(void); MODULE_SCOPE double TclpWideClicksToNanoseconds(Tcl_WideInt clicks); #endif MODULE_SCOPE int TclZlibInit(Tcl_Interp *interp); MODULE_SCOPE void * TclpThreadCreateKey(void); MODULE_SCOPE void TclpThreadDeleteKey(void *keyPtr); MODULE_SCOPE void TclpThreadSetMasterTSD(void *tsdKeyPtr, void *ptr); MODULE_SCOPE void * TclpThreadGetMasterTSD(void *tsdKeyPtr); MODULE_SCOPE void TclErrorStackResetIf(Tcl_Interp *interp, const char *msg, size_t length); | > > > > > > > > > > > > | 3184 3185 3186 3187 3188 3189 3190 3191 3192 3193 3194 3195 3196 3197 3198 3199 3200 3201 3202 3203 3204 3205 3206 3207 3208 3209 3210 3211 3212 3213 | MODULE_SCOPE int TclpLoadMemory(Tcl_Interp *interp, void *buffer, int size, int codeSize, Tcl_LoadHandle *loadHandle, Tcl_FSUnloadFileProc **unloadProcPtr, int flags); #endif MODULE_SCOPE void TclInitThreadStorage(void); MODULE_SCOPE void TclFinalizeThreadDataThread(void); MODULE_SCOPE void TclFinalizeThreadStorage(void); #ifdef TCL_WIDE_CLICKS MODULE_SCOPE Tcl_WideInt TclpGetWideClicks(void); MODULE_SCOPE double TclpWideClicksToNanoseconds(Tcl_WideInt clicks); MODULE_SCOPE double TclpWideClickInMicrosec(void); #else # ifdef _WIN32 # define TCL_WIDE_CLICKS 1 MODULE_SCOPE Tcl_WideInt TclpGetWideClicks(void); MODULE_SCOPE double TclpWideClickInMicrosec(void); # define TclpWideClicksToNanoseconds(clicks) \ ((double)(clicks) * TclpWideClickInMicrosec() * 1000) # endif #endif MODULE_SCOPE Tcl_WideInt TclpGetMicroseconds(void); MODULE_SCOPE int TclZlibInit(Tcl_Interp *interp); MODULE_SCOPE void * TclpThreadCreateKey(void); MODULE_SCOPE void TclpThreadDeleteKey(void *keyPtr); MODULE_SCOPE void TclpThreadSetMasterTSD(void *tsdKeyPtr, void *ptr); MODULE_SCOPE void * TclpThreadGetMasterTSD(void *tsdKeyPtr); MODULE_SCOPE void TclErrorStackResetIf(Tcl_Interp *interp, const char *msg, size_t length); |
︙ | ︙ | |||
3463 3464 3465 3466 3467 3468 3469 3470 3471 3472 3473 3474 3475 3476 | MODULE_SCOPE int Tcl_TellObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_ThrowObjCmd(void *dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_TimeObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_TraceObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_TryObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); | > > > | 3469 3470 3471 3472 3473 3474 3475 3476 3477 3478 3479 3480 3481 3482 3483 3484 3485 | MODULE_SCOPE int Tcl_TellObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_ThrowObjCmd(void *dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_TimeObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_TimeRateObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_TraceObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_TryObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); |
︙ | ︙ |
Changes to generic/tclObj.c.
︙ | ︙ | |||
2707 2708 2709 2710 2711 2712 2713 | * Must check for those bignum values that can fit in a long, even * when auto-narrowing is enabled. Only those values in the signed * long range get auto-narrowed to tclIntType, while all the * values in the unsigned long range will fit in a long. */ mp_int big; | < < < < | | > | | | | | | | | | | | | < | 2707 2708 2709 2710 2711 2712 2713 2714 2715 2716 2717 2718 2719 2720 2721 2722 2723 2724 2725 2726 2727 2728 2729 2730 2731 2732 2733 2734 2735 2736 2737 | * Must check for those bignum values that can fit in a long, even * when auto-narrowing is enabled. Only those values in the signed * long range get auto-narrowed to tclIntType, while all the * values in the unsigned long range will fit in a long. */ mp_int big; unsigned long scratch, value = 0, numBytes = sizeof(unsigned long); unsigned char *bytes = (unsigned char *) &scratch; UNPACK_BIGNUM(objPtr, big); if (mp_to_unsigned_bin_n(&big, bytes, &numBytes) == MP_OKAY) { while (numBytes-- > 0) { value = (value << CHAR_BIT) | *bytes++; } if (big.sign) { if (value <= 1 + (unsigned long)LONG_MAX) { *longPtr = - (long) value; return TCL_OK; } } else { if (value <= (unsigned long)ULONG_MAX) { *longPtr = (long) value; return TCL_OK; } } } #ifndef TCL_WIDE_INT_IS_LONG tooLarge: #endif if (interp != NULL) { |
︙ | ︙ | |||
2949 2950 2951 2952 2953 2954 2955 | if (objPtr->typePtr == &tclBignumType) { /* * Must check for those bignum values that can fit in a * Tcl_WideInt, even when auto-narrowing is enabled. */ mp_int big; | < < < < | | | | > | | | | | | | | | | | | | < | 2945 2946 2947 2948 2949 2950 2951 2952 2953 2954 2955 2956 2957 2958 2959 2960 2961 2962 2963 2964 2965 2966 2967 2968 2969 2970 2971 2972 2973 2974 2975 2976 2977 | if (objPtr->typePtr == &tclBignumType) { /* * Must check for those bignum values that can fit in a * Tcl_WideInt, even when auto-narrowing is enabled. */ mp_int big; Tcl_WideUInt value = 0; unsigned long numBytes = sizeof(Tcl_WideInt); Tcl_WideInt scratch; unsigned char *bytes = (unsigned char *) &scratch; UNPACK_BIGNUM(objPtr, big); if (mp_to_unsigned_bin_n(&big, bytes, &numBytes) == MP_OKAY) { while (numBytes-- > 0) { value = (value << CHAR_BIT) | *bytes++; } if (big.sign) { if (value <= 1 + ~(Tcl_WideUInt)WIDE_MIN) { *wideIntPtr = - (Tcl_WideInt) value; return TCL_OK; } } else { if (value <= (Tcl_WideUInt)WIDE_MAX) { *wideIntPtr = (Tcl_WideInt) value; return TCL_OK; } } } if (interp != NULL) { const char *s = "integer value too large to represent"; Tcl_Obj *msg = Tcl_NewStringObj(s, -1); |
︙ | ︙ | |||
3408 3409 3410 3411 3412 3413 3414 | */ void Tcl_SetBignumObj( Tcl_Obj *objPtr, /* Object to set */ mp_int *bignumValue) /* Value to store */ { | < < < < < | | | | > > > | | | | | | | | | | | | | | | | < | 3400 3401 3402 3403 3404 3405 3406 3407 3408 3409 3410 3411 3412 3413 3414 3415 3416 3417 3418 3419 3420 3421 3422 3423 3424 3425 3426 3427 3428 3429 3430 3431 3432 3433 3434 3435 3436 3437 | */ void Tcl_SetBignumObj( Tcl_Obj *objPtr, /* Object to set */ mp_int *bignumValue) /* Value to store */ { Tcl_WideUInt value = 0; unsigned long numBytes = sizeof(Tcl_WideUInt); Tcl_WideUInt scratch; unsigned char *bytes = (unsigned char *) &scratch; if (Tcl_IsShared(objPtr)) { Tcl_Panic("%s called with shared object", "Tcl_SetBignumObj"); } if (mp_to_unsigned_bin_n(bignumValue, bytes, &numBytes) != MP_OKAY) { goto tooLargeForWide; } while (numBytes-- > 0) { value = (value << CHAR_BIT) | *bytes++; } if (value > ((Tcl_WideUInt)WIDE_MAX + bignumValue->sign)) { goto tooLargeForWide; } if (bignumValue->sign) { TclSetIntObj(objPtr, -(Tcl_WideInt)value); } else { TclSetIntObj(objPtr, (Tcl_WideInt)value); } mp_clear(bignumValue); return; tooLargeForWide: TclInvalidateStringRep(objPtr); TclFreeIntRep(objPtr); TclSetBignumIntRep(objPtr, bignumValue); } /* |
︙ | ︙ |
Changes to generic/tclPort.h.
︙ | ︙ | |||
21 22 23 24 25 26 27 28 29 30 31 | # include "tclWinPort.h" #else # include "tclUnixPort.h" #endif #include "tcl.h" #define UWIDE_MAX ((Tcl_WideUInt)-1) #define WIDE_MAX ((Tcl_WideInt)(UWIDE_MAX >> 1)) #define WIDE_MIN ((Tcl_WideInt)((Tcl_WideUInt)WIDE_MAX+1)) #endif /* _TCLPORT */ | > > > | 21 22 23 24 25 26 27 28 29 30 31 32 33 34 | # include "tclWinPort.h" #else # include "tclUnixPort.h" #endif #include "tcl.h" #define UWIDE_MAX ((Tcl_WideUInt)-1) #define WIDE_MAX ((Tcl_WideInt)(UWIDE_MAX >> 1)) #define WIDE_MIN ((Tcl_WideInt)((Tcl_WideUInt)WIDE_MAX+1)) #define UWIDE_MAX ((Tcl_WideUInt)-1) #define WIDE_MAX ((Tcl_WideInt)(UWIDE_MAX >> 1)) #define WIDE_MIN ((Tcl_WideInt)((Tcl_WideUInt)WIDE_MAX+1)) #endif /* _TCLPORT */ |
Changes to generic/tclStrToD.c.
︙ | ︙ | |||
316 317 318 319 320 321 322 | static char * ShorteningQuickFormat(double, int, int, double, char *, int *); static char * StrictQuickFormat(double, int, int, double, char *, int *); static char * QuickConversion(double, int, int, int, int, int, int, int *, char **); static void CastOutPowersOf2(int *, int *, int *); | | | | | | | | | | 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 | static char * ShorteningQuickFormat(double, int, int, double, char *, int *); static char * StrictQuickFormat(double, int, int, double, char *, int *); static char * QuickConversion(double, int, int, int, int, int, int, int *, char **); static void CastOutPowersOf2(int *, int *, int *); static char * ShorteningInt64Conversion(Double *, Tcl_WideUInt, int, int, int, int, int, int, int, int, int, int, int, int *, char **); static char * StrictInt64Conversion(Double *, Tcl_WideUInt, int, int, int, int, int, int, int, int, int *, char **); static int ShouldBankerRoundUpPowD(mp_int *, int, int); static int ShouldBankerRoundUpToNextPowD(mp_int *, mp_int *, int, int, mp_int *); static char * ShorteningBignumConversionPowD(Double *dPtr, Tcl_WideUInt bw, int b2, int b5, int m2plus, int m2minus, int m5, int sd, int k, int len, int ilim, int ilim1, int *decpt, char **endPtr); static char * StrictBignumConversionPowD(Double *dPtr, Tcl_WideUInt bw, int b2, int b5, int sd, int k, int len, int ilim, int ilim1, int *decpt, char **endPtr); static int ShouldBankerRoundUp(mp_int *, mp_int *, int); static int ShouldBankerRoundUpToNext(mp_int *, mp_int *, mp_int *, int); static char * ShorteningBignumConversion(Double *dPtr, Tcl_WideUInt bw, int b2, int m2plus, int m2minus, int s2, int s5, int k, int len, int ilim, int ilim1, int *decpt, char **endPtr); static char * StrictBignumConversion(Double *dPtr, Tcl_WideUInt bw, int b2, int s2, int s5, int k, int len, int ilim, int ilim1, int *decpt, char **endPtr); static double BignumToBiasedFrExp(const mp_int *big, int *machexp); static double Pow10TimesFrExp(int exponent, double fraction, int *machexp); |
︙ | ︙ | |||
2343 2344 2345 2346 2347 2348 2349 | * one too high. * *---------------------------------------------------------------------- */ static inline void SetPrecisionLimits( | | | < | < < < < < < | | | | | 2343 2344 2345 2346 2347 2348 2349 2350 2351 2352 2353 2354 2355 2356 2357 2358 2359 2360 2361 2362 2363 2364 2365 2366 2367 2368 2369 2370 2371 2372 2373 2374 2375 2376 2377 2378 2379 2380 2381 2382 2383 2384 2385 2386 2387 | * one too high. * *---------------------------------------------------------------------- */ static inline void SetPrecisionLimits( int flags, /* Type of conversion: TCL_DD_SHORTEST, * TCL_DD_E_FMT, TCL_DD_F_FMT. */ int k, /* Floor(log10(number to convert)) */ int *ndigitsPtr, /* IN/OUT: Number of digits requested (will be * adjusted if needed). */ int *iPtr, /* OUT: Maximum number of digits to return. */ int *iLimPtr, /* OUT: Number of digits of significance if * the bignum method is used.*/ int *iLim1Ptr) /* OUT: Number of digits of significance if * the quick method is used. */ { switch (flags & TCL_DD_CONVERSION_TYPE_MASK) { case TCL_DD_E_FORMAT: if (*ndigitsPtr <= 0) { *ndigitsPtr = 1; } *iLimPtr = *iLim1Ptr = *iPtr = *ndigitsPtr; break; case TCL_DD_F_FORMAT: *iPtr = *ndigitsPtr + k + 1; *iLimPtr = *iPtr; *iLim1Ptr = *iPtr - 1; if (*iPtr <= 0) { *iPtr = 1; } break; default: *iLimPtr = *iLim1Ptr = -1; *iPtr = 18; *ndigitsPtr = 0; break; } } /* *---------------------------------------------------------------------- * * BumpUp -- |
︙ | ︙ | |||
2810 2811 2812 2813 2814 2815 2816 | * *---------------------------------------------------------------------- */ static inline char * ShorteningInt64Conversion( Double *dPtr, /* Original number to convert. */ | < < | 2803 2804 2805 2806 2807 2808 2809 2810 2811 2812 2813 2814 2815 2816 | * *---------------------------------------------------------------------- */ static inline char * ShorteningInt64Conversion( Double *dPtr, /* Original number to convert. */ Tcl_WideUInt bw, /* Integer significand. */ int b2, int b5, /* Scale factor for the significand in the * numerator. */ int m2plus, int m2minus, int m5, /* Scale factors for 1/2 ulp in the numerator * (will be different if bw == 1. */ int s2, int s5, /* Scale factors for the denominator. */ |
︙ | ︙ | |||
2878 2879 2880 2881 2882 2883 2884 | /* * Does the current digit put us on the low side of the exact value * but within within roundoff of being exact? */ if (b < mplus || (b == mplus | | | 2869 2870 2871 2872 2873 2874 2875 2876 2877 2878 2879 2880 2881 2882 2883 | /* * Does the current digit put us on the low side of the exact value * but within within roundoff of being exact? */ if (b < mplus || (b == mplus && (dPtr->w.word1 & 1) == 0)) { /* * Make sure we shouldn't be rounding *up* instead, in case the * next number above is closer. */ if (2 * b > S || (2 * b == S && (digit & 1) != 0)) { ++digit; |
︙ | ︙ | |||
2907 2908 2909 2910 2911 2912 2913 | /* * Does one plus the current digit put us within roundoff of the * number? */ if (b > S - mminus || (b == S - mminus | | | 2898 2899 2900 2901 2902 2903 2904 2905 2906 2907 2908 2909 2910 2911 2912 | /* * Does one plus the current digit put us within roundoff of the * number? */ if (b > S - mminus || (b == S - mminus && (dPtr->w.word1 & 1) == 0)) { if (digit == 9) { *s++ = '9'; s = BumpUp(s, retval, &k); break; } ++digit; *s++ = '0' + digit; |
︙ | ︙ | |||
2979 2980 2981 2982 2983 2984 2985 | * *---------------------------------------------------------------------- */ static inline char * StrictInt64Conversion( Double *dPtr, /* Original number to convert. */ | < < | 2970 2971 2972 2973 2974 2975 2976 2977 2978 2979 2980 2981 2982 2983 | * *---------------------------------------------------------------------- */ static inline char * StrictInt64Conversion( Double *dPtr, /* Original number to convert. */ Tcl_WideUInt bw, /* Integer significand. */ int b2, int b5, /* Scale factor for the significand in the * numerator. */ int s2, int s5, /* Scale factors for the denominator. */ int k, /* Number of output digits before the decimal * point. */ int len, /* Number of digits to allocate. */ |
︙ | ︙ | |||
3089 3090 3091 3092 3093 3094 3095 | static inline int ShouldBankerRoundUpPowD( mp_int *b, /* Numerator of the fraction. */ int sd, /* Denominator is 2**(sd*DIGIT_BIT). */ int isodd) /* 1 if the digit is odd, 0 if even. */ { int i; | | | 3078 3079 3080 3081 3082 3083 3084 3085 3086 3087 3088 3089 3090 3091 3092 | static inline int ShouldBankerRoundUpPowD( mp_int *b, /* Numerator of the fraction. */ 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 = ((mp_digit)1) << (DIGIT_BIT - 1); if (b->used < sd || (b->dp[sd-1] & topbit) == 0) { return 0; } if (b->dp[sd-1] != topbit) { return 1; } |
︙ | ︙ | |||
3125 3126 3127 3128 3129 3130 3131 | */ static inline int ShouldBankerRoundUpToNextPowD( mp_int *b, /* Numerator of the fraction. */ mp_int *m, /* Numerator of the rounding tolerance. */ int sd, /* Common denominator is 2**(sd*DIGIT_BIT). */ | < < < | 3114 3115 3116 3117 3118 3119 3120 3121 3122 3123 3124 3125 3126 3127 | */ static inline int ShouldBankerRoundUpToNextPowD( mp_int *b, /* Numerator of the fraction. */ mp_int *m, /* Numerator of the rounding tolerance. */ int sd, /* Common denominator is 2**(sd*DIGIT_BIT). */ int isodd, /* 1 if the integer significand is odd. */ mp_int *temp) /* Work area for the calculation. */ { int i; /* * Compare B and S-m - which is the same as comparing B+m and S - which we |
︙ | ︙ | |||
3153 3154 3155 3156 3157 3158 3159 | } for (i = sd-1; i >= 0; --i) { /* Check for ==s */ if (temp->dp[i] != 0) { /* > s */ return 1; } } | < < < < | 3139 3140 3141 3142 3143 3144 3145 3146 3147 3148 3149 3150 3151 3152 | } for (i = sd-1; i >= 0; --i) { /* Check for ==s */ if (temp->dp[i] != 0) { /* > s */ return 1; } } return isodd; } /* *---------------------------------------------------------------------- * * ShorteningBignumConversionPowD -- |
︙ | ︙ | |||
3186 3187 3188 3189 3190 3191 3192 | * *---------------------------------------------------------------------- */ static inline char * ShorteningBignumConversionPowD( Double *dPtr, /* Original number to convert. */ | < < | 3168 3169 3170 3171 3172 3173 3174 3175 3176 3177 3178 3179 3180 3181 | * *---------------------------------------------------------------------- */ static inline char * ShorteningBignumConversionPowD( Double *dPtr, /* Original number to convert. */ Tcl_WideUInt bw, /* Integer significand. */ int b2, int b5, /* Scale factor for the significand in the * numerator. */ int m2plus, int m2minus, int m5, /* Scale factors for 1/2 ulp in the numerator * (will be different if bw == 1). */ int sd, /* Scale factor for the denominator. */ |
︙ | ︙ | |||
3273 3274 3275 3276 3277 3278 3279 | /* * Does the current digit put us on the low side of the exact value * but within within roundoff of being exact? */ r1 = mp_cmp_mag(&b, (m2plus > m2minus)? &mplus : &mminus); if (r1 == MP_LT || (r1 == MP_EQ | | | 3253 3254 3255 3256 3257 3258 3259 3260 3261 3262 3263 3264 3265 3266 3267 | /* * Does the current digit put us on the low side of the exact value * but within within roundoff of being exact? */ r1 = mp_cmp_mag(&b, (m2plus > m2minus)? &mplus : &mminus); if (r1 == MP_LT || (r1 == MP_EQ && (dPtr->w.word1 & 1) == 0)) { /* * Make sure we shouldn't be rounding *up* instead, in case the * next number above is closer. */ if (ShouldBankerRoundUpPowD(&b, sd, digit&1)) { ++digit; |
︙ | ︙ | |||
3301 3302 3303 3304 3305 3306 3307 | } /* * Does one plus the current digit put us within roundoff of the * number? */ | | | 3281 3282 3283 3284 3285 3286 3287 3288 3289 3290 3291 3292 3293 3294 3295 | } /* * Does one plus the current digit put us within roundoff of the * number? */ if (ShouldBankerRoundUpToNextPowD(&b, &mminus, sd, dPtr->w.word1 & 1, &temp)) { if (digit == 9) { *s++ = '9'; s = BumpUp(s, retval, &k); break; } ++digit; |
︙ | ︙ | |||
3379 3380 3381 3382 3383 3384 3385 | * *---------------------------------------------------------------------- */ static inline char * StrictBignumConversionPowD( Double *dPtr, /* Original number to convert. */ | < < < < | 3359 3360 3361 3362 3363 3364 3365 3366 3367 3368 3369 3370 3371 3372 3373 3374 3375 3376 3377 3378 3379 3380 3381 3382 3383 3384 3385 3386 3387 3388 3389 3390 3391 3392 3393 3394 3395 3396 3397 3398 3399 3400 3401 3402 3403 3404 3405 3406 3407 3408 3409 3410 | * *---------------------------------------------------------------------- */ static inline char * StrictBignumConversionPowD( Double *dPtr, /* Original number to convert. */ Tcl_WideUInt bw, /* Integer significand. */ int b2, int b5, /* Scale factor for the significand in the * numerator. */ int sd, /* Scale factor for the denominator. */ int k, /* Number of output digits before the decimal * point. */ int len, /* Number of digits to allocate. */ int ilim, /* Number of digits to convert if b >= s */ int ilim1, /* Number of digits to convert if b < s */ int *decpt, /* OUTPUT: Position of the decimal point. */ char **endPtr) /* OUTPUT: Position of the terminal '\0' at * the end of the returned string. */ { char *retval = Tcl_Alloc(len + 1); /* Output buffer. */ mp_int b; /* Numerator of the fraction being * converted. */ mp_digit digit; /* Current output digit. */ char *s = retval; /* Cursor in the output buffer. */ int i; /* Index in the output buffer. */ /* * b = bw * 2**b2 * 5**b5 */ TclInitBignumFromWideUInt(&b, bw); MulPow5(&b, b5, &b); mp_mul_2d(&b, b2, &b); /* * Adjust if the logarithm was guessed wrong. */ if (b.used <= sd) { mp_mul_d(&b, 10, &b); ilim = ilim1; --k; } /* * Loop through the digits. Do division and mod by s == 2**(sd*DIGIT_BIT) * by mp_digit extraction. */ i = 1; |
︙ | ︙ | |||
3469 3470 3471 3472 3473 3474 3475 | } /* * Endgame - store the location of the decimal point and the end of the * string. */ | | | 3445 3446 3447 3448 3449 3450 3451 3452 3453 3454 3455 3456 3457 3458 3459 | } /* * Endgame - store the location of the decimal point and the end of the * string. */ mp_clear(&b); *s = '\0'; *decpt = k; if (endPtr) { *endPtr = s; } return retval; } |
︙ | ︙ | |||
3533 3534 3535 3536 3537 3538 3539 | static inline int ShouldBankerRoundUpToNext( mp_int *b, /* Remainder from the division that produced * the last digit. */ mp_int *m, /* Numerator of the rounding tolerance. */ mp_int *S, /* Denominator. */ | < < < | < > > | | > < < < | < | 3509 3510 3511 3512 3513 3514 3515 3516 3517 3518 3519 3520 3521 3522 3523 3524 3525 3526 3527 3528 3529 3530 3531 3532 3533 3534 3535 3536 3537 3538 3539 3540 | static inline int ShouldBankerRoundUpToNext( mp_int *b, /* Remainder from the division that produced * the last digit. */ mp_int *m, /* Numerator of the rounding tolerance. */ mp_int *S, /* Denominator. */ int isodd) /* 1 if the integer significand is odd. */ { int r; mp_int temp; /* * Compare b and S-m: this is the same as comparing B+m and S. */ mp_init(&temp); mp_add(b, m, &temp); r = mp_cmp_mag(&temp, S); mp_clear(&temp); switch(r) { case MP_LT: return 0; case MP_EQ: return isodd; case MP_GT: return 1; } Tcl_Panic("in ShouldBankerRoundUpToNext, trichotomy fails!"); return 0; } |
︙ | ︙ | |||
3584 3585 3586 3587 3588 3589 3590 | * *---------------------------------------------------------------------- */ static inline char * ShorteningBignumConversion( Double *dPtr, /* Original number being converted. */ | < < | 3555 3556 3557 3558 3559 3560 3561 3562 3563 3564 3565 3566 3567 3568 3569 3570 3571 3572 3573 3574 3575 3576 3577 3578 3579 3580 3581 3582 3583 3584 3585 3586 3587 3588 | * *---------------------------------------------------------------------- */ static inline char * ShorteningBignumConversion( Double *dPtr, /* Original number being converted. */ Tcl_WideUInt bw, /* Integer significand and exponent. */ int b2, /* Scale factor for the significand. */ int m2plus, int m2minus, /* Scale factors for 1/2 ulp in numerator. */ int s2, int s5, /* Scale factors for denominator. */ int k, /* Guessed position of the decimal point. */ int len, /* Size of the digit buffer to allocate. */ int ilim, /* Number of digits to convert if b >= s */ int ilim1, /* Number of digits to convert if b < s */ int *decpt, /* OUTPUT: Position of the decimal point. */ char **endPtr) /* OUTPUT: Pointer to the end of the number */ { char *retval = Tcl_Alloc(len+1); /* Buffer of digits to return. */ char *s = retval; /* Cursor in the return value. */ mp_int b; /* Numerator of the result. */ mp_int mminus; /* 1/2 ulp below the result. */ mp_int mplus; /* 1/2 ulp above the result. */ mp_int S; /* Denominator of the result. */ mp_int dig; /* Current digit of the result. */ int digit; /* Current digit of the result. */ int minit = 1; /* Fudge factor for when we misguess k. */ int i; int r1; /* * b = bw * 2**b2 * 5**b5 * S = 2**s2 * 5*s5 |
︙ | ︙ | |||
3641 3642 3643 3644 3645 3646 3647 | mp_init_set_int(&mminus, minit); mp_mul_2d(&mminus, m2minus, &mminus); if (m2plus > m2minus) { mp_init_copy(&mplus, &mminus); mp_mul_2d(&mplus, m2plus-m2minus, &mplus); } | < | < | | | 3610 3611 3612 3613 3614 3615 3616 3617 3618 3619 3620 3621 3622 3623 3624 3625 3626 3627 3628 3629 3630 3631 3632 3633 3634 3635 3636 3637 3638 3639 3640 3641 3642 3643 3644 3645 3646 3647 3648 3649 3650 3651 3652 3653 3654 3655 3656 3657 3658 3659 3660 3661 3662 3663 3664 | mp_init_set_int(&mminus, minit); mp_mul_2d(&mminus, m2minus, &mminus); if (m2plus > m2minus) { mp_init_copy(&mplus, &mminus); mp_mul_2d(&mplus, m2plus-m2minus, &mplus); } /* * Loop through the digits. */ mp_init(&dig); i = 1; for (;;) { mp_div(&b, &S, &dig, &b); if (dig.used > 1 || dig.dp[0] >= 10) { Tcl_Panic("wrong digit!"); } digit = dig.dp[0]; /* * Does the current digit leave us with a remainder small enough to * round to it? */ r1 = mp_cmp_mag(&b, (m2plus > m2minus)? &mplus : &mminus); if (r1 == MP_LT || (r1 == MP_EQ && (dPtr->w.word1 & 1) == 0)) { mp_mul_2d(&b, 1, &b); if (ShouldBankerRoundUp(&b, &S, digit&1)) { ++digit; if (digit == 10) { *s++ = '9'; s = BumpUp(s, retval, &k); break; } } *s++ = '0' + digit; break; } /* * Does the current digit leave us with a remainder large enough to * commit to rounding up to the next higher digit? */ if (ShouldBankerRoundUpToNext(&b, &mminus, &S, dPtr->w.word1 & 1)) { ++digit; if (digit == 10) { *s++ = '9'; s = BumpUp(s, retval, &k); break; } *s++ = '0' + digit; |
︙ | ︙ | |||
3770 3771 3772 3773 3774 3775 3776 | * Endgame - store the location of the decimal point and the end of the * string. */ if (m2plus > m2minus) { mp_clear(&mplus); } | | | 3737 3738 3739 3740 3741 3742 3743 3744 3745 3746 3747 3748 3749 3750 3751 | * Endgame - store the location of the decimal point and the end of the * string. */ if (m2plus > m2minus) { mp_clear(&mplus); } mp_clear_multi(&b, &mminus, &dig, &S, NULL); *s = '\0'; *decpt = k; if (endPtr) { *endPtr = s; } return retval; } |
︙ | ︙ | |||
3800 3801 3802 3803 3804 3805 3806 | * *---------------------------------------------------------------------- */ static inline char * StrictBignumConversion( Double *dPtr, /* Original number being converted. */ | < < | | 3767 3768 3769 3770 3771 3772 3773 3774 3775 3776 3777 3778 3779 3780 3781 3782 3783 3784 3785 3786 3787 3788 3789 3790 3791 3792 3793 3794 3795 3796 3797 3798 3799 3800 3801 3802 3803 3804 3805 3806 | * *---------------------------------------------------------------------- */ static inline char * StrictBignumConversion( Double *dPtr, /* Original number being converted. */ Tcl_WideUInt bw, /* Integer significand and exponent. */ int b2, /* Scale factor for the significand. */ int s2, int s5, /* Scale factors for denominator. */ int k, /* Guessed position of the decimal point. */ int len, /* Size of the digit buffer to allocate. */ int ilim, /* Number of digits to convert if b >= s */ int ilim1, /* Number of digits to convert if b < s */ int *decpt, /* OUTPUT: Position of the decimal point. */ char **endPtr) /* OUTPUT: Pointer to the end of the number */ { char *retval = Tcl_Alloc(len+1); /* Buffer of digits to return. */ char *s = retval; /* Cursor in the return value. */ mp_int b; /* Numerator of the result. */ mp_int S; /* Denominator of the result. */ mp_int dig; /* Current digit of the result. */ int digit; /* Current digit of the result. */ int g; /* Size of the current digit ground. */ int i, j; /* * b = bw * 2**b2 * 5**b5 * S = 2**s2 * 5*s5 */ mp_init_multi(&dig, NULL); TclInitBignumFromWideUInt(&b, bw); mp_mul_2d(&b, b2, &b); mp_init_set_int(&S, 1); MulPow5(&S, s5, &S); mp_mul_2d(&S, s2, &S); /* * Handle the case where we guess the position of the decimal point wrong. |
︙ | ︙ | |||
3934 3935 3936 3937 3938 3939 3940 | ++s; /* * Endgame - store the location of the decimal point and the end of the * string. */ | | | 3899 3900 3901 3902 3903 3904 3905 3906 3907 3908 3909 3910 3911 3912 3913 | ++s; /* * Endgame - store the location of the decimal point and the end of the * string. */ mp_clear_multi(&b, &S, &dig, NULL); *s = '\0'; *decpt = k; if (endPtr) { *endPtr = s; } return retval; } |
︙ | ︙ | |||
3970 3971 3972 3973 3974 3975 3976 | * according to the 'flags' argument. Valid values for 'flags' include: * TCL_DD_SHORTEST - This is the default for floating point conversion. * It constructs the shortest string of * digits that will reconvert to the given number when scanned. * For floating point numbers that are exactly between two * decimal numbers, it resolves using the 'round to even' rule. * With this value, the 'ndigits' parameter is ignored. | < < < < < < < < < | 3935 3936 3937 3938 3939 3940 3941 3942 3943 3944 3945 3946 3947 3948 | * according to the 'flags' argument. Valid values for 'flags' include: * TCL_DD_SHORTEST - This is the default for floating point conversion. * It constructs the shortest string of * digits that will reconvert to the given number when scanned. * For floating point numbers that are exactly between two * decimal numbers, it resolves using the 'round to even' rule. * With this value, the 'ndigits' parameter is ignored. * TCL_DD_E_FORMAT - This value is used to prepare numbers for %e format * conversion. It constructs a string of at most 'ndigits' digits, * choosing the one that is closest to the given number (and * resolving ties with 'round to even'). It is allowed to return * fewer than 'ndigits' if the number converts exactly; if the * TCL_DD_E_FORMAT|TCL_DD_SHORTEN_FLAG is supplied instead, it * also returns fewer digits if the shorter string will still |
︙ | ︙ | |||
4028 4029 4030 4031 4032 4033 4034 | int flags, /* Conversion flags. */ int *decpt, /* OUTPUT: Position of the decimal point. */ int *sign, /* OUTPUT: 1 if the result is negative. */ char **endPtr) /* OUTPUT: If not NULL, receives a pointer to * one character beyond the end of the * returned string. */ { | < < < < | 3984 3985 3986 3987 3988 3989 3990 3991 3992 3993 3994 3995 3996 3997 | int flags, /* Conversion flags. */ int *decpt, /* OUTPUT: Position of the decimal point. */ int *sign, /* OUTPUT: 1 if the result is negative. */ char **endPtr) /* OUTPUT: If not NULL, receives a pointer to * one character beyond the end of the * returned string. */ { Double d; /* Union for deconstructing doubles. */ Tcl_WideUInt bw; /* Integer significand. */ int be; /* Power of 2 by which b must be multiplied */ int bbits; /* Number of bits needed to represent b. */ int denorm; /* Flag == 1 iff the input number was * denormalized. */ int k; /* Estimate of floor(log10(d)). */ |
︙ | ︙ | |||
4099 4100 4101 4102 4103 4104 4105 | ComputeScale(be, k, &b2, &b5, &s2, &s5); /* * Correct an incorrect caller-supplied 'ndigits'. Also determine: * i = The maximum number of decimal digits that will be returned in the * formatted string. This is k + 1 + ndigits for F format, 18 for | | | | | | | 4051 4052 4053 4054 4055 4056 4057 4058 4059 4060 4061 4062 4063 4064 4065 4066 4067 4068 4069 4070 4071 4072 4073 4074 4075 4076 | ComputeScale(be, k, &b2, &b5, &s2, &s5); /* * Correct an incorrect caller-supplied 'ndigits'. Also determine: * i = The maximum number of decimal digits that will be returned in the * formatted string. This is k + 1 + ndigits for F format, 18 for * shortest, and ndigits for E format. * ilim = The number of significant digits to convert if k has been * guessed correctly. This is -1 for shortest (which * stop when all significance has been lost), 'ndigits' for E * format, and 'k + 1 + ndigits' for F format. * ilim1 = The minimum number of significant digits to convert if k has * been guessed 1 too high. This, too, is -1 for shortest, * and 'ndigits' for E format, but it's 'ndigits-1' for F * format. */ SetPrecisionLimits(flags, k, &ndigits, &i, &ilim, &ilim1); /* * Try to do low-precision conversion in floating point rather than * resorting to expensive multiprecision arithmetic. */ if (ilim >= 0 && ilim <= QUICK_MAX && !(flags & TCL_DD_NO_QUICK)) { |
︙ | ︙ | |||
4183 4184 4185 4186 4187 4188 4189 | * If 10*2**s2*5**s5 == 2**(s2+1)+5**(s5+1) fits in a 64-bit word, * then all our intermediate calculations can be done using exact * 64-bit arithmetic with no need for expensive multiprecision * operations. (This will be true for all numbers in the range * [1.0e-3 .. 1.0e+24]). */ | | | | | 4135 4136 4137 4138 4139 4140 4141 4142 4143 4144 4145 4146 4147 4148 4149 4150 4151 4152 4153 4154 4155 4156 4157 4158 4159 4160 4161 4162 4163 4164 4165 4166 4167 4168 4169 4170 4171 4172 4173 4174 4175 4176 4177 | * If 10*2**s2*5**s5 == 2**(s2+1)+5**(s5+1) fits in a 64-bit word, * then all our intermediate calculations can be done using exact * 64-bit arithmetic with no need for expensive multiprecision * operations. (This will be true for all numbers in the range * [1.0e-3 .. 1.0e+24]). */ return ShorteningInt64Conversion(&d, bw, b2, b5, m2plus, m2minus, m5, s2, s5, k, len, ilim, ilim1, decpt, endPtr); } else if (s5 == 0) { /* * The denominator is a power of 2, so we can replace division 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); b2 += delta; m2plus += delta; m2minus += delta; s2 += delta; } return ShorteningBignumConversionPowD(&d, bw, b2, b5, m2plus, m2minus, m5, s2/DIGIT_BIT, k, len, ilim, ilim1, decpt, endPtr); } else { /* * Alas, there's no helpful special case; use full-up bignum * arithmetic for the conversion. */ return ShorteningBignumConversion(&d, bw, b2, m2plus, m2minus, s2, s5, k, len, ilim, ilim1, decpt, endPtr); } } else { /* * Non-shortening conversion. */ |
︙ | ︙ | |||
4239 4240 4241 4242 4243 4244 4245 | /* * If 10*2**s2*5**s5 == 2**(s2+1)+5**(s5+1) fits in a 64-bit word, * then all our intermediate calculations can be done using exact * 64-bit arithmetic with no need for expensive multiprecision * operations. */ | | | | | 4191 4192 4193 4194 4195 4196 4197 4198 4199 4200 4201 4202 4203 4204 4205 4206 4207 4208 4209 4210 4211 4212 4213 4214 4215 4216 4217 4218 4219 4220 4221 4222 4223 4224 4225 4226 4227 4228 4229 4230 4231 4232 | /* * If 10*2**s2*5**s5 == 2**(s2+1)+5**(s5+1) fits in a 64-bit word, * then all our intermediate calculations can be done using exact * 64-bit arithmetic with no need for expensive multiprecision * operations. */ return StrictInt64Conversion(&d, bw, b2, b5, s2, s5, k, len, ilim, ilim1, decpt, endPtr); } else if (s5 == 0) { /* * The denominator is a power of 2, so we can replace division 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); b2 += delta; s2 += delta; } return StrictBignumConversionPowD(&d, bw, b2, b5, s2/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 * conversion in steps of DIGIT_GROUP digits, so as to have many * fewer mp_int divisions. */ return StrictBignumConversion(&d, bw, b2, s2, s5, k, len, ilim, ilim1, decpt, endPtr); } } } /* *---------------------------------------------------------------------- |
︙ | ︙ |
Changes to generic/tclTest.c.
︙ | ︙ | |||
1698 1699 1700 1701 1702 1703 1704 | * * Usage: * testdoubledigits fpval ndigits type ?shorten" * * Parameters: * fpval - Floating-point value to format. * ndigits - Digit count to request from Tcl_DoubleDigits | | < < | 1698 1699 1700 1701 1702 1703 1704 1705 1706 1707 1708 1709 1710 1711 1712 1713 1714 1715 1716 1717 1718 1719 1720 1721 1722 1723 1724 1725 1726 1727 1728 1729 1730 1731 1732 1733 1734 1735 | * * Usage: * testdoubledigits fpval ndigits type ?shorten" * * Parameters: * fpval - Floating-point value to format. * ndigits - Digit count to request from Tcl_DoubleDigits * type - One of 'shortest', 'e', 'f' * shorten - Indicates that the 'shorten' flag should be passed in. * *----------------------------------------------------------------------------- */ static int TestdoubledigitsObjCmd(void *unused, /* NULL */ Tcl_Interp* interp, /* Tcl interpreter */ int objc, /* Parameter count */ Tcl_Obj* const objv[]) /* Parameter vector */ { static const char* options[] = { "shortest", "e", "f", NULL }; static const int types[] = { TCL_DD_SHORTEST, TCL_DD_E_FORMAT, TCL_DD_F_FORMAT }; const Tcl_ObjType* doubleType; double d; int status; |
︙ | ︙ |
Changes to generic/tclUtf.c.
︙ | ︙ | |||
1962 1963 1964 1965 1966 1967 1968 | * quickly if the next char in the pattern isn't a special * character */ if ((p != '[') && (p != '?') && (p != '\\')) { if (nocase) { while (*uniStr && (p != *uniStr) | | | 1962 1963 1964 1965 1966 1967 1968 1969 1970 1971 1972 1973 1974 1975 1976 | * quickly if the next char in the pattern isn't a special * character */ if ((p != '[') && (p != '?') && (p != '\\')) { if (nocase) { while (*uniStr && (p != *uniStr) && (p != (Tcl_UniChar)Tcl_UniCharToLower(*uniStr))) { uniStr++; } } else { while (*uniStr && (p != *uniStr)) { uniStr++; } } |
︙ | ︙ | |||
2154 2155 2156 2157 2158 2159 2160 | * quickly if the next char in the pattern isn't a special * character. */ if ((p != '[') && (p != '?') && (p != '\\')) { if (nocase) { while ((string < stringEnd) && (p != *string) | | | 2154 2155 2156 2157 2158 2159 2160 2161 2162 2163 2164 2165 2166 2167 2168 | * quickly if the next char in the pattern isn't a special * character. */ if ((p != '[') && (p != '?') && (p != '\\')) { if (nocase) { while ((string < stringEnd) && (p != *string) && (p != (Tcl_UniChar)Tcl_UniCharToLower(*string))) { string++; } } else { while ((string < stringEnd) && (p != *string)) { string++; } } |
︙ | ︙ |
Added tests-perf/clock.perf.tcl.
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 | #!/usr/bin/tclsh # ------------------------------------------------------------------------ # # test-performance.tcl -- # # This file provides common performance tests for comparison of tcl-speed # degradation by switching between branches. # (currently for clock ensemble only) # # ------------------------------------------------------------------------ # # Copyright (c) 2014 Serg G. Brester (aka sebres) # # See the file "license.terms" for information on usage and redistribution # of this file. # array set in {-time 500} if {[info exists ::argv0] && [file tail $::argv0] eq [file tail [info script]]} { array set in $argv } ## common test performance framework: if {![namespace exists ::tclTestPerf]} { source [file join [file dirname [info script]] test-performance.tcl] } namespace eval ::tclTestPerf-TclClock { namespace path {::tclTestPerf} ## set testing defaults: set ::env(TCL_TZ) :CET # warm-up interpeter compiler env, clock platform-related features: ## warm-up test-related features (load clock.tcl, system zones, locales, etc.): clock scan "" -gmt 1 clock scan "" clock scan "" -timezone :CET clock scan "" -format "" -locale en clock scan "" -format "" -locale de ## ------------------------------------------ proc test-format {{reptime 1000}} { _test_run $reptime { # Format : short, week only (in gmt) {clock format 1482525936 -format "%u" -gmt 1} # Format : short, week only (system zone) {clock format 1482525936 -format "%u"} # Format : short, week only (CEST) {clock format 1482525936 -format "%u" -timezone :CET} # Format : date only (in gmt) {clock format 1482525936 -format "%Y-%m-%d" -gmt 1} # Format : date only (system zone) {clock format 1482525936 -format "%Y-%m-%d"} # Format : date only (CEST) {clock format 1482525936 -format "%Y-%m-%d" -timezone :CET} # Format : time only (in gmt) {clock format 1482525936 -format "%H:%M" -gmt 1} # Format : time only (system zone) {clock format 1482525936 -format "%H:%M"} # Format : time only (CEST) {clock format 1482525936 -format "%H:%M" -timezone :CET} # Format : time only (in gmt) {clock format 1482525936 -format "%H:%M:%S" -gmt 1} # Format : time only (system zone) {clock format 1482525936 -format "%H:%M:%S"} # Format : time only (CEST) {clock format 1482525936 -format "%H:%M:%S" -timezone :CET} # Format : default (in gmt) {clock format 1482525936 -gmt 1 -locale en} # Format : default (system zone) {clock format 1482525936 -locale en} # Format : default (CEST) {clock format 1482525936 -timezone :CET -locale en} # Format : ISO date-time (in gmt, numeric zone) {clock format 1246379400 -format "%Y-%m-%dT%H:%M:%S %z" -gmt 1} # Format : ISO date-time (system zone, CEST, numeric zone) {clock format 1246379400 -format "%Y-%m-%dT%H:%M:%S %z"} # Format : ISO date-time (CEST, numeric zone) {clock format 1246379400 -format "%Y-%m-%dT%H:%M:%S %z" -timezone :CET} # Format : ISO date-time (system zone, CEST) {clock format 1246379400 -format "%Y-%m-%dT%H:%M:%S %Z"} # Format : julian day with time (in gmt): {clock format 1246379415 -format "%J %H:%M:%S" -gmt 1} # Format : julian day with time (system zone): {clock format 1246379415 -format "%J %H:%M:%S"} # Format : locale date-time (en): {clock format 1246379415 -format "%x %X" -locale en} # Format : locale date-time (de): {clock format 1246379415 -format "%x %X" -locale de} # Format : locale lookup table month: {clock format 1246379400 -format "%b" -locale en -gmt 1} # Format : locale lookup 2 tables - month and day: {clock format 1246379400 -format "%b %Od" -locale en -gmt 1} # Format : locale lookup 3 tables - week, month and day: {clock format 1246379400 -format "%a %b %Od" -locale en -gmt 1} # Format : locale lookup 4 tables - week, month, day and year: {clock format 1246379400 -format "%a %b %Od %Oy" -locale en -gmt 1} # Format : dynamic clock value (without converter caches): setup {set i 0} {clock format [incr i] -format "%Y-%m-%dT%H:%M:%S" -locale en -timezone :CET} cleanup {puts [clock format $i -format "%Y-%m-%dT%H:%M:%S" -locale en -timezone :CET]} # Format : dynamic clock value (without any converter caches, zone range overflow): setup {set i 0} {clock format [incr i 86400] -format "%Y-%m-%dT%H:%M:%S" -locale en -timezone :CET} cleanup {puts [clock format $i -format "%Y-%m-%dT%H:%M:%S" -locale en -timezone :CET]} # Format : dynamic format (cacheable) {clock format 1246379415 -format [string trim "%d.%m.%Y %H:%M:%S "] -gmt 1} # Format : all (in gmt, locale en) {clock format 1482525936 -format "%%a = %a | %%A = %A | %%b = %b | %%h = %h | %%B = %B | %%C = %C | %%d = %d | %%e = %e | %%g = %g | %%G = %G | %%H = %H | %%I = %I | %%j = %j | %%J = %J | %%k = %k | %%l = %l | %%m = %m | %%M = %M | %%N = %N | %%p = %p | %%P = %P | %%Q = %Q | %%s = %s | %%S = %S | %%t = %t | %%u = %u | %%U = %U | %%V = %V | %%w = %w | %%W = %W | %%y = %y | %%Y = %Y | %%z = %z | %%Z = %Z | %%n = %n | %%EE = %EE | %%EC = %EC | %%Ey = %Ey | %%n = %n | %%Od = %Od | %%Oe = %Oe | %%OH = %OH | %%Ok = %Ok | %%OI = %OI | %%Ol = %Ol | %%Om = %Om | %%OM = %OM | %%OS = %OS | %%Ou = %Ou | %%Ow = %Ow | %%Oy = %Oy" -gmt 1 -locale en} # Format : all (in CET, locale de) {clock format 1482525936 -format "%%a = %a | %%A = %A | %%b = %b | %%h = %h | %%B = %B | %%C = %C | %%d = %d | %%e = %e | %%g = %g | %%G = %G | %%H = %H | %%I = %I | %%j = %j | %%J = %J | %%k = %k | %%l = %l | %%m = %m | %%M = %M | %%N = %N | %%p = %p | %%P = %P | %%Q = %Q | %%s = %s | %%S = %S | %%t = %t | %%u = %u | %%U = %U | %%V = %V | %%w = %w | %%W = %W | %%y = %y | %%Y = %Y | %%z = %z | %%Z = %Z | %%n = %n | %%EE = %EE | %%EC = %EC | %%Ey = %Ey | %%n = %n | %%Od = %Od | %%Oe = %Oe | %%OH = %OH | %%Ok = %Ok | %%OI = %OI | %%Ol = %Ol | %%Om = %Om | %%OM = %OM | %%OS = %OS | %%Ou = %Ou | %%Ow = %Ow | %%Oy = %Oy" -timezone :CET -locale de} } } proc test-scan {{reptime 1000}} { _test_run $reptime { # Scan : date (in gmt) {clock scan "25.11.2015" -format "%d.%m.%Y" -base 0 -gmt 1} # Scan : date (system time zone, with base) {clock scan "25.11.2015" -format "%d.%m.%Y" -base 0} # Scan : date (system time zone, without base) {clock scan "25.11.2015" -format "%d.%m.%Y"} # Scan : greedy match {clock scan "111" -format "%d%m%y" -base 0 -gmt 1} {clock scan "1111" -format "%d%m%y" -base 0 -gmt 1} {clock scan "11111" -format "%d%m%y" -base 0 -gmt 1} {clock scan "111111" -format "%d%m%y" -base 0 -gmt 1} # Scan : greedy match (space separated) {clock scan "1 1 1" -format "%d%m%y" -base 0 -gmt 1} {clock scan "111 1" -format "%d%m%y" -base 0 -gmt 1} {clock scan "1 111" -format "%d%m%y" -base 0 -gmt 1} {clock scan "1 11 1" -format "%d%m%y" -base 0 -gmt 1} {clock scan "1 11 11" -format "%d%m%y" -base 0 -gmt 1} {clock scan "11 11 11" -format "%d%m%y" -base 0 -gmt 1} # Scan : time (in gmt) {clock scan "10:35:55" -format "%H:%M:%S" -base 1000000000 -gmt 1} # Scan : time (system time zone, with base) {clock scan "10:35:55" -format "%H:%M:%S" -base 1000000000} # Scan : time (gmt, without base) {clock scan "10:35:55" -format "%H:%M:%S" -gmt 1} # Scan : time (system time zone, without base) {clock scan "10:35:55" -format "%H:%M:%S"} # Scan : date-time (in gmt) {clock scan "25.11.2015 10:35:55" -format "%d.%m.%Y %H:%M:%S" -base 0 -gmt 1} # Scan : date-time (system time zone with base) {clock scan "25.11.2015 10:35:55" -format "%d.%m.%Y %H:%M:%S" -base 0} # Scan : date-time (system time zone without base) {clock scan "25.11.2015 10:35:55" -format "%d.%m.%Y %H:%M:%S"} # Scan : julian day in gmt {clock scan 2451545 -format %J -gmt 1} # Scan : julian day in system TZ {clock scan 2451545 -format %J} # Scan : julian day in other TZ {clock scan 2451545 -format %J -timezone +0200} # Scan : julian day with time: {clock scan "2451545 10:20:30" -format "%J %H:%M:%S"} # Scan : julian day with time (greedy match): {clock scan "2451545 102030" -format "%J%H%M%S"} # Scan : century, lookup table month {clock scan {1970 Jan 2} -format {%C%y %b %d} -locale en -gmt 1} # Scan : century, lookup table month and day (both entries are first) {clock scan {1970 Jan 01} -format {%C%y %b %Od} -locale en -gmt 1} # Scan : century, lookup table month and day (list scan: entries with position 12 / 31) {clock scan {2016 Dec 31} -format {%C%y %b %Od} -locale en -gmt 1} # Scan : ISO date-time (CEST) {clock scan "2009-06-30T18:30:00+02:00" -format "%Y-%m-%dT%H:%M:%S%z"} {clock scan "2009-06-30T18:30:00 CEST" -format "%Y-%m-%dT%H:%M:%S %z"} # Scan : ISO date-time (UTC) {clock scan "2009-06-30T18:30:00Z" -format "%Y-%m-%dT%H:%M:%S%z"} {clock scan "2009-06-30T18:30:00 UTC" -format "%Y-%m-%dT%H:%M:%S %z"} # Scan : locale date-time (en): {clock scan "06/30/2009 18:30:15" -format "%x %X" -gmt 1 -locale en} # Scan : locale date-time (de): {clock scan "30.06.2009 18:30:15" -format "%x %X" -gmt 1 -locale de} # Scan : dynamic format (cacheable) {clock scan "25.11.2015 10:35:55" -format [string trim "%d.%m.%Y %H:%M:%S "] -base 0 -gmt 1} break # # Scan : long format test (allock chain) # {clock scan "25.11.2015" -format "%d.%m.%Y %d.%m.%Y %d.%m.%Y %d.%m.%Y %d.%m.%Y %d.%m.%Y %d.%m.%Y %d.%m.%Y" -base 0 -gmt 1} # # Scan : dynamic, very long format test (create obj representation, allock chain, GC, etc): # {clock scan "25.11.2015" -format [string repeat "[incr i] %d.%m.%Y %d.%m.%Y" 10] -base 0 -gmt 1} # # Scan : again: # {clock scan "25.11.2015" -format [string repeat "[incr i -1] %d.%m.%Y %d.%m.%Y" 10] -base 0 -gmt 1} } {puts [clock format $_(r) -locale en]} } proc test-freescan {{reptime 1000}} { _test_run $reptime { # FreeScan : relative date {clock scan "5 years 18 months 385 days" -base 0 -gmt 1} # FreeScan : relative date with relative weekday {clock scan "5 years 18 months 385 days Fri" -base 0 -gmt 1} # FreeScan : relative date with ordinal month {clock scan "5 years 18 months 385 days next 1 January" -base 0 -gmt 1} # FreeScan : relative date with ordinal month and relative weekday {clock scan "5 years 18 months 385 days next January Fri" -base 0 -gmt 1} # FreeScan : ordinal month {clock scan "next January" -base 0 -gmt 1} # FreeScan : relative week {clock scan "next Fri" -base 0 -gmt 1} # FreeScan : relative weekday and week offset {clock scan "next January + 2 week" -base 0 -gmt 1} # FreeScan : time only with base {clock scan "19:18:30" -base 148863600 -gmt 1} # FreeScan : time only without base, gmt {clock scan "19:18:30" -gmt 1} # FreeScan : time only without base, system {clock scan "19:18:30"} # FreeScan : date, system time zone {clock scan "05/08/2016 20:18:30"} # FreeScan : date, supplied time zone {clock scan "05/08/2016 20:18:30" -timezone :CET} # FreeScan : date, supplied gmt (equivalent -timezone :GMT) {clock scan "05/08/2016 20:18:30" -gmt 1} # FreeScan : date, supplied time zone gmt {clock scan "05/08/2016 20:18:30" -timezone :GMT} # FreeScan : time only, numeric zone in string, base time gmt (exchange zones between gmt / -0500) {clock scan "20:18:30 -0500" -base 148863600 -gmt 1} # FreeScan : time only, zone in string (exchange zones between system / gmt) {clock scan "19:18:30 GMT" -base 148863600} # FreeScan : fast switch of zones in cycle - GMT, MST, CET (system) and EST {clock scan "19:18:30 MST" -base 148863600 -gmt 1 clock scan "19:18:30 EST" -base 148863600 } } {puts [clock format $_(r) -locale en]} } proc test-add {{reptime 1000}} { set tests { # Add : years {clock add 1246379415 5 years -gmt 1} # Add : months {clock add 1246379415 18 months -gmt 1} # Add : weeks {clock add 1246379415 20 weeks -gmt 1} # Add : days {clock add 1246379415 385 days -gmt 1} # Add : weekdays {clock add 1246379415 3 weekdays -gmt 1} # Add : hours {clock add 1246379415 5 hours -gmt 1} # Add : minutes {clock add 1246379415 55 minutes -gmt 1} # Add : seconds {clock add 1246379415 100 seconds -gmt 1} # Add : +/- in gmt {clock add 1246379415 -5 years +21 months -20 weeks +386 days -19 hours +30 minutes -10 seconds -gmt 1} # Add : +/- in system timezone {clock add 1246379415 -5 years +21 months -20 weeks +386 days -19 hours +30 minutes -10 seconds -timezone :CET} # Add : gmt {clock add 1246379415 -5 years 18 months 366 days 5 hours 30 minutes 10 seconds -gmt 1} # Add : system timezone {clock add 1246379415 -5 years 18 months 366 days 5 hours 30 minutes 10 seconds -timezone :CET} # Add : all in gmt {clock add 1246379415 4 years 18 months 50 weeks 378 days 3 weekdays 5 hours 30 minutes 10 seconds -gmt 1} # Add : all in system timezone {clock add 1246379415 4 years 18 months 50 weeks 378 days 3 weekdays 5 hours 30 minutes 10 seconds -timezone :CET} } # if does not support add of weekdays: if {[catch {clock add 0 3 weekdays -gmt 1}]} { regsub -all {\mweekdays\M} $tests "days" tests } _test_run $reptime $tests {puts [clock format $_(r) -locale en]} } proc test-convert {{reptime 1000}} { _test_run $reptime { # Convert locale (en -> de): {clock format [clock scan "Tue May 30 2017" -format "%a %b %d %Y" -gmt 1 -locale en] -format "%a %b %d %Y" -gmt 1 -locale de} # Convert locale (de -> en): {clock format [clock scan "Di Mai 30 2017" -format "%a %b %d %Y" -gmt 1 -locale de] -format "%a %b %d %Y" -gmt 1 -locale en} # Convert TZ: direct {clock format [clock scan "19:18:30" -base 148863600 -timezone EST] -timezone MST} {clock format [clock scan "19:18:30" -base 148863600 -timezone MST] -timezone EST} # Convert TZ: included in scan string & format {clock format [clock scan "19:18:30 EST" -base 148863600] -format "%H:%M:%S %z" -timezone MST} {clock format [clock scan "19:18:30 EST" -base 148863600] -format "%H:%M:%S %z" -timezone EST} # Format locale 1x: comparison values {clock format 0 -gmt 1 -locale en} {clock format 0 -gmt 1 -locale de} {clock format 0 -gmt 1 -locale fr} # Format locale 2x: without switching locale (en, en) {clock format 0 -gmt 1 -locale en; clock format 0 -gmt 1 -locale en} # Format locale 2x: with switching locale (en, de) {clock format 0 -gmt 1 -locale en; clock format 0 -gmt 1 -locale de} # Format locale 3x: without switching locale (en, en, en) {clock format 0 -gmt 1 -locale en; clock format 0 -gmt 1 -locale en; clock format 0 -gmt 1 -locale en} # Format locale 3x: with switching locale (en, de, fr) {clock format 0 -gmt 1 -locale en; clock format 0 -gmt 1 -locale de; clock format 0 -gmt 1 -locale fr} # Scan locale 2x: without switching locale (en, en) + (de, de) {clock scan "Tue May 30 2017" -format "%a %b %d %Y" -gmt 1 -locale en; clock scan "Tue May 30 2017" -format "%a %b %d %Y" -gmt 1 -locale en} {clock scan "Di Mai 30 2017" -format "%a %b %d %Y" -gmt 1 -locale de; clock scan "Di Mai 30 2017" -format "%a %b %d %Y" -gmt 1 -locale de} # Scan locale 2x: with switching locale (en, de) {clock scan "Tue May 30 2017" -format "%a %b %d %Y" -gmt 1 -locale en; clock scan "Di Mai 30 2017" -format "%a %b %d %Y" -gmt 1 -locale de} # Scan locale 3x: with switching locale (en, de, fr) {clock scan "Tue May 30 2017" -format "%a %b %d %Y" -gmt 1 -locale en; clock scan "Di Mai 30 2017" -format "%a %b %d %Y" -gmt 1 -locale de; clock scan "mar. mai 30 2017" -format "%a %b %d %Y" -gmt 1 -locale fr} # Format TZ 2x: comparison values {clock format 0 -timezone CET -format "%Y-%m-%d %H:%M:%S %z"} {clock format 0 -timezone EST -format "%Y-%m-%d %H:%M:%S %z"} # Format TZ 2x: without switching {clock format 0 -timezone CET -format "%Y-%m-%d %H:%M:%S %z"; clock format 0 -timezone CET -format "%Y-%m-%d %H:%M:%S %z"} {clock format 0 -timezone EST -format "%Y-%m-%d %H:%M:%S %z"; clock format 0 -timezone EST -format "%Y-%m-%d %H:%M:%S %z"} # Format TZ 2x: with switching {clock format 0 -timezone CET -format "%Y-%m-%d %H:%M:%S %z"; clock format 0 -timezone EST -format "%Y-%m-%d %H:%M:%S %z"} # Format TZ 3x: with switching (CET, EST, MST) {clock format 0 -timezone CET -format "%Y-%m-%d %H:%M:%S %z"; clock format 0 -timezone EST -format "%Y-%m-%d %H:%M:%S %z"; clock format 0 -timezone MST -format "%Y-%m-%d %H:%M:%S %z"} # Format TZ 3x: with switching (GMT, EST, MST) {clock format 0 -gmt 1 -format "%Y-%m-%d %H:%M:%S %z"; clock format 0 -timezone EST -format "%Y-%m-%d %H:%M:%S %z"; clock format 0 -timezone MST -format "%Y-%m-%d %H:%M:%S %z"} # FreeScan TZ 2x (+1 system-default): without switching TZ {clock scan "19:18:30 MST" -base 148863600; clock scan "19:18:30 MST" -base 148863600} {clock scan "19:18:30 EST" -base 148863600; clock scan "19:18:30 EST" -base 148863600} # FreeScan TZ 2x (+1 system-default): with switching TZ {clock scan "19:18:30 MST" -base 148863600; clock scan "19:18:30 EST" -base 148863600} # FreeScan TZ 2x (+1 gmt, +1 system-default) {clock scan "19:18:30 MST" -base 148863600 -gmt 1; clock scan "19:18:30 EST" -base 148863600} # Scan TZ: comparison included in scan string vs. given {clock scan "2009-06-30T18:30:00 CEST" -format "%Y-%m-%dT%H:%M:%S %z"} {clock scan "2009-06-30T18:30:00 CET" -format "%Y-%m-%dT%H:%M:%S %z"} {clock scan "2009-06-30T18:30:00" -timezone CET -format "%Y-%m-%dT%H:%M:%S"} } } proc test-other {{reptime 1000}} { _test_run $reptime { # Bad zone {catch {clock scan "1 day" -timezone BAD_ZONE -locale en}} # Scan : julian day (overflow) {catch {clock scan 5373485 -format %J}} # Scan : test rotate of GC objects (format is dynamic, so tcl-obj removed with last reference) {set i 0; time { clock scan "[incr i] - 25.11.2015" -format "$i - %d.%m.%Y" -base 0 -gmt 1 } 50} # Scan : test reusability of GC objects (format is dynamic, so tcl-obj removed with last reference) {set i 50; time { clock scan "[incr i -1] - 25.11.2015" -format "$i - %d.%m.%Y" -base 0 -gmt 1 } 50} } } proc test-ensemble-perf {{reptime 1000}} { _test_run $reptime { # Clock clicks (ensemble) {clock clicks} # Clock clicks (direct) {::tcl::clock::clicks} # Clock seconds (ensemble) {clock seconds} # Clock seconds (direct) {::tcl::clock::seconds} # Clock microseconds (ensemble) {clock microseconds} # Clock microseconds (direct) {::tcl::clock::microseconds} # Clock scan (ensemble) {clock scan ""} # Clock scan (direct) {::tcl::clock::scan ""} # Clock format (ensemble) {clock format 0 -f %s} # Clock format (direct) {::tcl::clock::format 0 -f %s} } } proc test {{reptime 1000}} { puts "" test-ensemble-perf [expr {$reptime / 2}]; #fast enough test-format $reptime test-scan $reptime test-freescan $reptime test-add $reptime test-convert [expr {$reptime / 2}]; #fast enough test-other $reptime puts \n**OK** } }; # end of ::tclTestPerf-TclClock # ------------------------------------------------------------------------ # if calling direct: if {[info exists ::argv0] && [file tail $::argv0] eq [file tail [info script]]} { ::tclTestPerf-TclClock::test $in(-time) } |
Added tests-perf/test-performance.tcl.
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 | # ------------------------------------------------------------------------ # # test-performance.tcl -- # # This file provides common performance tests for comparison of tcl-speed # degradation or regression by switching between branches. # # To execute test case evaluate direct corresponding file "tests-perf\*.perf.tcl". # # ------------------------------------------------------------------------ # # Copyright (c) 2014 Serg G. Brester (aka sebres) # # See the file "license.terms" for information on usage and redistribution # of this file. # namespace eval ::tclTestPerf { # warm-up interpeter compiler env, calibrate timerate measurement functionality: # if no timerate here - import from unsupported: if {[namespace which -command timerate] eq {}} { namespace inscope ::tcl::unsupported {namespace export timerate} namespace import ::tcl::unsupported::timerate } # if not yet calibrated: if {[lindex [timerate {} 10] 6] >= (10-1)} { puts -nonewline "Calibration ... "; flush stdout puts "done: [lrange \ [timerate -calibrate {}] \ 0 1]" } proc {**STOP**} {args} { return -code error -level 4 "**STOP** in [info level [expr {[info level]-2}]] [join $args { }]" } proc _test_get_commands {lst} { regsub -all {(?:^|\n)[ \t]*(\#[^\n]*|\msetup\M[^\n]*|\mcleanup\M[^\n]*)(?=\n\s*(?:[\{\#]|setup|cleanup|$))} $lst "\n{\\1}" } proc _test_out_total {} { upvar _ _ set tcnt [llength $_(itm)] if {!$tcnt} { puts "" return } set mintm 0x7fffffff set maxtm 0 set nett 0 set wtm 0 set wcnt 0 set i 0 foreach tm $_(itm) { if {[llength $tm] > 6} { set nett [expr {$nett + [lindex $tm 6]}] } set wtm [expr {$wtm + [lindex $tm 0]}] set wcnt [expr {$wcnt + [lindex $tm 2]}] set tm [lindex $tm 0] if {$tm > $maxtm} {set maxtm $tm; set maxi $i} if {$tm < $mintm} {set mintm $tm; set mini $i} incr i } puts [string repeat ** 40] set s [format "%d cases in %.2f sec." $tcnt [expr {([clock milliseconds] - $_(starttime)) / 1000.0}]] if {$nett > 0} { append s [format " (%.2f nett-sec.)" [expr {$nett / 1000.0}]] } puts "Total $s:" lset _(m) 0 [format %.6f $wtm] lset _(m) 2 $wcnt lset _(m) 4 [format %.3f [expr {$wcnt / (($nett ? $nett : ($tcnt * [lindex $_(reptime) 0])) / 1000.0)}]] if {[llength $_(m)] > 6} { lset _(m) 6 [format %.3f $nett] } puts $_(m) puts "Average:" lset _(m) 0 [format %.6f [expr {[lindex $_(m) 0] / $tcnt}]] lset _(m) 2 [expr {[lindex $_(m) 2] / $tcnt}] if {[llength $_(m)] > 6} { lset _(m) 6 [format %.3f [expr {[lindex $_(m) 6] / $tcnt}]] lset _(m) 4 [format %.0f [expr {[lindex $_(m) 2] / [lindex $_(m) 6] * 1000}]] } puts $_(m) puts "Min:" puts [lindex $_(itm) $mini] puts "Max:" puts [lindex $_(itm) $maxi] puts [string repeat ** 40] puts "" } proc _test_run {args} { upvar _ _ # parse args: set _(out-result) 1 if {[lindex $args 0] eq "-no-result"} { set _(out-result) 0 set args [lrange $args 1 end] } if {[llength $args] < 2 || [llength $args] > 3} { return -code error "wrong # args: should be \"[lindex [info level [info level]] 0] ?-no-result? reptime lst ?outcmd?\"" } set outcmd {puts $_(r)} set args [lassign $args reptime lst] if {[llength $args]} { set outcmd [lindex $args 0] } # avoid output if only once: if {[lindex $reptime 0] <= 1 || ([llength $reptime] > 1 && [lindex $reptime 1] == 1)} { set _(out-result) 0 } array set _ [list itm {} reptime $reptime starttime [clock milliseconds]] # process measurement: foreach _(c) [_test_get_commands $lst] { puts "% [regsub -all {\n[ \t]*} $_(c) {; }]" if {[regexp {^\s*\#} $_(c)]} continue if {[regexp {^\s*(?:setup|cleanup)\s+} $_(c)]} { puts [if 1 [lindex $_(c) 1]] continue } # if output result (and not once): if {$_(out-result)} { set _(r) [if 1 $_(c)] if {$outcmd ne {}} $outcmd if {[llength $_(reptime)] > 1} { # decrement max-count lset _(reptime) 1 [expr {[lindex $_(reptime) 1] - 1}] } } puts [set _(m) [timerate $_(c) {*}$_(reptime)]] lappend _(itm) $_(m) puts "" } _test_out_total } }; # end of namespace ::tclTestPerf |
Added tests-perf/timer-event.perf.tcl.
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 | #!/usr/bin/tclsh # ------------------------------------------------------------------------ # # timer-event.perf.tcl -- # # This file provides performance tests for comparison of tcl-speed # of timer events (event-driven tcl-handling). # # ------------------------------------------------------------------------ # # Copyright (c) 2014 Serg G. Brester (aka sebres) # # See the file "license.terms" for information on usage and redistribution # of this file. # if {![namespace exists ::tclTestPerf]} { source [file join [file dirname [info script]] test-performance.tcl] } namespace eval ::tclTestPerf-Timer-Event { namespace path {::tclTestPerf} proc test-queue {{reptime {1000 10000}}} { set howmuch [lindex $reptime 1] # because of extremely short measurement times by tests below, wait a little bit (warming-up), # to minimize influence of the time-gradation (just for better dispersion resp. result-comparison) timerate {after 0} 156 puts "*** up to $howmuch events ***" # single iteration by update, so using -no-result (measure only): _test_run -no-result $reptime [string map [list \{*\}\$reptime $reptime \$howmuch $howmuch \\# \#] { # generate up to $howmuch idle-events: {after idle {set foo bar}} # update / after idle: {update; if {![llength [after info]]} break} # generate up to $howmuch idle-events: {after idle {set foo bar}} # update idletasks / after idle: {update idletasks; if {![llength [after info]]} break} # generate up to $howmuch immediate events: {after 0 {set foo bar}} # update / after 0: {update; if {![llength [after info]]} break} # generate up to $howmuch 1-ms events: {after 1 {set foo bar}} setup {after 1} # update / after 1: {update; if {![llength [after info]]} break} # generate up to $howmuch immediate events (+ 1 event of the second generation): {after 0 {after 0 {}}} # update / after 0 (double generation): {update; if {![llength [after info]]} break} # cancel forwards "after idle" / $howmuch idle-events in queue: setup {set i 0; timerate {set ev([incr i]) [after idle {set foo bar}]} {*}$reptime} setup {set le $i; set i 0; list 1 .. $le; # cancel up to $howmuch events} {after cancel $ev([incr i]); if {$i >= $le} break} cleanup {update; unset -nocomplain ev} # cancel backwards "after idle" / $howmuch idle-events in queue: setup {set i 0; timerate {set ev([incr i]) [after idle {set foo bar}]} {*}$reptime} setup {set le $i; incr i; list $le .. 1; # cancel up to $howmuch events} {after cancel $ev([incr i -1]); if {$i <= 1} break} cleanup {update; unset -nocomplain ev} # cancel forwards "after 0" / $howmuch timer-events in queue: setup {set i 0; timerate {set ev([incr i]) [after 0 {set foo bar}]} {*}$reptime} setup {set le $i; set i 0; list 1 .. $le; # cancel up to $howmuch events} {after cancel $ev([incr i]); if {$i >= $howmuch} break} cleanup {update; unset -nocomplain ev} # cancel backwards "after 0" / $howmuch timer-events in queue: setup {set i 0; timerate {set ev([incr i]) [after 0 {set foo bar}]} {*}$reptime} setup {set le $i; incr i; list $le .. 1; # cancel up to $howmuch events} {after cancel $ev([incr i -1]); if {$i <= 1} break} cleanup {update; unset -nocomplain ev} # end $howmuch events. cleanup {if [llength [after info]] {error "unexpected: [llength [after info]] events are still there."}} }] } proc test-access {{reptime {1000 5000}}} { set howmuch [lindex $reptime 1] _test_run $reptime [string map [list \{*\}\$reptime $reptime \$howmuch $howmuch] { # event random access: after idle + after info (by $howmuch events) setup {set i -1; timerate {set ev([incr i]) [after idle {}]} {*}$reptime} {after info $ev([expr {int(rand()*$i)}])} cleanup {update; unset -nocomplain ev} # event random access: after 0 + after info (by $howmuch events) setup {set i -1; timerate {set ev([incr i]) [after 0 {}]} {*}$reptime} {after info $ev([expr {int(rand()*$i)}])} cleanup {update; unset -nocomplain ev} # end $howmuch events. cleanup {if [llength [after info]] {error "unexpected: [llength [after info]] events are still there."}} }] } proc test-exec {{reptime 1000}} { _test_run $reptime { # after idle + after cancel {after cancel [after idle {set foo bar}]} # after 0 + after cancel {after cancel [after 0 {set foo bar}]} # after idle + update idletasks {after idle {set foo bar}; update idletasks} # after idle + update {after idle {set foo bar}; update} # immediate: after 0 + update {after 0 {set foo bar}; update} # delayed: after 1 + update {after 1 {set foo bar}; update} # empty update: {update} # empty update idle tasks: {update idletasks} # simple shortest sleep: {after 0} } } proc test-nrt-capability {{reptime 1000}} { _test_run $reptime { # comparison values: {after 0 {set a 5}; update} {after 0 {set a 5}; vwait a} # conditional vwait with very brief wait-time: {after 1 {set a timeout}; vwait a; expr {$::a ne "timeout" ? 1 : "0[unset ::a]"}} {after 0 {set a timeout}; vwait a; expr {$::a ne "timeout" ? 1 : "0[unset ::a]"}} } } proc test-long {{reptime 1000}} { _test_run $reptime { # in-between important event by amount of idle events: {time {after idle {after 30}} 10; after 1 {set important 1}; vwait important;} cleanup {foreach i [after info] {after cancel $i}} # in-between important event (of new generation) by amount of idle events: {time {after idle {after 30}} 10; after 1 {after 0 {set important 1}}; vwait important;} cleanup {foreach i [after info] {after cancel $i}} } } proc test {{reptime 1000}} { test-exec $reptime foreach howmuch {5000 50000} { test-access [list $reptime $howmuch] } test-nrt-capability $reptime test-long $reptime puts "" foreach howmuch { 10000 20000 40000 60000 } { test-queue [list $reptime $howmuch] } puts \n**OK** } }; # end of ::tclTestPerf-Timer-Event # ------------------------------------------------------------------------ # if calling direct: if {[info exists ::argv0] && [file tail $::argv0] eq [file tail [info script]]} { array set in {-time 500} array set in $argv ::tclTestPerf-Timer-Event::test $in(-time) } |
Changes to tests/cmdMZ.test.
︙ | ︙ | |||
337 338 339 340 341 342 343 344 345 346 347 348 349 350 | test cmdMZ-5.7 {Tcl_TimeObjCmd: errors generate right trace} { list [catch {time {error foo}} msg] $msg $::errorInfo } {1 foo {foo while executing "error foo" invoked from within "time {error foo}"}} # The tests for Tcl_WhileObjCmd are in while.test # cleanup cleanupTests } namespace delete ::tcl::test::cmdMZ | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 | test cmdMZ-5.7 {Tcl_TimeObjCmd: errors generate right trace} { list [catch {time {error foo}} msg] $msg $::errorInfo } {1 foo {foo while executing "error foo" invoked from within "time {error foo}"}} test cmdMZ-6.1 {Tcl_TimeRateObjCmd: basic format of command} { list [catch {timerate} msg] $msg } {1 {wrong # args: should be "timerate ?-direct? ?-calibrate? ?-overhead double? command ?time ?max-count??"}} test cmdMZ-6.2.1 {Tcl_TimeRateObjCmd: basic format of command} { list [catch {timerate a b c d} msg] $msg } {1 {wrong # args: should be "timerate ?-direct? ?-calibrate? ?-overhead double? command ?time ?max-count??"}} test cmdMZ-6.2.2 {Tcl_TimeRateObjCmd: basic format of command} { list [catch {timerate a b c} msg] $msg } {1 {expected integer but got "b"}} test cmdMZ-6.2.3 {Tcl_TimeRateObjCmd: basic format of command} { list [catch {timerate a b} msg] $msg } {1 {expected integer but got "b"}} test cmdMZ-6.3 {Tcl_TimeRateObjCmd: basic format of command} { list [catch {timerate -overhead b {} a b} msg] $msg } {1 {expected floating-point number but got "b"}} test cmdMZ-6.4 {Tcl_TimeRateObjCmd: compile of script happens even with negative iteration counts} { list [catch {timerate "foreach a {c d e} \{" -12456} msg] $msg } {1 {missing close-brace}} test cmdMZ-6.5 {Tcl_TimeRateObjCmd: result format and one iteration} { regexp {^\d+.\d+ \ws/# 1 # \d+ #/sec \d+.\d+ nett-ms$} [timerate {} 0] } 1 test cmdMZ-6.6 {Tcl_TimeRateObjCmd: slower commands take longer, but it remains almost the same time of measument} { set m1 [timerate {after 0} 20] set m2 [timerate {after 1} 20] list \ [expr {[lindex $m1 0] < [lindex $m2 0]}] \ [expr {[lindex $m1 0] < 100}] \ [expr {[lindex $m2 0] >= 500}] \ [expr {[lindex $m1 2] > 1000}] \ [expr {[lindex $m2 2] <= 50}] \ [expr {[lindex $m1 4] > 10000}] \ [expr {[lindex $m2 4] < 10000}] \ [expr {[lindex $m1 6] > 10 && [lindex $m1 6] < 50}] \ [expr {[lindex $m2 6] > 10 && [lindex $m2 6] < 50}] } [lrepeat 9 1] test cmdMZ-6.7 {Tcl_TimeRateObjCmd: errors generate right trace} { list [catch {timerate {error foo} 1} msg] $msg $::errorInfo } {1 foo {foo while executing "error foo" invoked from within "timerate {error foo} 1"}} test cmdMZ-6.8 {Tcl_TimeRateObjCmd: allow (conditional) break from timerate} { set m1 [timerate {break}] list \ [expr {[lindex $m1 0] < 1000}] \ [expr {[lindex $m1 2] == 1}] \ [expr {[lindex $m1 4] > 1000}] \ [expr {[lindex $m1 6] < 10}] } {1 1 1 1} test cmdMZ-6.9 {Tcl_TimeRateObjCmd: max count of iterations} { set m1 [timerate {} 1000 5]; # max-count wins set m2 [timerate {after 20} 1 5]; # max-time wins list [lindex $m1 2] [lindex $m2 2] } {5 1} test cmdMZ-6.10 {Tcl_TimeRateObjCmd: huge overhead cause 0us result} { set m1 [timerate -overhead 1e6 {after 10} 100 1] list \ [expr {[lindex $m1 0] == 0.0}] \ [expr {[lindex $m1 2] == 1}] \ [expr {[lindex $m1 4] == 1000000}] \ [expr {[lindex $m1 6] <= 0.001}] } {1 1 1 1} # The tests for Tcl_WhileObjCmd are in while.test # cleanup cleanupTests } namespace delete ::tcl::test::cmdMZ |
︙ | ︙ |
Changes to tools/tcltk-man2html-utils.tcl.
︙ | ︙ | |||
145 146 147 148 149 150 151 152 153 154 155 156 157 158 | {\%} {} \ "\\\n" "\n" \ {\(+-} "±" \ {\(co} "©" \ {\(em} "—" \ {\(en} "–" \ {\(fm} "′" \ {\(mu} "×" \ {\(mi} "−" \ {\(->} "<font size=\"+1\">→</font>" \ {\fP} {\fR} \ {\.} . \ {\(bu} "•" \ ] | > | 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 | {\%} {} \ "\\\n" "\n" \ {\(+-} "±" \ {\(co} "©" \ {\(em} "—" \ {\(en} "–" \ {\(fm} "′" \ {\(mc} "µ" \ {\(mu} "×" \ {\(mi} "−" \ {\(->} "<font size=\"+1\">→</font>" \ {\fP} {\fR} \ {\.} . \ {\(bu} "•" \ ] |
︙ | ︙ |
Changes to unix/tclUnixTime.c.
︙ | ︙ | |||
55 56 57 58 59 60 61 62 63 64 65 66 67 68 | { return time(NULL); } /* *---------------------------------------------------------------------- * * TclpGetClicks -- * * This procedure returns a value that represents the highest resolution * clock available on the system. There are no garantees on what the * resolution will be. In Tcl we will call this value a "click". The * start time is also system dependant. * | > > > > > > > > > > > > > > > > > > > > > > > > > > | 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 | { return time(NULL); } /* *---------------------------------------------------------------------- * * TclpGetMicroseconds -- * * This procedure returns the number of microseconds from the epoch. * On most Unix systems the epoch is Midnight Jan 1, 1970 GMT. * * Results: * Number of microseconds from the epoch. * * Side effects: * None. * *---------------------------------------------------------------------- */ Tcl_WideInt TclpGetMicroseconds(void) { Tcl_Time time; tclGetTimeProcPtr(&time, tclTimeClientData); return ((Tcl_WideInt)time.sec)*1000000 + time.usec; } /* *---------------------------------------------------------------------- * * TclpGetClicks -- * * This procedure returns a value that represents the highest resolution * clock available on the system. There are no garantees on what the * resolution will be. In Tcl we will call this value a "click". The * start time is also system dependant. * |
︙ | ︙ | |||
187 188 189 190 191 192 193 194 195 196 197 198 199 200 | #else #error Wide high-resolution clicks not implemented on this platform #endif } return nsec; } #endif /* TCL_WIDE_CLICKS */ /* *---------------------------------------------------------------------- * * Tcl_GetTime -- * | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 | #else #error Wide high-resolution clicks not implemented on this platform #endif } return nsec; } /* *---------------------------------------------------------------------- * * TclpWideClickInMicrosec -- * * This procedure return scale to convert click values from the * TclpGetWideClicks native resolution to microsecond resolution * and back. * * Results: * 1 click in microseconds as double. * * Side effects: * None. * *---------------------------------------------------------------------- */ double TclpWideClickInMicrosec(void) { if (tclGetTimeProcPtr != NativeGetTime) { return 1.0; } else { #ifdef MAC_OSX_TCL static int initialized = 0; static double scale = 0.0; if (initialized) { return scale; } else { mach_timebase_info_data_t tb; mach_timebase_info(&tb); /* value of tb.numer / tb.denom = 1 click in nanoseconds */ scale = ((double)tb.numer) / tb.denom / 1000; initialized = 1; return scale; } #else #error Wide high-resolution clicks not implemented on this platform #endif } } #endif /* TCL_WIDE_CLICKS */ /* *---------------------------------------------------------------------- * * Tcl_GetTime -- * |
︙ | ︙ |
Changes to win/tclWinTime.c.
︙ | ︙ | |||
24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 | typedef struct { CRITICAL_SECTION cs; /* Mutex guarding this structure. */ int initialized; /* Flag == 1 if this structure is * initialized. */ int perfCounterAvailable; /* Flag == 1 if the hardware has a performance * counter. */ HANDLE calibrationThread; /* Handle to the thread that keeps the virtual * clock calibrated. */ HANDLE readyEvent; /* System event used to trigger the requesting * thread when the clock calibration procedure * is initialized for the first time. */ HANDLE exitEvent; /* Event to signal out of an exit handler to * tell the calibration loop to terminate. */ LARGE_INTEGER nominalFreq; /* Nominal frequency of the system performance * counter, that is, the value returned from * QueryPerformanceFrequency. */ | > < > > > > | | | | > > > > > > > > > > > > > | 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 | typedef struct { CRITICAL_SECTION cs; /* Mutex guarding this structure. */ int initialized; /* Flag == 1 if this structure is * initialized. */ int perfCounterAvailable; /* Flag == 1 if the hardware has a performance * counter. */ DWORD calibrationInterv; /* Calibration interval in seconds (start 1 sec) */ HANDLE calibrationThread; /* Handle to the thread that keeps the virtual * clock calibrated. */ HANDLE readyEvent; /* System event used to trigger the requesting * thread when the clock calibration procedure * is initialized for the first time. */ HANDLE exitEvent; /* Event to signal out of an exit handler to * tell the calibration loop to terminate. */ LARGE_INTEGER nominalFreq; /* Nominal frequency of the system performance * counter, that is, the value returned from * QueryPerformanceFrequency. */ /* * The following values are used for calculating virtual time. Virtual * time is always equal to: * lastFileTime + (current perf counter - lastCounter) * * 10000000 / curCounterFreq * and lastFileTime and lastCounter are updated any time that virtual time * is returned to a caller. */ ULARGE_INTEGER fileTimeLastCall; LARGE_INTEGER perfCounterLastCall; LARGE_INTEGER curCounterFreq; LARGE_INTEGER posixEpoch; /* Posix epoch expressed as 100-ns ticks since * the windows epoch. */ /* * Data used in developing the estimate of performance counter frequency */ Tcl_WideUInt fileTimeSample[SAMPLES]; /* Last 64 samples of system time. */ Tcl_WideInt perfCounterSample[SAMPLES]; /* Last 64 samples of performance counter. */ int sampleNo; /* Current sample number. */ } TimeInfo; static TimeInfo timeInfo = { { NULL, 0, 0, NULL, NULL, 0 }, 0, 0, 1, (HANDLE) NULL, (HANDLE) NULL, (HANDLE) NULL, #ifdef HAVE_CAST_TO_UNION (LARGE_INTEGER) (Tcl_WideInt) 0, (ULARGE_INTEGER) (DWORDLONG) 0, (LARGE_INTEGER) (Tcl_WideInt) 0, (LARGE_INTEGER) (Tcl_WideInt) 0, (LARGE_INTEGER) (Tcl_WideInt) 0, #else {0, 0}, {0, 0}, {0, 0}, {0, 0}, {0, 0}, #endif { 0 }, { 0 }, 0 }; /* * Scale to convert wide click values from the TclpGetWideClicks native * resolution to microsecond resolution and back. */ static struct { int initialized; /* 1 if initialized, 0 otherwise */ int perfCounter; /* 1 if performance counter usable for wide clicks */ double microsecsScale; /* Denominator scale between clock / microsecs */ } wideClick = {0, 0.0}; /* * Declarations for functions defined later in this file. */ static void StopCalibration(ClientData clientData); static DWORD WINAPI CalibrationThread(LPVOID arg); static void UpdateTimeEachSecond(void); static void ResetCounterSamples(Tcl_WideUInt fileTime, Tcl_WideInt perfCounter, Tcl_WideInt perfFreq); static Tcl_WideInt AccumulateSample(Tcl_WideInt perfCounter, Tcl_WideUInt fileTime); static void NativeScaleTime(Tcl_Time* timebuf, ClientData clientData); static Tcl_WideInt NativeGetMicroseconds(void); static void NativeGetTime(Tcl_Time* timebuf, ClientData clientData); /* * TIP #233 (Virtualized Time): Data for the time hooks, if any. */ |
︙ | ︙ | |||
126 127 128 129 130 131 132 | * *---------------------------------------------------------------------- */ Tcl_WideUInt TclpGetSeconds(void) { | > > > > > > > > | | | > | 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 | * *---------------------------------------------------------------------- */ Tcl_WideUInt TclpGetSeconds(void) { Tcl_WideInt usecSincePosixEpoch; /* Try to use high resolution timer */ if ( tclGetTimeProcPtr == NativeGetTime && (usecSincePosixEpoch = NativeGetMicroseconds()) ) { return usecSincePosixEpoch / 1000000; } else { Tcl_Time t; tclGetTimeProcPtr(&t, tclTimeClientData); /* Tcl_GetTime inlined. */ return t.sec; } } /* *---------------------------------------------------------------------- * * TclpGetClicks -- * |
︙ | ︙ | |||
154 155 156 157 158 159 160 | * *---------------------------------------------------------------------- */ Tcl_WideUInt TclpGetClicks(void) { | > > > > > > > > | | | | | < | > | > | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | > > > > > > > > > > | 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 | * *---------------------------------------------------------------------- */ Tcl_WideUInt TclpGetClicks(void) { Tcl_WideInt usecSincePosixEpoch; /* Try to use high resolution timer */ if ( tclGetTimeProcPtr == NativeGetTime && (usecSincePosixEpoch = NativeGetMicroseconds()) ) { return (Tcl_WideUInt)usecSincePosixEpoch; } else { /* * Use the Tcl_GetTime abstraction to get the time in microseconds, as * nearly as we can, and return it. */ Tcl_Time now; /* Current Tcl time */ tclGetTimeProcPtr(&now, tclTimeClientData); /* Tcl_GetTime inlined */ return (Tcl_WideUInt)(now.sec * 1000000) + now.usec; } } /* *---------------------------------------------------------------------- * * TclpGetWideClicks -- * * This procedure returns a WideInt value that represents the highest * resolution clock in microseconds available on the system. * * Results: * Number of microseconds (from some start time). * * Side effects: * This should be used for time-delta resp. for measurement purposes * only, because on some platforms can return microseconds from some * start time (not from the epoch). * *---------------------------------------------------------------------- */ Tcl_WideInt TclpGetWideClicks(void) { LARGE_INTEGER curCounter; if (!wideClick.initialized) { LARGE_INTEGER perfCounterFreq; /* * The frequency of the performance counter is fixed at system boot and * is consistent across all processors. Therefore, the frequency need * only be queried upon application initialization. */ if (QueryPerformanceFrequency(&perfCounterFreq)) { wideClick.perfCounter = 1; wideClick.microsecsScale = 1000000.0 / perfCounterFreq.QuadPart; } else { /* fallback using microseconds */ wideClick.perfCounter = 0; wideClick.microsecsScale = 1; } wideClick.initialized = 1; } if (wideClick.perfCounter) { if (QueryPerformanceCounter(&curCounter)) { return (Tcl_WideInt)curCounter.QuadPart; } /* fallback using microseconds */ wideClick.perfCounter = 0; wideClick.microsecsScale = 1; return TclpGetMicroseconds(); } else { return TclpGetMicroseconds(); } } /* *---------------------------------------------------------------------- * * TclpWideClickInMicrosec -- * * This procedure return scale to convert wide click values from the * TclpGetWideClicks native resolution to microsecond resolution * and back. * * Results: * 1 click in microseconds as double. * * Side effects: * None. * *---------------------------------------------------------------------- */ double TclpWideClickInMicrosec(void) { if (!wideClick.initialized) { (void)TclpGetWideClicks(); /* initialize */ } return wideClick.microsecsScale; } /* *---------------------------------------------------------------------- * * TclpGetMicroseconds -- * * This procedure returns a WideInt value that represents the highest * resolution clock in microseconds available on the system. * * Results: * Number of microseconds (from the epoch). * * Side effects: * None. * *---------------------------------------------------------------------- */ Tcl_WideInt TclpGetMicroseconds(void) { Tcl_WideInt usecSincePosixEpoch; /* Try to use high resolution timer */ if ( tclGetTimeProcPtr == NativeGetTime && (usecSincePosixEpoch = NativeGetMicroseconds()) ) { return usecSincePosixEpoch; } else { /* * Use the Tcl_GetTime abstraction to get the time in microseconds, as * nearly as we can, and return it. */ Tcl_Time now; tclGetTimeProcPtr(&now, tclTimeClientData); /* Tcl_GetTime inlined */ return (((Tcl_WideInt)now.sec) * 1000000) + now.usec; } } /* *---------------------------------------------------------------------- * * Tcl_GetTime -- * |
︙ | ︙ | |||
195 196 197 198 199 200 201 | *---------------------------------------------------------------------- */ void Tcl_GetTime( Tcl_Time *timePtr) /* Location to store time information. */ { | > > > > > > > > > | > | 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 | *---------------------------------------------------------------------- */ void Tcl_GetTime( Tcl_Time *timePtr) /* Location to store time information. */ { Tcl_WideInt usecSincePosixEpoch; /* Try to use high resolution timer */ if ( tclGetTimeProcPtr == NativeGetTime && (usecSincePosixEpoch = NativeGetMicroseconds()) ) { timePtr->sec = (long) (usecSincePosixEpoch / 1000000); timePtr->usec = (unsigned long) (usecSincePosixEpoch % 1000000); } else { tclGetTimeProcPtr(timePtr, tclTimeClientData); } } /* *---------------------------------------------------------------------- * * NativeScaleTime -- * |
︙ | ︙ | |||
228 229 230 231 232 233 234 | * Native scale is 1:1. Nothing is done. */ } /* *---------------------------------------------------------------------- * | | | | | > | | | > > | > > > > | | > | > > > > | 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 | * Native scale is 1:1. Nothing is done. */ } /* *---------------------------------------------------------------------- * * NativeGetMicroseconds -- * * Gets the current system time in microseconds since the beginning * of the epoch: 00:00 UCT, January 1, 1970. * * Results: * Returns the wide integer with number of microseconds from the epoch, or * 0 if high resolution timer is not available. * * Side effects: * On the first call, initializes a set of static variables to keep track * of the base value of the performance counter, the corresponding wall * clock (obtained through ftime) and the frequency of the performance * counter. Also spins a thread whose function is to wake up periodically * and monitor these values, adjusting them as necessary to correct for * drift in the performance counter's oscillator. * *---------------------------------------------------------------------- */ static inline Tcl_WideInt NativeCalc100NsTicks( ULONGLONG fileTimeLastCall, LONGLONG perfCounterLastCall, LONGLONG curCounterFreq, LONGLONG curCounter ) { return fileTimeLastCall + ((curCounter - perfCounterLastCall) * 10000000 / curCounterFreq); } static Tcl_WideInt NativeGetMicroseconds(void) { /* * Initialize static storage on the first trip through. * * Note: Outer check for 'initialized' is a performance win since it * avoids an extra mutex lock in the common case. */ if (!timeInfo.initialized) { TclpInitLock(); if (!timeInfo.initialized) { timeInfo.posixEpoch.LowPart = 0xD53E8000; timeInfo.posixEpoch.HighPart = 0x019DB1DE; timeInfo.perfCounterAvailable = QueryPerformanceFrequency(&timeInfo.nominalFreq); /* * Some hardware abstraction layers use the CPU clock in place of * the real-time clock as a performance counter reference. This * results in: |
︙ | ︙ | |||
368 369 370 371 372 373 374 | if (timeInfo.perfCounterAvailable && timeInfo.curCounterFreq.QuadPart!=0) { /* * Query the performance counter and use it to calculate the current * time. */ | | | < < < < < < < < < < | | | | | < < < | | | > | | < | > | < < > > > | | | > > | > > > > > > > > > > > > > > > > > > > > > > > > > > > > | | > > | | | > > > | 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 | if (timeInfo.perfCounterAvailable && timeInfo.curCounterFreq.QuadPart!=0) { /* * Query the performance counter and use it to calculate the current * time. */ ULONGLONG fileTimeLastCall; LONGLONG perfCounterLastCall, curCounterFreq; /* Copy with current data of calibration cycle */ LARGE_INTEGER curCounter; /* Current performance counter. */ QueryPerformanceCounter(&curCounter); /* * Hold time section locked as short as possible */ EnterCriticalSection(&timeInfo.cs); fileTimeLastCall = timeInfo.fileTimeLastCall.QuadPart; perfCounterLastCall = timeInfo.perfCounterLastCall.QuadPart; curCounterFreq = timeInfo.curCounterFreq.QuadPart; LeaveCriticalSection(&timeInfo.cs); /* * If calibration cycle occurred after we get curCounter */ if (curCounter.QuadPart <= perfCounterLastCall) { /* Calibrated file-time is saved from posix in 100-ns ticks */ return fileTimeLastCall / 10; } /* * If it appears to be more than 1.1 seconds since the last trip * through the calibration loop, the performance counter may have * jumped forward. (See MSDN Knowledge Base article Q274323 for a * description of the hardware problem that makes this test * necessary.) If the counter jumps, we don't want to use it directly. * Instead, we must return system time. Eventually, the calibration * loop should recover. */ if (curCounter.QuadPart - perfCounterLastCall < 11 * curCounterFreq * timeInfo.calibrationInterv / 10 ) { /* Calibrated file-time is saved from posix in 100-ns ticks */ return NativeCalc100NsTicks(fileTimeLastCall, perfCounterLastCall, curCounterFreq, curCounter.QuadPart) / 10; } } /* * High resolution timer is not available. */ return 0; } /* *---------------------------------------------------------------------- * * NativeGetTime -- * * TIP #233: Gets the current system time in seconds and microseconds * since the beginning of the epoch: 00:00 UCT, January 1, 1970. * * Results: * Returns the current time in timePtr. * * Side effects: * See NativeGetMicroseconds for more information. * *---------------------------------------------------------------------- */ static void NativeGetTime( Tcl_Time *timePtr, ClientData clientData) { Tcl_WideInt usecSincePosixEpoch; /* * Try to use high resolution timer. */ if ( (usecSincePosixEpoch = NativeGetMicroseconds()) ) { timePtr->sec = (long) (usecSincePosixEpoch / 1000000); timePtr->usec = (unsigned long) (usecSincePosixEpoch % 1000000); } else { /* * High resolution timer is not available. Just use ftime. */ struct _timeb t; _ftime(&t); timePtr->sec = (long)t.time; timePtr->usec = t.millitm * 1000; } } /* *---------------------------------------------------------------------- * * StopCalibration -- * * Turns off the calibration thread in preparation for exiting the * process. * * Results: * None. * * Side effects: * Sets the 'exitEvent' event in the 'timeInfo' structure to ask the * thread in question to exit, and waits for it to do so. * *---------------------------------------------------------------------- */ void TclWinResetTimerResolution(void); static void StopCalibration( ClientData unused) /* Client data is unused */ { SetEvent(timeInfo.exitEvent); |
︙ | ︙ | |||
518 519 520 521 522 523 524 525 526 527 528 529 530 531 | */ GetSystemTimeAsFileTime(&curFileTime); QueryPerformanceCounter(&timeInfo.perfCounterLastCall); QueryPerformanceFrequency(&timeInfo.curCounterFreq); timeInfo.fileTimeLastCall.LowPart = curFileTime.dwLowDateTime; timeInfo.fileTimeLastCall.HighPart = curFileTime.dwHighDateTime; ResetCounterSamples(timeInfo.fileTimeLastCall.QuadPart, timeInfo.perfCounterLastCall.QuadPart, timeInfo.curCounterFreq.QuadPart); /* * Wake up the calling thread. When it wakes up, it will release the | > > | 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 | */ GetSystemTimeAsFileTime(&curFileTime); QueryPerformanceCounter(&timeInfo.perfCounterLastCall); QueryPerformanceFrequency(&timeInfo.curCounterFreq); timeInfo.fileTimeLastCall.LowPart = curFileTime.dwLowDateTime; timeInfo.fileTimeLastCall.HighPart = curFileTime.dwHighDateTime; /* Calibrated file-time will be saved from posix in 100-ns ticks */ timeInfo.fileTimeLastCall.QuadPart -= timeInfo.posixEpoch.QuadPart; ResetCounterSamples(timeInfo.fileTimeLastCall.QuadPart, timeInfo.perfCounterLastCall.QuadPart, timeInfo.curCounterFreq.QuadPart); /* * Wake up the calling thread. When it wakes up, it will release the |
︙ | ︙ | |||
577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 | static void UpdateTimeEachSecond(void) { LARGE_INTEGER curPerfCounter; /* Current value returned from * QueryPerformanceCounter. */ FILETIME curSysTime; /* Current system time. */ LARGE_INTEGER curFileTime; /* File time at the time this callback was * scheduled. */ Tcl_WideInt estFreq; /* Estimated perf counter frequency. */ Tcl_WideInt vt0; /* Tcl time right now. */ Tcl_WideInt vt1; /* Tcl time one second from now. */ Tcl_WideInt tdiff; /* Difference between system clock and Tcl * time. */ Tcl_WideInt driftFreq; /* Frequency needed to drift virtual time into * step over 1 second. */ /* | > | < > > > > > > > > | > | > < | 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 | static void UpdateTimeEachSecond(void) { LARGE_INTEGER curPerfCounter; /* Current value returned from * QueryPerformanceCounter. */ FILETIME curSysTime; /* Current system time. */ static LARGE_INTEGER lastFileTime; /* File time of the previous calibration */ LARGE_INTEGER curFileTime; /* File time at the time this callback was * scheduled. */ Tcl_WideInt estFreq; /* Estimated perf counter frequency. */ Tcl_WideInt vt0; /* Tcl time right now. */ Tcl_WideInt vt1; /* Tcl time one second from now. */ Tcl_WideInt tdiff; /* Difference between system clock and Tcl * time. */ Tcl_WideInt driftFreq; /* Frequency needed to drift virtual time into * step over 1 second. */ /* * Sample performance counter and system time (from posix epoch). */ GetSystemTimeAsFileTime(&curSysTime); curFileTime.LowPart = curSysTime.dwLowDateTime; curFileTime.HighPart = curSysTime.dwHighDateTime; curFileTime.QuadPart -= timeInfo.posixEpoch.QuadPart; /* If calibration still not needed (check for possible time switch) */ if ( curFileTime.QuadPart > lastFileTime.QuadPart && curFileTime.QuadPart < lastFileTime.QuadPart + (timeInfo.calibrationInterv * 10000000) ) { /* again in next one second */ return; } QueryPerformanceCounter(&curPerfCounter); lastFileTime.QuadPart = curFileTime.QuadPart; /* * We devide by timeInfo.curCounterFreq.QuadPart in several places. That * value should always be positive on a correctly functioning system. But * it is good to be defensive about such matters. So if something goes * wrong and the value does goes to zero, we clear the * timeInfo.perfCounterAvailable in order to cause the calibration thread * to shut itself down, then return without additional processing. */ if (timeInfo.curCounterFreq.QuadPart == 0){ timeInfo.perfCounterAvailable = 0; return; } /* * Several things may have gone wrong here that have to be checked for. * (1) The performance counter may have jumped. |
︙ | ︙ | |||
647 648 649 650 651 652 653 | * * vt1 = 20000000 + curFileTime * * The frequency that we need to use to drift the counter back into place * is estFreq * 20000000 / (vt1 - vt0) */ | < | | < < | > | < > > | > > > > > > > > > > > > > | > > | > > > > | > > > > > > > | > > > > > > > > > > > > > > > | | > | > > | > > > > > > > > | 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 | * * vt1 = 20000000 + curFileTime * * The frequency that we need to use to drift the counter back into place * is estFreq * 20000000 / (vt1 - vt0) */ vt0 = NativeCalc100NsTicks(timeInfo.fileTimeLastCall.QuadPart, timeInfo.perfCounterLastCall.QuadPart, timeInfo.curCounterFreq.QuadPart, curPerfCounter.QuadPart); /* * If we've gotten more than a second away from system time, then drifting * the clock is going to be pretty hopeless. Just let it jump. Otherwise, * compute the drift frequency and fill in everything. */ tdiff = vt0 - curFileTime.QuadPart; if (tdiff > 10000000 || tdiff < -10000000) { /* jump to current system time, use curent estimated frequency */ vt0 = curFileTime.QuadPart; } else { /* calculate new frequency and estimate drift to the next second */ vt1 = 20000000 + curFileTime.QuadPart; driftFreq = (estFreq * 20000000 / (vt1 - vt0)); /* * Avoid too large drifts (only half of the current difference), * that allows also be more accurate (aspire to the smallest tdiff), * so then we can prolong calibration interval by tdiff < 100000 */ driftFreq = timeInfo.curCounterFreq.QuadPart + (driftFreq - timeInfo.curCounterFreq.QuadPart) / 2; /* * Average between estimated, 2 current and 5 drifted frequencies, * (do the soft drifting as possible) */ estFreq = (estFreq + 2 * timeInfo.curCounterFreq.QuadPart + 5 * driftFreq) / 8; } /* Avoid too large discrepancy from nominal frequency */ if (estFreq > 1003*timeInfo.nominalFreq.QuadPart/1000) { estFreq = 1003*timeInfo.nominalFreq.QuadPart/1000; vt0 = curFileTime.QuadPart; } else if (estFreq < 997*timeInfo.nominalFreq.QuadPart/1000) { estFreq = 997*timeInfo.nominalFreq.QuadPart/1000; vt0 = curFileTime.QuadPart; } else if (vt0 != curFileTime.QuadPart) { /* * Be sure the clock ticks never backwards (avoid it by negative drifting) * just compare native time (in 100-ns) before and hereafter using * new calibrated values) and do a small adjustment (short time freeze) */ LARGE_INTEGER newPerfCounter; Tcl_WideInt nt0, nt1; QueryPerformanceCounter(&newPerfCounter); nt0 = NativeCalc100NsTicks(timeInfo.fileTimeLastCall.QuadPart, timeInfo.perfCounterLastCall.QuadPart, timeInfo.curCounterFreq.QuadPart, newPerfCounter.QuadPart); nt1 = NativeCalc100NsTicks(vt0, curPerfCounter.QuadPart, estFreq, newPerfCounter.QuadPart); if (nt0 > nt1) { /* drifted backwards, try to compensate with new base */ /* first adjust with a micro jump (short frozen time is acceptable) */ vt0 += nt0 - nt1; /* if drift unavoidable (e. g. we had a time switch), then reset it */ vt1 = vt0 - curFileTime.QuadPart; if (vt1 > 10000000 || vt1 < -10000000) { /* larger jump resp. shift relative new file-time */ vt0 = curFileTime.QuadPart; } } } /* In lock commit new values to timeInfo (hold lock as short as possible) */ EnterCriticalSection(&timeInfo.cs); /* grow calibration interval up to 10 seconds (if still precise enough) */ if (tdiff < -100000 || tdiff > 100000) { /* too long drift - reset calibration interval to 1000 second */ timeInfo.calibrationInterv = 1; } else if (timeInfo.calibrationInterv < 10) { timeInfo.calibrationInterv++; } timeInfo.fileTimeLastCall.QuadPart = vt0; timeInfo.curCounterFreq.QuadPart = estFreq; timeInfo.perfCounterLastCall.QuadPart = curPerfCounter.QuadPart; LeaveCriticalSection(&timeInfo.cs); } /* *---------------------------------------------------------------------- |
︙ | ︙ |