[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.

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

proc log args {}; # override with another proc to get all kind of debugging data.

 namespace eval capicol {}
 namespace eval capicol::interp {
  # state:
  #   my_address
  #     <capicol address>
  #   number_of_children
  #     <number>
  #   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 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]
    }
    # todo: move the space quota check into the prim commands that change the state
    #       prime locations: the framestack builder and the command binder
    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 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 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 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 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]
  }

  # primitives (or built in commands)
  proc 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] }
      "command_exists?" { return [exec_prim_command_exists? $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_logical_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 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 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 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 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 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 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 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 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 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]
    switch -exact -- $subcommand {
      "append"  { return [exec_prim_dict_append [lrange $arguments 1 end] $state] }
      "create"  { return [exec_prim_dict_create [lrange $arguments 1 end] $state] }
      "exists"  { return [exec_prim_dict_exists [lrange $arguments 1 end] $state] }
      "filter"  { return [exec_prim_dict_filter [lrange $arguments 1 end] $state] }
      "for"     { return [exec_prim_dict_for [lrange $arguments 1 end] $state] }
      "get"     { return [exec_prim_dict_get [lrange $arguments 1 end] $state] }
      "incr"    { return [exec_prim_dict_incr [lrange $arguments 1 end] $state] }
      "info"    { return [exec_prim_dict_info [lrange $arguments 1 end] $state] }
      "keys"    { return [exec_prim_dict_keys [lrange $arguments 1 end] $state] }
      "lappend" { return [exec_prim_dict_lappend [lrange $arguments 1 end] $state] }
      "merge"   { return [exec_prim_dict_merge [lrange $arguments 1 end] $state] }
      "remove"  { return [exec_prim_dict_remove [lrange $arguments 1 end] $state] }
      "replace" { return [exec_prim_dict_replace [lrange $arguments 1 end] $state] }
      "set"     { return [exec_prim_dict_set [lrange $arguments 1 end] $state] }
      "size"    { return [exec_prim_dict_size [lrange $arguments 1 end] $state] }
      "unset"   { return [exec_prim_dict_unset [lrange $arguments 1 end] $state] }
      "update"  { return [exec_prim_dict_update [lrange $arguments 1 end] $state] }
      "values"  { return [exec_prim_dict_values [lrange $arguments 1 end] $state] }
      "with"    { return [exec_prim_dict_remove [lrange $arguments 1 end] $state] }
    }
    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 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 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 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 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 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 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]
    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 exec_prim_dict_info {arguments state} {
    log invoked [info level] [info level 0]
    return [list "no info" $state]
  }
  proc 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 exec_prim_dict_lappend {arguments state} {
    log invoked [info level] [info level 0]
    # use replace
    return [call [list error "not yet implemented!"] $state]
  }
  proc 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 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 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 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 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 exec_prim_dict_unset {arguments state} {
    log invoked [info level] [info level 0]
    # use dict remove
    return [call [list error "not yet implemented!"] $state]
  }
  proc exec_prim_dict_update {arguments state} {
    log invoked [info level] [info level 0]
    return [call [list error "not yet implemented"] $state]
  }
  proc 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 exec_prim_dict_with {arguments state} {
    log invoked [info level] [info level 0]
    return [call [list error "not yet implemented!"] $state]
  }
  # prim dict -end-
  proc 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 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 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 exec_prim_gain {arguments state} {
    log invoked [info level] [info level 0]
    return [call [list error "not yet implemented sorry!"] $state]
  }
  proc 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 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 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
    }
    lassign [exec_prim_set [list [lindex $arguments 0] $result] $state] _ state
    return [list $result $state]
  }
  proc 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 exec_prim_lindex {arguments state} {
    log invoked [info level] [info level 0]
    if {[llength $arguments] < 1} {
      return [call [list error "wrong # args: should be \"lindex list ?index ...?\""] $state]
    }
    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]} {
        return [call [list error "bad index \"[set item]\": must be integer or end?-integer?"] $state]
      }
      set list [lindex $list $item]
    }    
    return [list $list $state]
  }
  proc exec_prim_linsert {arguments state} {
    log invoked [info level] [info level 0]
    if {[llength $arguments] < 3} {
      return [call [list error "wrong # args: should be \"linsert list index element ?element ...?\""] $state]
    }
    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]} {
      return [call [list error "bad index \"[set index]\": must be integer or end?-integer?"] $state]
    }
    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 $list $state]
  }
  proc exec_prim_list {arguments state} {
    log invoked [info level] [info level 0]
    # this is intentionaly nearly empty!
    return [list $arguments $state]
  }
  proc exec_prim_llength {arguments state} {
    log invoked [info level] [info level 0]
    if {[llength $arguments != 1} {
      return [call [list error "wrong # args: should be \"llength list\""]
    }
    return [list [llength [lindex $arguments 0]] $state]
  }
  proc exec_prim_lrange {arguments state} {
    log invoked [info level] [info level 0]
    if {[llength $arguments != 3} {
      return [call [list error "wrong # args: should be \"lrange list first last\""]
    }
    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]} {
      return [call [list error "bad index \"[set first]\": must be integer or end?-integer?"] $state]
    }
    set last  [lindex $arguments 2]
    if {![string is digit $last] && \
        ![string equal -length 3 "end" $last] && \
        ![string equal -length 4 "end-" $last]} {
      return [call [list error "bad index \"[set last]\": must be integer or end?-integer?"] $state]
    }
    return [list [lrange $list $first $last] $state]
  }
  proc exec_prim_lrepeat {arguments state} {
    log invoked [info level] [info level 0]
    if {[llength $arguments] < 2} {
      return [call [list error "wrong # args: should be \"lrepeat positiveCount value ?value ...?\""] $state]
    }
    set counter [lindex $arguments 0]
    if {![string is digit $counter]} {
      return [call [list error "expected integer but got \"[set counter]\""] $state]
    }
    if {$counter < 1} {
      return [call [list error "must have a count of at least 1"] $state]
    }
    set values [lrange $arguments 1 end]
    set result {}
    while {$counter > 0} {
      foreach value $values {
        lappend result $value
      }
      incr counter -1
    }
    return [list $result $state]
  }
  proc exec_prim_lsearch {arguments state} {
    log invoked [info level] [info level 0]
    if {[llength $arguments] < 2} {
      return [call [list error "wrong # args: should be \"lsearch ?options? list pattern\""] $state]
    }
    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} {
          return [call [list error "make up your damn mind about the options to lsearch will ya!"] $state]
        }
      } elseif {[string equal $item "-glob"]} {
        set option-glob yes
        if {$option-exact || $option-regexp} {
          return [call [list error "make up your damn mind about the options to lsearch will ya!"] $state]
        }
      } 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]} {
          return [call [list error "bad index \"[set option-index]\": must be integer or end?-integer?"
        }
      } 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} {
          return [call [list error "make up your damn mind about the options to lsearch will ya!"] $state]
        }
      } 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]} {
          return [call [list error "bad index \"[set option-start]\": must be integer or end?-integer?"
        }
      } elseif {[string equal $item "-subindices"]} {
        set subindices yes
        if {[string equal $option-index ""]} {
          return [call [list error "-subindices cannot be used without -index option"] $state]
        }
      } else {
        return [call [list error "bad option \"[set item]\": must be -all, -ascii, -decreasing, -dictionary, -exact, -glob, -increasing, -index, -inline, -integer, -not, -real, -regexp, -sorted, -start or -subindices"] $state]
      }
    }
    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]} {
      return [call [list error $result] $state]
    }
    return [list $result $state]
  }
  proc exec_prim_lset {arguments state} {
    log invoked [info level] [info level 0]
    if {[llength $arguments] < 3} {
      return [call [list error "lset listVar index ?index...? value"] $state]
    }
    set listvar [lindex $arguments 0]
    set indexes [lrange $arguments 1 end-1]
    set value   [lindex $arguments end]
    lassign [exec_prim_var_exists? $listvar $state] exists state
    if {!$exists} {
      return [call [list error "can't read \"$listvar\": no such variable"] $state]
    }
    lassign [exec_prim_get $listvar $state] listval state
    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]} {
        return [call [list 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]]      
    }
    lassign [exec_prim_set [list $listvar $listval] $state] _ state
    return [list $listval $state]
  }
  proc exec_prim_lsort {arguments state} {
    log invoked [info level] [info level 0]
    if {[llength $arguments] < 1} {
      return [call [list error "wrong # args: should be \"lsort ?options? list\""] $state]
    }
    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
        return [call [list error "sorry not yet implemented! too tricky as it is!"] $state]
      } 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]} {
          return [call [list error "bad index \"[set option-index]\": must be integer or end?-integer?"] $state]
        }
      } 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 {
        return [call [list error "bad option \"[set item]\": must be -ascii, -command, -decreasing, -dictionary, -increasing, -index, -indices, -integer, -real, or -unique"] $state]
      }
    }
    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]} {
      return [call [list error $result] $state]
    }
    return [list $result $state]
  }
  proc exe_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 exec_prim_logical_or {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 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 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 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 exec_prim_command_exists? {arguments state} {
    log invoked [info level] [info level 0]
    if {[llength $arguments] != 1} {
      return [call [list error "wrong # args: should be \"command_exists? name\"] $state]
    }
    set name [lindex $arguments 0]
    return [list [dict exists $state commands $name]} {
  }
  proc 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 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 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 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 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 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
    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
    }
    handle_outmessages $state
  }
  proc handle_outmessages {state} {
    log invoked [info level] [info level 0]
    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]
      switch -exact -- $type {
        "die" {
          set reason [lindex $message 1]
          set message  [list capicol-death $name $reason $state]
          unschedule $name
          dict unset capicols $name
          set creator [join [lrange [split $name "."] 0 end-1]"."]
          send_message [list $creator $message [string length $message]]
          break
        }
        "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 [::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
        }
        "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
        }
        "message" { send_message $name [lindex $message 1] }
        default { error "unknown out-queue type: [set type] in $message" }
      }
    }
    return
  }
  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 $filname 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]
  }
 }

----
[[[Category Tcl Implementations]|[Category Design]]]