Capicol

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.

Zarutian 23. july 2007: Needs a bit wikignoming that I dont have time to do right now. (Needs a space before each line of code) Turns out I have a bit time.

Zarutian 19. september 2007: I am thinking about simplifing the capability list saved with each capicol state.

 # 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.6
 package require Tcl 8.5
 package provide capicol 0.6.0

 # state:
 #   my_address
 #     <capicol address>
 #   number_of_children
 #     <number>
 #   running
 #     <boolean>
 #   quota
 #     <number>
 #   capabilities
 #     <address>*
 #   in-queue
 #     <in_message>*
 #   out_queue
 #     <out_message>*
 #      <type>
 #   commands
 #     <command name>*
 #       <type> <contents>
 #   returnstack
 #     frame*
 #   frame
 #     pointer
 #       <number>
 #     code
 #       <call template>*
 #     results
 #       <number>
 #         <result>
 #     type
 #       macro | micro
 # einungis fyrir macro frames:
 #     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
 # <type> := "prim" | "execlist" | "script"
 #
 # decided to upvar state from all that stuff that [advance $state] invokes
 # þarf að breyta áköll á exec_prim_set úr öðrum exec_prims yfir í call set <varname> <value>
 # þarf að breyta exec_prim_set þannig að það finni macro frame og breyti breytum þar

 namespace eval capicol {}
 proc capicol::log args {
   # override with another proc to get all kind of debugging data.
 } 
 namespace eval capicol::interp {}

 proc capicol::interp::state_check {} {
   upvar state state
   if {![dict exists $state commands]}        { error "commands missing" }
   if {![dict exists $state frame code]}      { error "code missing" }
   if {![dict exists $state my_address]} {
     error "an capicol state cannot be without an address!"
   }
   if {![dict exists $state capabilities]} {
     error "an capicol without capabilities: why?"
   }
   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 {} }
 }
 proc capicol::interp::prepare_command_to_be_invoked {} {
   upvar state state
   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]]
   return [set cmd&args]
 }
 proc capicol::interp::new_callframe_for_execlist {code args} {
   upvar state state
   dict set state frame code $code
   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
 }
 proc capicol::interp::advance {state} {
   capicol::log invoked [info level] [info level 0]
   state_check
   set args [lassign [prepare_command_to_be_invoked] cmd]
   if {[dict exists $state commands $cmd]} {
     if {[llength [dict get $state commands $cmd]] > 1} { error "malformed command record for $cmd" }
     set rest [lassign [dict get $state commands $cmd] type contents]
     switch -exact -- $type {
       "execlist" {
         push_continuation $state
         new_callframe_for_execlist $contents $args
       }
       "prim"     {
         set pointer [dict get $state frame pointer]
         dict set state frame results $pointer [exec_prim [dict get $state commands $cmd contents] $args]
       }
       "script"   {
         dict set state commands $cmd [list execlist [translate $contents] $contents]
         return [advance $state]
       }
       default {
         error "unknown command type $type"
       }
     }
   } else {
     # the unknown command handling
     if {![dict exists $state commands unknown]} {
       call error "unknown command $cmd"
       return
     } else {
       # invoke the unknown command
       dict set state frame results \[[dict get $state pointer]\] [call unknown [set cmd&args]]
     }
   }
   if {[llength [dict get $state frame code]] < [dict get $state frame pointer]} {
     # execution fell off the end of an execlist
     set state [lindex [exec_prim_return {} $state] end]
   }
   dict set state frame pointer [expr [dict get $state frame pointer] + 1]; # autoincr
   return $state
 }
 proc capicol::interp::translate {script {offset 0}} {
   upvar state state; # here only for [call error] in this procedure
   capicol::log invoked [info level] [info level 0]
   # todo: refactor this mess of a procedure
   # translates scripts into execlists
   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} { call 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} { call 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} {
         call 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::interp::interpolate {map template} {
   # mig grunar að þessi procedure hafi einhver vandkvæði
   capicol::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::interp::space_quota_check {} {
   upvar state state
   if {([string length [dict get $state commands]] + \
        [string length [dict get $state returnstack]] + \
        [string length [dict get $state frame]]) > [dict get $state quota]} {
     call error "not enaugh quota to run!"
     return
   }
 }
 proc capicol::interp::push_continuation {continuation} {
   upvar state state
   capicol::log invoked [info level] [info level 0]
   set temp [dict create]
   dict lappend state returnstack [dict get $state frame]
   space_quota_check
 }
 proc capicol::interp::call {args} {
   upvar state state
   capicol::log invoked [info level] [info level 0]
   push_continuation $state
   dict set state frame code [list [set args]]
   dict set state frame pointer -1
   #return -code return
 }

 # primitives (or built in commands)
 proc capicol::interp::exec_prim {primid arguments} {
   upvar state state
   capicol::log invoked [info level] [info level 0]
   # giant despatching switch
   # I rather use jump tables but cant have them easily in higher level languages
   # I wonder about the speed of this thing
   switch -exact -- $primid {
      "+" -
      "-" -
      "*" -
      "/" -
      "%" -
      "&" -
      "|" -
      "^" -
     "<<" -
     ">>" { return [exec_prim_math $primid $arguments] }
     "<"  -
     "<=" -
     "==" -
     "!=" { return [exec_prim_compare $primid $arguments] }
     "and"             { return [exec_prim_logical_and $arguments] }
     "any_messages?"   { return [exec_prim_any_messages? $arguments] }
     "args"            { return [exec_prim_args $arguments] }
     "beget"           { return [exec_beget $arguments] }
     "break"           { return [exec_prim_break $arguments] }
     "catch"           { return [exec_prim_catch $arguments] }
     "capabilities"    { return [exec_prim_capabilites $arguments] }
     "continue"        { return [exec_prim_continue $arguments] }
     "command_exists?" { return [exec_prim_command_exists? $arguments] }
     "dict"            { return [exec_prim_dict $arguments] }
     "die"             { return [exec_prim_die $arguments] }
     "drop_capability" { return [exec_prim_drop_capability $arguments] }
     "error"           { return [exec_prim_error $arguments] }
     "gain"            { return [exec_prim_gain $arguments] }
     "get"             { return [exec_prim_get $arguments] }
     "if"              { return [exec_prim_if $arguments] }
     "lappend"         { return [exec_prim_lappend $arguments] }
     "lassign"         { return [exec_prim_lassign $arguments] }
     "lindex"          { return [exec_prim_lindex $arguments] }
     "linsert"         { return [exec_prim_linsert $arguments] }
     "list"            { return [exec_prim_list $arguments] }
     "llength"         { return [exec_prim_llength $arguments] }
     "lrange"          { return [exec_prim_lrange $arguments] }
     "lrepeat"         { return [exec_prim_lrepeat $arguments] }
     "lsearch"         { return [exec_prim_lsearch $arguments] }
     "lset"            { return [exec_prim_lset $arguments] }
     "lsort"           { return [exec_prim_lsort $arguments] }
     "next_message"    { return [exec_prim_next_message $arguments] }
     "not"             { return [exec_prim_logical_not $arguments] }
     "or"              { return [exec_prim_logical_or $arguments] }
     "rename"          { return [exec_prim_rename $arguments] }
     "return"          { return [exec_prim_return $arguments] }
     "routine"         { return [exec_prim_routine $arguments] }
     "send_message"    { return [exec_prim_send_message $arguments] }
     "set"             { return [exec_prim_set $arguments] }
     "string"          { return [exec_prim_string $arguments] }
     "unset"           { return [exec_prim_unset $arguments] }
     "uplevel"         { return [exec_prim_uplevel $arguments] }
     "var_exists?"     { return [exec_prim_var_exists? $arguments] }
     "while"           { return [exec_prim_while $arguments] }
     "__branch"        { return [exec_prim___branch $arguments] }
     "__jump"          { return [exec_prim___jump $arguments] }
     default  { error "unknown capicol primitive $primid" }
   }
 }
 proc capicol::interp::exec_prim_math {op arguments} {
   capicol::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 $result
 }
 proc capicol::interp::exec_prim_compare {op arguments} {
   capicol::log invoked [info level] [info level 0]
   if {[llength $arguments] != 2} {
     upvar state state
     call error "wrong # args: should be \"$op number number\""
     return
   }
   return [expr [lindex $arguments 0] $op [lindex $arguments 1]]
 }
 proc capicol::interp::exec_prim_logical_and {arguments} {
   log invoked [info level] [info level 0]
   set result [lindex $arguments 0]
   foreach item [lrange $arguments 1 end] {
     set result [expr $result && $item]
   }
   return $result
 }
 proc capicol::interp::exec_prim_any_messages? {arguments} {
   upvar state state
   capicol::log invoked [info level] [info level 0]
   if {![dict exists $state in_queue]} {
     dict set state in_queue {}
   }
   return [expr [llength [dict get $state in_queue]] != 0]
 }
 proc capicol::interp::exec_prim_args {arguments} {
   upvar state state
   capicol::log invoked [info level] [info level 0]
   if {![dict exists $state frame args]} {
     dict set state frame args {}
   }
   return [dict get $state frame args]
 }
 proc capicol::interp::exec_prim_beget {arguments} {
   upvar state state
   capicol::log invoked [info level] [info level 0]
   if {[llength $arguments] != 3} {
     call error "wrong # args: should be \"beget startup_script capabilities quota\""
     return
   }
   set startup_script [lindex $arguments 0]
   set addresses      [lindex $arguments 1]
   set quota          [lindex $arguments 2]

   foreach address $addresses {
     if {[lsearch -exact [dict get $state capabilities] $address] == -1} {
       call error "this capicol has no such address in capabilities list: $address"
       return
     }
   }

   if {[dict get $state quota] < $quota} {
     call error "this capicol has not enaugh quota for giving to child"
     return
   }
   if {$quota < [string length $startup_script]} {
     call error "not enaugh quota allotted to child for the startup script!"
     return
   }

   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
   }
   # make new address for the "child" using the replicator serial scheme
   set child "[dict get $state my_address].[dict incr state number_of_children]"
   ::capicol::runtime::beget $child $startup_script $addresses $quota
   # add the child to the states capabilities list
   dict lappend state capabilities $child
   return $child
 }
 proc capicol::interp::exec_prim_break {arguments} {
   # depends on the implementation of exec_prim_while
   upvar state state
   capicol::log invoked [info level] [info level 0]
   # search up the invocation stack for break-goto
   set level [llength [dict get $state returnstack]]
   incr level -1
   while true {
     set frame [lindex [dict get $state returnstack] $level]
     if {[dict exists $frame break-goto]} {
       incr level -1
       dict set state returnstack [lrange [dict get $state returnstack] 0 $level]
       dict set state frame $frame
       dict set state frame pointer [expr [dict get $frame break-goto] - 1]
       return
     }
     if {$level == -1} {
       call error "break invoked outside an loop"
       return
     }
     incr level -1
   }
 }
 proc capicol::interp::exec_prim_catch {arguments} {
   # depends on the implementation of exec_prim_error
   upvar state state
   capicol::log invoked [info level] [info level 0]
   # catch <script> [<var>]
   if {([llength $arguments] < 1) || ([llength $arguments] > 2)} {
     call error "wrong # args: should be \"catch script ?var?\""
     return
   }
   dict set state frame catcher [lindex $arguments 1]
   exec_prim_upevel [list 0 [lindex $arguments 0]]
 }
 proc capicol::interp::exec_prim_capabilities {arguments} {
   upvar state state
   capicol::log invoked [info level] [info level 0]
   if {![dict exists $state capabilities]} {
     error "an capicol without capabilities: why?"
   }
   return [dict get $state capabilities]
 }
 proc capicol::interp::exec_prim_continue {arguments} {
   # depends on the implementation of exec_prim_while
   upvar state state
   capicol::log invoked [info level] [info level 0]
   # search up the invocation stack for continue-goto
   set level [llength [dict get $state returnstack]]
   incr level -1
   while true {
     set frame [lindex [dict get $state returnstack] $level]
     if {[dict exists $frame continue-goto]} {
       incr level -1
       dict set state returnstack [lrange [dict get $state returnstack] 0 $level]
       dict set state frame $frame
       dict set state frame pointer [expr [dict get $frame continue-goto] - 1]
       return
     }
     if {$level == -1} {
       call error "continue invoked outside an loop"
       return
     }
     incr level -1
   }
 }
 proc capicol::interp::exec_prim_dict {arguments} {
   upvar state state
   capicol::log invoked [info level] [info level 0]
   if {[llength $arguments] < 1} {
     call error "wrong # args: should be \"dict subcommand ?arg ...?\""
     return
   }
   # simple dispatcher
   set subcommand [lindex $arguments 0]
   set arguments [lrange $arguments 1 end]
   switch -exact -- $subcommand {
     "append"  { return [exec_prim_dict_append  $arguments] }
     "create"  { return [exec_prim_dict_create  $arguments] }
     "exists"  { return [exec_prim_dict_exists  $arguments] }
     "filter"  { return [exec_prim_dict_filter  $arguments] }
     "for"     { return [exec_prim_dict_for     $arguments] }
     "get"     { return [exec_prim_dict_get     $arguments] }
     "incr"    { return [exec_prim_dict_incr    $arguments] }
     "info"    { return [exec_prim_dict_info    $arguments] }
     "keys"    { return [exec_prim_dict_keys    $arguments] }
     "lappend" { return [exec_prim_dict_lappend $arguments] }
     "merge"   { return [exec_prim_dict_merge   $arguments] }
     "remove"  { return [exec_prim_dict_remove  $arguments] }
     "replace" { return [exec_prim_dict_replace $arguments] }
     "set"     { return [exec_prim_dict_set     $arguments] }
     "size"    { return [exec_prim_dict_size    $arguments] }
     "unset"   { return [exec_prim_dict_unset   $arguments] }
     "update"  { return [exec_prim_dict_update  $arguments] }
     "values"  { return [exec_prim_dict_values  $arguments] }
     "with"    { return [exec_prim_dict_remove  $arguments] }
   }
   call 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"
 }
 proc capicol::interp::exec_prim_dict_append {arguments} {
   upvar state state
   capicol::log invoked [info level] [info level 0]
   if {[llength $arguments] < 3} {
     call error "wrong # args: should be \"dict append varName key ?key ...? value\""
     return
   }
   set varname [lindex $arguments 0]
   set keys    [lrange $arguments 1 end-1]
   set value   [lindex $arguments 0]

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

   set dict [exec_prim_get [list $varname]]
   set prevValue [exec_prim_dict_get [list $dict {*}$keys]]
   set value "[set prevValue][set value]"
   set dict [exec_prim_dict_replace [list $dict {*}$keys $value]]
   exec_prim_dict_set [list $varname $dict]
   return $value
 }
 proc capicol::interp::exec_prim_dict_info {arguments} {
   capicol::log invoked [info level] [info level 0]
   return "no info"
 }
 proc capicol::interp::exec_prim_dict_keys {arguments} {
   upvar state state
   capicol::log invoked [info level] [info level 0]
   if {[llength $arguments] < 1} {
     call error "wrong # args: should be \"dict keys dictionary ?pattern?\""
     return
   }
   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 $result
 }
 proc capicol::interp::exec_prim_dict_lappend {arguments} {
   upvar state state
   capicol::log invoked [info level] [info level 0]
   # use replace
   call error "not yet implemented!"
 }
 proc capicol::interp::exec_prim_dict_merge {arguments} {
   upvar state state
   capicol::log invoked [info level] [info level 0]
   set out {}
   foreach dict $arguments {
     if {([llength $dict] % 2) != 0} {
       call error "missing value to go with key"
       return
     }
     foreach key [dict keys $dict] {
       dict set out $key [dict get $dict $key]
     }
   }
   return $out
 }
 proc capicol::interp::exec_prim_dict_remove {arguments} {
   upvar state state
   capicol::log invoked [info level] [info level 0]
   if {[llength $arguments] < 1} {
     call error "wrong # args: should be \"dict remove dictionary ?key ...?\""
     return
   }
   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] {
       set dict [exec_prim_dict_get [list $dict [lindex $keys 0]]]
       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} {
     set out [exec_prim_dict_replace [list $out {*}[lrange $keys 0 end-1] $out]]
   }
   return $out
 }
 proc capicol::interp::exec_prim_dict_replace {arguments} {
   upvar state state
   capicol::log invoked [info level] [info level 0]
   if {[llength $arguments] < 3} {
     call error "wrong # args: should be \"dict replace dictionary key ?key ...? value\""
     return
   }
   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 $dict
 }
 proc capicol::interp::exec_prim_dict_set {arguments} {
   upvar state state
   capicol::log invoked [info level] [info level 0]
   if {[llength $arguments] < 3} {
     call error "wrong # args: should be \"dict set varName key ?key ...? value\""
     return
   }
   set varname [lindex $arguments 0]
   set keys    [lrange $arguments 1 end-1]
   set value   [lindex $arguments end]
   set bool [exec_prim_var_exists? $varname]
   if {$bool} {
     set dict [exec_prim_get $varname]
   }
   lset arguments 0 $dict
   set dict [exec_prim_dict_replace $arguments]
   return [exec_prim_set [list $varname $dict]]
 }
 proc capicol::interp::exec_prim_dict_size {arguments} {
   upvar state state
   capicol::log invoked [info level] [info level 0]
   if {[llength $arguments] != 1} {
     call error "wrong # args: should be \"dict size dictionary\""
     return
   }
   return [expr {[length $arguments] / 2}]
 }
 proc capicol::interp::exec_prim_dict_unset {arguments} {
   upvar state state
   capicol::log invoked [info level] [info level 0]
   # use dict remove
   call error "not yet implemented!"
 }
 proc capicol::interp::exec_prim_dict_update {arguments} {
   upvar state state
   capicol::log invoked [info level] [info level 0]
   call error "not yet implemented!"
 }
 proc capicol::interp::exec_prim_dict_values {arguments} {
   upvar state state
   capicol::log invoked [info level] [info level 0]
   if {[llength $arguments] < 1} {
     call error "wrong # args: should be \"dict values dictionary ?pattern?\""
     return
   }
   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 $result
 }
 proc capicol::interp::exec_prim_dict_with {arguments} {
   upvar state state
   capicol::log invoked [info level] [info level 0]
   call error "not yet implemented!"
 }
 # prim dict -end-
 proc capicol::interp::exec_prim_die {arguments} {
   upvar state state
   capicol::log invoked [info level] [info level 0]
   capicol::runtime::died $state $arguments
 }
 proc capicol::interp::exec_prim_drop_capability {arguments} {
   upvar state state
   capicol::log invoked [info level] [info level 0]
   if {[llength $arguments] != 1} {
     call error "wrong # args: should be \"drop_capability <address>\""
     return
   }
   if {![dict exists $state capabilities]} {
     error "an capicol without an capabilities: why?"
   }
   if {[set r [lsearch -exact [dict get $state capabilities] $arguments]] == -1} {
     call error "this capicol doesnt have address $arguments on its capabilities list"
     return
   }
   dict set state capabilities [lreplace [dict get $state capabilities] $r $r]
 }
 proc capicol::interp::exec_prim_error {arguments} {
   # depends on the implementation of exec_prim_catch
   upvar state state
   capicol::log invoked [info level] [info level 0]
   while true {
     if {[dict exists $state frame catcher]} break
     if {[string equal [dict get $state returnstack] ""]} {
       call die error $arguments
       return
     }
     exec_prim_return {}
   }
   set catcher [dict get $state frame catcher]
   dict unset state frame catcher
   exec_prim_set [list $catcher $arguments]
   return true
 }
 proc capicol::interp::exec_prim_gain {arguments} {
   upvar state state
   capicol::log invoked [info level] [info level 0]
   call error "not yet implemented!"
 }
 proc capicol::interp::exec_prim_get {arguments} {
   upvar state state
   capicol::log invoked [info level] [info level 0]
   if {[llength $arguments] != 1} {
     call error "wrong # args: should be \"get varName\"
     return
   }
   if {![dict exists $state frame variables $arguments]} {
     call error "can't read \"[set arguments]\": no such variable"
     return
   }
   return [dict get $state frame variables $arguments]
 }
 proc capicol::interp::exec_prim_if {arguments} {
   upvar state state
   capicol::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])} {
     call error "wrong # args: should be \"if test yes-body \[else no-body\]\""
     return
   }
   if {([llength $arguments] == 4) && ![string equal "else" [lindex $arguments 2]]} {
     call error "else keyword missing"
     return
   }
   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]
   push_continuation $state
   dict set state frame code $code
   dict set state frame pointer -1
   return
 }
 proc capicol::interp::exec_prim_lappend {arguments} {
   upvar state state
   capicol::log invoked [info level] [info level 0]
   if {[llength $arguments] < 1} {
     call error "wrong # args: should be \"lappend varname ?value ...?\""
     return
   }
   set result [exec_prim_get [lindex $arguments 0]]
   foreach item [lrange $arguments 1 end] {
     lappend result $item
   }
   exec_prim_set [list [lindex $arguments 0] $result]
   return $result
 }
 proc capicol::interp::exec_prim_lassign {arguments} {
   upvar state state
   log invoked [info level] [info level 0]
   if {[llength $arguments] < 2} {
     call error "wrong # args: should be \"lassign list varname ?varname ...?\""
     return
   }
   set list [lindex $arguments 0]
   set vars [lrange $arguments 1 end]

   set counter 0
   foreach var $vars {
     exec_prim_set [list $var [lindex $list $counter]]
     incr counter
   }
   return [lrange $list $counter end]
 }
 proc capicol::interp::exec_prim_lindex {arguments} {
   upvar state state
   capicol::log invoked [info level] [info level 0]
   if {[llength $arguments] < 1} {
     call error "wrong # args: should be \"lindex list ?index ...?\""
     return
   }
   set list    [lindex $arguments 0]
   set indexes [lrange $arguments 1 end]
   foreach item $indexes {
     if {![string is digit $item] && \
         ![string equal -length 3 "end" $item] && \
         ![string equal -length 4 "end-" $item]} {
       call error "bad index \"[set item]\": must be integer or end?-integer?"
       return
     }
     set list [lindex $list $item]
   }
   return [list $list $state]
 }
 proc capicol::interp::exec_prim_linsert {arguments} {
   upvar state state
   capicol::log invoked [info level] [info level 0]
   if {[llength $arguments] < 3} {
     call error "wrong # args: should be \"linsert list index element ?element ...?\""
     return
   }
   set list     [lindex $arguments 0]
   set index    [lindex $arguments 1]
   if {![string is digit $index] && \
       ![string equal -length 3 "end" $index] && \
       ![string equal -length 4 "end-" $index]} {
     call error "bad index \"[set index]\": must be integer or end?-integer?"
     return
   }
   if {[string equal -length "end-" $index]} {
     set index [expr {[llength $list] - [string range $index 4 end]}
   }
   set elements [lrange $arguments 2 end]
   foreach item $elements {
     set list [linsert $list $index $item]
     incr index +1
   }
   return $list
 }
 proc capicol::interp::exec_prim_list {arguments} {
   capicol::log invoked [info level] [info level 0]
   return $arguments
 }
 proc capicol::exec_prim_llength {arguments} {
   upvar state state
   capicol::log invoked [info level] [info level 0]
   if {[llength $arguments != 1} {
     call error "wrong # args: should be \"llength list\""
     return
   }
   return [llength [lindex $arguments 0]]
 }
 # var hér þann 26. október 2007 kl 01:48
  proc exec_prim_lrange {arguments} {
    upvar state state
    log invoked [info level] [info level 0]
    if {[llength $arguments != 3} {
      call error "wrong # args: should be \"lrange list first last\""
      return
    }
    set list  [lindex $arguments 0]
    set first [lindex $arguments 1]
    if {![string is digit $first] && \
        ![string equal -length 3 "end" $first] && \
        ![string equal -length 4 "end-" $first]} {
      call error "bad index \"[set first]\": must be integer or end?-integer?"
      return
    }
    set last  [lindex $arguments 2]
    if {![string is digit $last] && \
        ![string equal -length 3 "end" $last] && \
        ![string equal -length 4 "end-" $last]} {
      call error "bad index \"[set last]\": must be integer or end?-integer?"
      return
    }
    return [list [lrange $list $first $last] $state]
  }
  proc exec_prim_lrepeat {arguments} {
    upvar state state
    log invoked [info level] [info level 0]
    if {[llength $arguments] < 2} {
      call error "wrong # args: should be \"lrepeat positiveCount value ?value ...?\""
      return
    }
    set counter [lindex $arguments 0]
    if {![string is digit $counter]} {
      call error "expected integer but got \"[set counter]\""
      return
    }
    if {$counter < 1} {
      call error "must have a count of at least 1"
      return
    }
    set values [lrange $arguments 1 end]
    set result {}
    while {$counter > 0} {
      foreach value $values {
        lappend result $value
      }
      incr counter -1
    }
    return $result
  }
  proc exec_prim_lsearch {arguments} {
    upvar state state
    log invoked [info level] [info level 0]
    if {[llength $arguments] < 2} {
      call error "wrong # args: should be \"lsearch ?options? list pattern\""
      return
    }
    set list [lindex $arguments end-1]
    set pattern [lindex $arguments end]
    set options [lrange $arguments 0 end-2]

    set option-all no
    set option-ascii no
    set option-decreasing no
    set option-dictionary no
    set option-exact no
    set option-glob no
    set option-increasing no
    set option-index ""
    set option-inline no
    set option-integer no
    set option-not no
    set option-real no
    set option-regexp no
    set option-sorted no
    set option-start ""
    set option-subindices no
    set index 0
    while {$index < [llength $options]} {
      set item [lindex $options $index]
      incr index
      if {[string equal $item "-all"]} {
        set option-all yes
      } elseif {[string equal $item "-ascii"]} {
        set option-ascii yes
      } elseif {[string equal $item "-decreasing"]} {
        set option-decreasing yes
      } elseif {[string equal $item "-dictionary"]} {
        set option-dictionary yes
      } elseif {[string equal $item "-exact"]} {
        set option-exact yes
        if {$option-glob || $option-regexp} {
          call error "make up your damn mind about the options to lsearch will ya!"
          return
        }
      } elseif {[string equal $item "-glob"]} {
        set option-glob yes
        if {$option-exact || $option-regexp} {
          call error "make up your damn mind about the options to lsearch will ya!"
          return
        }
      } elseif {[string equal $item "-increasing"]} {
        set option-increasing yes
      } elseif {[string equal $item "-index"]} {
        set option-index [lindex $options $index]
        incr index
        if {![string is digit $option-index] && \
            ![string equal -length 3 "end" $option-index] && \
            ![string equal -length 4 "end-" $option-index]} {
          call error "bad index \"[set option-index]\": must be integer or end?-integer?"
          return
        }
      } elseif {[string equal $item "-inline"]} {
        set option-inline yes
      } elseif {[string equal $item "-not"]} {
        set option-not yes
      } elseif {[string equal $item "-real"]} {
        set option-real yes
      } elseif {[string equal $item "-regexp"]} {
        set option-regexp yes
        if {$option-glob || $option-exact} {
          call error "make up your damn mind about the options to lsearch will ya!"
          return
        }
      } elseif {[string equal $item "-sorted"]} {
        set sorted yes
      } elseif {[string equal $item "-start"]} {
        set option-start [lindex $options $index]
        incr index
        if {![string is digit $option-start] && \
            ![string equal -length 3 "end" $option-start] && \
            ![string equal -length 4 "end-" $option-start]} {
          call error "bad index \"[set option-start]\": must be integer or end?-integer?"
          return
        }
      } elseif {[string equal $item "-subindices"]} {
        set subindices yes
        if {[string equal $option-index ""]} {
          call error "-subindices cannot be used without -index option"
          return
        }
      } else {
        call error "bad option \"[set item]\": must be -all, -ascii, -decreasing, -dictionary, -exact, -glob, -increasing, -index, -inline, -integer, -not, -real, -regexp, -sorted, -start or -subindices"
        return
      }
    }
    set tmp "lsearch"
    if {$option-all}        { lappend tmp -all }
    if {$option-ascii}      { lappend tmp -ascii }
    if {$option-decreasing} { lappend tmp -decreasing }
    if {$option-dictionary} { lappend tmp -dictionary }
    if {$option-exact}      { lappend tmp -exact }
    if {$option-glob}       { lappend tmp -glob }
    if {$option-increasing} { lappend tmp -increasing }
    if {![string equal $option-index ""]} { lappend tmp -index $option-index }
    if {$option-inline}     { lappend tmp -inline }
    if {$option-integer}    { lappend tmp -integer }
    if {$option-not}        { lappend tmp -not }
    if {$option-real}       { lappend tmp -real }
    if {$option-regexp}     { lappend tmp -regexp }
    if {$option-sorted}     { lappend tmp -sorted }
    if {![string equal $option-start ""]} { lappend tmp -start $option-start }
    if {$option-subindices} { lappend tmp -subindices }
    lappend tmp $list
    lappend tmp $pattern
    if {[catch $tmp result]} {
      call error $result
      return
    }
    return $result
  }
  proc exec_prim_lset {arguments} {
    upvar state state
    log invoked [info level] [info level 0]
    if {[llength $arguments] < 3} {
      call error "lset listVar index ?index...? value"
      return
    }
    set listvar [lindex $arguments 0]
    set indexes [lrange $arguments 1 end-1]
    set value   [lindex $arguments end]
    if {![exec_prim_var_exists? $listvar]} {
      call error "can't read \"$listvar\": no such variable"
      return
    }
    set listval [exec_prim_get $listvar]
    set stack ""
    set counter -1
    foreach index $indexes {
      if {![string is digit $index] && \
          ![string equal -length 3 "end" $index] && \
          ![string equal -length 4 "end-" $index]} {
        call error "bad index \"[set index]\": must be integer or end?-integer?"
      }
      lappend stack $listval
      set listval [lindex $listval $index]
      incr counter
    }
    lappend stack $value
    while {$counter > -1} {
      set listval [lreplace [lindex $stack $counter] [lindex $indexes $counter] [lindex $indexes $counter]]
    }
    exec_prim_set [list $listvar $listval]
    return $listval
  }
  proc exec_prim_lsort {arguments} {
    upvar state state
    log invoked [info level] [info level 0]
    if {[llength $arguments] < 1} {
      call error "wrong # args: should be \"lsort ?options? list\""
    }
    set list    [lindex $arguments end]
    set options [lrange $arguments 0 end-1]
    set option-ascii no
    set option-creasing in
    set option-dictionary no
    set option-index ""
    set option-indices no
    set option-integer no
    set option-real no
    set option-unique no
    set index 0
    while {$index < [llenght $options]} {
      set item [lindex $options $index]
      incr index
      if {[string equal $item "-ascii"]} {
        set option-ascii yes
      } elseif {[string equal $item "-command"]} {
        set option-command [lindex $options $index]
        incr index
        call error "sorry not yet implemented! too tricky as it is!"
        return
      } elseif {[string equal $item "-decreasing"]} {
        set option-creasing de
      } elseif {[string equal $item "-dictionary"]} {
        set option-dictionary yes
      } elseif {[string equal $item "-index"]} {
        set option-index [lindex $options $index]
        incr index
        if {![string is digit $option-index] && \
            ![string equal -length 3 "end" $option-index] && \
            ![string equal -length 4 "end-" $option-index]} {
          call error "bad index \"[set option-index]\": must be integer or end?-integer?"
          return
        }
      } elseif {[string equal $item "-indices"]} {
        set option-indices yes
      } elseif {[string equal $item "-integer"]} {
        set option-integer yes
      } elseif {[string equal $item "-real"]} {
        set option-real yes
      } elseif {[string equal $item "-unique"]} {
        set option-unique yes
      } else {
        call error "bad option \"[set item]\": must be -ascii, -command, -decreasing, -dictionary, -increasing, -index, -indices, -integer, -real, or -unique"
        return
      }
    }
    set tmp "lsort"
    if {$option-ascii} { lappend tmp -ascii }
    if {[string equal "de" $option-creasing]} { lappend tmp -decreasing }
    if {$option-dictionary} { lappend tmp -dictionary }
    if {![string equal "" $option-index]} { lappend tmp -index $option-index }
    if {$option-indices} { lappend tmp -indices }
    if {$option-integer} { lappend tmp -integer }
    if {$option-real}    { lappend tmp -real }
    if {$option-unique}  { lappend tmp -unique }
    lappend tmp $list
    if {[catch $tmp result]} {
      call [list error $result]
      return
    }
    return $resul
  }
  proc exe_prim_next_message {arguments} {
    upvar state 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
      # because the in-queue is empty
      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
    set tmp [dict get $state capabilities]
    foreach address $addresses {
      lappend tmp $address
    }
    dict set state capabilities $tmp
    dict incr state quota $quota
    return $message
  }
  proc exec_prim_logical_or {arguments} {
    log invoked [info level] [info level 0]
    set result [lindex $arguments 0]
    foreach item [lrange $arguments 1 end] {
      set result [expr $result || $item]
    }
    return $result
  }
  proc exec_prim_rename {arguments} {
    upvar state state
    log invoked [info level] [info level 0]
    if {[llength $arguments] != 2} {
      call error "wrong # args: should be \"rename oldName newName\""
      return
    }
    set old [lindex $arguments 0]
    set new [lindex $arguments 1]
    if {![dict exists $state commands $old]} {
      call error "no such command: $old"
      return
    }
    if {[dict exists $state commands $new]} {
      call error "$new exists already"
      return
    }
    if {![string equal $new ""]} {
      dict set state commands $new [dict get $state commands $old]
    }
    dict unset state commands $old
    return
  }
  proc exec_prim_return {arguments} {
    upvar state state
    log invoked [info level] [info level 0]
    # return from a frame 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]]} {
      exec_prim_die "end of program"
    }
    # 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 $result
  }; # var hér
  proc exec_prim_routine {arguments} {
    upvar state state
    log invoked [info level] [info level 0]
    if {[llength $arguments] != 2} {
      call error "wrong # args: should be \"routine name body\"
      return
    }
    set name [lindex $arguments 0]
    set body [lindex $arguments 1]
    if {[dict exists $state commands $name]} {
      call error "command already exists!"
      return
    }
    dict set state commands $name type script
    dict set state commands $name contents $body
    space_quota_check
    return $name
  }
  proc exec_prim_command_exists? {arguments} {
    upvar state state
    log invoked [info level] [info level 0]
    if {[llength $arguments] != 1} {
      call error "wrong # args: should be \"command_exists? name\"
      return
    }
    set name [lindex $arguments 0]
    return [dict exists $state commands $name]
  }
  proc exec_prim_send_message {arguments} {
    upvar state state
    log invoked [info level] [info level 0]
    if {[llength $arguments] < 2} {
      call error "wrong # args: should be \"send_message addresses data ?quota?\"
    }
    set addresses [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]} {
      call error "not enaugh quota alotted for data to be sent"
      return
    }
    if {[dict get $state quota] < $quota} {
      call error "not enaugh quota to send message"
      return
    }
    foreach address $addresses {
      if {[lsearch -exact [dict get $state capabilities] $address] == -1} {
        call "this capicol has not address $address in its capabilities list"
        return
      }
    }
    ::capicol::runtime::send_message [dict get $state my_address [list $addresses $data $quota]]
  }; # var hér
  proc 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 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]
    switch -exact -- $subcommand {
      "bytelength" { return [exec_prim_string_bytelength $rest $state] }
      "compare"    { return [exec_prim_string_compare $rest $state] }
      "equal"      { return [exec_prim_string_equal $rest $state] }
      "first"      { return [exec_prim_string_first $rest $state] }
      "index"      { return [exec_prim_string_index $rest $state] }
      "is"         { return [exec_prim_string_is $rest $state] }
      "last"       { return [exec_prim_string_last $rest $state] }
      "length"     { return [exec_prim_string_length $rest $state] }
      "map"        { return [exec_prim_string_map $rest $state] }
      "match"      { return [exec_prim_string_match $rest $state] }
      "range"      { return [exec_prim_string_range $rest $state] }
      "repeat"     { return [exec_prim_string_repeat $rest $state] }
      "replace"    { return [exec_prim_string_replace $rest $state] }
      "tolower"    { return [exec_prim_string_tolower $rest $state] }
      "toupper"    { return [exec_prim_string_toupper $rest $state] }
      "totitle"    { return [exec_prim_string_totitle $rest $state] }
      "trim"       { return [exec_prim_string_trim $rest $state] }
      "trimleft"   { return [exec_prim_string_trimleft $rest $state] }
      "trimright"  { return [exec_prim_string_trimright $rest $state] }
      "wordend"    { return [exec_prim_string_wordend $rest $state] }
      "wordstart"  { return [exec_prim_string_wordstart $rest $state] }
      default { 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 exec_prim_string_bytelength {arguments state} {
    log invoked [info level] [info level 0]
    if {[llength $arguments] != 1} {
      return [call [list error "wrong # args: should be \"string bytelength string\""] $state]
    }
    return [list [string bytelength [lindex $arguments 0]] $state]
  }
  proc exec_prim_string_compare {arguments state} {
    log invoked [info level] [info level 0]
    if {[llength $arguments] < 2} {
      return [call [list error "wrong # args: should be \"string compare ?-nocase? ?-length int? string1 string2\""] $state]
    }
    set string1 [lindex $arguments end-1]
    set string2 [lindex $arguments end]
    set options [lrange $arguments 0 end-2]
    set option-nocase no
    set option-length ""
    set index 0
    while {$index < [llength $options]} {
      set item [lindex $options $index]
      incr index
      if {[string equal $item "-nocase"]} {
        set option-nocase yes
      } elseif {[string equal $item "-length"]} {
        set option-length [lindex $options $index]
        incr index
      } else {
        return [call [list error "bad option \"[set item]\": must be -nocase or -length"] $state]
      }
    }
    set tmp "string"
    lappend tmp "compare"
    if {$option-nocase} { lappend tmp -nocase }
    if {![string equal $option-length ""]} {
      lappend tmp -length
      lappend tmp $option-length
    }
    lappend tmp $string1
    lappend tmp $string2
    catch $tmp result
    return [list $result $state]
  }
  proc exec_prim_string_equal {arguments state} {
    log invoked [info level] [info level 0]
    if {[llength $arguments] < 2} {
      return [call [list error "wrong # args: should be \"string equal ?-nocase? ?-length int? string1 string2\""] $state]
    }
    set string1 [lindex $arguments end-1]
    set string2 [lindex $arguments end]
    set options [lrange $arguments 0 end-2]
    set option-nocase no
    set option-length ""
    set index 0
    while {$index < [llength $options]} {
      set item [lindex $options $index]
      incr index
      if {[string equal $item "-nocase"]} {
        set option-nocase yes
      } elseif {[string equal $item "-length"]} {
        set option-length [lindex $options $index]
        incr index
      } else {
        return [call [list error "bad option \"[set item]\": must be -nocase or -length"] $state]
      }
    }
    set tmp "string"
    lappend tmp "equal"
    if {$option-nocase} { lappend tmp -nocase }
    if {![string equal $option-length ""]} {
      lappend tmp -length
      lappend tmp $option-length
    }
    lappend tmp $string1
    lappend tmp $string2
    catch $tmp result
    return [list $result $state]
  }
  proc exec_prim_string_first {arguments state} {
    log invoked [info level] [info level 0]
    if {([llength $arguments] < 2) || ([llength $arguments] > 3)} {
      return [call [list error "wrong # args: should be \"string first subString string ?startIndex?\""] $state]
    }
    set substring  [lindex $arguments 0]
    set string     [lindex $arguments 1]
    set startIndex [lindex $argumnets 2]
    if {[string equal $startIndex ""]} {
      set startIndex 0
    }
    if {![string is digit $startIndex] && \
        ![string equal -length 3 $startIndex "end"] && \
        ![string equal -length 4 $startIndex "end-"]} {
      return [call [list error "bad index \"[set startIndex]\": must be integer or end?-integer?"] $state]
    }
    return [list [string first $substring $string $startIndex] $state]
  }
  proc exec_prim_string_index {arguments state} {
    log invoked [info level] [info level 0]
    if {[llength $arguments] != 2} {
      return [call [list error "wrong # args: should be \"string index string charIndex\""] $state]
    }
    set string [lindex $arguments 0]
    set index  [lindex $arguments 1]
    if {![string is digit $index] && \
        ![string equal -length 3 $index "end"] && \
        ![string equal -length 4 $index "end-"]} {
      return [call [list error "bad index \"[set index]\": must be integer or end?-integer?"] $state]
    }
    return [list [string index $string $index] $state]
  }
  proc exec_prim_string_is {arguments state} {
    log invoked [info level] [info level 0]
    if {[llength $arguments] < 2} {
      return [call [list error "wrong # args: should be \"string is class ?-strict? string\""] $state]
    }
    set class  [lindex $arguments 0]
    set string [lindex $arguments end]
    set option-strict [expr {([string equal "-strict" [lindex $arguments 1]] && ([llength $arguments] == 3)}]
    if {[lsearch -exact {alnum alpha ascii control boolean digit double false graph integer lower print punct space true upper wordchar xdigit} $class] == -1} {
      return [call [list error "bad class \"[set class]\": must be alnum, alpha, ascii, control, boolean, digit, double, false, graph, integer, lower, print, space, true, upper, wordchar or xdigit"] $state]
    }
    set tmp "string"
    lappend tmp "is"
    lappend tmp $class
    if {$option-strict} { lappend tmp -strict }
    lappend tmp $string
    catch $tmp result
    return [list $result $state]
  }
  proc exec_prim_string_last {arguments state} {
    log invoked [info level] [info level 0]
    if {([llength $arguments] < 2) || ([llength $arguments] > 3)} {
      return [call [list error "wrong # args: should be \"string last subString string ?startIndex?\""] $state]
    }
    set substring  [lindex $arguments 0]
    set string     [lindex $arguments 1]
    set startIndex [lindex $argumnets 2]
    if {[string equal $startIndex ""]} {
      set startIndex 0
    }
    if {![string is digit $startIndex] && \
        ![string equal -length 3 $startIndex "end"] && \
        ![string equal -length 4 $startIndex "end-"]} {
      return [call [list error "bad index \"[set startIndex]\": must be integer or end?-integer?"] $state]
    }
    return [list [string last $substring $string $startIndex] $state]
  }
  proc exec_prim_string_length {arguments state} {
    log invoked [info level] [info level 0]
    if {[llength $arguments] != 1} {
      return [call [list error "wrong # args: should be \"string length string\""] $state]
    }
    return [list [string length [lindex $arguments 0]] $state]
  }
  proc exec_prim_string_map {arguments state} {
    log invoked [info level] [info level 0]
  }
  proc exec_prim_string_match {arguments state} {}
  proc exec_prim_string_range {arguments state} {}
  proc exec_prim_string_repeat {arguments state} {}
  proc exec_prim_string_tolower {arguments state} {}
  proc exec_prim_string_toupper {arguments state} {}
  proc exec_prim_string_totitle {arguments state} {}
  proc exec_prim_string_trim {arguments state} {}
  proc exec_prim_string_trimleft {arguments state} {}
  proc exec_prim_string_trimright {arguments state} {}
  proc exec_prim_string_wordend {arguments state} {}
  proc exec_prim_string_wordstart {arguments state} {}

  proc 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 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 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 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 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 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 new_state {address} {
    log invoked [info level] [info level 0]
    dict set c my_address $address
    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 {}
    set alist [list]
    foreach content {+ - * / % & | ^ < << >> <= == != and any_messages? args beget break catch capabilities continue dict die drop_capability error gain get
      if lappend lassign lindex linsert list llength lrange lrepeat lreplace lsearch lset lsort next_message or rename return routine send_message
      set string uplevel var_exists? while __branch __jump
    } {
      lappend alist $content [list type prim contents $content]
    }
    dict set c commands $alist
    dict set c quota [expr [string length [dict get $state commands]] + \
                           [string length [dict get $state returnstack]] + \
                           [string length [dict get $state frame]]]
    return $c
  }

 }

 namespace eval capicol::runtime {
  variable capicols {}
  variable runlist  {}
  proc run_one_slice {} {
    log invoked [info level] [info level 0]
    variable capicols
    variable runlist
    # round robin scheduling of run slices.
    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 [::capicol::interp::advance $state]
      if {$counter == 0} { break }
      incr counter -1
      if {![dict get $state running]} {
        deschedule $name
        break
      }
    }
    dict set capicols $name $state
  }
  proc died {state reason} {
    variable capicols
    set name [dict get $state my_address]
    set message  [list capicol-death $name $reason $state]
    deschedule $name
    dict unset capicols $name
    set creator [join [lrange [split $name "."] 0 end-1]"."]
    send_message [list $creator $message [string length $message]]
  }
  proc beget {child_name startup_code addresses quota} {
    set child [::capicol::interp::new_state $child_name]
    dict incr child quota $quota
    lassign [caphandles_from_adddresses $addresses $child] dummy child
    dict set child code [translate $startup_code]
    variable capicols
    dict set capicols $child_name $child
    schedule $child_name
  }

  proc 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 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 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)
      variable external_handlers
      foreach {pattern command} $external_handlers {
        if {[string match $patter $destination]} {
          append command " "
          append command [list $destination]
          append command " "
          append command [list $sender]
          append command " "
          append command [list $message]
          catch $command
        }
      }
    }
    return
  }
  proc register_external_handler {pattern command} {
    variable external_handlers
    set external_handlers "[list $command] [set external handlers]"
    set external_handlers "[list $pattern] [set external handlers]"
    return
  }
  proc unregister_external_handler {pattern command} {
    variable external_handlers
    set index 0
    foreach {p c} $external_handlers {
      if {[string equal $p $pattern] && [string equal $c $command]} {
        set external_handlers [lreplace $external_handlers $index [expr $index +1]]
        return
      }
      incr index 2
    }
  }

  proc store_snapshot {filename} {
    set fd [open $filename w]
    fconfigure $fd -encoding utf-8
    variable capicols
    variable runlist
    dict set tmp runlist $runlist
    dict set tmp capicols $capicols
    puts $fd $tmp
    close $fd
  }
  proc load_snapshot {filename} {
    set fd [open $filename r]
    fconfigure $fd -encoding utf-8
    set tmp [read $fd]
    close $fd
    variable capicols [dict get $tmp capicols]
    variable runlist  [dict get $tmp runlist]
  }
  proc looper {} {
    run_one_slice
    after idle [list ::capicol::runtime::looper]
  }
  proc start {} {
    after idle [list ::capicol::runtime::looper]
  }
 }