speed up clock format and clock scan

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

  • clock format 15 times faster
  • clock scan 20 times faster

This is experimental untested stuff.

  • 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

It is a pleasure to use critcl, as it does a lot of magic in the background

  • 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

To test and improve the code below I recommend you to visit page duplicator , click on the code block and copy-paste

scan 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]]
}
test

A 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...