1# -*- tcl -*- 2# # ## ### ##### ######## ############# 3# (C) 2009 Andreas Kupries 4 5# @@ Meta Begin 6# Package tcl::chan::fifo2 1 7# Meta as::author {Andreas Kupries} 8# Meta as::copyright 2009 9# Meta as::license BSD 10# Meta as::notes This fifo2 command does not have to 11# Meta as::notes deal with the pesky details of 12# Meta as::notes threading for cross-thread 13# Meta as::notes communication. That is hidden in the 14# Meta as::notes implementation of reflected 15# Meta as::notes channels. It is less optimal as the 16# Meta as::notes command provided by Memchan as this 17# Meta as::notes fifo2 may involve three threads when 18# Meta as::notes sending data around: The threads the 19# Meta as::notes two endpoints are in, and the thread 20# Meta as::notes holding this code. Memchan's C 21# Meta as::notes implementation does not need this last 22# Meta as::notes intermediary thread. 23# Meta description Re-implementation of Memchan's fifo2 24# Meta description channel. Based on Tcl 8.5's channel 25# Meta description reflection support. Exports a single 26# Meta description command for the creation of new 27# Meta description channels. No arguments. Result are the 28# Meta description handles of the two new channels. 29# Meta platform tcl 30# Meta require TclOO 31# Meta require tcl::chan::halfpipe 32# Meta require {Tcl 8.5} 33# @@ Meta End 34# # ## ### ##### ######## ############# 35 36package require Tcl 8.5 37package require TclOO 38package require tcl::chan::halfpipe 39 40# # ## ### ##### ######## ############# 41 42namespace eval ::tcl::chan {} 43 44proc ::tcl::chan::fifo2 {} { 45 46 set coordinator [fifo2::implementation new] 47 48 lassign [halfpipe \ 49 -write-command [list $coordinator froma] \ 50 -close-command [list $coordinator closeda]] \ 51 a ha 52 53 lassign [halfpipe \ 54 -write-command [list $coordinator fromb] \ 55 -close-command [list $coordinator closedb]] \ 56 b hb 57 58 $coordinator connect $a $ha $b $hb 59 60 return [list $a $b] 61} 62 63oo::class create ::tcl::chan::fifo2::implementation { 64 method connect {thea theha theb thehb} { 65 set a $thea 66 set b $theb 67 set ha $theha 68 set hb $thehb 69 return 70 } 71 72 method closeda {c} { 73 set a {} 74 if {$b ne {}} { 75 close $b 76 set b {} 77 } 78 my destroy 79 return 80 } 81 82 method closedb {c} { 83 set b {} 84 if {$a ne {}} { 85 close $a 86 set a {} 87 } 88 my destroy 89 return 90 } 91 92 method froma {c bytes} { 93 $hb put $bytes 94 return 95 } 96 97 method fromb {c bytes} { 98 $ha put $bytes 99 return 100 } 101 102 # # ## ### ##### ######## ############# 103 104 variable a b ha hb 105 106 # # ## ### ##### ######## ############# 107} 108 109# # ## ### ##### ######## ############# 110package provide tcl::chan::fifo2 1 111return 112