[Zarutian] 3. july 2007: Capicol is an variant of picol wich in turn is an variant of Tcl.
Capicol stands for Capability picol and is my investigation into capability based security and
asynchronus message passing in concurrent enviroment.
It is not complete yet and probably very slow. (I want to get it right before fast, thank you)

 # This code is hereby released in the public domain.
 # Any infriging software patents will be disregarded and
 # propably made invalid because of obviouseness.
 # v 0.1
 package require Tcl 8.5
 package provide capicol 0.3

 # state:
 #   running
 #     <boolean>
 #   quota
 #     <number>
 #   capabilities
 #     <caphandle>
 #       <address>
 #   in-queue
 #     <in_message>*
 #   out_queue
 #     <out_message>*
 #      <type> 
 #   commands
 #     <command name>*
 #       type
 #         prim | combo | script
 #       contents
 #   returnstack
 #     frame*
 #   frame
 #     pointer
 #       <number>
 #     code
 #       <call template>*
 #     results
 #       <number>
 #         <result>
 #     variables
 #       <name>
 #         <value>
 #     arguments
 #       <string>
 #    [break-goto]
 #       <number>
 #    [continue-goto]
 #       <number>
 #    [catcher]
 #       <name of a variable>
 #    [save-to]
 #      dest
 #        <number>
 #      variables
 #        <name>
 #          <value>
 # <in_message> := <addresses> <data> <quota>
 # <out_message> := <out_message_type> <out_message_contents>
 # <out_message_type>     := "beget" | "gain" | "message"
 # <out_message_contents> := <startup script> <addresses> <quota>; for "beget"
 # <out_message_contents> := <in_message> ; for "message"
 # <out_message_contents> := <cert> ; for "gain"
 # <addresses> := <address>*
 # <call template> := a string where [<index into the result table>] must be replace with that result
 #
 # design decision: use primitives gain and beget or just send messages to local addresses?
 # hugmynd: sleppa [gain] og [beget] úr grunnskipanasafninu 

 proc log args {
   if {[string equal [lindex $args 0] "invoked"]} {  
     set call_level [lindex $args 1]
     puts "log: [string repeat { } $call_level] invoked [lindex $args 2 0]"
   } else {
     puts "log: $args"
   }
 }

 namespace eval capicol {}

 proc capicol::basic_tester {code} {
   set t1 [capicol::new_state]
   dict set t1 frame code $code
   set i [llength $code]
   while {$i > 0} {
     set t1 [capicol::advance $t1]
     incr i -1
   }
   return $t1
 }
 # tests (not complete and should be moved to the end)
 # capicol::basic_tester {{+ 1 2 3}}
 # capicol::basic_tester {{- 3 2 1}}
 # capicol::basic_tester {{* 5 3 2}}
 # capicol::basic_tester {{/ 60 5 2}}
 # capicol::basic_tester {{% 20 4}}
 # capicol::basic_tester {{& 0xFF 0x0E}}
 # capicol::basic_tester {{| 0xF0 0x0F}}
 # capicol::basic_tester {{^ 0xF0 0x0F}}
 # capicol::basic_tester {{<< 2 1}}
 # capicol::basic_tester {{>> 8 2}}
 # capicol::basic_tester {{< 10 5}}
 # capicol::basic_tester {{<= 9 10}}
 # capicol::basic_tester {{== 20 20}}
 # capicol::basic_tester {{!= 20 20}}
 # capicol::basic_tester {{and yes yes}}
 # capicol::basic_tester {{any_messages?}}

 proc capicol::advance {state} {
   log invoked [info level] [info level 0]
     if {![dict exists $state commands]}        { error "commands missing" }
     if {![dict exists $state frame code]}      { error "code missing" }
     if {![dict exists $state frame pointer]}   { dict set state frame pointer 0 }
     if {![dict exists $state frame results]}   { dict set state frame results {} }
     if {![dict exists $state frame variables]} { dict set state frame variables {} }
     if {![dict exists $state frame args]}      { dict set state frame args {} }
     if {![dict exists $state returnstack]}     { dict set state returnstack {} }

     set cmd&args [lindex [dict get $state frame code] [dict get $state frame pointer]]
     set cmd&args [interpolate [dict get $state frame 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]]} {
         # nokkuð mjög líklegt að verði mikið notað
         # push current continuation onto returnstack
         set state [push_contination $state]
         # stilla state fyrir að keyra innihald procs
         dict set state frame code [dict get $state commands $cmd contents]
         dict set state frame pointer -1; # þarf að vera -1 út af autoincr
         dict set state frame variables {}
         dict set state frame results {}
         dict set state frame args $args
       } elseif {[string equal "prim" [dict get $state commands $cmd type]]} {
         set pointer [dict get $state frame pointer]
         lassign [exec_prim [dict get $state commands $cmd contents] $args $state] result state
         dict set state frame results $pointer $result
       } elseif {[string equal "script" [dict get $state commands $cmd type]]} {
         dict set state commands $cmd script [dict get $state commands $cmd contents]
         dict set state commands $cmd type combo
         dict set state commands $cmd contents [translate [dict get $state commands $cmd contents]]
         return [advance $state]
       } else {
         error "unknown command type [dict get $state commands $cmd type]"
       }
     } else {
       # the unknown command handling
       if {![dict exists $state commands unknown]} {
         lassign [call [list error "unknown command $cmd"] $state] _ state
       } else {
         # invoke the unknown command
         lassign [call [list unknown [set cmd&args]] $state] temp state
         dict set state frame results \[[dict get $state pointer]\] $temp
       }
     }
     if {[llength [dict get $state frame code]] < [dict get $state frame pointer]} {
       set state [lindex [exec_prim_return {} $state] end]
     }
     if {([string length [dict get $state commands]] + \
          [string length [dict get $state returnstack]] + \
          [string length [dict get $state frame]]) > [dict get $state quota]} {
       lassign [call [list error "not enaugh quota to run!"] $state] _ state
     }
     dict set state frame pointer [expr [dict get $state frame pointer] + 1]; # autoincr
     return $state
 }

 proc capicol::push_continuation {state} {
   log invoked [info level] [info level 0]
   set temp [dict create]
   dict lappend state returnstack [dict get $state frame]
   return $state
 }
 proc capicol::call {cmd&args state} {
   log invoked [info level] [info level 0]
   set state [push_continuation $state]
   dict set state frame code [list [set cmd&args]]
   dict set state frame pointer -1
   return [list {} $state]
 }
 proc capicol::exec_prim {prim arguments state} {
   log invoked [info level] [info level 0]
   # giant despatching switch
   # I rather use jump tables but cant have them easily in higher level languages
   switch -exact -- $prim {
     "+" { return [exec_prim_math + $arguments $state] }
     "-" { return [exec_prim_math - $arguments $state] }
     "*" { return [exec_prim_math * $arguments $state] }
     "/" { return [exec_prim_math / $arguments $state] }
     "%" { return [exec_prim_math % $arguments $state] }
     "&" { return [exec_prim_math & $arguments $state] }
     "|" { return [exec_prim_math | $arguments $state] }
     "^" { return [exec_prim_math ^ $arguments $state] }
     "<<" { return [exec_prim_math << $arguments $state] }
     ">>" { return [exec_prim_math >> $arguments $state] }
     "<"  { return [exec_prim_compare <  $arguments $state] }
     "<=" { return [exec_prim_compare <= $arguments $state] }
     "==" { return [exec_prim_compare == $arguments $state] }
     "!=" { return [exec_prim_compare != $arguments $state] }
     "and" { return [exec_prim_logical_and $arguments $state] }
     "any_messages?" { return [exec_prim_any_messages? $arguments $state] }
     "args" { return [exec_prim_args $arguments $state] }
     "beget" { return [exec_prim_beget $arguments $state] }
     "break" { return [exec_prim_break $arguments $state] }
     "catch" { return [exec_prim_catch $arguments $state] }
     "capabilities" { return [exec_prim_capabilites $arguments $state] }       
     "continue" { return [exec_prim_continue $arguments $state] }
     "dict" { return [exec_prim_dict $arguments $state] }    
     "die" { return [exec_prim_die $arguments $state] }
     "drop_capability" { return [exec_prim_drop_capability $arguments $state] }
     "error" { return [exec_prim_error $arguments $state] }
     "gain" { return [exec_prim_gain $arguments $state] }
     "get" { return [exec_prim_get $arguments $state] }
     "if" { return [exec_prim_if $arguments $state] }
     "lappend" { return [exec_prim_lappend $arguments $state] }
     "lassign" { return [exec_prim_lassign $arguments $state] }
     "lindex" { return [exec_prim_lindex $arguments $state] }
     "linsert" { return [exec_prim_linsert $arguments $state] }
     "list" { return [exec_prim_list $arguments $state] }
     "llength" { return [exec_prim_llength $arguments $state] }
     "lrange" { return [exec_prim_lrange $arguments $state] }
     "lrepeat" { return [exec_prim_lrepeat $arguments $state] }
     "lsearch" { return [exec_prim_lsearch $arguments $state] }
     "lset" { return [exec_prim_lset $arguments $state] }
     "lsort" { return [exec_prim_lsort $arguments $state] }
     "next_message" { return [exec_prim_next_message $arguments $state] }
     "or" { return [exec_prim_or $arguments $state] }
     "rename" { return [exec_prim_rename $arguments $state] }
     "return" { return [exec_prim_return $arguments $state] }
     "routine" { return [exec_prim_routine $arguments $state] }
     "send_message" { return [exec_prim_send_message $arguments $state] }
     "set" { return [exec_prim_Set $arguments $state] }
     "string" { return [exec_prim_string $arguments $state] }
     "unset"  { return [exec_prim_unset $arguments $state] }
     "uplevel" { return [exec_prim_uplevel $arguments $state] }
     "var_exists?" { return [exec_prim_var_exists? $arguments $state] }
     "while" { return [exec_prim_while $arguments $state] }
     "__branch" { return [exec_prim___branch $arguments $state] }
     "__jump" { return [exec_prim___jump $arguments $state] }
     default  { error "unknown capicol primitive $prim" }
   }
 }

 proc capicol::exec_prim_math {op arguments state} {
   log invoked [info level] [info level 0]
   set result [lindex $arguments 0]
   foreach item [lrange $arguments 1 end] {
     set result [expr $result $op $item]
   }
   return [list $result $state]
 }
 proc capicol::exec_prim_compare {op arguments state} {
   log invoked [info level] [info level 0]
   if {[llength $arguments] != 2} {
     return [call [list error "wrong # args: should be \"$op number number\""] $state]
   }
   set result [expr [lindex $arguments 0] $op [lindex $arguments 1]]
   return [list $result $state]
 }
 proc capicol::exec_prim_logical_and {arguments state} {
   log invoked [info level] [info level 0]
   set result [lindex $arguments 0]
   foreach item [lrange $arguments 1 end] {
     set result [expr $result && $item]
   }
   return [list $result $state]
 }
 proc capicol::exec_prim_any_messages? {arguments state} {
   log invoked [info level] [info level 0]
   if {![dict exists $state in_queue]} {
     dict set state in_queue {}
   } 
   return [list [expr [llength [dict get $state in_queue]] != 0] $state]
 }
 proc capicol::exec_prim_args {arguments state} {
   log invoked [info level] [info level 0]
   if {![dict exists $state frame args]} {
     dict set state frame args {}
   }
   return [list [dict get $state frame args] $state]
 }
 proc capicol::exec_prim_beget {arguments state} {
   log invoked [info level] [info level 0]
   # beget <startup script> <capabilities> <quota> returns <capability>
   if {[llength $arguments] != 3} {
     return [call [list error "wrong # args: should be \"beget startupscript capabilities quota\""] $state]
   }
   # make new address for the "child" using the replicator serial scheme
   if {![dict exists $state my_address]} {
     error "an capicol state cannot be without an address!"
   }
   if {![dict exists $state number_of_children]} {
     dict set state number_of_children 0
   }
   set child "[dict get $state my_address].[dict incr state number_of_children]"
   
   if {[catch [list addresses_from_caphandles [lindex $arguments 1] $state] res]} {
     return [call [list error $res] $state]
   } else {
     set addresses [lindex $res 0]
     set state     [lindex $res end]
     unset res
   }
  
   set res [add_capability $child $state]
   set state [lindex $res end]
   set handle [lindex $res 0]
   unset res

   if {[dict get $state quota] < $quota} {
     return [call [list error "not enaugh quota!"] $state]
   }
   if {$quota < [string length [lindex $arguments 0]]} {
     return [call [list error "not enaugh quota allotted to child!"] $state]
   }
  
   dict lappend state out_queue [list beget $child [lindex $arguments 0] $adresses $quota]
   return [list $handle $state]
 }

 proc capicol::add_capability {address state} {
   log invoked [info level] [info level 0]
   if {![dict exists $state capabilities counter]} {
     dict set state capabilities counter [expr 2 * [dict size [dict get $state capabilities]]] 
   }
   if {[lsearch [dict keys $state capabilities] $address] == -1} {
     set handle cap[dict incr state capabilities counter]
     dict set state capabilities $handle $address
   } else {
     foreach {handle item} [dict get $state capabilities] {
       if {[string equal $item $address]} break
     }
   }
   return [list $handle $state]
 }
 proc capicol::addresses_from_caphandles {caphandles state} {
   log invoked [info level] [info level 0]
   set addresses {}
   set caphandles [dict get $state capabilities]
   foreach caphandle $caphandles {
     if {![dict exists $capabilities $caphandle]} {
       error "no such caphandle: $caphandle"
     }
     lappend addresses [dict get $capabilities $caphandle]
   }
   return [list $addresses $state]
 }
 proc capicol::caphandles_from_adddresses {addresses state} {
   log invoked [info level] [info level 0]
   set tmp [list]
   foreach item $addresses {
     lassign [add_capability $item $state] caphandle state
     lappend tmp $caphandle
   }
   return [list $tmp $state]
 }

 proc capicol::exec_prim_break {arguments state} {
   log invoked [info level] [info level 0]
   while true {
     if {[dict exists $state frame break-goto]} break
     if {[string equal [dict get $state returnstack] ""]} {
       return [call [list error "break invoked outside an loop"] $state]
     }
     set state [lindex [exec_prim_return {} $state] end]
   }
   dict set state frame pointer [expr [dict get $state frame break-goto] - 1]
   return [list {} $state]
 }
 proc capicol::exec_prim_catch {arguments state} {
   log invoked [info level] [info level 0]
   # catch <script> [<var>]
   if {([llength $arguments] < 1) || ([llength $arguments] > 2)} {
     return [call [list error "wrong # args: should be \"catch script ?var?\""] $state]
   }
   dict set state frame catcher [lindex $arguments 1]
   return [exec_prim_upevel [list 0 [lindex $arguments 0]] $state]
 }
 proc capicol::exec_prim_capabilities {arguments state} {
   log invoked [info level] [info level 0]
   set result [dict keys $state capabilities]
   set t1 [lsearch -exact $result counter]
   set result [lreplace $result $t1 $t1]
   return [list $result $state]
 }
 proc capicol::exec_prim_continue {arguments state} {
   log invoked [info level] [info level 0]
   while true {
     if {[dict exists $state frame continue-goto]} break
     if {[string equal [dict get $state returnstack] ""]} {
       return [call [list error "continue invoked outside an loop"] $state]
     }
     set state [lindex [exec_prim_return {} $state] end]
   }
   dict set state frame pointer [expr [dict get $state frame continue-goto] - 1]
   return [list {} $state]
 }
 proc capicol::exec_prim_dict {arguments state} {
   log invoked [info level] [info level 0]
   if {[llength $arguments] < 1} {
     return [call [list error "wrong # args: should be \"dict subcommand ?arg ...?\""] $state]
   }
   # simple dispatcher
   set subcommand [lindex $arguments 0]
         if {[string equal "append" $subcommand]} {
     return [exec_prim_dict_append [lrange $arguments 1 end] $state]
   } elseif {[string equal "create" $subcommand]} {
     return [exec_prim_dict_create [lrange $arguments 1 end] $state]
   } elseif {[string equal "exists" $subcommand]} {
     return [exec_prim_dict_exists [lrange $arguments 1 end] $state]
   } elseif {[string equal "filter" $subcommand]} {
     return [exec_prim_dict_filter [lrange $arguments 1 end] $state]
   } elseif {[string equal "for" $subcommand]} {
     return [exec_prim_dict_for [lrange $arguments 1 end] $state]
   } elseif {[string equal "get" $subcommand]} {
     return [exec_prim_dict_get [lrange $arguments 1 end] $state]
   } elseif {[string equal "incr" $subcommand]} {
     return [exec_prim_dict_incr [lrange $arguments 1 end] $state]
   } elseif {[string equal "info" $subcommand]} {
     return [exec_prim_dict_info [lrange $arguments 1 end] $state]
   } elseif {[string equal "keys" $subcommand]} {
     return [exec_prim_dict_keys [lrange $arguments 1 end] $state]
   } elseif {[string equal "lappend" $subcommand]} {
     return [exec_prim_dict_lappend [lrange $arguments 1 end] $state]
   } elseif {[string equal "merge" $subcommand]} {
     return [exec_prim_dict_merge [lrange $arguments 1 end] $state]
   } elseif {[string equal "remove" $subcommand]} {
     return [exec_prim_dict_remove [lrange $arguments 1 end] $state]
   } elseif {[string equal "replace" $subcommand]} {
     return [exec_prim_dict_replace [lrange $arguments 1 end] $state]
   } elseif {[string equal "set" $subcommand]} {
     return [exec_prim_dict_set [lrange $arguments 1 end] $state]
   } elseif {[string equal "size" $subcommand]} {
     return [exec_prim_dict_size [lrange $arguments 1 end] $state]
   } elseif {[string equal "unset" $subcommand]} {
     return [exec_prim_dict_unset [lrange $arguments 1 end] $state]
   } elseif {[string equal "update" $subcommand]} {
     return [exec_prim_dict_update [lrange $arguments 1 end] $state]
   } elseif {[string equal "values" $subcommand]} {
     return [exec_prim_dict_values [lrange $arguments 1 end] $state]
   } elseif {[string equal "with" $subcommand]} {
     return [exec_prim_dict_remove [lrange $arguments 1 end] $state]
   } else {
    return [call [list error "bad subcommand \"[lindex $arguments 0]\": must be append, create, exists, filter, for, get, incr, info, keys, lappend, merge, remove, replace, set, size, unset, update, values or with"] $state]
   }
 }
 proc capicol::exec_prim_dict_append {arguments state} {
   log invoked [info level] [info level 0]
   if {[llength $arguments] < 3} {
     return [call [list error "wrong # args: should be \"dict append varName key ?key ...? value\""] $state]
   }
   set varname [lindex $arguments 0]
   set keys    [lrange $arguments 1 end-1]
   set value   [lindex $arguments 0]

   lassign [exec_prim_get [list $varname] $state] dict state
   lassign [exec_prim_dict_get [list $dict {expand}$keys] $state] prevValue state
   set value "[set prevValue][set value]"
   lassign [exec_prim_dict_replace [list $dict {expand}$keys $value] $state] dict state
   return [exec_prim_dict_set [list $varname $dict] $state]
 }
 proc capicol::exec_prim_dict_create {arguments state} {
   log invoked [info level] [info level 0]
   if {([llength $arguments]  % 2) != 0} {
     return [call [list error "wrong # args: should be \"dict create ?key value ...?\""] $state]
   }
   return [list $arguments $state]
 }
 proc capicol::exec_prim_dict_exists {arguments state} {
   log invoked [info level] [info level 0]
   if {[llength $arguments] < 2} {
     return [call [list error "wrong # args: should be \"dict exists dictionary key ?key ...?\""] $state]
   }
   set dict [lindex $arguments 0]
   set keys [lrange $arguments 1 end]
   set found no
   while {[llength $keys] > 0} {
     set found no
     foreach {k v} $dict {
       if {[string equal $k [lindex $keys 0]]} {
         set found yes
         set value $v
       }
     }
     if {!$found} { break }
     set dict $value
     set keys [lrange $keys 1 end]
   }
   return [list $found $state]
 }
 proc capicol::exec_prim_dict_filter {arguments state} {
   log invoked [info level] [info level 0]
      set message "not yet implemented: use this idiom instead:\n"
   append message " set results {}\n"
   append message " foreach {key value} \$dictionary \{\n"
   append message "   if $condition \{\n"
   append message "     lappend result $key\n"
   append message "     lappend result $value\n"
   append message "   \}\n"
   append message " \}\n"
   return [call [list error $message] $state]
 }
 proc capicol::exec_prim_dict_for {arguments state} {
   log invoked [info level] [info level 0]
      set message "not yet implemented: ude this idiom instead:\n"
   append message "  foreach {keyVar valueVar} dictionary script\n"
   return [call [list error $message] $state]
 }
 proc capicol::exec_prim_dict_get {arguments state} {
   log invoked [info level] [info level 0]
   if {[llength $arguments] < 1} {
     return [call [list error "wrong # args: should be \"dict get dictionary ?key ...?\""] $state]
   }
   set dict [lindex $arguments 0]
   set keys [lrange $arguments 1 end]
   while {[llength $keys] > 0} {
     set found no
     foreach {k v} $dict {
       if {[string equal $k [lindex $keys 0]]} {
         set found yes
         set value $v
       }
     }
     if {!$found} {
       return [call [list error "key \"[lindex $keys 0]\" not known in dictionary"] $state]
     }
     set dict $value
     set keys [lrange $keys 1 end]
   }
   return [list $value $state]
 }
 proc capicol::exec_prim_dict_incr {arguments state} {
   log invoked [info level] [info level 0]
   if {[llength $arguments] < 3} {
     return [call [list error "wrong # args: should be \"dict append varName key ?key ...? increment\""] $state]
   }
   set varname [lindex $arguments 0]
   set keys    [lrange $arguments 1 end-1]
   set value   [lindex $arguments 0]

   lassign [exec_prim_get [list $varname] $state] dict state
   lassign [exec_prim_dict_get [list $dict {expand}$keys] $state] prevValue state
   set value "[set prevValue][set value]"
   lassign [exec_prim_dict_replace [list $dict {expand}$keys $value] $state] dict state
   return [exec_prim_dict_set [list $varname $dict] $state]
 }
 proc capicol::exec_prim_dict_info {arguments state} {
   log invoked [info level] [info level 0]
   return [list "" $state]
 }
 proc capicol::exec_prim_dict_keys {arguments state} {
   log invoked [info level] [info level 0]
   if {[llength $arguments] < 1} {
     return [call [list error "wrong # args: should be \"dict keys dictionary ?pattern?\""] $state]
   }
   set result {}
   set pattern *
   if {[llength $arguments] == 2} { set pattern [lindex $arguments 1] }
   foreach {key value} [lindex $arguments 0] {
     if {[string match $pattern $key]} {
       lappend result $key
     }
   }
   return [list $result $state]
 }
 proc capicol::exec_prim_dict_lappend {arguments state} {
   log invoked [info level] [info level 0]
   # use replace
 }
 proc capicol::exec_prim_dict_merge {arguments state} {
   log invoked [info level] [info level 0]
   set out {}
   foreach dict $arguments {
     if {([llength $dict] % 2) != 0} {
       return [call [list error "missing value to go with key"] $state]
     }
     foreach key [dict keys $dict] {
       dict set out $key [dict get $dict $key]
     }
   }
   return [list $out $state]
 }
 proc capicol::exec_prim_dict_remove {arguments state} {
   log invoked [info level] [info level 0]
   if {[llength $arguments] < 1} {
     return [call [list error "wrong # args: should be \"dict remove dictionary ?key ...?] $state]
   }
   set dict  [lindex $arguments 0]
   set keys  [lrange $arguments 1 end]
 
   set vstack [list $dict]
   if {[llength $keys] > 1} {
     foreach key [lrange $keys 0 end-1] {
       lassign [exec_prim_dict_get [list $dict [lindex $keys 0]] $state] dict state
       lappend vstack $dict
     }
     set key [lindex $keys 0]
   } else {
     set key $keys
   }
   set out {}
   foreach {k v} $dict {
     if {![string equal $k $key]} {
       lappend out $k
       lappend out $v
     }
   }
   if {[llength $keys] > 1} {
     lassign [exec_prim_dict_replace [list $out {expand}[lrange $keys 0 end-1] $out] $state] $out state
   }
   return [list $out $state]
 }
 proc capicol::exec_prim_dict_replace {arguments state} {
   log invoked [info level] [info level 0]
   if {[llength $arguments] < 3} {
     return [call [list error "wrong # args: should be \"dict replace dictionary key ?key ...? value\""] $state]
   }
   set dict  [lindex $arguments 0]
   set keys  [lrange $arguments 1 end-1]
   set value [lindex $arguments end]
 
   set kstack [lrange $keys 0 end-1]
   set vstack {}
   set d $dict
   while {[llength $kstack] > 0} {
     set v2 {}
     foreach {k v} $d {
       if {[string equal $k [lindex $kstack 0]]} { set v2 $v }
     }
     lappend vstack $v2
     set d $v2
      set kstack [lrange $kstack 1 end]
   }
   lappend vstack $value
   while {[llength $vstack] > 0} {
     set temp [lindex $vstack end-1]
     lappend temp [lindex $keys end]
     lappend temp [lindex $vstack end]
     lset vstack end-1 $temp
     set keys   [lrange $keys 0 end-1]
     set vstack [lrange $vstack 0 end-1]
   }
   set dict $vstack
   return [list $dict $state]
 }
 proc capicol::exec_prim_dict_set {arguments state} {
   log invoked [info level] [info level 0]
   if {[llength $arguments] < 3} {
     return [call [list error "wrong # args: should be \"dict set varName key ?key ...? value\""] $state]
   }
   set varname [lindex $arguments 0]
   set keys    [lrange $arguments 1 end-1]
   set value   [lindex $arguments end]
   lassign [exec_prim_var_exists? $varname $state] bool state
   if {$bool} {
     lassign [exec_prim_get $varname $state] dict state
   }
   lset arguments 0 $dict
   lassign [exec_prim_dict_replace $arguments $state] dict state
   return [exec_prim_set [list $varname $dict] $state]
 }
 proc capicol::exec_prim_dict_size {arguments state} {
   log invoked [info level] [info level 0]
   if {[llength $arguments] != 1} {
     return [call [list error "wrong # args: should be \"dict size dictionary\""] $state]
   }
   return [list [expr {[length $arguments] / 2}] $state]
 }
 proc capicol::exec_prim_dict_unset {arguments state} {
   log invoked [info level] [info level 0]
   # use dict remove
 }
 proc capicol::exec_prim_dict_update {arguments state} {
   log invoked [info level] [info level 0]
   return [call [list error "not yet implemented"] $state]
 }
 proc capicol::exec_prim_dict_values {arguments state} {
   log invoked [info level] [info level 0]
   if {[llength $arguments] < 1} {
     return [call [list error "wrong # args: should be \"dict values dictionary ?pattern?\""] $state]
   }
   set result {}
   set pattern *
   if {[llength $arguments] == 3} { set pattern [lindex $arguments 2] }
   foreach {key value} [lindex $arguments 1] {
     if {[string match $pattern $value]} {
       lappend result $value
     }
   }
   return [list $result $state]
 }
 proc capicol::exec_prim_dict_with {arguments state} {
   log invoked [info level] [info level 0]
 }


 proc capicol::exec_prim_die {arguments state} {
   log invoked [info level] [info level 0]
   set result {}
   dict set state running no
   dict lappend state out_queue [list die $arguments]
   return [list $result $state]
 }
 proc capicol::exec_prim_drop_capability {arguments state} {
   log invoked [info level] [info level 0]
   if {[llength $arguments] != 1} {
     return [call [list error "wrong # args: should be \"drop_capability\"] $state]
   }
   set caphandle [lindex $arguments 0]
   if {![dict exists $state capabilities $caphandle]} {
     return [call [list error "no such caphandle $caphandle"] $state]
   }
   dict unset state capabilities $caphandle
   return [list {} $state]
 }
 proc capicol::exec_prim_error {arguments state} {
   log invoked [info level] [info level 0]
   while true {
     if {[dict exists $state frame catcher]} break
     if {[string equal [dict get $state returnstack] ""]} {
       return [call [list die error $arguments] $state]
     }
     set state [lindex [exec_prim_return {} $state] end]
   }
   set catcher [dict get $state frame catcher]
   dict unset state frame catcher
   set state [lindex [exec_prim_set [list $catcher $arguments] $state] end]
   return [list true $state]
 }
 proc capicol::exec_prim_gain {arguments state} {
   log invoked [info level] [info level 0]
   return [call [list error "not yet implemented sorry!"] $state]
 }
 proc capicol::exec_prim_get {arguments state} {
   log invoked [info level] [info level 0]
   if {[llength $arguments] != 1} {
     return [call [list error "wrong # args: should be \"get varName\"] $state]
   }
   if {![dict exists $state variables $arguments]} {
     return [call [list error "can't read \"[set arguments]\": no such variable"] $state]
   }
   return [list [dict get $state variables $arguments] $state]
 }
 proc capicol::exec_prim_if {arguments state} {
   log invoked [info level] [info level 0]
   # only primitive if supported:
   #  if <test> <yes-command> [else <no-command>]
   if {([llength $arguments] < 2) || (4 < [llength $arguments])} {
     return [call [list error "wrong # args: should be \"if test yes-body \[else no-body\]\""] $state]
   }
   if {([llength $arguments] == 4) && ![string equal "else" [lindex $arguments 2]]} {
     return [call [list error "else keyword missing"] $state]
   }
   set test  [lindex $arguments 0]
   set true  [lindex $arguments 1]
   set false {}
   if {[llength $arguments] == 4} { set false [lindex $arguments 3] }
   set code [list uplevel 1 $test]
   lappend code [list __branch "\[0\]" 4]
   lappend code [list uplevel 1 $false]
   lappend code [list __jump 5]
   lappend code [list uplevel 1 $true]
   lappend code [list]
   return [call $code $state]
 }
 proc capicol::exec_prim_lappend {arguments state} {
   log invoked [info level] [info level 0]
   if {[llength $arguments] < 1} {
     return [call [list error "wrong # args: should be \"lappend varname ?value ...?\""] $state]
   }
   lassign [exec_prim_get [lindex $arguments 0] $state] result state
   foreach item [lrange $arguments 1 end] {
     lappend result $item
   }
   return [list $result $state]
 }
 proc capicol::exec_prim_lassign {arguments state} {
   log invoked [info level] [info level 0]
   if {[llength $arguments] < 2} {
     return [call [list error "wrong # args: should be \"lassign list varname ?varname ...?\""] $state]
   }
   set list [lindex $arguments 0]
   set vars [lrange $arguments 1 end]
 
   set counter 0
   foreach var $vars {
     lassign [exec_prim_set [list $var [lindex $list $counter]] $state] _ state
     incr counter
   }
   set result [lrange $list $counter end]
   return [list $result $state]
 }
 proc capicol::exec_prim_lindex {arguments state} {
   log invoked [info level] [info level 0]
   set tmp "lindex"
   foreach item $arguments { lappend tmp $item }
   if {[catch $tmp result]} {
     return [call [list error $result] $state]
   }
   return [list $result $state]
 }
 proc capicol::exec_prim_linsert {arguments state} {
   log invoked [info level] [info level 0]
   set tmp "linsert"
   foreach item $arguments { lappend tmp $item }
   if {[catch $tmp result]} {
     return [call [list error $result] $state]
   }
   return [list $result $state]
 }
 proc capicol::exec_prim_list {arguments state} {
   log invoked [info level] [info level 0]
   return [list $arguments $state]
 }
 proc capicol::exec_prim_llength {arguments state} {
   log invoked [info level] [info level 0]
   return [list [llength $arguments] $state]
 }
 proc capicol::exec_prim_lrange {arguments state} {
   log invoked [info level] [info level 0]
   set tmp "lrange"
   foreach item $arguments { lappend tmp $item }
   if {[catch $tmp result]} {
     return [call [list error $result] $state]
   }
   return [list $result $state]
 }
 proc capicol::exec_prim_lrepeat {arguments state} {
   log invoked [info level] [info level 0]
   set tmp "lrepeat"
   foreach item $arguments { lappend tmp $item }
   if {[catch $tmp result]} {
     return [call [list error $result] $state]
   }
   return [list $result $state]
 }
 proc capicol::exec_prim_lsearch {arguments state} {
   log invoked [info level] [info level 0]
   set tmp "lsearch"
   foreach item $arguments { lappend tmp $item }
   if {[catch $tmp result]} {
     return [call [list error $result] $state]
   }
   return [list $result $state]
 }
 proc capicol::exec_prim_lset {arguments state} {
   log invoked [info level] [info level 0]
   # not yet implemented
   return [list $result $state]
 }
 proc capicol::exec_prim_lsort {arguments state} {
   log invoked [info level] [info level 0]
   # not yet implemented
   return [list $result $state]
 }
 proc capicol::exec_prim_next_message {arguments state} {
   log invoked [info level] [info level 0]
   # no pattern matching or anything fancy
   if {[llength [dict get $state in-queue]] == 0} {
     # suspend the capicol state for a retry later
     dict set state running no
     dict incr state pointer -1
     return [list <?promise?> $state]
   }
   set message [lindex [dict get $state in-queue] 0]
   dict set state in-queue [lrange [dict get $state in-queue] 1 end]
   lassign $message addresses data quota
   lassign [caphandles_from_adddresses $addresses $state] caphandles state
   dict incr state quota $quota
   lset message 0 $caphandles
   return [list $message $state]
 }
 proc capicol::exec_prim_or {arguments state} {
   log invoked [info level] [info level 0]
   # not yet implemented
   return [list $result $state]
 }
 proc capicol::exec_prim_rename {arguments state} {
   log invoked [info level] [info level 0]
   if {[llength $arguments] != 2} {
     return [call [list error "wrong # args: should be \"rename oldName newName\""] $state]
   }
   set old [lindex $arguments 0]
   set new [lindex $arguments 1]
   if {![dict exists $state commands $old]} {
     return [call [list error "no such command: $old"] $state]
   }
   if {[dict exists $state commands $new]} {
     return [call [list error "$new exists already"] $state]
   }
   if {![string equal $new ""]} {
     dict set state commands $new [dict get $state commands $old]
   }
   dict unset state commands $old
   return [list {} $state]
 }
 proc capicol::exec_prim_return {arguments state} {
   log invoked [info level] [info level 0]
   # return from a routine command
   if {[llength $arguments] == 1} {
     set result [lindex $arguments 0]
   } else {
     set last_result_index [lindex [lsort [dict keys [dict get $state frame results] *]] end]
     set result [dict get $state frame results $last_result_index]
   }
   if {0 == [llength [dict get $state returnstack]]} {
     return [exec_prim_die "end of program" $state]
   }
   # related to uplevel -begin-
   if {[dict exists $state frame saveto]} {
     dict set state frame saveto variables [dict get $state frame variables]
   }
   # related to uplevel -end-
   dict set state frame [lindex [dict get $state returnstack] end]
   dict set state returnstack [lrange [dict get $state returnstack] 0 end-1]
   # related to uplevel -begin-
   if {[dict exists $state frame saveto]} {
     set t1 [dict get $state frame saveto dest]
     set t2 [dict get $state frame saveto variables]
     set t3 [lindex [dict get $state returnstack] $t1]
     set t4 [dict merge $t3 [list variables $t2]]
     set t5 [lreplace [dict get $state returnstack] $t1 $t1 $t4]
     dict set state returnstack $t5
     dict unset state frame saveto
   }
   # related to uplevel -end-
   dict set state results \[[dict get $state frame pointer]\] $result
   return [list $result $state]
 }
 proc capicol::exec_prim_routine {arguments state} {
   log invoked [info level] [info level 0]
   if {[llength $arguments] != 2} {
     return [call [list error "wrong # args: should be \"routine name body\"] $state]
   }
   set name [lindex $arguments 0]
   set body [lindex $arguments 1]
   if {[dict exists $state commands $name]} {
     return [call [list error "command already exists!"] $state]
   }
   dict set state commands $name type script
   dict set state commands $name contents $body
   return [list $name $state]
 }
 proc capicol::exec_prim_send_message {arguments state} {
   log invoked [info level] [info level 0]
   if {[llength $arguments] < 2} {
     return [call [list error "wrong # args: should be \"send_message caphandles data ?quota?\"] $state]
   }
   set caphandles [lindex $arguments 0]
   set data       [lindex $arguments 1]
   set quota      [lindex $arguments 2]
   if {[string equal $quota ""]} { set quota [string length $data] }
   if {$quota < [string length $data]} {
     return [call [list error "not enaugh quota alotted for data to be sent"] $state]
   }
   if {[dict get $state quota] < $quota} {
     return [call [list error "not enaugh quota to send message"] $state]
   }
   dict lappend state out_queue [list message [addresses_from_caphandles $caphandles] $data $quota]
   return [list {} $state]
 }
 proc capicol::exec_prim_set {arguments state} {
   log invoked [info level] [info level 0]
   if {[llength $arguments] != 2} {
     return [call [list error "wrong # args: should be \"set varName value\""] $state]
   }
   set varname [lindex $arguments 0]
   set value   [lindex $arguments 1]
   dict set state variables $varname $value
   return [list $value $state]
 }
 proc capicol::exec_prim_string {arguments state} {
   log invoked [info level] [info level 0]
   if {[llength $arguments] < 1} {
     return [call [list error "wrong # args: should be \"string option arg ?arg ...?\""] $state]
   }
   set subcommand [lindex $arguments 0]
   set rest       [lrange $arguments 1 end]
         if {[string equal "bytelength" $subcommand]} {
     return [exec_prim_string_bytelength $rest $state]
   } elseif {[string equal "compare"    $subcommand]} {
     return [exec_prim_string_compare $rest $state]
   } elseif {[string equal "equal"      $subcommand]} {
     return [exec_prim_string_equal $rest $state]
   } elseif {[string equal "first"      $subcommand]} {
     return [exec_prim_string_first $rest $state]
   } elseif {[string equal "index"      $subcommand]} {
     return [exec_prim_string_index $rest $state]
   } elseif {[string equal "is"         $subcommand]} {
     return [exec_prim_string_is $rest $state]
   } elseif {[string equal "last"       $subcommand]} {
     return [exec_prim_string_last $rest $state]
   } elseif {[string equal "length"     $subcommand]} {
     return [exec_prim_string_length $rest $state]
   } elseif {[string equal "map"        $subcommand]} {
     return [exec_prim_string_map $rest $state]
   } elseif {[string equal "match"      $subcommand]} {
     return [exec_prim_string_match $rest $state]
   } elseif {[string equal "range"      $subcommand]} {
     return [exec_prim_string_range $rest $state]
   } elseif {[string equal "repeat"     $subcommand]} {
     return [exec_prim_string_repeat $rest $state]
   } elseif {[string equal "replace"    $subcommand]} {
     return [exec_prim_string_replace $rest $state]
   } elseif {[string equal "tolower"    $subcommand]} {
     return [exec_prim_string_tolower $rest $state]
   } elseif {[string equal "toupper"    $subcommand]} {
     return [exec_prim_string_toupper $rest $state]
   } elseif {[string equal "totitle"    $subcommand]} {
     return [exec_prim_string_totitle $rest $state]
   } elseif {[string equal "trim"       $subcommand]} {
     return [exec_prim_string_trim $rest $state]
   } elseif {[string equal "trimleft"   $subcommand]} {
     return [exec_prim_string_trimleft $rest $state]
   } elseif {[string equal "trimright"  $subcommand]} {
     return [exec_prim_string_trimright $rest $state]
   } elseif {[string equal "wordend"    $subcommand]} {
     return [exec_prim_string_wordend $rest $state]
   } elseif {[string equal "wordstart"  $subcommand]} {
     return [exec_prim_string_wordstart $rest $state]
   } else {
     return [call [list error "bad option \"[set subcommand]\": must be bytelength, compare, equal, first, index, is, last, length, map, match, range, repeat, replace, tolower, toupper, totitle, trim, trimleft, trimright, wordend, or wordstart"] $state]
   }
 }
 proc capicol::exec_prim_string_bytelength {arguments state} {
   log invoked [info level] [info level 0]
 }
 proc capicol::exec_prim_string_compare {arguments state} {
   log invoked [info level] [info level 0]
 }
 proc capicol::exec_prim_string_equal {arguments state} {
   log invoked [info level] [info level 0]
 }
 proc capicol::exec_prim_string_first {arguments state} {
   log invoked [info level] [info level 0]
 }
 proc capicol::exec_prim_string_index {arguments state} {
   log invoked [info level] [info level 0]
 }
 proc capicol::exec_prim_string_is {arguments state} {
   log invoked [info level] [info level 0]
 }
 proc capicol::exec_prim_string_last {arguments state} {
   log invoked [info level] [info level 0]
 }
 proc capicol::exec_prim_string_length {arguments state} {
   log invoked [info level] [info level 0]
 }
 proc capicol::exec_prim_string_map {arguments state} {
   log invoked [info level] [info level 0]
 }
 proc capicol::exec_prim_string_match {arguments state} {
   log invoked [info level] [info level 0]
 }
 proc capicol::exec_prim_string_range {arguments state} {
   log invoked [info level] [info level 0]
 }
 proc capicol::exec_prim_string_repeat {arguments state} {
   log invoked [info level] [info level 0]
 }
 proc capicol::exec_prim_string_replace {arguments state} {
   log invoked [info level] [info level 0]
 }
 proc capicol::exec_prim_string_tolower {arguments state} {
   log invoked [info level] [info level 0]
 }
 proc capicol::exec_prim_string_toupper {arguments state} {
   log invoked [info level] [info level 0]
 }
 proc capicol::exec_prim_string_totitle {arguments state} {
   log invoked [info level] [info level 0]
 }
 proc capicol::exec_prim_string_trim {arguments state} {
   log invoked [info level] [info level 0]
 }
 proc capicol::exec_prim_string_trimleft {arguments state} {
   log invoked [info level] [info level 0]
 }
 proc capicol::exec_prim_string_trimright {arguments state} {
   log invoked [info level] [info level 0]
 }
 proc capicol::exec_prim_string_wordend {arguments state} {
   log invoked [info level] [info level 0]
 }
 proc capicol::exec_prim_string_wordstart {arguments state} {
   log invoked [info level] [info level 0]
 }
 

 proc capicol::exec_prim_unset {arguments state} {
   log invoked [info level] [info level 0]
   if {[llength $arguments] != 1} {
     return [call [list error "wrong # args: should be \"unset varname\""] $state]
   }
   dict unset state frame variables $arguments
   return [list "" $state]
 }
 proc capicol::exec_prim_uplevel {arguments state} {
   log invoked [info level] [info level 0]
   if {[llength $arguments] != 2} {
     return [call [list error "wrong # args: should be \"uplevel level script\""] $state]
   }
   set level  [lindex $arguments 0]
   set script [lindex $arguments 1]
   if {[string equal [string index $level 0] "#"]} {
     set relative {}
     set level [string range $level 1 end]
   } else {
     set relative "end-"
   }
   if {![string is digit $level]} {
     return [call [list error "level must be an number optionaly preceded with #"] $state]
   }
   set state [push_continuation $state]
 
   set frame [lindex [dict get $state returnstack] [set relative][set level]]
   dict set state frame variables [dict get $frame variables]
   dict set state frame args      [dict get $frame args]
   dict set state frame saveto dest [set relative][set level]
   dict set state frame pointer -1
   dict set state frame code [translate [lindex $arguments 1]]
   return [list {} $state]
 }
 proc capicol::exec_prim_var_exists? {arguments state} {
   log invoked [info level] [info level 0]
   if {[llength $arguments] != 1} {
     return [call [list error "wrong # args: should be \"var_exists? varName\""] $state]
   }
   return [list [dict exists $state variables $arguments] $state]
 }
 proc capicol::exec_prim_while {arguments state} {
   log invoked [info level] [info level 0]
   # not done
   if {[llength $arguments] != 2} {
     return [call [list error "wrong # args: should be \"while test script\""] $state]
   }
   set code [list error "<empty jump slot>"]
   # script body:
   lappend code [list uplevel 1 [lindex $arguments 1]]
   lset code 0 [list __jump [llength $code]]
   # here I use the picol way: test is an script
   lappend code [list uplevel 1 [lindex $arguments 0]]
   lappend code [list __branch "\[[llength $code]\]" 1]
   return [call $code $state]
 }
 proc capicol::exec_prim___branch {arguments state} {
   log invoked [info level] [info level 0]
   if {[llength $arguments] != 2} {
     return [call [list error "wrong # args: should be \"__branch condition destination\""] $state]
   }
   if {![string is bool [lindex $arguments 0]]} {
     return [call [list error "condition must be an boolean value"] $state]
   }
   if {![string is digit [lindex $arguments 1]]} {
     return [call [list error "destination must be numerical"] $state]
   }
   if {[string is true [lindex $arguements 0]]} {
     dict set state frame pointer [expr $arguments - 1]
   }
   return [list {} $state]
 }
 proc capicol::exec_prim___jump {arguments state} {
   log invoked [info level] [info level 0]
   if {[llength $arguments] != 1} {
     return [call [list error "wrong # args: should be \"__jump destination\""] $state]
   }
   if {![string is digit $arguments]} {
     return [call [list error "destination must be numerical"] $state]
   }
   dict set state frame pointer [expr $arguments - 1]
   return [list {} $state]
 }
 
 proc capicol::translate {script {offset 0}} {
   log invoked [info level] [info level 0]
   # todo: refactor this mess of a procedure
   # translates scripts into exec_lists
   set code [list]
   set counter $offset
   set level 0
   dict set stack $level {}
   set index 0
   set length [string length $script]
   set braced 0
   set quoted no
   while {$index < $length} {
     set char [string index $code $index]
     incr index
     if {[string equal "#" $char] && [string is space [dict get $stack $level]]} {
       # handle comments
       # deviates from the 11 syntax rules in the way that comments are until end of line
       while true {
         set char [string index $code $index]
         incr index
         if {[string equal "\n" $char]} { break }
       }
     } elseif {[string equal "\$" $char] && !$braced} {
       # translate $varname into [get varname]
       set varname ""
       while true {
         set char [string index $script $index]
         incr index
         if {[string is space $char] || [string equal $char "\""]} {
           break
         } else {
           append varname $char
         }
       }
       lappend code "get $varname"
       dict append stack $level "\[[set counter]\]"
       incr counter
     } elseif {[string equal $char "\""] && !$braced} {
       # handle quotes
       if {$quoted} {
         set quoted no
       } else {
         set quoted yes
       }
     } elseif {[string equal $char "\\"]} {
       # handle escaped characters
       dict append stack $level "\\"
       dict append stack $level [string index $script $index]
       incr index
     } elseif {[string equal $char "\["] && !$braced} {
       # handle opening bracket
       incr level +1
       dict set stack $level {}
     } elseif {[string equal $char "\]"] && !$braced} {
       # handle closeing bracket
       lappend code [dict get $stack $level]
       dict unset stack $level
       incr level -1
       if {$level < 0} { error "too many \[ or too few \]" }
       dict append stack $level \[[set counter]\]
       incr counter
     } elseif {([string equal $char "\n"] || [string equal $char ";"]) && !$braced} {
       # handle newline and semicolon
       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
     }
   }
   return $code
 }
 proc capicol::interpolate {map template} {
   log invoked [info level] [info level 0]
   set out {}
   set i 0
   while {$i < [string length $template]} {
     set char [string index $template $i]
     incr i
     if {[string equal $char "\["]} {
       set tag {}
       while true {
         set char [string index $template $i]
         incr i
         if {[string equal $char "\]"]} {
           break
         } elseif {[string equal $char "\["]} {
           error "only one bracket level allowed in interpolation"
         } else {
           append tag $char
         }
         if {$i >= [string length $template]} {
           error "where is the closing bracket?"
         }
       }
       if {![dict exists $map $tag]} { error "tag not found in map" }
       append out [dict get $map $tag]
       # finnst eins og ég sé að gleyma einhverju hér
     } elseif {[string equal $char "\{"]} {
       append out $char
       set level 1
       while true {
         set char [string index $template $i]
         incr i
         if {[string equal $char "\{"]} {
           incr level +1
         } elseif {[string equal $char "\}"]} {
           incr level -1
         }
         append out $char
         if {$level == 0} { break }
         if {$i >= [string length $template]} {
           error "missing closing brace some where"
          }
      }
     } elseif {[string equal $char "\\"]} {
       append out "\\"
       append out [string index $template $i]; incr i
      } else {
      append out $char
     }
   }
   return $out
 }

 proc capicol::new_state {} {
   log invoked [info level] [info level 0]
   dict set c frame args {}
   dict set c frame pointer 0
   dict set c frame results {}
   dict set c frame variables {}
   dict set c frame code [list [list error "capicol::new_state doesnt supply the code! you do!"]]
   dict set c returnstack {}
   dict set c quota 4096; # bit of an quota well here, no?
   dict set c commands  {
     +               {type prim contents +}
     -               {type prim contents -}
     *               {type prim contents *}
     /               {type prim contents /}
     %               {type prim contents %}
     &               {type prim contents &}
     |               {type prim contents |}
     ^               {type prim contents ^}
     <               {type prim contents <}
     <<              {type prim contents <<}
     >>              {type prim contents >>}
     <=              {type prim contents <=}
     ==              {type prim contents ==}
     !=              {type prim contents !=}
     and             {type prim contents and}
     any_messages?   {type prim contents any_messages?}
     args            {type prim contents args}
     beget           {type prim contents beget}
     break           {type prim contents break}
     catch           {type prim contents catch}
     capabilities    {type prim contents capabilities}
     continue        {type prim contents continue}
     dict            {type prim contents dict}
     die             {type prim contents die}
     drop_capability {type prim contents drop_capability}
     error           {type prim contents error}
     gain            {type prim contents gain}
     get             {type prim contents get}
     if              {type prim contents if}
     lappend         {type prim contents lappend}
     lassign         {type prim contents lassign}
     lindex          {type prim contents lindex}
     linsert         {type prim contents linsert}
     list            {type prim contents list}
     llength         {type prim contents llength}
     lrange          {type prim contents lrange}
     lrepeat         {type prim contents lrepeat}
     lreplace        {type prim contents lreplace}
     lsearch         {type prim contents lsearch}
     lset            {type prim contents lset}
     lsort           {type prim contents lsort}
     next_message    {type prim contents next_message}
     or              {type prim contents or}
     rename          {type prim contents rename}
     return          {type prim contents return}
     routine         {type prim contents routine}
     send_message    {type prim contents send_message}
     set             {type prim contents set}
     string          {type prim contents string}
     uplevel         {type prim contents uplevel}
     var_exists?     {type prim contents var_exists?}
     while           {type prim contents while}
     __branch        {type prim contents __branch}
     __jump          {type prim contents __jump}
   }
   return $c
 }

 proc capicol::send_message {sender message} {
   log invoked [info level] [info level 0]
   variable capicols
   
   lassign $message addresses
   lassign $addresses destination

   if {[dict exists $capicols $destination]} {
     # internal (between capicols on same machine/runtime)
     schedule $destination
     set t [dict get $capicols $destination in_queue]
     lappend t $message
     dict set $capicols $destination in_queue $t
   } else {
     # external (to external objects and between capicols on diffrent machines/runtimes)
     send_message_out $sender $message
   }
   return
 }
 proc capicol::send_message_out {sender message} {
   log invoked [info level] [info level 0]
   # for now just print the whole thing
   puts stdout "capicol message: [list $message]"
   flush stdout
 }
 proc capicol::schedule {name} {
   log invoked [info level] [info level 0]
   variable capicols
   variable runlist
   dict set capicols $name running yes
   if {![dict exists $capicols $name run_slice_size]} {
     dict set capicols $name run_slice_size 8
   }
   if {[lsearch -exact $runlist $name] == -1} {
     lappend runlist $name
   }
   return
 }
 proc capicol::deschedule {name} {
   log invoked [info level] [info level 0]
   variable capicols
   variable runlist
   dict set capicols $name running no
   set t [lsearch -exact $runlist $name]
   set runlist [lreplace $runlist $t $t]
   return
 }
 proc capicol::run_one_slice {} {
   log invoked [info level] [info level 0]
   variable capicols
   variable runlist
   set name [lindex $runlist 0]
   set runlist [join [list [lrange $runlist 1 end] [list $name]]]
   set state [dict get $capicols $name]
   if {![dict exists $state run_slice_size]} {
     dict set state run_slice_size 8
   }
   set counter [dict get $state run_slize_size]
   while {[dict get $state running]} {
     set state [advance $state]
     if {$counter == 0} { break }
     incr counter -1
   }
   if {![dict get $state running]} {
     deschedule $name
   }

   set messages [dict get $state out_queue]
   dict set state out_queue {}
   dict set capicols $name $state
   
   foreach message $messages {
     set type [lindex $message 0]
     if {[string equal $type "die"]} {
       set reason [lindex $message 1]
       # for now print to stderr
       puts stderr "capicol $name died because of \"$reason\" (but its carcass is still around mind you)"
       # later:
       #set message  [list capicol-death $name $reason $state]
       #unschedule $name
       #dict unset capicols $name
       #send_message [list $creator $message [string length $message]]
       break
     } elseif {[string equal $type "beget"]} {
       set child_name   [lindex $message 1]
       set startup_code [lindex $message 3]
       set addresses    [lindex $message 4]
       set quota        [lindex $message 5]
       
       set child [new_state]
       dict set child my_address $child_name
       dict incr child quota $quota
       lassign [caphandles_from_adddresses $addresses $child] dummy child
       dict set child code [translate $startup_code]
       
       dict set capicols $child_name $child
       schedule $child_name

       return
     } elseif {[string equal $type "gain"]} {
       set certificate [lindex $message 1]
       # requires SEXP and SPKI
       # where an certificate contains
       #   . a set of capabilities (capicol addresses in this instance) can be granted to
       #     eather an prinicipal (see SPKI docu) or an capicol
       #   . more quota can be granted to eather an principal or an capicol
       #   . an forzen capicol state that can be thawed and run
       #   . an beget code as in the beget capicol primitive
     } elseif {[string equal $type "message"]} {
       send_message $name [lindex $message 1]
     } else {
       error "what the heck is [set type]? ([set message])"
     }
   }
  }
  # added at wiki:
  proc capicol::start {} {
    capicol::run_one_slice    
    after idle [info level 0]
  }

----
[Category Code]