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

[Zarutian] 11. july 2007:
So how does Capicol (or intend to) implement capabilities?
Well, simply through a dictionary that the code running in the capicol interp doesn't have
access to.

That dictionary maps handles to addresses of other Capicolets (and simple i/o adaptors to the world outside the Capicolets),
Capicolet being the snapshot state of an capicol interp, which might themselves be running or stored on other machines.
Back to that dictionary. A Capicolet can only send an message to an address it has a handle for.

So how does a Capicolet get an handle for a yet unknown address?

Via the addresses field of a message that the capicol interp code replaces with handles (making new ones when coming across currently unknown addresses)
upon receipt of a message and vice verse on sending.

[Zarutian] 20.. july 2007: for an introduction to capability based security see http://www.skyhunter.com/marcs/capabilityIntro/index.html and on capability based security in general see erights.org
New and improved version of the following code coming soon.

 # 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]