1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
|
# -*- tcl -*-
# # ## ### ##### ######## #############
# (C) 2009 Andreas Kupries
# @@ Meta Begin
# Package tcl::chan::fifo 1.1
# Meta as::author {Andreas Kupries}
# Meta as::copyright 2009
# Meta as::license BSD
# Meta description Re-implementation of Memchan's fifo
# Meta description channel. Based on Tcl 8.5's channel
# Meta description reflection support. Exports a single
# Meta description command for the creation of new
# Meta description channels. No arguments. Result is the
# Meta description handle of the new channel.
# Meta platform tcl
# Meta require TclOO
# Meta require tcl::chan::events
# Meta require {Tcl 8.5}
# @@ Meta End
# # ## ### ##### ######## #############
package require Tcl 8.5 9
package require TclOO
package require tcl::chan::events
# # ## ### ##### ######## #############
namespace eval ::tcl::chan {}
proc ::tcl::chan::fifo {} {
return [::chan create {read write} [fifo::implementation new]]
}
oo::class create ::tcl::chan::fifo::implementation {
superclass ::tcl::chan::events ; # -> initialize, finalize, watch
method initialize {args} {
my allow write
next {*}$args
}
method read {c n} {
set max [string length $read]
set last [expr {$at + $n - 1}]
set result {}
# last+1 <= max
# <=> at+n <= max
# <=> n <= max-at
if {$n <= ($max - $at)} {
# The request is less than what we have left in the read
# buffer, we take it, and move the read pointer forward.
append result [string range $read $at $last]
incr at $n
incr $size -$n
} else {
# We need the whole remaining read buffer, and more. For
# the latter we shift the write buffer contents over into
# the read buffer, and then read from the latter again.
append result [string range $read $at end]
incr n -[string length $result]
set at 0
set read $write
set write {}
set size [string length $read]
set max $size
# at == 0
if {$n <= $max} {
# The request is less than what we have in the updated
# read buffer, we take it, and move the read pointer
# forward.
append result [string range $read 0 $last]
set at $n
incr $size -$n
} else {
# We need the whole remaining read buffer, and
# more. As we took the data from write already we have
# nothing left, and update accordingly.
append result $read
set at 0
set read {}
set size 0
}
}
my Readable
if {$result eq {}} {
return -code error EAGAIN
}
return $result
}
method write {c bytes} {
append write $bytes
set n [string length $bytes]
incr size $n
my Readable
return $n
}
# # ## ### ##### ######## #############
variable at read write size
# # ## ### ##### ######## #############
constructor {} {
set at 0
set read {}
set write {}
set size 0
next
}
method Readable {} {
if {$size} {
my allow read
} else {
my disallow read
}
return
}
}
# # ## ### ##### ######## #############
package provide tcl::chan::fifo 1.1
return
|
