fr2016-11-24
Q: What speedup can be expected, when specific functionality of Tcl procedure clock is implemented in C? The code below uses the package critcl to evaluate speedup of "clock format" and "clock scan" on a set of working examples.
A: with Tcl version is 8.6.6, platform Linux armv7l, critcl 3.1.16
This is experimental untested stuff.
It is a pleasure to use critcl, as it does a lot of magic in the background
To test and improve the code below I recommend you to visit page duplicator , click on the code block and copy-paste
package require critcl
critcl::config keepsrc 1
namespace eval libc {
critcl::ccommand clock_scan {cd interp objc objv} {
TCL_DECLARE_MUTEX(scanMutex);
Tcl_Obj *resObj;
char timedate[30];
#include <time.h>
//struct tm zz; //->factor 2, very slow
static struct tm zz; // factor >20 , mutex added
size_t n, len1, len2;
char *pdatetime;
char *pformat;
if (objc != 3) {
Tcl_WrongNumArgs(interp, 3, objv, NULL);
return(TCL_ERROR);
}
pdatetime=Tcl_GetStringFromObj(objv[1],&len1);
//printf("datestring is %s\n", pdatetime);
pformat=Tcl_GetStringFromObj(objv[2],&len2);
//printf("formatstring is %s\n", pformat);
Tcl_MutexLock(&scanMutex);
(void) strptime(pdatetime, pformat, &zz);
//printf ("year %d\n", zz.tm_year);
n=strftime(&timedate[0], 30, "%s", &zz);
Tcl_MutexUnlock(&scanMutex);
resObj=Tcl_NewByteArrayObj(&timedate[0], n);
Tcl_SetObjResult(interp, resObj);
return(TCL_OK);
}
}
set secs [libc::clock_scan 01.05.1990 %d.%m.%Y]
puts "for warmup: secs=$secs"
puts [clock format $secs]
set datelist { {2031-12-31 06:01:08} {1971-11-09 21:33:01} {2016-11-24 09:30:12}}
set fmt "%Y-%m-%d %H:%M:%S"
puts "format is <$fmt>"
set x [lindex $datelist 0]
puts x=$x
puts [clock scan $x -format $fmt]
puts [clock scan [lindex $datelist 0] -format $fmt]
set repeat 10
#set repeat 1
set time_proc [time {
set secs_list0 {}
foreach x $datelist {
lappend secs_list0 [clock scan $x -format $fmt]
}
} $repeat]
set time_ccommand [time {
set secs_list1 {}
foreach x $datelist {
# unfortunately braces are needed around the format string
lappend secs_list1 [libc::clock_scan [list $x] "{%Y-%m-%d %H:%M:%S}"]
}
} $repeat]
puts $secs_list0
puts $secs_list1
set slow [lindex $time_proc 0]
set fast [lindex $time_ccommand 0]
puts "speedup by factor [format %.2f [expr {$slow/$fast}]]"
# show differences
foreach x $datelist sec_proc $secs_list0 sec_ccommand $secs_list1 {
puts $x
puts "$sec_proc [clock format $sec_proc -format $fmt], $sec_ccommand [clock format $sec_ccommand -format $fmt]"
puts "difference [expr {$sec_proc - $sec_ccommand}] \[sec\]"
puts ""
}package require critcl
if {1} {
#critcl::config outdir [file join [pwd] dac]
critcl::config keepsrc 1
critcl::config force 1
if {![critcl::compiling]} {
puts stderr "critcl is not enabled"
exit 1
}
}
#set ::env(LD_LIBRARY_PATH) somepath
namespace eval libc {
variable tz [clock format 0 -format %z]
variable tz_name [clock format 0 -format %Z]
set tz_clock [clock format 0 -format %Z\ %z]
set ::env(TZ) $tz_clock
critcl::ccommand clock_format {cd interp objc objv} {
Tcl_Obj *resObj;
int seconds;
#include <time.h>
time_t local;
struct tm *cr;
struct tm mx;
char timedate[30];
size_t n;
static const char FT[]="%F %T";
char *fmt;
size_t length;
if (objc == 2) {
fmt=&FT[0];
} else {
if (objc != 3) {
Tcl_WrongNumArgs(interp, 3, objv, NULL);
return(TCL_ERROR);
}
fmt=Tcl_GetStringFromObj(objv[2], &length);
}
Tcl_GetIntFromObj(interp, objv[1], &seconds);
local=(time_t) seconds;
cr=TclpGetDate(&local,0);
if (0) {
printf("year: %02d-%02d-%02d\n", 1900 + cr->tm_year, 1+cr->tm_mon, cr->tm_mday);
printf("day of year %03d\n", cr->tm_yday);
printf("time %02d:%02d:%02d\n", cr->tm_hour, cr->tm_min, cr->tm_sec);
}
n=strftime(&timedate[0], 30, fmt, cr);
resObj=Tcl_NewByteArrayObj(&timedate[0], n);
Tcl_SetObjResult(interp, resObj);
return(TCL_OK);
}
}
proc test {} {
#warmup to load extension
set wu [lindex [time {set x [libc::clock_format 3600]} 1] 0]
puts $x
puts "warmup $wu"
set now [clock seconds]
set repeats 50
#set a [time {set p [clock format $now -format %Y-%m-%d\ %H:%M.%S]} $repeats]
set a [time {set a0 [clock format $now]} $repeats]
# use default internal format
#set b [time {set b0 [libc::clock_format $now]} $repeats]
# use explicit format as second parameter
set b [time {set b0 [libc::clock_format $now "%Y-%m-%d %T"]} $repeats]
puts "proc: $a0 <-> ccommand $b0"
set slow [lindex $a 0]
set fast [lindex $b 0]
puts "proc: $a, $slow"
puts "ccommand : $b, $fast"
puts [format "speedup factor %.2f" [expr $slow/$fast]]
}
testA personal note about date/time conversion:
It is far more convenient to deal with integer values as provided from Tcl's "clock seconds" command opposed to datetime fields of SQL databases.You need not use the vendor's date functions.
When it is required to display some selected values in a gui, the performance of "clock format" should not be an issue.
To display date/time values provided by a webserver, the conversion may be delegated to the browser's javascript engine, when the information is sent as seconds since epoch.
IMHO to provide faster date formatting and scanning as requested on bounty program , this extension or something similar needs not be integrated in the Tcl core. It breaks the documentation and OS independence.
Special case: "clock format" some sorted time values
An idea I started to implement but never finished:
On the script level speed improvements can be achieved by comparison with the previous value. It can be checked by a precalculated integer range check, if the current value has the same date, reuse the stored date and recalculate time only.
Finally you may want to relax and explore Index with/without key acceleration
dkf - 2016-11-28 15:57:39
Be aware that we moved away from using strftime() and strptime() in Tcl 8.5 precisely because they were inclined to have different bugs on different platforms. Some libcs have really awful implementations of those functions. Doing it ourselves means that at least we have the same bugs everywhere, and perhaps might even fix them sometime? It's a hope...