* http://zarutian.internet.net/ is my web current page
   * [Flow Based Programming]
   * [SEXP]
   * [Zarutian's Thingy Package]
   * [Zarutian's SEXP Package]
   * [serializable Safe Slave Interp]
   * http://erights.org/  everything about object-capabilities
   * http://www.erights.org/elib/distrib/pipeline.html  Promise Pipelining
   * http://www.fpx.de/Combat/  CORBA implemented in Tcl
   * [Transputer]
   * http://www.ibm.com/developerworks/linux/library/l-clear-code/?ca=dgr-FClnxw01linuxcodetips
   * [Capicol]
   * http://corewar.co.uk/
   * [procedure decorators]

How the hell do you pronounce my nick? In four syllabels: Za-ru-ti-an

Stuff I am thinking about implementing/doing (DONT PUT PRESURE ON ME PLEASE!):
   * write a simple Tcl interpreter purely in Lua.
   * publishing my bindiff procedures and binpatch procedure. (that would be awesome! Please do)
That might take a while because I have to dig the up from my old CRT iMac. (29.mars 2006) Which I still havent got around to do (14. oktober 2006)

   * write multiplexing and demultiplexing stuff to learn some tricks with [rechan]
   * - One is to have dual sided memchan (aka one handle to write to and another one to read from)
   * investigate what whould be the best way to write a bytecode compiler for Tcl ''in'' pure-Tcl (related to [Scripted Compiler])
   * - Arent Syntax Dictionary Encoded code better cross platform than bytecodes?
   * change the unknown procedure to lookup a procedure in the parent namespaces up to the global namespace instead in just current and global.
   * wikit additions:
   * - post to the Tcler's chatroom when a page has been edited. (Some sort of flood preventation would be a good idea)
   * - add reversion deltas. (Current version and back-deltas to earlier versions are saved in two files)
   * ? autosave like in Gmail compose
   * get the packages I write in some sort of order (hint for no nameconflict: prepend zarutian/ before the packages name)

-----------------
my version of [apply].

 package ifneeded zarutian/apply 1.0 {
   # inlined package
   package require Tcl 8.5
   proc apply {fun args} {
     # no variable are used in this procedure
     # due to possibility of var conflict
     if {[llength [lindex [info level 0] 1] != 2} {
       error "cant interpret \"[lindex [info level 0] 1]\" as an anonymous function"
     }
     bind_vars [lindex [info level 0] 1 0] [lrange [info level 0] 2 end]
     eval [lindex [info level 0] 1 1]
   }
   proc bind_vars {argl args} {
     set counter 0
     foreach item $argl {
       if {[llength $item] == 2} {
         set var [lindex $item 0]
         if {[llength $args] <= $counter} {
           set val [lindex $item 1]
         } else {
           set val [lindex $args $counter]
         }
       } else {
         set var $item
         set val [lindex $args $counter]
       }
       uplevel 1 [list set $var $val]
       incr counter
     }
   }
   package provide zarutian/apply 1.0
 }
-----------------
Improved version by kruzalex, should work with more variables and of course for tcl 8.4:

   proc apply {fun args} {
     if {[llength [lindex [info level 0] 1]] != 2} {
       error "cant interpret \"[lindex [info level 0] 1]\" as an anonymous function"
     }
     bind_vars [lindex [info level 0] 1 0] [lrange [info level 0] 2 end]
     eval [lindex [info level 0] 1 1]
   }
   proc bind_vars {argl args} {
     set counter 0
     foreach item $argl {
           set var $item
           set val [eval lindex $args $counter]      
       uplevel 1 [list set $var $val]
       incr counter
     }
   }


 apply {x {expr $x+$x}} 5
 apply {{x y} {expr hypot($x,$y)}} 1 2
------------------  



extends [RS]'es thingy[http://wiki.tcl.tk/1225] to work as a minmal but handy Object-Orientation system

 package ifneeded zarutian/thingy 1.3 {
   # inlined package
   package require Tcl 8.5
   proc thingy {name} {
     if {[lsearch -exact [info commands] $name] != -1} {
       error "a command/thingy with $name already exists!"
     }
     namespace eval ::things::[set name] {}
     proc ::things::[set name]::self {} "return [namespace current]::$name"
     proc ::things::[set name]::initialize {args} {}
     proc ::things::[set name]::destroy {args} {
       namespace delete [namespace current]
     }
     proc ::things::[set name]::dispatch {args} {
       return [uplevel 1 $args]
     }
     proc $name args "namespace eval ::things::[set name] dispatch \$args"
   }
   thingy maker
   maker variable templates {}
   maker variable instanced {}
   maker proc template {name body} {
     variable templates
     dict set templates $name $body
     return
   }
   maker proc new {name {args {}}} {
     variable templates
     if {![dict exists $templates $name]} {
       error "maker: no such template $name"
     }
     variable instanced
     if {![dict exists $instanced $name]} {
       dict set instanced $name 0
     }
     dict incr instanced $name
     set i [set name][dict get $instanced $name]
     thingy $i
     $i eval [dict get $templates $name]
     $i initialize {*}[set args]
     return $i
   }
   package provide zarutian/thingy 1.3
 }
-----------------
Serializes an namespace (all the variables, all the procedures, all the traces on variables and procedures and all the children of the namespace).
can be used to snapshot things (all of them or just few) from package zarutian/thingy above.

 package ifneeded zarutian/serialize_namespace 1.0 {
  # inlined package
  package require Tcl 8.0
  proc serialize_namespace {namespace} {
    set memento "namespace eval [list $namespace]] \{\n"
    # variables
    foreach var [info vars [set namespace]::*] {
      append memento "  "
      append memento "variable [list [namespace tail $var]]"
      if {[info exists $var]} {
        # how to get an variable's value without tripping any read traces is tricky
        if {[array exists $var]} {
          append memento "\narray set [list [namespace tail $var]] [list [array get $var]]\n"
        } else {
          append memento " [list [set $var]]\n"
        }
      } else {
        append memento "\n"
      }
      # traces on variables
      foreach trace [trace info variable $var] {
        append memento "  "
        append memento "trace add variable [namespace tail $var]"
        append memento " [list [lindex $trace 0]] [list [lindex $trace 1]]\n"
      }
    }
    # procedures
    foreach proc [info procs [set namespace]::*] {
      append memento "  "
      append memento "proc [list [namespace tail $proc]] "
      set args {}
      foreach arg [info args $proc] {
        if {[info default $proc $arg default]} {
          lappend args [list $arg $default]
        } else {
          lappend args $arg
        }
      }
      append memento "[list $args] [list [info body $proc]]\n"
      # traces on execution of procedures
      foreach trace [trace info execution $proc] {
        append memento "  "
        append memento "trace add execution [namespace tail $proc]"
        append memento " [list [lindex $trace 0]] [list [lindex $trace 1]]\n"
      }
      # traces on commands
      foreach trace [trace info command $proc] {
        append memento "  "
        append memento "trace add command [namespace tail $proc]"
        append memento " [list [lindex $trace 0]] [list [lindex $trace 1]]\n"      
      }
    }
    append memento "\}\n"
    # children namespaces
    foreach child [namespace children $namespace] {
      append memento [raw_serialize $child]
    }
    return $memento
  }
  package provide zarutian/serialize_namespace 1.0
 }
-----------------
some common list manipulation procedures.

 package ifneeded zarutian/list_extension 1.0 {
  # inlined package
  package require Tcl 8.0
  proc lexclude {list excluded} {
    # isnt this just an [lfilter]?
    set result [list]
    foreach item $list {
      if {[lsearch -exact $excluded $item] == -1} {
        lappend result $item
      }
    }
    return $result
  }
  proc lcommon {a b} {
    # isnt this just an [lfilter]?
    set result [list]
    foreach item $a {
      if {[lsearch -exact $b $item] != -1} {
        lappend result $item
      }
    }
    return $result
  }
  proc lrotate {list} { return [join [list [lrange $list 1 end] [lindex $list 0]]] }
  package provide zarutian/list_extension 1.0
 }
-----------------
compares two trees of file folders for commonality and diffrences.

 package ifneeded zarutian/dir_tree_compariator 1.0 {
  # inlined package
  package require Tcl 8.0
  package require zarutian/list_extension 1.0
  namespace eval ::zarutian::dir_tree_compariator {}
  proc ::zarutian::dir_tree_compariator::dir_diff {old new} {
    set result [list]
    set old_items [glob -nocomplain -tails -directory $old -- *]
    set new_items [glob -nocomplain -tails -directory $new -- *]
    set added   [lexclude $new_items $old_items]
    set common  [lcommon  $old_items $new_items]
    set removed [lexclude $old_items $new_items]

    foreach item $added {
      lappend result [list new [file join $new $item]]
    }
    foreach item $common {
      set old_item [file join $old $item]
      set new_item [file join $new $item]
      if {[file isfile $old_item] && [file isfile $new_item]} {
        if {[same_file? $old_item $new_item]} {
          # lappend result [list same_file $old_item $new_item]
        } else {
          lappend result [list diff_file $old_item $new_item]
        }
      } else {

      }
      if {[file isdirectory $old_item] && [file isdirectory $new_item]} {
        foreach item [dir_diff $old_item $new_item] {
          lappend result $item
        }
      } else {

      }  
    }
    foreach item $removed {
      lappend result [list del [file join $new $item]]
    }
    # todo: check if an pair of {new <path>} {del <path>} is just an move
    #       by checking if they mean the same file (same contents)
    return $result
  }
  proc ::zarutian::dir_tree_compariator::same_file? {file1 file2} {
    # returns yes or no
    if {[file size $file1] != [file size $file2]} { return no }
    set fd1 [open $file1 r]
    set fd2 [open $file2 r]
    fconfigure $fd1 -encoding binary -translation binary
    fconfigure $fd2 -encoding binary -translation binary
    while {![eof $fd1] && ![eof $fd2]} {
      if {![string equal [read $fd1 1] [read $fd2 1]]} {
        close $fd1
        close $fd2
        return no
      }
    }
    close $fd1
    close $fd2
    return yes
  }
  package provide zarutian/dir_tree_compariator 1.0
 }
-----------------

=== scrachpad 3 ===
  package require Tcl 8.5

  proc advance {state} {
    if {![dict exists $state pointer]}     { dict set state pointer 0 }
    if {![dict exists $state results]}     { dict set state results {} }
    if {![dict exists $state returnstack]} { dict set state returnstack {} }
    if {![dict exists $state variables]}   { dict set state variables {} }
    if {![dict exists $state commands]}    { error "commands missing" }
    if {![dict exists $state code]}        { error "code missing" }

    if {[dict get $state pointer] < [llength [dict get $state code]]} {
      set state [lindex [exec_prim return {} $state] end]
    }

    set cmd&args [lindex [dict get $state code] [dict get $state pointer]]
    set cmd&args [string map [dict get $state results] [set cmd&args]]
    set cmd      [lindex [set cmd&args] 0]
    set args     [lrange [set cmd&args] 1 end]
    if {[dict exists $state commands $cmd]} {
      if {![dict exists $state commands $cmd type]} { error "type of command $cmd missing" }
      if {![dict exists $state commands $cmd contents]} { error "contents of command $cmd missing" }
      if {[string equal "combo" [dict get $state commands $cmd type]]} {
        # push current continuation onto returnstack
        set t1 [dict new]
        dict set t1 code [dict get $state code]
        dict set t1 pointer [expr [dict get $state pointer] +1]
        dict set t1 results [dict get $state results]
        dict set t1 variables [dict get $state variables]
        dict lappend state returnstack  $t1

        # stilla state fyrir að keyra innihald procs
        dict set state code [dict get $state commands $cmd contents]
        dict set state pointer -1; # þarf að vera -1 út af autoincr
        dict set state variables {}
        dict set state results {}    
      } elseif {[string equal "prim" [dict get $state commands $cmd type]]} {
        set t1 [exec_prim [dict get $state commands $cmd contents] $args $state]
        set state [lindex $t1 end]
        dict set state results \[[dict get $state pointer]\] [lindex $t1 0]
      } else {
        error "unknown command type [dict get $state commands $cmd type]"
      }
    } else {
      # unknown command handling
      if {![dict exists $state commands unknown]} {
        set state [lindex [exec_prim error "unknown command $cmd" $state] end]
      } else {
        # invoke the unknown command
        set t1 [exec_prim eval [list unknown [set cmd&args]] $state]
        set state [lindex $t1 end]
        dict set state results \[[dict get $state pointer]\] [lindex $t1 0]
      }
    }
    dict incr state pointer; # autoincr
    return $state
  }
  proc exec_prim {cmd argus state} {
    set result {}
    if {[string equal $cmd "return"]} {
      # return from a proc command
      if {[llength $argus] == 1} {
        set t1 [lindex $argus 0]
      } else {
        set t1 [get_last_result [dict get $state results]]
      }
      dict set state code      [dict get [lindex [dict get $state returnstack] end] code]
      dict set state pointer   [dict get [lindex [dict get $state returnstack] end] pointer]
      dict set state results   [dict get [lindex [dict get $state returnstack] end] results]
      dict set state variables [dict get [lindex [dict get $state returnstack] end] variables]
      dict set state returnstack [lrange [dict get $state returnstack] 0 end-1]
      set t2 [expr [dict get $state pointer] -1]
      dict set state results \[[set t2]\] [set t1]
    } elseif {[string equal $cmd "<"]} {
      # comparison
      if {[llength $argus] != 2} {
        set state [lindex [exec_prim error "wrong # of args" $state] end]
      }
      if {![string is digit [lindex $argus 0]] || ![string is digit [lindex $argus 1]]} {
        set state [lindex [exec_prim error "arguments must be numeric" $state] end]
      }
      # not done; was here when stopped
    } elseif {[string equal $cmd "eval"]} {
    } elseif {[string equal $cmd "error"]} {
    } elseif {[string equal $cmd "+"]} {
    } elseif {[string equal $cmd "-"]} {
    } elseif {[string equal $cmd "/"]} {
    } elseif {[string equal $cmd "%"]} {
    } elseif {[string equal $cmd "&"]} {
    } elseif {[string equal $cmd "set"]} {
      if {([llength $argus] < 1) || (2  < [llength $argus])} {
        set state [lindex [exec_prim error "wrong # of args" $state] end]
      } else {
        if {[llength $argus] == 2} {
          dict set state variables [lindex $argus 0] [lindex $argus 1]
          set result [lindex $argus 1]
        } else {
          set result [dict get $state variables [lindex $argus 0]]
        }
      }
    } elseif {[string equal $cmd "get"]} {
      if {[llength $argus] != 1} {
        set state [lindex [exec_prim error "wrong # of args" $state] end]
      } else {
      }
    } elseif {[string equal $cmd "args"]} {
    } else {
      error "unknown prim $cmd"
    }
    return [list $result $state]
  }
  proc get_last_result {results} {
    return [dict get $results [lindex [lsort [dict keys $results]] end]]
  }
  proc translate {script} {
    set code {}
    return $code
  }

=== scrachpad 2 ===
  package require Tcl 8.5

  # definitions
  #   <name>
  #     type  primitive / script
  #     data  identifier / code
  # frame
  #   type  subroutine / catcher / loop / {}
  #   code
  #   code_pointer
  #   invocation
  #   result
  # returnstack
  #   <frame>
 
  # package require zarutian/generic 1.0
  proc @ {name} {
    upvar [set name] [set name]
    return [set [set name]]
  }
  proc repeat {body keyword condition} {
    if {[string equal $keyword "until"]} {
      set condition "!([set condition])"
    } elseif {[string equal $keyword "while"]} {
      # left empty on purpose
    } else {
      error "expected: until or while as a keyword between the body and the condition"
    }
    uplevel 1 $body
    while {[uplevel 1 [list expr $condition]]} {
      uplevel 1 $body
    }
  }

  # package require zarutian/thingy 1.3
  proc thingy {name} {
    set id thing[incr ::things::counter]
    namespace eval ::things::[@ id] {
      proc dispatch args { uplevel 1 [@ args]] }
      proc destroy {} {
        namespace delete [namespace current]
      }
      proc serialize {} { error "implementation not yet gotten of usb-stick" }
    }
    proc [@ name] args "namespace eval ::things::[@ id] dispatch \[@ args\]"
    [@ name] variable self [@ name]
  }

  thingy picol_interp
  picol_interp proc init {} {
    variable frame
    variable definitions {
      "set"    { type primitive data set }
      "unset"  { type primitive data unset }
      "string" { type primitive data string }
      "dict"   { type primitive data dict }
      # and more to come
    }
    variable returnstack {}
    dict set frame code {}
    dict set frame code_pointer 0
    dict set frame results {}
    dict set frame type {}
    dict set frame invocation {}
    variable run_quota 1024
    variable storage_quota [expr 128 * 1024]
    variable actor
    dict set actor addressbook {}
    dict set actor addressbook_counter 0
    dict set actor address {}

  }
  picol_interp init
  picol_interp proc run {} {
    # part of interface
    variable run_quota
    variable running [@ run_quota]) 
    variable frame
    while {0 < [@ running]} {
      dict set frame results [dict get [@ frame] code_pointer] \
        [execute \
          [spliceIn [lindex [dict get [@ frame] code] [dict get [@ frame] code_pointer]] [dict get [@ frame] results]]]
      if {[llength [dict get [@ frame] code]] <= [dict get [@ frame] code_pointer]} { popReturnstack }
      incr code_pointer +1
      incr running -1
    }
  }
  picol_interp proc popReturnstack {} {
    variable returnstack
    if {[llength [@ returnstack]] == 0} {
      # nothing more to run
      variable running 0
      return
    }
    variable frame
    if {[llength [dict get [@ frame] code]] < [dict get [@ frame] code_pointer]} {
      dict set frame code_pointer [llength [dict get [@ frame] code]]
    }
    set value [dict [dict get [@ frame] results] [expr [dict get [@ frame] code_pointer] - 1]]
    set frame [lindex [@ returnstack] end]
    set returnstack [lrange [@ returnstack] 0 end-1]
    # code_pointer points to this command
    dict set frame results [expr [dict get [@ frame] code_pointer] - 1] [@ value]
    return
  }
  picol_interp proc pushReturnstack {{extra {}} {
    variable returnstack
    variable frame
    lappend returnstack [dict merge [@ frame] [@ extra]]
    return
  }
  picol_interp proc newFrame {overrides} {
    pushReturnstack
    variable frame
    dict set frame invocation [@ call]
    dict set frame code_pointer -1; # because of the auto increasementer in method run
    dict set frame results {}
    dict set frame code {}
    set frame [dict merge [@ frame] [@ overrides]]
  }
  picol_interp proc execute {call} {
    variable definitions
    set command [lindex [@ call] 0]
    if {[dict exists [@ definitions] [@ command]]} {
      set def [dict get [@ definitions] [@ command]]
      if {![dict exists [@ def] type]}     { bgerror "type of definition missing"; return }
      if {[string equal "script" [dict get [@ def] type]]} {
        if {![dict exists [@ def] data]} { bgerror "1 data missing from an definition"; return }
        if {![dict exists [@ def] execlist]} {
          dict set definitions [@ command] execlist [translate [dict get [@ def] data]]
        }
        newFrame [list code [dict get [@ definitions] [@ command] execlist] type subroutine]
      } elseif {[string equal "primitive" [dict get [@ def] type]]} {
        if {![dict exists [@ def] data]} { bgerror "2 data missing from an definition"; return }
        switch -exact -- [dict get [@ def] data] {
          "" {}
          "eval" {
            if {[llength [@ call]] != 2} {
              execute [list error "wrong number of arguments"]
              return
            }
            set script [lindex [@ call] 1]
            newFrame [list code [translate [@ script]]]
            return
          }
          "set" {
            if {[llength [@ call]] != 3} {
              execute [list error "wrong number of arguments"]
              return
            }
            set varname [lindex [@ call] 1]
            set value   [lindex [@ call] 2]
            variable frame
            dict set frame variables [@ varname] [@ value]
          }
          "unset" {
            if {[llength [@ call]] != 2} {
              execute [list error "wrong number of arguments"]
              return
            }
            if {[dict exists [@ frame] variables [@ varname]]} {
              dict unset [@ frame] variables [@ varname]
            } else {
              execute [list error "no such variable [@ varname]"]
              return
            }
          }
          "get" {
            if {[llength [@ call]] != 2} {
              execute [list error "wrong number of arguments"]
              return
            }
            variable frame
            if {[dict exists [@ frame] variables [@ varname]]} {
              return [dict get [@ frame] variables [@ varname]]
            } else {
              execute [list error "no such variable [@ varname]"]
              return
            }
          }
          "string" {
            if {[llength [@ call] < 2} {
              execute [list error "no subcommand given"]
              return
            }
            switch -glob -- [lindex [@ call] 1] {
              "bytelength" {
                if  {[llength [@ call]] != 3} {
                   execute [list error "wrong number of args. Should be: string bytelength <string>"]
                   return
                }
                return [string bytelength [lindex [@ call] 2]]
              }
              "compare" {
                if {([llength [@ call]] < 4) || (7 < [llength [@ call]])} {
                  execute [list error "wrong number of args. Should be: string compare ?-nocase? ?-length <int>? <string1> <string2>"]
                  return
                }
                return [[join [list {string compare} [lrange [@ call] 2 end]]]]
              }
              "equal" {
                if {([llength [@ call]] < 4) || (7 < [llength [@ call]])} {
                  execute [list error "wrong number of args. Should be: string equal ?-nocase? ?-length <int>? <string1> <string2>"]
                  return
                }
                return [[join [list {string equal} [lrange [@ call] 2 end]]]]
              }
              "first" {
                if {([llength [@ call]] < 4) || (5 < [llength [@ call]])} {
                  execute [list error "wrong number of args. Should be: string first <sub string> <string> ?<startIndex>?"]
                  return
                }
                set startIndex 0
                if {[llength [@ call] == 5} { set startIndex [lindex [@ call] end] }
                return [string first [lindex [@ call] 2] [lindex [@ call] 3] [@ startIndex]]
              }
              "index" {
                if {[llength [@ call]] != 4} {
                  execute [list error "wrong number of args. Should be: string index <string> <charIndex>"]
                  return
                }
                return [string index [lindex [@ call] 2] [lindex [@ call] 3]
              }; #ash
            }
          }
          "string is" {}
          "string last" {}
          "string length" {}
          "string map" {}
          "string match" {}
          "string range" {}
          "string repeat" {}
          "string replace" {}
          "string tolower" {}
          "string toupper" {}
          "string totitle" {}
          "string trim" {}
          "string trimleft" {}
          "string trimright" {}
          "string wordend" {}
          "string wordstart" {}
          "dict" {}
          "dict append" {}
          "dict create" {}
          "dict exists" {}
          "dict filter" {}
          "dict for" {}
          "dict get" {}
          "dict incr" {}
          "dict info" {}
          "dict keys" {}
          "dict lappend" {}
          "dict merge" {}
          "dict remove" {}
          "dict replace" {}
          "dict set" {}
          "dict size" {}
          "dict unset" {}
          "dict update" {}
          "dict values" {}
          "dict with" {}
          "if" {
            if {([llength [@ call]] != 3) && ([llength [@ call]] != 5)} {
              execute [list error "if: wrong number of arguments should be: if <predicate> <true body> \[else <false body>\]"]
              return
            }
            set predicate  [lindex [@ call] 1]
            set true-body  [lindex [@ call] 2]
            set false-body {}
            if {([llength [@call]] == 5) && [string equal "else" [lindex [@ call] 3]]} {
              set false-body [lindex [@ call] 4]
            }
            # reverse lookup to find the primitives required
            foreach def [dict keys [@ definitions]] {
              if {[string equal [dict get [@ definitions] [@ def] type] "primitive"]} {
                if {[string equal [dict get [@ definitions] [@ def] data] "__branch"]} { set __branch [@ def] }
                if {[string equal [dict get [@ definitions] [@ def] data] "__jump"]} { set __jump [@ def] }
              }
            }
            if {![info exists __branch]} { bgerror "__branch primitive not found!"; return }
            if {![info exists __jump]} { bgerror "__jump primitive not found!"; return }

                set daCode [translate [@ predicate]]
                set slot1 [llength [@ daCode]]
            lappend daCode "<<<__branch primitive comes here>>>"
            foreach item [translate [@ true-body] [llength [@ daCode]]] { lappend daCode [@ item] }
            if {![string equal [@ false-body] {}]} {
                  set slot2 [llength [@ daCode]]
              lappend daCode "<<<__jump primitive comes here>>>"
            }
            lset daCode [@ slot1] [list [@ __branch] [expr [@ slot1] -1] [llength [@ daCode]]]
            if {![string equal [@ false-body] {}]} {
              foreach item [translate [@ false-body] [llength [@ daCode]]] { lappend daCode [@ item] }
              lset daCode [@ slot2] [list [@ __jump] [llength [@ daCode]]]
            }
            newFrame [list code [@ daCode] type if]
            return
          }
          "while" {
            if {[llength [@ call]] != 3} {
              execute [list error "while: wrong number of arguments should be: while <predicate> <loop body>"]
              return
            }
            set predicate [lindex [@ call] 1]
            set loop-body [lindex [@ call] 2]
            # reverse lookup to find the primitives required
            foreach def [dict keys [@ definitions]] {
              if {[string equal [dict get [@ definitions] [@ def] type] "primitive"]} {
                if {[string equal [dict get [@ definitions] [@ def] identifier] "__branch"]} { set __branch [@ def] }
                if {[string equal [dict get [@ definitions] [@ def] identifier] "__jump"]} { set __jump [@ def] }
              }
            }
            if {![info exists __branch]} { bgerror "__branch primitive not found!"; return }
            if {![info exists __jump]} { bgerror "__jump primitive not found!"; return }
            set slot1 0
            set daCode "<<<__jump primitive goes here>>>"
            set dest1 [llength [@ daCode]]
            foreach item [translate [@ loop-body] [llength [@ daCode]]] { lappend daCode [@ item] }
            lset daCode [@ slot1] [list [@ __jump] [llength [@ daCode]]]
            foreach item [translate [@ predicate] [llength [@ daCode]]] { lappend daCode [@ item] }
            set slot2 [llength [@ daCode]]
            lappend daCode "<<<__branch primitive goes here>>>"
            lappend daCode [list [@ __jump] [@ dest1]]
            lset daCode [@ slot2] [list [@ __branch] [expr [@ slot2] -1] [llength [@ daCode]]]
            variable invocation
            newFrame [list code [@ daCode] type loop continue [@ dest1] break [llength [@ daCode]]]]
            return
          }
          "break" {
            variable returnstack
            variable frame
            set aFrame [@ frame]
            set counter 0
            while {[@ counter] < [llength [@ returnstack]]} {
              if {[string equal [dict get [@ aFrame] type] "loop"]} {
                if {![dict exists [@ aFrame] break]} { bgerror "break destination no found" }
                set frame [dict merge [@ aFrame] [list code_pointer [dict get [@ aFrame] break]]]
                return
              }
              if {[string equal [dict get [@ aFrame] type] "catcher"] || \
                  [string equal [dict get [@ aFrame] type] "subroutine"]} {
                execute [list error "break called outside an loop!"]
                return
              }
              set aFrame [lindex [@ returnstack] end-[@ counter]]
              incr counter
            }
          }
          "continue" {
            variable returnstack
            variable frame
            set aFrame [@ frame]
            set counter 0
            while {[@ counter] < [llength [@ returnstack]]} {
              if {[string equal [dict get [@ aFrame] type] "loop"]} {
                if {![dict exists [@ aFrame] continue]} { bgerror "continue destination no found" }
                set frame [dict merge [@ aFrame] [list code_pointer [dict get [@ aFrame] continue]]]
                return
              }
              if {[string equal [dict get [@ aFrame] type] "catcher"] || \
                  [string equal [dict get [@ aFrame] type] "subroutine"]} {
                execute [list error "continue called outside an loop!"]
                return
              }
              set aFrame [lindex [@ returnstack] end-[@ counter]]
              incr counter
            }
          }
          "rename" {
            if {[llength [@ call]] != 3} {
              execute [list error "wrong number of arguments should be: [@ command] <old name> <new name>"]
              return
            }
            set old_name [lindex [@ call] 1]
            set new_name [lindex [@ call] 2]
            variable definitions
            if {[string equal [@ new_name] ""]} {
              dict unset definitions [@ old_name]
            } else {
              dict set definitions [@ new_name] [dict get [@ definitions] [@ old_name]]
            }
          }
          "routine" {
            if {[llength [@ call]] != 3} {
              execute [list error "wrong number of arguments should be: [@ command] <name> <body>"]
              return
            }
            variable definitions
            variable storage_quota
            if {[@ storage_quota] < [string length [@ definitions]]} {
              execute [list error "over storage quota!"]
              return
            }
            set name [lindex [@ call] 1]
            set body [lindex [@ call] 2]
            dict set definitions [@ name] type script
            dict set definitions [@ name] data [@ body]
            dict set definitions [@ name] execlist [translate [@ body]]
          }
          "return" { popReturnstack }
          "+" - "-" - "/" - "*" - "^" - "|" - "&" - "<" - "<=" - "==" - "!="  {
            foreach item [lrange [@ call] 1 end] {
              if {![string is digit [@ item]]} {
                execute [list error "not a number!"]
                return
              }
            }
            set tally [lindex [@ call] 1]
            foreach item [lrange [@ call] 2 end] {
              set tally [expr [@ tally] [dict get [@ def] data] [@ item]]
            }
            return [@ tally]
          }
          "round" - "sqrt" - "sin" - "log10" - "log" - "floor" - "atan" - "bool" -
          "abs" - "acos" - "entier" - "sinh" - "tan" - "tanh" - "int" - "asin" -
          "ceil" - "cos" {
            if {[llength [@ call]] != 2} {
              execute [list error "wrong number of arguments should be: [@ command] <number>"]
              return
            }
            foreach item [lrange [@ call] 1 end] {
              if {![string is digit [@ item]]} {
                execute [list error "not a number!"]
                return
              }
            }
            if {[catch {
               set tally [expr [dict get [@ def] data]([lindex [@ call] 1])]
              } res]} {
              execute [list error [@ res]]
              return
            }
            return [@ tally]
          }
          
          "hypot" - "atan2" - "pow" - "fmod" {
            if {[llength [@ call]] != 3} {
              execute [list error "wrong number of arguments should be: [@ command] <number> <number>"]
              return
            }
            foreach item [lrange [@ call] 1 end] {
              if {![string is digit [@ item]]} {
                execute [list error "not a number!"]
                return
              }
            }
            if {[catch {
               set tally [expr [dict get [@ def] data]([lindex [@ call] 1],[lindex [@ call] 2])]
              } res]} {
              execute [list error [@ res]]
              return
            }
          }
          
          "min" -
          "max" {
            foreach item [lrange [@ call] 1 end] {
              if {![string is digit [@ item]]} {
                execute [list error "not a number!"]
                return
              }
            }
          }
          "and" {}
          "or" {}
          "negate" {}
          "actor" {}
          "actor send_message" {
            if {[llength [@ call]] != 2} {
              execute [list error "[@ command] <message>\n <message> := <addresses> <data>"]
              return
            }
            variable actor
            set message [lindex [@ call] 1]
            set temp {}
            foreach addr [lindex [@ message] 0] {
              if {[dict exists [@ actor] addressbook] [@ addr]]} {
                lappend temp [dict get [@ actor] addressbook [@ addr]]
              } else {
                execute [list error "no such address handle: [@ addr]"]
                return
              }
            }
            lset message 0 [@ temp]
            actor send_message [@ message]
          }
          "actor any_messages?" {
            variable actor
            return [actor any_messsages? [dict get [@ actor] address]]
          }
          "actor next_message" {
            variable actor
            if {[actor any_messages? [dict get [@ actor] address]]} {
              set message [actor next_message [dict get [@ actor] address]]
              set temp {}
              foreach address [lindex [@ message] 0] {
                set found no
                foreach {key value} [dict get [@ actor] addressbook] {
                  if {[string equal [@ value] [@ address]]} {
                    lappend temp [@ key]
                    set found yes
                    break; # the innermost loop (just a reminder)
                  }
                }
                if {![@ found]} {
                  set id addr[dict incr actor addressbook_counter]
                  dict set actor addressbook [@ id] [@ address]
                  lappend temp [@ id]
                }
              }
              lset message 0 [@ temp]
              return [@ message]
            } else {
              variable running 0
              variable frame
              set frame [dict merge [@ frame] [list code_pointer [expr [dict get [@ frame] code_pointer] - 1]]]
              return
            }
          }
          "actor beget" {}
          "actor die" {
            variable self
            variable actor
            actor die [dict get [@ actor] name]
            scheduler remove [@ self]
            [@ self] destroy
          }
          "actor drop_address" {
             if {[llength [@ call] != 2]} {
               execute [list error "wrong number of arguments should be: [@ command] <address handle>"]
               return
             }
             variable actor
             set addr [lindex [@ call] 1]
             if {[dict exists [@ actor] addressbook [@ addr]]} {
               dict unset actor addressbook [@ addr]
             } else {
               execute [list error "no such address handle: [@ addr]"]
               return
             }
           }
          "actor gain" {}
          "yield" {
            variable running 0
            variable frame
            set frame [dict merge [@ frame] [list code_pointer [expr [dict get [@ frame] code_pointer] - 1]]]
          }
          "lappend" {}
          "lassign" {}
          "lindex" {}
          "linsert" {}
          "list" {}
          "llength" {}
          "lrange" {}
          "lrepeat" {}
          "lreplace" {}
          "lsearch" {}
          "lsort" {}
          "__jump" {
            if {[llength [@ call] != 2} { bgerror "primitive __jump: wrong # of args"; return }
            set destination [lindex [@ call] 1]
            if {![string is digit [@ destination]]} { bgerror "primitive __jump: destination is not a number" }
            variable code_pointer [@ destination]
            return
          }
          "__branch" {
            # branch if predicate is {}
            if {[llength [@ call] != 3} { bgerror "primitive __branch: wrong # of args"; return }
            set predicate   [lindex [@ call] 1]
            set destination [lindex [@ call] 2]
            if {![string is digit [@ destination]]} { bgerror "primitive __branch: destination is not a number"; return }
            variable results
            if {[string equal [dict get [@ results] [@ predicate]] {}]} {
              variable code_pointer [@ destination]
            }
            return
          }
          "invocation" {
            variable frame
            return [dict get [@ frame] invocation]
          }
        }
      } else {
        error "unknown definition type"
      }
    } else {
      if {[dict exists [@ definitions] unknown]} {
        return [execute [list unknown [@ call]]
      } else {
        if {[dict exists [@ definitions] error]} {
          return [execute [list error "no unknown proc exists"]]
        } else {
          bgerror "no error proc/command defined"
        }
      }
    }
  }
  picol_interp proc spliceIn {template values} {
    set result ""
    set index 0
    while {[@ index] < [string length [@ template]]} {
      set char [string index [@ template] [@ index]
      incr index
      if {[string equal "\\" [@ char]]} {
        set char [string index [@ template] [@ index]
        incr index
        if {[string equal "u" [@ char]]} {
          set value [string range [@ template] [@ index] [incr index 3]]
          incr index
          append result [format "%c" [expr 0x[@ value]]]
        } elseif {[string equal "x" [@ char]]} {
          set value [string range [@ template] [@ index] [incr index]]
          incr index
          append result [format "%c" [expr 0x[@ value]]]
        } elseif {[string equal "t" [@ char]]} { append result "\t"
        } elseif {[string equal "r" [@ char]]} { append result "\r"
        } elseif {[string equal "n" [@ char]]} { append result "\n"
        } elseif {[string equal "b" [@ char]]} { append result "\b"
        } else {
          append result [@ char]
        }
      } elseif {[string equal "\[" [@ char]]} {
        set symbol ""
        repeat {
          set char [string index [@ template] [@ index]]
          if {![string equal "\]" [@ char]]} {
            append symbol [@ char]
          }
        } until {[string equal "\]" [@ char]]}
        if {![dict exists [@ values] [@ symbol]]} {
          bgerror "symbol not in values" ; return
        }
        append result [list [dict get [@ values] [@ symbol]]
      } elseif {[string equal "\{" [@ char]]} {
        append reuslt "\{"
        set level 1
        repeat {
          set char [string index [@ template] [@ index]]
          incr index
          append result [@ char]
          if {[string equal "\{" [@ char]]} {
            incr level +1
          } elseif {[string equal "\}" [@ char]]} {
            incr level -1
          } elseif {[string equal "\\" [@ char]]} {
            set char [string index [@ template] [@ index]]
            incr index
            append result [@ char]
          }
        } until {[@ level] == 0} 
      } else {
        append result [@ char]
      }
    }
    return [@ result]
  }
  thingy picol_translator
  picol_translator variable entries {}
  picol_translator variable lastUsed {}
  picol_translator proc translate {code {offset 0}} {
    variable entries
    variable lastUsed
    # have we translated this piece of code already?
    if {[dict exists [@ entries] [info level 0]]} {
      # yes
      dict set lastUsed [info level 0] [clock millisec]
      return [dict get [@ entries] [info level 0]]
    }
    # no
    # but do we have enaugh space?
    if {1000 < [dict size [@ entries]]} {
      # nope, discard all but around top 100 most used
      set top100 [lrange [lsort -decreasing -unique [dict values [@ lastUsed]] 0 100]
      foreach item [dict keys [@ lastUsed]] {
        if {[lsearch -exact [@ top100] [dict get [@ lastUsed] [@ item]]] == -1} {
          dict unset lastUsed [@ item]
          dict unset entries  [@ item]
        }
      }
    }
    # translate the code into execlist
    set result [list]
    set counter [@ offset]
    set level 0
    dict set stack [@ level] {}
    set index 0
    set length [string length [@ code]]
    set braced? no
    set quoted? no
    while {[@ index] < [@ length]} {
      set char [string index [@ code] [@ index]]
      incr index
      if {[string equal "\$" [@ char]] && ![@ braced?]} {
        # not thpught all the way through yet
        set varname ""
        repeat {
          set char [string index [@ code] [@ index]]
          incr index
          if {![string is space [@ char]] && ![string equal [@ char] "\""]} {
            append varname [@ char]
          }
        } until {[string is space [@ char]] || [string equal [@ char] "\""]}
        dict append stack [@ level] "\[var_[@ varname]\]"
      } elseif {[string equal "\"" [@ char]] && ![@ braced?]} {
        if {[@ quoted?]} {
          set quoted? no
        } else {
          set quoted? yes
        }
      } elseif {[string equal "\\" [@ char]]} {
        dict append stack [@ level] "\\"
        dict append stack [@ level] [string index [@ code] [@ index]]
        incr index
      } elseif {[string equal "\[" [@ char]] && ![@ braced?]]} {
        incr level +1
        dict set stack [@ level] {}
      } elseif {[string equal "\]" [@ char]] && ![@ braced?]]} {
        lappend result [dict get [@ stack] [@ level]]
        dict unset stack [@ level]
        incr level -1
        if {[@ level] < 0} { error "too many \[ or too few \]" }
        dict append stack [@ level] "\[[@ counter]\]"
        incr counter
      } elseif {[string equal "\n" [@ char]] && ![@ braced?]]} {
        if {[@ level] != 0} { error "unquoted \\n inside an command" }
        if {![string is space [dict get [@ stack] 0]]} {
          lappend result [dict get [@ stack] 0]
          incr counter
          dict set stack 0 {}
        }
      } elseif {[string equal "\{" [@ char]]} {
        if {![@ braced?]} {
          set braced? 1
        } else {
          incr braced? +1
        }
        dict append stack [@ level] [@ char]
      } elseif {[string equal "\}" [@ char]]} {
        if {![@ braced?]} {
          error "missing \{ somewhere or too many \}"
        } else {
          incr braced? -1
        }
        dict append stack [@ level] [@ char]
      } else {
        dict append stack [@ level] [@ char]
      }
    }
  dict set entries [info level 0] [@ result]
  dict set lastUsed [info level 0] [clock millisec]
  return [@ result]
  }
  picol_interp proc translate {code} { return [picol_translator translate [@ code]]}
  thingy actor
  actor variable storage {}
  actor proc next_message {mailbox} {
    variable storage
    if {![dict exists [@ storage] [@ mailbox]]} { error "actor mailbox [@ mailbox] doesnt exists localy" }
    if {[llength [dict get [@ storage] [@ mailbox]] == 0} { error "actor mailbox [@ mailbox] empty" }
    set message [lindex [dict get [@ storage] [@ mailbox]] 0]
    dict set storage [@ mailbox] [lrange [dict get [@ storage] [@ mailbox]] 1 end]
    return [@ message]
  }
  actor proc any_messages? {mailbox} {
    variable storage
    if {![dict exists [@ storage] [@ mailbox]]} { return no }
    return [expr ([llength [dict get [@ storage] [@ mailbox]]] != 0)]

  }
  actor proc send_message {message} {
    variable storage
    set recipiant [lindex [@ message] 0 0]; # address part of message, first address
    if {[dict exists [@ storage] [@ recipiant]]} {
      dict lappend storage [@ recipiant] [@ message]
      return
    } else {
      # doesnt exists locally
    }
  }
  actor proc beget args {
    foreach item {newaddress startscript startaddressbook} {
      if {![dict exists [@ args] [@ item]]} { error "missing keyword parameter [@ item]" }
    }
    thingy picol_interp_[@ newaddress]
    picol_interp_[@ newaddress] [picol_interp serialize]
    picol_interp_[@ newaddress] dict set actor addressbook [@ startaddressbook]
    picol_interp_[@ newaddress] dict set actor name [@ newaddress]
    picol_interp_[@ newaddress] dict set frame code [picol_tanslator translate [@ startscript]]
    picol_interp_[@ newaddress] set returnstack {}
    picol_interp_[@ newaddress] dict set frame code_pointer 0
    scheduler schedule picol_interp_[@ newaddress]
  }
  actor proc die {mailbox} {
    variable storage
    dict unset storage [@ mailbox]
  }
  thingy scheduler
  scheduler variable tasks {}
  scheduler proc schedule {task} {
    variable tasks
    lappend tasks [@ task]
  }
  scheduler proc run {} {
    variable tasks
    set current [lindex [@ tasks] 0]
    set tasks [join [list [lrange [@ tasks] 1 end] [@ current]]
    catch {
      [@ task] run
    }
    after idle [list scheduler run]
  }
=== scratchpad ===
  package require Tcl 8.5
  # Tcl 8.5 required because of usage of dict
  proc run {} {
    variable state
    while {[dict get $state running]} {
      switch -exact -- [string index [dict get $state code] [dict get $state index]] {
        "\{" {
          set item "\{"
          set brace-level 1
          dict incr state index +1
          while {$brace-level > 0} {
            set char [string index [dict get $state code] [dict get $state index]]
            if {$char == "\\"} {
              append item $char
              dict incr state index +1
              append item [string index [dict get $state code] [dict get $state index]]
            } elseif {$char == "\{"} {
              append item $char
              incr brace-level +1
            } elseif {$char == "\}"} {
              append item $char
              incr brace-level -1
            } else {
              append item $char
            }
            dict incr state index +1
          }
          dict append state stack [dict get $state stack-level] command $item
        }
        "\[" {
          dict incr state stack-level +1
          dict set state stack [dict get $state stack-level] start-index [dict get $state index]
        }
        "\]" {
          set frame [dict get $state stack [dict get $state stack-level]]
          dict unset state stack [dict get $state stack-level]
          dict incr state stack-level -1
          dict append state stack [dict get $state stack-level] command [execute $frame]
        }
        "\n" {
          set frame [dict get $state stack [dict get $state stack-level]]
          dict unset state stack [dict get $state stack-level]
          execute $frame
        }
        default {
          dict append state stack [dict get $state stack-level] command [string index [dict get $state code] [dict get $state index]]
        }
      }
      if {[dict get $state index] >= [string length [dict get $state code]]} { popReturnstack }
      dict incr state index +1
    }
  }
  proc exacute {frame} {
    variable state
    dict incr state run_quota -1
    if {[dict get state run_quota] == 1} {
      dict set state running no
    }
    set command_name [lindex [dict get $frame command] 0]
    if {[dict exists $state definitions $command_name]} {
      if {[string equal "primitive" [dict get $state definitions $command_name type]]} {
        set opcode [dict get $state definitions $command_name contents]
        switch -exact -- $opcode {

        }
      } elseif {[string equal "combined" [dict get $state definitions $command_name type]]} {
        pushReturnstack
        initFrame [list code [dict get $state definitions $command_name contents]]
      }
    } else {
      if {[string equal $command_name "unknown"]} {
        execute [list command [list error "unknown command not found"]]
      } else {
        execute [dict merge $frame [list command [list unknown [dict get $frame command]]]]
      }
    }
  }
  proc popReturnstack {} {
    variable state
    dict set state [dict merge $state [dict get $state returnStack]]
  }
  proc pushReturnstack {} {
    variable state
    dict set state returnStack $state 
  }
  proc initFrame {presets} {
    variable state
    dict set state index -1 
    dict set state code  {}
    dict set state stack-level 0
    dict set state stack 0 {}
    dict set state [dict merge $state $presets]
  }

=== codeStart ===
  proc textDelta {strA strB} {
    # strA should always be longer than strB
    if {[string length $strA] < [string length $strB]} {
      set tmp $strA
      set strA $strB
      set strB $tmp
      unset tmp
    }
    set indexA 0
    set indexB 0
    set theChange_text ""
    set theChange_end undefined
    set theChange_start undefined
    while {$indexA < [string length $strA]} {
      set charA [string index $strA $indexA]
      set charB [string index $strB $indexB]
      if {$charA == $charB} {
        incr indexB
        if {$theChange_start != "undefined"} {
          set theChange_end $indexA
        }
      } else {
        append theChange_text $charA
        if {$theChange_start == "undefined"} {
          set theChange_start $indexA
        }
      }
      incr indexA
    }
    if {$theChange_end == "undefined"} { set theChange_end $theChange_start }
    return [list $theChange_text $theChange_start $theChange_end]
  }
  proc namedArgs {} {
    upvar args args
    foreach {name value} $args {
      upvar $name tmp
      set tmp $value
    }
  }
  
  if 0 { Zarutian: The following is deprecated. }

 package ifneeded zarutian.memchan 1.0 {
  package require rechan 1.0
  namespace eval ::zarutian::memchan {}
  proc ::zarutian::memchan::handler args {
    log [info level 0]
    set cmd  [lindex $args 0]
    set chan [lindex $args 1]
    variable buffers
    variable write_read
    if {$cmd == "write"} {
      if {[lsearch [array names write_read] $chan] == -1} {
        error "$chan is only open for reading"
      }
    }
    append buffers($write_read($chan)) [lindex $args 2]
    return [string length [lindex $args 2]]
  } elseif {$cmd == "read"} {
    if {[lsearch [array names write_read] $chan] != -1} {
     error "$chan is only open for writing"
    }
    set data [string range $buffers($chan) 0 [lindex $args 2]]
    set buffers($chan) [string range $buffers($chan) [expr [lindex $args 2] +1] end]
    return $data
  } elseif {$cmd == "close"} {
    if {[lsearch [array names write_read] [lindex $args 1]] != -1} {
      close $write_read($chan)
      unset buffers($write_read($chan))
      unset write_read($chan)
    }
  }
 }
 proc ::zarutian::memchan::new {} {
  log [info level 0]
  variable write_read
  set write [rechan ::zarutian::memchan::handler 4]
  set read  [rechan ::zarutian::memchan::handler 2]
  set write_read($write) $read
  return [list $write $read]
 }
 package provide zarutian.memchan 1.0
 }

 package ifneeded zarutian.demultiplexing 1.0 {
  package require zarutian.memchan 1.0
  namespace eval ::zarutian::demultiplexing {}
  proc ::zarutian::demultiplexing::readChan {incoming_channel} {
    variable channels
    if {[eof $incoming_channel]} {
      foreach item [array names channels] {
        if {[string match "[set incoming_channel]_*" $item]} {
          foreach chan [set channels($item)] {
            close $chan
          }
        }
      }
      close $incoming_channel
      return
    }
    fconfigure $incoming_channel -encoding unicode -blocking 1 -translation auto
    gets $incoming_channel line
    set cmd [lindex $line 0]
    if {$cmd == "data"} {
      set chanId [lindex $line 1]
      set length  [lindex $line 2]
      fconfigure $incoming_channel -encoding binary -blocking 1 -translation binary
      set data [read $incoming_channel $length]
      foreach chan $channels("[set incoming_channel]_[set chanId]") {
        puts $chan $data
      }
      return
    } elseif {$cmd == "eof"} {
      set chanId [lindex $line 1]
      foreach chan $channels("[set incoming_channel]_[set chanId]") {
        close $chan
      }
      return
    } elseif {$cmd == "flush"} {
      set chanId [lindex $line 1]
      foreach chan $channels("[set incoming_channel]_[set chanId]") {
        flush $chan
      }
      return
    }
  }
  proc ::zarutian::demultiplexing::addChan {channel chanid {listenChannel {}}} {
    variable channels
    if {$listenChannel != {}} {
      set write $listenChannel
      set read  $listenChannel
    } else {
      set temp [::zarutian::memchan::new]
      set write [lindex $temp 0]
      set read  [lindex $temp 1]
    }
    lappend channels("[set channel]_[set chanid]") $write 
    return $read
  }
  proc ::zarutian::demultiplexing::setup {incoming_channel} {
    fileevent $incoming_channel [list ::zarutian::demultiplexing::readChan $incoming_channel]
  }
  package provide zarutian.demultiplexing 1.0
 }

 package ifneeded zarutain.multiplexing 1.0 {
   package require zarutian.memchan 1.0
   namespace eval ::zarutian::multiplexing {}

   proc ::zarutian::multiplexing::readChan {channel} {
     variable outgoing_channelsId
     variable outgoing_channelsMainChan
     if {[eof $channel]} {
       puts $outgoing_channelsMainChan($channel) "eof [set outgoing_channelsId($channel)]"
       flush $outgoing_channelsMainChan($channel)
       return
     }
     set rememberBlocking    [fconfigure $channel -blocking]
     set rememberTranslation [fconfigure $channel -translation]
     fconfigure $channel -blocking 1 -translation binary
     set data [read $channel]
     set length [string bytelength $data]
     fconfigure $channel -blocking $rememberBlocking -translation $rememberTranslation
  
     puts $outgoing_channelsMainChan($channel) "data [set outgoing_channelsId($channel)] $length"
     fconfigure $outgoing_channelsMainChan($channel) -encoding binary -translation binary
     puts $outgoing_channelsMainChan($channel) $data
     flush $outgoing_channelsMainChan($channel)
     fconfigure $outgoing_channelsMainChan($channel) -encoding unicode -translation auto
     return
   }
   proc ::zarutian::multiplexing::addChan {mainchannel chanId channel} {
     variable outgoing_channelsId
     set outgoing_channelsId($channel) $chanId
     set outgoing_channelsMainChan($channel) $mainchannel
     fileevent $channel readable [list ::zarutian::multiplexing::readChan $channel]
   }
   package provide zarutain.multiplexing 1.0
 }

 package ifneeded zarutain.leftShiftingRegister 1.0 {
   package require rechan 1.0
   namespace eval ::zarutian::leftShiftingRegister {}
   proc ::zarutian::leftShiftingRegister::handler args {
     variable states
     variable polynominals
     variable lengths
     set cmd      [lindex $args 0]
     set instance [lindex $args 1]
     if {$cmd == "write"} {
       error "this chanel is only open for reading"
     } elseif {$cmd == "close"} {
       unset states($instance)
       unset polynominals($instance)
       unset lengths($instance)
     } elseif {$cmd == "read"} {
       set reqlength [expr [lindex $args 2] * 8]
       set buffer $states($instance)
       set polyA  [lindex $polynominals($instance) 0]
       set polyB  [lindex $polynominals($instance) 1]
       if {($polyA < 0) || ($polyB <0)} { error "a polynominal is under zero" }
       if {($polyA > $lengths($instance)) || ($polyB > $lengths($instance))} {
         error "a polynominal addresses out of bound for the register"
       }
       if {$polyA == $polyB} { error "the polynominals must not be same" }
    
       for {} {$reqlength > 0} {incr reqlength -1} { 
         append buffer [XOR [string index $states($instance) $polyA] [string index $states($instance) $polyB]]
       }
    
       set states($instance) [string range $buffer end-[expr $lengths($instance) +1] end] 
       return [binary format B* $buffer)]
     }
  }
 proc ::zarutian::leftShiftingRegister::XOR {a b} {
  #IS: ýetta er bara sanntafla.
  #EN: This is just an truthtable.
  if {$a && $b} {
    return 0
  } elseif {$a && (!$b)} {
    return 1
  } elseif {(!$a) && $b} {
    return 1
  } elseif {(!$a) && (!$b)} {
    return 0
  }
 }
 proc ::zarutian::leftShiftingRegister::new {startingState length polynominal} {
  variable states
  variable polynominals
  variable lengths

  set instance [rechan ::zarutian::leftShiftingRegister::handler 6]
 
  if {[llength $polynominal] != 2} {
    error "$polynomnial must be two positive numbers"
  }
  set states($instance) $startingState
  set polynominals($instance) $polynominal
  set lengths($instance) $length
  
  return $instance
 }
 package provide zarutain.leftShiftingRegister 1.0
}

package ifneeded zarutian.bitSelector 0.1 {
 package require rechan 1.0
 namespace eval ::zarutian::bitSelector {}
 proc ::zarutain::bitSelector::handler args {
  variable channelAs
  variable channelSs
  set cmd  [lindex $args 0]
  set chan [lindex $args 1]
  if{$cmd == "read"} {
    set reqlength [lindex $args 2]
    set rememberChannelConfigurationA [fconfigure $channelAs($chan)]
    set rememberChannelConfigurationB [fconfigure $channelSs($chan)]
    fconfigure $channelAs($chan) -translation binary -encoding binary
    fconfigure $channelSs($chan) -translation binary -encoding binary
    
    set bufferS [read $channelSs($chan) $reqlength]
    binary scan $bufferS B* bufferS
    
    set bufferA ""    
    
    # ýaý er ýruglega einhver villa hýr inný -byrjun-
    #  hef ýaý ý tilfininguni aý ýg ýtti ekki aý nota gildi breytunar
    #  temp1 sem index ý breytuna byte
    for {set temp2 1} {$temp2 <= $reqlength} {incr temp2} {
      binary scan [read $channelAs($chan) 1] byte
      for {set temp1 1} {$temp1 <= 8} {incr temp1} {
        set temp3 [expr ($temp2 * 8) + $temp1]
        if {[string index $bufferS $temp3]} {
          append bufferA [string index $byte $temp1]
        }
      }
    }
    # ýaý er ýruglega einhver villa hýr inný -lok-
    
    fconfigure $channelAs($chan) [join $rememberChannelConfigurationA " "]
    fconfigure $channelSs($chan) [join $rememberChannelConfigurationB " "]
    return [binary format B* $bufferA]
  } elseif {$cmd == "write"} {}
  # lesa fyrsta af rýs S einn bita yfir ý breytu x
  # ef x er 1 ýý lesa einn bita af rýs A yfir ý breytu y
  # býta y viý buffer
 }
 proc ::zarutian::bitSelector::new {channelA channelS} {
  # channelA is the victim
  # channelS is the torturer
  variable instances
  if {[info exists instances("[set channelA]_[set channelS]")]} {
    return $instances("[set channelA]_[set channelS]")
  }
  set instance [rechan ::zarutain::bitSelector::handler 6]
  lappend instances $instance
  variable channelAs
  variable channelSs
  set channelAs($instance) $channelA
  set channelSs($instance) $channelS
  return $instance
 }
 package provide zarutian.bitSelector 0.1
}

comment {
 other possible Tcl Core implementation thoughts

Basic datatypes:
   * boolean (true/false)
   * bytestring (can be any binarydata that can be contained in octects)
   * table (like in Lua)

floating points will be represented as a table containing something like this:
  "type": "float"
  "base": <bytestring treated as an number>
  "exponent": <bytestring treated as an number>
}

package ifneeded zarutian.app.synchRemoteEval 0.1 {
  proc getCallstack {} {
    set calls [list]
    set me [expr [info level] -1]
    for {set i $me} {$i > 0} {incr i -1} {
      lappend calls [info level $i]
    }
    return $calls
  }
  proc syncRemoteEval {channel} {
    set calls [getCallstack]
   
    set cmd [lindex $calls 2]
    set d [info level]
    if {$d > 2} {
      set u2 [lindex $calls 3]
      if {[lindex $u2 0] == "syncRemoteEval"} {
        return
      }
    }
    # info feedback prevention aka dont send back what we recived.
    set ok 1
    foreach call $calls {
      if {[lindex $call 0] == "fileevent_for_synchRemoteEval"} { set ok 0; break }
    } 
    if {$ok} { putsAndFlush $channel "callstack [list $calls]" }
    set val {}
    catch {set val [eval $cmd]} res
    if {$res != $val} {
      putsAndFlush $channel "error [list $res]"
    } else {
      putsAndFlush $channel "result [list $res]"
    }
    return -code return $res
  }
  proc fileevent_for_syncRemoteEval {chan} {
    
  }
  proc putsAndFlush {chan data} {
    catch {
      puts $chan $data
      flush $chan
    }
  }
  package provide zarutian.app.synchRemoteEval 0.1
}

package ifneed zarutian.app.synchRemoteEvalVersionB 0.1 {
  # same as above but using execution traces
  package require Tcl 8.4
  proc getCallstack {} {
    set calls [list]
    set me [expr [info level] -1]
    for {set i $me} {$i > 0} {incr i -1} {
      lappend calls [info level $i]
    }
    return $calls
  }
  proc was_called_anytime_by? {cmdname} {
    set calls [lrange [getCallstack] 1 end]
    foreach call $calls {
      if {[lindex $call 0] == $cmdname} { return 1 }
    }
    return 0
  }
  proc sendToTheOtherEnd {data} {
    global remoteEvalSynch_channel
    catch {
      fconfigure $channel -encoding unicode ; # make sure that the data on the channel is unicode encoded
      puts $remoteEvalSynch_channel $data
      flush $remoteEvalSynch_channel
    }
  }
  proc remoteEvalSynchExecuteCallback args {
    set cmd [lindex $args 0]
    set op  [lindex $args end]
    if {$op == "enter"} {
      if {![was_called_anytime_by? "remoteEvalSynchFileeventCallback"]} {
        sendToTheOtherEnd "start-eval [list $cmd]"
        # sendToTheOtherEnd "start-eval [list $cmd [getCallstack]]"
      }
    } elseif {$op == "leave"} {
      set code   [lindex $args 1]
      set result [lindex $args 2]
      sendToTheOtherEnd "result-update [list $cmd $code $result]"
      # sendToTheOtherEnd "result-update [list $cmd $code $result [getCallstack]]"
    }
  }
  proc remoteEvalSynchFileeventCallback {channel} {
    global buffers
    if {[eof $channel} {
      # for the time being raise an error when channel is eofed by the other end
      error "$channel eofed!"
    }
    fconfigure $channel -encoding unicode ; # make sure that the data on the channel is unicode encoded
    append buffers($channel) [gets $channel]
    if {[info complete $buffers($channel)} {
      set event [lindex $buffers($channel) 0]
      set data  [lindex $buffers($channel) 1]
      if {$event == "start-eval"} {
        set cmd [lindex $data 0]
        # set callstack [lindex $data 1]
        catch {
          eval $cmd
        }
      } elseif {$event == "result-update"} {
        # what should I do with this?
        # fyrst um sinn: check if code is error and error on it
        set cmd    [lindex $data 0]
        set code   [lindex $data 1]
        set result [lindex $data 2]
        # set callstack [lindex $data 3]
        if {$code == "error"} { error "remote-error: $channel [list $cmd] [list $result ]"}
      }
      unset buffers($channel)
    }
  }
  proc remoteEvalSynch {victim channel} {
    # channel must be two way
    fileevent $channel readable [list remoteEvalSynchFileeventCallback $channel]
    trace add execution $victim {enter leave} remoteEvalSynchExecuteCallback
  }
  package provide zarutian.app.synchRemoteEvalVersionB 0.1
}

----
!!!!!!
%|[Category Person]|%
Category Clutter?
!!!!!!