Zarutian

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[L1 ] 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 {}
        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 {}
        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
}

scratchpad 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 {$cmd eq {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 {$cmd eq {<}} {
        # 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 {$cmd eq "eval"} {
    } elseif {$cmd eq "error"} {
    } elseif {$cmd eq "+"} {
    } elseif {$cmd eq "-"} {
    } elseif {$cmd eq "/"} {
    } elseif {$cmd eq "%"} {
    } elseif {$cmd eq "&"} {
    } elseif {$cmd eq "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 {$cmd eq "get"} {
        if {[llength $argus] != 1} {
            set state [lindex [exec_prim error "wrong # of args" $state] end]
        } else {
        }
    } elseif {$cmd eq {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 {$keyword eq {until}} {
        set condition !([set condition])
    } elseif {$keyword eq {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 {[dict get [@ def] type] eq {script}} {
            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 {[dict get [@ def] type] eq "primitive"} {
            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 {[dict get [@ definitions] [
                            @ def] type] eq {primitive}} {

                            if {[dict get [@ definitions] [
                                @ def] data] eq {__branch}} {
                                    set __branch [@ def]
                            }
                            if {[dict get [@ definitions] [
                                @ def] data] eq {__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 {[@ false-body] ne {}} {
                                set slot2 [llength [@ daCode]]
                        lappend daCode {<<<__jump primitive comes here>>>}
                    }
                    lset daCode [@ slot1] [list [@ __branch] [
                        expr [@ slot1] -1] [llength [@ daCode]]]
                    if {[@ false-body] ne {}} {
                        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 {[dict get [@ definitions] [
                            @ def] type] eq {primitive}} {
                            if {[dict get [@ definitions] [
                                @ def] identifier] eq {__branch}} {
                                    set __branch [@ def]
                                }
                            if {[dict get [@ definitions] [
                                @ def] identifier] eq {__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 {[dict get [@ aFrame] type] eq {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 {[dict get [@ aFrame] type] eq {catcher}
                            || [dict get [@ aFrame] type] eq {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 {[dict get [@ aFrame] type] eq {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 {[dict get [@ aFrame] type] eq {catcher}
                            || [dict get [@ aFrame] type] eq {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 {[@ new_name] eq {}} {
                        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 {[@ value] eq [@ 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 {[dict get [@ results] [@ predicate]] eq {}} {
                        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 {[@ char] eq "\\"} {
            set char [string index [@ template] [@ index]
            incr index
            if {{u} eq [@ char]} {
                set value [string range [@ template] [@ index] [incr index 3]]
                incr index
                append result [format %c [expr 0x[@ value]]]
            } elseif {{x} eq [@ char]} {
                set value [string range [@ template] [@ index] [incr index]]
                incr index
                append result [format %c [expr 0x[@ value]]]
            } elseif {{t} eq [@ char]} {append result \t
            } elseif {{r} eq [@ char]} {append result \r
            } elseif {{n} eq [@ char]} {append result \n
            } elseif {{b} eq [@ char]} {append result \b
            } else {
                append result [@ char]
            }
        } elseif {{[} eq [@ char]} {
            set symbol {} 
            repeat {
                set char [string index [@ template] [@ index]]
                if {{]} ne [@ char]} {
                    append symbol [@ char]
                }
            } until {{]} eq [@ char]}
            if {![dict exists [@ values] [@ symbol]]} {
                bgerror {symbol not in values}
                return
            }
            append result [list [dict get [@ values] [@ symbol]]
        } elseif {"\{" eq [@ char]} {
            append result \{
            set level 1
            repeat {
                set char [string index [@ template] [@ index]]
                incr index
                append result [@ char]
                if {"\{" eq [@ char]} {
                    incr level +1
                } elseif {"\}" eq [@ char]} {
                    incr level -1
                } elseif {"\\" eq [@ 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 {{$} eq [@ char] && ![@ braced?]} {
            # not thought all the way through yet
            set varname {} 
            repeat {
                set char [string index [@ code] [@ index]]
                incr index
                if {![string is space [@ char]] && [@ char] ne {"}} {
                    append varname [@ char]
                }
            } until {[string is space [@ char]] || [@ char] eq {"}}
            dict append stack [@ level] \[var_[@ varname]\]
        } elseif {{"} eq [@ char] && ![@ braced?]} {
            if {[@ quoted?]} {
                set quoted? no
            } else {
                set quoted? yes
            }
        } elseif {"\\" eq [@ char]} {
            dict append stack [@ level] \\
            dict append stack [@ level] [string index [@ code] [@ index]]
            incr index
        } elseif {{[} eq [@ char] && ![@ braced?]} {
            incr level +1
            dict set stack [@ level] {}
        } elseif {{]} eq [@ 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 {"\n" [@ char] && ![@ braced?]} {
            if {[@ level] != 0} {error {unquoted \n inside a command}}
            if {![string is space [dict get [@ stack] 0]]} {
                lappend result [dict get [@ stack] 0]
                incr counter
                dict set stack 0 {}
            }
        } elseif {"\{" eq [@ char]} {
            if {![@ braced?]} {
                set braced? 1
            } else {
                incr braced? +1
            }
            dict append stack [@ level] [@ char]
        } elseif {"\}" eq [@ 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] doesn't exist locally"
    }
    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

    # address part of message, first address
    set recipient [lindex [@ message] 0 0]

    if {[dict exists [@ storage] [@ recipient]]} {
        dict lappend storage [@ recipient] [@ message]
        return
    } else {
        # doesn't exist 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 eq "\\"} {
                        append item $char
                        dict incr state index +1
                        append item [string index [dict get $state code] [
                            dict get $state index]]
                    } elseif {$char eq "\{"} {
                        append item $char
                        incr brace-level +1
                    } elseif {$char eq "\}"} {
                        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 {{primitive} eq [dict get $state definitions $command_name type]]} {
            set opcode [dict get $state definitions $command_name contents]
            switch -exact -- $opcode {
            }
        } elseif {{combined} eq [
            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 eq $charB} {
            incr indexB
            if {$theChange_start ne {undefined}} {
                set theChange_end $indexA
            }
        } else {
            append theChange_text $charA
            if {$theChange_start eq {undefined}} {
                set theChange_start $indexA
            }
        }
        incr indexA
    }
    if {$theChange_end eq {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.}

ackage 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 eq {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 eq {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 eq {close}} {
    if {[lsearch [array names write_read] [lindex $args 1]] != -1} {
        close $write_read($chan)
        unset buffers($write_read($chan))
        unset write_read($chan)
    }
}

roc ::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 eq {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 eq {eof}} {
            set chanId [lindex $line 1]
            foreach chan $channels([set incoming_channel]_[set chanId]) {
                close $chan
            }
            return
        } elseif {$cmd eq {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 ne {}} {
        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 eq {write}} {
            error {this chanel is only open for reading}
        } elseif {$cmd eq {close}} {
            unset states($instance)
            unset polynominals($instance)
            unset lengths($instance)
        } elseif {$cmd eq {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 eq {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 eq {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
}


if 0 {
    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] eq {syncRemoteEval}} {
                return
            }
        }
        # info feedback prevention aka dont send back what we recived.
        set ok 1
        foreach call $calls {
            if {[lindex $call 0] eq {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 ifneeded 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] eq $cmdname} {return 1}
        }
        return 0
    }

    proc sendToTheOtherEnd data {
        global remoteEvalSynch_channel
        catch {
            # make sure that the data on the channel is unicode encoded
            fconfigure $channel -encoding unicode
            puts $remoteEvalSynch_channel $data
            flush $remoteEvalSynch_channel
        }
    }

    proc remoteEvalSynchExecuteCallback args {
        set cmd [lindex $args 0]
        set op  [lindex $args end]
        if {$op eq {enter}} {
            if {![was_called_anytime_by? remoteEvalSynchFileeventCallback]} {
                sendToTheOtherEnd "start-eval [list $cmd]"
                # sendToTheOtherEnd "start-eval [list $cmd [getCallstack]]"
            }
        } elseif {$op eq {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!"
        }

        # make sure that the data on the channel is unicode encoded
        fconfigure $channel -encoding unicode

        append buffers($channel) [gets $channel]
        if {[info complete $buffers($channel)} {
            set event [lindex $buffers($channel) 0]
            set data  [lindex $buffers($channel) 1]
            if {$event eq {start-eval}} {
                set cmd [lindex $data 0]
                # set callstack [lindex $data 1]
                catch {
                    eval $cmd
                }
            } elseif {$event eq {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 eq {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
}