- clock format 15 times faster
- clock scan 20 times faster
- Linux only
- no plausibility checks are implemented
- structs are not initialized
- although quite similar, the format syntax differs from Tcl's documentation, see the documentation of strptime, strftime library functions
- scan does not use TZ environment
- you will find the generated C-code in ~/.critcl/.. -directory.
- for errors and warnings see file with extension 'log'
- the shared library - generated whenever your file containing the ccomand changes - is loaded automatically
, click on the code block and copy-pastescan test
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 ""
}format test
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 valuesAn 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 accelerationdkf - 2016-11-28 15:57:39Be 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...
