Critcl Code

Source:

  package require critcl
  namespace import critcl::*
 
  cproc noop {} void {}
 
  cproc add {int x int y} int {
    return x + y;
  }
 
  cproc cube {int x} int {
    return x * x * x;
  }
 
  puts "add 123 456 : [add 123 456]"

  catch {add 1} err;      puts "add 1       : $err"
  catch {add 1 2 3} err;  puts "add 1 2 3   : $err"
  catch {add 0 zero} err; puts "add 0 zero  : $err"
 
  proc sum {a b} { return [expr {$a+$b}] }
  proc pow3 {a} { return [expr {$a*$a*$a}] }
 
  proc ntimes {n cmd t} {
    set on $n
    set r {}
    while {[incr n -1] >= 0} { lappend r $cmd }
    set v [uplevel 1 [list time [join $r {; }] $t]]
    return [lreplace $v 0 0 [expr {[lindex $v 0]/(1.0*$on)}]]
  }
 
  puts ""
  puts "Tcl noop:  [ntimes 100 {} 1000]"
  puts "  C noop:  [ntimes 100 {noop} 1000]"
 
  set a 1
  set b 2
  puts ""
  puts "Tcl expr:  [ntimes 100 {expr {1+2}} 1000]"
  puts "Tcl vars:  [ntimes 100 {expr {$a+$b}} 1000]"
  puts "Tcl  sum:  [ntimes 100 {sum 1 2} 1000]"
  puts "  C  add:  [ntimes 100 {add 1 2} 1000]"
  puts "  C vars:  [ntimes 100 {add $a $b} 1000]"
  puts ""
  puts "Tcl expr:  [ntimes 100 {expr {2*2*2}} 1000]"
  puts "Tcl vars:  [ntimes 100 {expr {$b*$b*$b}} 1000]"
  puts "Tcl pow3:  [ntimes 100 {pow3 2} 1000]"
  puts "  C cube:  [ntimes 100 {cube 2} 1000]"
  puts "  C vars:  [ntimes 100 {cube $b} 1000]"

Output (SuSE 7.1 Linux, PIII/650):

  add 123 456 : 579
  add 1       : wrong # args: should be "add x y"
  add 1 2 3   : wrong # args: should be "add x y"
  add 0 zero  : expected integer but got "zero"

  Tcl noop:  0.01 microseconds per iteration
    C noop:  0.67 microseconds per iteration

  Tcl expr:  0.36 microseconds per iteration
  Tcl vars:  1.92 microseconds per iteration
  Tcl  sum:  2.51 microseconds per iteration
    C  add:  1.06 microseconds per iteration
    C vars:  2.66 microseconds per iteration

  Tcl expr:  0.7 microseconds per iteration
  Tcl vars:  2.83 microseconds per iteration
  Tcl pow3:  2.78 microseconds per iteration
    C cube:  0.96 microseconds per iteration
    C vars:  1.81 microseconds per iteration

JH:

In order to have this work with ActiveTcl (Tcl with tcllib), I had to change the first few lines of the critcl.tcl code to:

 catch {package require md5}
 if {[llength [info commands ::md5::md5]]} {
     interp alias {} ::md5 {} ::md5::md5
 }

and it provided some very nice performance numbers on just the md5 stuff:

 (jeffh) 60 % time {md5 hello} 1000
 801 microseconds per iteration
 (jeffh) 61 % time {md5c hello} 1000
 4 microseconds per iteration

The catch... would break if there was already an "md5" command, wouldn't it? In fact, while I think I understand why that code is written in the way it is, is there a way to do things simpler? - JCW

Maybe the following is a solution:

  if {[catch md5]} { catch {package require md5} }
  if {[catch md5]} { interp alias {} ::md5 {} ::md5::md5 }

It's still extremely messy and weak (brittle) IMO, and illustrates how we seem to be making it harder and harder to write readable, clean, solid code... :-(

Works on Win98 with mingw. IDG