[fr]2016-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 http://taipudex.com/wiki/lam.tml?p=48274%|%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 https://github.com/flightaware/Tcl-bounties%|%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 http://notab.tk/wiki%|%Index with/without key acceleration%|%

<<Category Critcl>>