1 "{ Package: 'jv:libgdbs' }" |
1 "{ Package: 'jv:libgdbs' }" |
2 |
2 |
3 Stream subclass:#GDBInternalPipeStream |
3 Stream subclass:#GDBInternalPipeStream |
4 instanceVariableNames:'queue' |
4 instanceVariableNames:'buffer first last accessLock dataAvailable spaceAvailable closed' |
5 classVariableNames:'' |
5 classVariableNames:'DefaultBufferSize' |
6 poolDictionaries:'' |
6 poolDictionaries:'' |
7 category:'GDB-Private' |
7 category:'GDB-Support' |
8 ! |
8 ! |
|
9 |
|
10 !GDBInternalPipeStream class methodsFor:'documentation'! |
|
11 |
|
12 documentation |
|
13 " |
|
14 not useful on its own, but can be used to talk to a vt100 |
|
15 terminal view ... |
|
16 See example. |
|
17 " |
|
18 ! |
|
19 |
|
20 examples |
|
21 " |
|
22 [exBegin] |
|
23 |p| |
|
24 |
|
25 p := InternalPipeStream new. |
|
26 [ |
|
27 10 timesRepeat:[ |
|
28 p nextPutLine:'hello' |
|
29 ]. |
|
30 ] fork. |
|
31 |
|
32 [ |
|
33 10 timesRepeat:[ |
|
34 Transcript showCR:p nextLine |
|
35 ]. |
|
36 ] fork. |
|
37 [exEnd] |
|
38 |
|
39 [exBegin] |
|
40 |userInput elizasOutput top terminal| |
|
41 |
|
42 userInput := InternalPipeStream new. |
|
43 elizasOutput := InternalPipeStream new. |
|
44 |
|
45 top := StandardSystemView new. |
|
46 terminal := VT100TerminalView openOnInput: userInput output:elizasOutput in:top. |
|
47 |
|
48 top extent:(terminal preferredExtent). |
|
49 top label:'The doctor is in'. |
|
50 top iconLabel:'doctor'. |
|
51 top open. |
|
52 top waitUntilVisible. |
|
53 |
|
54 terminal translateNLToCRNL:true. |
|
55 terminal inputTranslateCRToNL:true. |
|
56 terminal localEcho:true. |
|
57 |
|
58 elizasOutput nextPutLine:'Hi, I am Eliza'. |
|
59 elizasOutput nextPutLine:'What is your problem ?'. |
|
60 elizasOutput nextPutLine:''. |
|
61 elizasOutput nextPutAll:'>'. |
|
62 |
|
63 [top realized] whileTrue:[ |
|
64 |line answer matchingRule| |
|
65 |
|
66 line := userInput nextLine. |
|
67 (#('quit' 'exit' 'end' 'bye') includes:line) ifTrue:[ |
|
68 top destroy. |
|
69 ^ self |
|
70 ]. |
|
71 |
|
72 answer := 'Tell me more.'. |
|
73 elizasOutput nextPutLine:answer. |
|
74 elizasOutput nextPutAll:'>'. |
|
75 ]. |
|
76 [exEnd] |
|
77 " |
|
78 ! ! |
|
79 |
|
80 !GDBInternalPipeStream class methodsFor:'initialization'! |
|
81 |
|
82 initialize |
|
83 "Invoked at system start or when the class is dynamically loaded." |
|
84 |
|
85 "/ please change as required (and remove this comment) |
|
86 |
|
87 DefaultBufferSize := 1024. |
|
88 |
|
89 "Modified: / 07-06-2014 / 00:49:15 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
90 ! ! |
9 |
91 |
10 !GDBInternalPipeStream class methodsFor:'instance creation'! |
92 !GDBInternalPipeStream class methodsFor:'instance creation'! |
11 |
93 |
12 new |
94 new |
13 ^ self basicNew initialize |
95 ^ self newWithBufferSize: DefaultBufferSize |
|
96 |
|
97 "Modified: / 10-06-2014 / 00:26:32 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
98 ! |
|
99 |
|
100 newWithBufferSize: bufferSize |
|
101 ^ self basicNew initializeWithBufferSize: bufferSize |
|
102 |
|
103 "Created: / 07-06-2014 / 00:48:48 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
14 ! ! |
104 ! ! |
15 |
105 |
16 !GDBInternalPipeStream methodsFor:'accessing'! |
106 !GDBInternalPipeStream methodsFor:'accessing'! |
17 |
107 |
18 atEnd |
108 atEnd |
19 ^ false . "/ queue notNil |
109 ^ closed and:[ last == 0 ] |
|
110 |
|
111 "Modified: / 07-06-2014 / 01:06:55 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
20 ! |
112 ! |
21 |
113 |
22 close |
114 close |
23 queue := nil |
115 closed := true. |
24 ! |
116 |
|
117 "Modified: / 07-06-2014 / 01:02:33 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
118 ! |
|
119 |
|
120 size |
|
121 last == 0 ifTrue:[ ^ 0 ]. |
|
122 last >= first ifTrue:[ |
|
123 ^ last - first + 1 |
|
124 ] ifFalse:[ |
|
125 ^ buffer size - first + 1 + last |
|
126 ]. |
|
127 |
|
128 "Modified: / 07-06-2014 / 01:08:53 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
129 ! ! |
|
130 |
|
131 !GDBInternalPipeStream methodsFor:'initialization'! |
|
132 |
|
133 initializeWithBufferSize: bufferSize |
|
134 buffer := String new: bufferSize. |
|
135 first := 1. |
|
136 last := 0. |
|
137 |
|
138 accessLock := Semaphore forMutualExclusion." Plug new respondTo: #critical: with: [ :block | block value ]; yourself." |
|
139 dataAvailable := Semaphore new. |
|
140 spaceAvailable := Semaphore new. |
|
141 |
|
142 closed := false |
|
143 |
|
144 "Created: / 07-06-2014 / 00:49:41 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
145 "Modified: / 11-06-2014 / 23:12:54 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
146 ! ! |
|
147 |
|
148 !GDBInternalPipeStream methodsFor:'non homogenous reading'! |
|
149 |
|
150 nextAvailableBytes:max into:out startingAt:offset |
|
151 | count | |
|
152 |
|
153 accessLock critical:[ |
|
154 last == 0 ifTrue:[ |
|
155 count := 0 |
|
156 ] ifFalse:[ |
|
157 last >= first ifTrue:[ |
|
158 count := max min: (last - first + 1). |
|
159 out replaceFrom:offset to: offset + count - 1 with: buffer startingAt: first. |
|
160 first := first + count. |
|
161 first > last ifTrue:[ |
|
162 first := 1. |
|
163 last := 0. |
|
164 ]. |
|
165 spaceAvailable signalForAll. |
|
166 ] ifFalse:[ |
|
167 "/ Wrap around |
|
168 count := max. |
|
169 first + count <= buffer size ifTrue:[ |
|
170 out replaceFrom:offset to: offset + count - 1 with: buffer startingAt: first. |
|
171 first := (first + count) \\ buffer size. |
|
172 spaceAvailable signalForAll. |
|
173 ] ifFalse:[ |
|
174 | rem | |
|
175 |
|
176 count := max min: (buffer size - first) + last. |
|
177 rem := buffer size - first. |
|
178 out replaceFrom: offset to: offset + (buffer size - first) with: buffer startingAt: first. |
|
179 |
|
180 out replaceFrom: offset + (buffer size - first + 1) to: offset + count with: buffer startingAt: 1. |
|
181 rem == last ifTrue:[ |
|
182 first := 1. |
|
183 last := 0. |
|
184 ] ifFalse:[ |
|
185 first := rem + 1. |
|
186 ]. |
|
187 ]. |
|
188 ]. |
|
189 ]. |
|
190 ]. |
|
191 ^ count |
|
192 |
|
193 "Modified: / 11-06-2014 / 21:40:47 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
194 ! ! |
|
195 |
|
196 !GDBInternalPipeStream methodsFor:'non homogenous writing'! |
|
197 |
|
198 nextPutBytes:count from:bytes startingAt:start |
|
199 "Write count bytes from an object starting at index start. |
|
200 Return the number of bytes written. |
|
201 The object must have non-pointer indexed instvars |
|
202 (i.e. be a ByteArray, String, Float- or DoubleArray). |
|
203 Use with care - non object oriented i/o. |
|
204 This is provided for compatibility with externalStream; |
|
205 to support binary storage" |
|
206 |
|
207 | written write remaining offset space | |
|
208 |
|
209 closed ifTrue:[ |
|
210 self class writeErrorSignal signal:'Pipe stream closed'. |
|
211 ]. |
|
212 written := 0. |
|
213 remaining := count. |
|
214 offset := start. |
|
215 |
|
216 space := true. |
|
217 [ space and:[remaining > 0] ] whileTrue:[ |
|
218 accessLock critical:[ |
|
219 space := ("self hasSpace"last == 0 or:[ ( (last \\ buffer size) + 1) ~~ first]). |
|
220 space ifTrue:[ |
|
221 last == 0 ifTrue:[ |
|
222 "/ Special case - empty buffer |
|
223 write := remaining min: bytes size. |
|
224 buffer replaceFrom:1 to: write with: bytes startingAt: offset. |
|
225 last := write. |
|
226 ] ifFalse:[ |
|
227 | lastPlusOne | |
|
228 |
|
229 lastPlusOne := (last \\ buffer size) + 1. |
|
230 |
|
231 first < lastPlusOne ifTrue:[ |
|
232 write := remaining min: (buffer size - last). |
|
233 ] ifFalse:[ |
|
234 write := (first - lastPlusOne + 1) min: remaining. |
|
235 ]. |
|
236 buffer replaceFrom: lastPlusOne to: lastPlusOne + write - 1 with: bytes startingAt: offset. |
|
237 last := (last \\ buffer size) + write. |
|
238 ]. |
|
239 remaining := remaining - write. |
|
240 written := written + write. |
|
241 offset := offset + write. |
|
242 dataAvailable signalForAll. |
|
243 ]. |
|
244 ]. |
|
245 ]. |
|
246 ^ written. |
|
247 |
|
248 "Created: / 09-06-2014 / 22:04:15 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
249 "Modified: / 11-06-2014 / 22:59:13 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
250 ! ! |
|
251 |
|
252 !GDBInternalPipeStream methodsFor:'private'! |
|
253 |
|
254 contentsSpecies |
|
255 ^ buffer class |
|
256 |
|
257 "Created: / 09-06-2014 / 21:50:45 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
258 ! ! |
|
259 |
|
260 !GDBInternalPipeStream methodsFor:'private-queries'! |
|
261 |
|
262 hasData |
|
263 ^ last ~~ 0 |
|
264 |
|
265 "Created: / 11-06-2014 / 21:19:10 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
266 ! |
|
267 |
|
268 hasSpace |
|
269 ^ last == 0 or:[ ( (last \\ buffer size) + 1) ~~ first] |
|
270 |
|
271 "Created: / 11-06-2014 / 21:18:57 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
272 ! ! |
|
273 |
|
274 !GDBInternalPipeStream methodsFor:'reading'! |
25 |
275 |
26 next |
276 next |
27 "return the next element from the stream (might block until something is written)" |
277 "return the next element from the stream (might block until something is written)" |
28 |
278 |
29 ^ queue next |
279 | c | |
30 ! |
280 |
31 |
281 [ |
32 nextAvailableBytes:nMax into:aBuffer startingAt:startIndex |
282 accessLock critical:[ |
33 |n idx ch| |
283 ("self hasData"last ~~ 0) ifTrue:[ |
34 |
284 c := buffer at: first. |
35 n := 0. |
285 first == last ifTrue:[ |
36 idx := startIndex. |
286 first := 1. |
37 [n <= nMax] whileTrue:[ |
287 last := 0. |
38 ch := queue nextIfEmpty:[^ n ]. |
288 ] ifFalse:[ |
39 aBuffer at:idx put:ch. |
289 first := (first \\ buffer size) + 1 |
40 idx := idx + 1. |
290 ]. |
41 n := n + 1 |
291 spaceAvailable signalForAll. |
42 ]. |
292 ^ c |
43 ^ n |
293 ] ifFalse:[ |
44 ! |
294 closed ifTrue:[ ^ nil ] |
45 |
295 ]. |
46 nextPut:something |
296 ]. |
47 "write an element (might wakeup readers)" |
297 dataAvailable wait. |
48 |
298 ] loop. |
49 queue nextPut:something |
299 |
50 ! |
300 "Modified: / 11-06-2014 / 21:38:08 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
51 |
|
52 size |
|
53 ^ queue size |
|
54 ! ! |
|
55 |
|
56 !GDBInternalPipeStream methodsFor:'initialization'! |
|
57 |
|
58 initialize |
|
59 queue := SharedQueue new: 1024. |
|
60 |
|
61 "Modified: / 02-06-2014 / 23:30:42 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
62 ! ! |
|
63 |
|
64 !GDBInternalPipeStream methodsFor:'private'! |
|
65 |
|
66 contentsSpecies |
|
67 "this should return the class of which an instance is |
|
68 returned by the #contents method. Here, Array is returned, |
|
69 since the abstract Stream-class has no idea of the underlying |
|
70 collection class. |
|
71 It is redefined in some subclasses - for example, to return String." |
|
72 |
|
73 ^ String |
|
74 |
|
75 "Created: / 02-06-2014 / 23:30:25 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
76 ! ! |
301 ! ! |
77 |
302 |
78 !GDBInternalPipeStream methodsFor:'synchronization'! |
303 !GDBInternalPipeStream methodsFor:'synchronization'! |
79 |
304 |
80 readWait |
305 readWait |
81 queue readSemaphore wait |
306 last == 0 ifTrue:[ |
82 ! ! |
307 dataAvailable wait. |
83 |
308 ]. |
|
309 |
|
310 "Modified: / 07-06-2014 / 01:09:29 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
311 ! |
|
312 |
|
313 writeWait |
|
314 | hasSpace | |
|
315 |
|
316 accessLock critical:[ hasSpace := self hasSpace ]. |
|
317 hasSpace ifTrue:[ |
|
318 spaceAvailable wait. |
|
319 ]. |
|
320 |
|
321 "Created: / 11-06-2014 / 22:04:30 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
322 ! ! |
|
323 |
|
324 !GDBInternalPipeStream methodsFor:'writing'! |
|
325 |
|
326 nextPut:aCharacter |
|
327 | done | |
|
328 |
|
329 closed ifTrue:[ |
|
330 self class writeErrorSignal signal:'Pipe stream closed'. |
|
331 ^ self. |
|
332 ]. |
|
333 |
|
334 done := false. |
|
335 [ done ] whileFalse:[ |
|
336 accessLock critical:[ |
|
337 ("self hasSpace"last == 0 or:[ ( (last \\ buffer size) + 1) ~~ first]) ifTrue:[ |
|
338 last := (last \\ buffer size) + 1. |
|
339 buffer at: last put: aCharacter. |
|
340 done := true. |
|
341 ]. |
|
342 ]. |
|
343 done ifFalse:[ |
|
344 spaceAvailable wait. |
|
345 ]. |
|
346 ]. |
|
347 dataAvailable signalForAll. |
|
348 |
|
349 "Modified: / 11-06-2014 / 21:49:00 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
350 ! |
|
351 |
|
352 nextPutAll:aCollection |
|
353 "Put all elements of the argument, aCollection onto the receiver." |
|
354 |
|
355 ^ self nextPutAll: aCollection startingAt: 1 to: aCollection size |
|
356 |
|
357 "Created: / 09-06-2014 / 21:58:13 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
358 ! |
|
359 |
|
360 nextPutAll:aCollection startingAt:firstIndex to: lastIndex |
|
361 "Append the elements with index from firstIndex to lastIndex |
|
362 of the argument, aCollection, onto the receiver." |
|
363 |
|
364 closed ifTrue:[ |
|
365 self class writeErrorSignal signal:'Pipe stream closed'. |
|
366 ]. |
|
367 |
|
368 (aCollection class == self contentsSpecies) ifTrue:[ |
|
369 | remaining offset written | |
|
370 |
|
371 remaining := lastIndex - firstIndex + 1. |
|
372 offset := firstIndex. |
|
373 [ remaining > 0 ] whileTrue:[ |
|
374 written := self nextPutBytes: remaining from: aCollection startingAt: offset. |
|
375 remaining := remaining - written. |
|
376 offset := offset + written. |
|
377 remaining > 0 ifTrue:[ |
|
378 self writeWait. |
|
379 ]. |
|
380 ]. |
|
381 |
|
382 ] ifFalse:[ |
|
383 super nextPutAll:aCollection startingAt:firstIndex to: lastIndex |
|
384 ]. |
|
385 |
|
386 "Created: / 09-06-2014 / 21:57:15 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
387 "Modified: / 11-06-2014 / 23:04:32 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
388 ! ! |
|
389 |
|
390 !GDBInternalPipeStream class methodsFor:'documentation'! |
|
391 |
|
392 version_HG |
|
393 |
|
394 ^ '$Changeset: <not expanded> $' |
|
395 ! ! |
|
396 |
|
397 |
|
398 GDBInternalPipeStream initialize! |