proc co_vwait_callback {coro args} {$coro}

proc co_vwait varname {
 upvar $varname var
 puts waiting($varname,[info coroutine])
 set callback "co_vwait_callback [info coroutine]"
 trace add variable var write $callback 
 yield
 trace remove variable var write $callback
 puts waited($varname,[info coroutine])
 after idle [info coroutine]
 yield
}

proc obj {
 args
} {
 lassign $args VL_T VL_N VL_N_coro
 puts =obj=crea($args)
 while 1 {
  set args [lassign [yield $args] VL_key]
  switch $VL_key {
   in {
    puts =obj=in($args)
    set VL_res [$VL_N_coro [list out {*}$args]]
    puts =obj=in=ret=($VL_res)       
   }
   out {
    puts =obj=out($args)
    set VL_res [$VL_N_coro [list in {*}$args]]
    while {![string equal $VL_res ok]} {
     co_vwait $VL_res
     puts RETRY
     set VL_res [$VL_N_coro [list in {*}$args]]
    }
    puts =obj=out=ret=($VL_res) 
   }
  }
 }
}
proc lchan {
 args
} {
 lassign $args VL_max VL_var
 set VL_buf [list]
 puts =lchan=crea($args)
 while 1 {
  set args [lassign [yield $args] VL_key]
  switch $VL_key {
   in {
    puts =lchan=in($args)
    if {[llength $VL_buf] == $VL_max} {
     puts =lchan=in=BLOCK($args)
     set args $VL_var
    } else {     
     lappend VL_buf $args
     puts =lchan=in=LEN([llength $VL_buf]) 
     set args ok
    }
   }
   out {
    puts =lchan=out($args)
    if {[llength $VL_buf] == $VL_max} {
     puts =lchan=out=UNBLOCK($args)
     set $VL_var {}
    }    
    set args [lindex $VL_buf 0]
    set VL_buf [lrange $VL_buf 1 end]    
   }
  }
 }
}

coroutine A obj out slot CHAN
coroutine B obj in slot CHAN

coroutine CHAN lchan 3 ::VG_CHAN

A {out slot yi}
A {out slot er}
A {out slot san}
A {out slot si}
B {in slot}

vwait forever