1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17 scenario channel [
18 run [
19 ¦ local-scope
20 ¦ source:&:source:num, sink:&:sink:num <- new-channel 3/capacity
21 ¦ sink <- write sink, 34
22 ¦ 10:num/raw, 11:bool/raw, source <- read source
23 ]
24 memory-should-contain [
25 ¦ 10 <- 34
26 ¦ 11 <- 0
27 ]
28 ]
29
30 container channel:_elem [
31 lock:bool
32 first-full:num
33 first-free:num
34
35
36
37 data:&:@:_elem
38 ]
39
40
41
42
43 container source:_elem [
44 chan:&:channel:_elem
45 ]
46
47 container sink:_elem [
48 chan:&:channel:_elem
49 ]
50
51 def new-channel capacity:num -> in:&:source:_elem, out:&:sink:_elem [
52 local-scope
53 load-inputs
54 result:&:channel:_elem <- new {(channel _elem): type}
55 *result <- put *result, first-full:offset, 0
56 *result <- put *result, first-free:offset, 0
57 capacity <- add capacity, 1
58 data:&:@:_elem <- new _elem:type, capacity
59 *result <- put *result, data:offset, data
60 in <- new {(source _elem): type}
61 *in <- put *in, chan:offset, result
62 out <- new {(sink _elem): type}
63 *out <- put *out, chan:offset, result
64 ]
65
66
67 def write out:&:sink:_elem, val:_elem -> out:&:sink:_elem [
68 local-scope
69 load-inputs
70 assert out, [write to null channel]
71 chan:&:channel:_elem <- get *out, chan:offset
72 <channel-write-initial>
73
74 lock:location <- get-location *chan, lock:offset
75
76 {
77
78 ¦ wait-for-reset-then-set lock
79
80 ¦ full?:bool <- channel-full? chan
81 ¦ break-unless full?
82
83 ¦
84 ¦
85 ¦ reset lock
86 ¦ current-routine-is-blocked
87 ¦ switch
88 ¦ loop
89 }
90 current-routine-is-unblocked
91
92
93 circular-buffer:&:@:_elem <- get *chan, data:offset
94 free:num <- get *chan, first-free:offset
95 val-copy:_elem <- deep-copy val
96 *circular-buffer <- put-index *circular-buffer, free, val-copy
97
98 free <- add free, 1
99 {
100 ¦
101 ¦ len:num <- length *circular-buffer
102 ¦ at-end?:bool <- greater-or-equal free, len
103 ¦ break-unless at-end?
104 ¦ free <- copy 0
105 }
106
107 *chan <- put *chan, first-free:offset, free
108
109 reset lock
110 ]
111
112
113 def read in:&:source:_elem -> result:_elem, eof?:bool, in:&:source:_elem [
114 local-scope
115 load-inputs
116 assert in, [read on null channel]
117 eof? <- copy 0/false
118 chan:&:channel:_elem <- get *in, chan:offset
119
120 lock:location <- get-location *chan, lock:offset
121
122 {
123
124 ¦ wait-for-reset-then-set lock
125
126 ¦ empty?:bool <- channel-empty? chan
127 ¦ break-unless empty?
128
129 ¦
130 ¦
131 ¦ reset lock
132 ¦ current-routine-is-blocked
133 ¦ <channel-read-empty>
134 ¦ switch
135 ¦ loop
136 }
137 current-routine-is-unblocked
138
139 full:num <- get *chan, first-full:offset
140 circular-buffer:&:@:_elem <- get *chan, data:offset
141 result <- index *circular-buffer, full
142
143 empty:&:_elem <- new _elem:type
144 *circular-buffer <- put-index *circular-buffer, full, *empty
145
146 full <- add full, 1
147 {
148 ¦
149 ¦ len:num <- length *circular-buffer
150 ¦ at-end?:bool <- greater-or-equal full, len
151 ¦ break-unless at-end?
152 ¦ full <- copy 0
153 }
154
155 *chan <- put *chan, first-full:offset, full
156
157 reset lock
158 ]
159
160
161
162
163 scenario channel-initialization [
164 run [
165 ¦ local-scope
166 ¦ source:&:source:num <- new-channel 3/capacity
167 ¦ chan:&:channel:num <- get *source, chan:offset
168 ¦ 10:num/raw <- get *chan, first-full:offset
169 ¦ 11:num/raw <- get *chan, first-free:offset
170 ]
171 memory-should-contain [
172 ¦ 10 <- 0
173 ¦ 11 <- 0
174 ]
175 ]
176
177 scenario channel-write-increments-free [
178 local-scope
179 _, sink:&:sink:num <- new-channel 3/capacity
180 run [
181 ¦ sink <- write sink, 34
182 ¦ chan:&:channel:num <- get *sink, chan:offset
183 ¦ 10:num/raw <- get *chan, first-full:offset
184 ¦ 11:num/raw <- get *chan, first-free:offset
185 ]
186 memory-should-contain [
187 ¦ 10 <- 0
188 ¦ 11 <- 1
189 ]
190 ]
191
192 scenario channel-read-increments-full [
193 local-scope
194 source:&:source:num, sink:&:sink:num <- new-channel 3/capacity
195 sink <- write sink, 34
196 run [
197 ¦ _, _, source <- read source
198 ¦ chan:&:channel:num <- get *source, chan:offset
199 ¦ 10:num/raw <- get *chan, first-full:offset
200 ¦ 11:num/raw <- get *chan, first-free:offset
201 ]
202 memory-should-contain [
203 ¦ 10 <- 1
204 ¦ 11 <- 1
205 ]
206 ]
207
208 scenario channel-wrap [
209 local-scope
210
211 source:&:source:num, sink:&:sink:num <- new-channel 1/capacity
212 chan:&:channel:num <- get *source, chan:offset
213
214 sink <- write sink, 34
215 _, _, source <- read source
216 run [
217 ¦
218 ¦ 10:num/raw <- get *chan, first-free:offset
219 ¦ 11:num/raw <- get *chan, first-free:offset
220 ¦
221 ¦ sink <- write sink, 34
222 ¦ 20:num/raw <- get *chan, first-free:offset
223 ¦
224 ¦ _, _, source <- read source
225 ¦ 30:num/raw <- get *chan, first-full:offset
226 ]
227 memory-should-contain [
228 ¦ 10 <- 1
229 ¦ 11 <- 1
230 ¦ 20 <- 0
231 ¦ 30 <- 0
232 ]
233 ]
234
235 scenario channel-new-empty-not-full [
236 run [
237 ¦ local-scope
238 ¦ source:&:source:num <- new-channel 3/capacity
239 ¦ chan:&:channel:num <- get *source, chan:offset
240 ¦ 10:bool/raw <- channel-empty? chan
241 ¦ 11:bool/raw <- channel-full? chan
242 ]
243 memory-should-contain [
244 ¦ 10 <- 1
245 ¦ 11 <- 0
246 ]
247 ]
248
249 scenario channel-write-not-empty [
250 local-scope
251 source:&:source:num, sink:&:sink:num <- new-channel 3/capacity
252 chan:&:channel:num <- get *source, chan:offset
253 run [
254 ¦ sink <- write sink, 34
255 ¦ 10:bool/raw <- channel-empty? chan
256 ¦ 11:bool/raw <- channel-full? chan
257 ]
258 memory-should-contain [
259 ¦ 10 <- 0
260 ¦ 11 <- 0
261 ]
262 ]
263
264 scenario channel-write-full [
265 local-scope
266 source:&:source:num, sink:&:sink:num <- new-channel 1/capacity
267 chan:&:channel:num <- get *source, chan:offset
268 run [
269 ¦ sink <- write sink, 34
270 ¦ 10:bool/raw <- channel-empty? chan
271 ¦ 11:bool/raw <- channel-full? chan
272 ]
273 memory-should-contain [
274 ¦ 10 <- 0
275 ¦ 11 <- 1
276 ]
277 ]
278
279 scenario channel-read-not-full [
280 local-scope
281 source:&:source:num, sink:&:sink:num <- new-channel 1/capacity
282 chan:&:channel:num <- get *source, chan:offset
283 sink <- write sink, 34
284 run [
285 ¦ _, _, source <- read source
286 ¦ 10:bool/raw <- channel-empty? chan
287 ¦ 11:bool/raw <- channel-full? chan
288 ]
289 memory-should-contain [
290 ¦ 10 <- 1
291 ¦ 11 <- 0
292 ]
293 ]
294
295 scenario channel-clear [
296 local-scope
297
298 source:&:source:num, sink:&:sink:num <- new-channel 3/capacity
299 chan:&:channel:num <- get *sink, chan:offset
300 write sink, 30
301 write sink, 31
302 write sink, 32
303 run [
304 ¦ clear source
305 ¦ 10:bool/raw <- channel-empty? chan
306 ]
307 memory-should-contain [
308 ¦ 10 <- 1
309 ]
310 ]
311
312 def clear in:&:source:_elem -> in:&:source:_elem [
313 local-scope
314 load-inputs
315 chan:&:channel:_elem <- get *in, chan:offset
316 {
317 ¦ empty?:bool <- channel-empty? chan
318 ¦ break-if empty?
319 ¦ _, _, in <- read in
320 ¦ loop
321 }
322 ]
323
324
325
326
327
328 container channel:_elem [
329 closed?:bool
330 ]
331
332
333
334 def close x:&:source:_elem -> x:&:source:_elem [
335 local-scope
336 load-inputs
337 chan:&:channel:_elem <- get *x, chan:offset
338 *chan <- put *chan, closed?:offset, 1/true
339 ]
340 def close x:&:sink:_elem -> x:&:sink:_elem [
341 local-scope
342 load-inputs
343 chan:&:channel:_elem <- get *x, chan:offset
344 *chan <- put *chan, closed?:offset, 1/true
345 ]
346
347
348
349
350
351
352
353 after <channel-write-initial> [
354 closed?:bool <- get *chan, closed?:offset
355 return-if closed?
356 ]
357 after <channel-read-empty> [
358 closed?:bool <- get *chan, closed?:offset
359 {
360 ¦ break-unless closed?
361 ¦ empty-result:&:_elem <- new _elem:type
362 ¦ current-routine-is-unblocked
363 ¦ return *empty-result, 1/true
364 }
365 ]
366
367
368
369
370 def channel-empty? chan:&:channel:_elem -> result:bool [
371 local-scope
372 load-inputs
373
374 full:num <- get *chan, first-full:offset
375 free:num <- get *chan, first-free:offset
376 result <- equal full, free
377 ]
378
379
380
381 def channel-full? chan:&:channel:_elem -> result:bool [
382 local-scope
383 load-inputs
384
385 tmp:num <- get *chan, first-free:offset
386 tmp <- add tmp, 1
387 {
388 ¦
389 ¦ len:num <- capacity chan
390 ¦ at-end?:bool <- greater-or-equal tmp, len
391 ¦ break-unless at-end?
392 ¦ tmp <- copy 0
393 }
394
395 full:num <- get *chan, first-full:offset
396 result <- equal full, tmp
397 ]
398
399 def capacity chan:&:channel:_elem -> result:num [
400 local-scope
401 load-inputs
402 q:&:@:_elem <- get *chan, data:offset
403 result <- length *q
404 ]
405
406
407
408 def buffer-lines in:&:source:char, buffered-out:&:sink:char -> buffered-out:&:sink:char, in:&:source:char [
409 local-scope
410 load-inputs
411
412 eof?:bool <- copy 0/false
413 {
414 ¦ line:&:buffer:char <- new-buffer 30
415 ¦
416 ¦ {
417 ¦ ¦ +next-character
418 ¦ ¦ c:char, eof?:bool, in <- read in
419 ¦ ¦ break-if eof?
420 ¦ ¦
421 ¦ ¦ {
422 ¦ ¦ ¦
423 ¦ ¦ ¦ backspace?:bool <- equal c, 8
424 ¦ ¦ ¦ break-unless backspace?
425 ¦ ¦ ¦
426 ¦ ¦ ¦ {
427 ¦ ¦ ¦ ¦ buffer-length:num <- get *line, length:offset
428 ¦ ¦ ¦ ¦ buffer-empty?:bool <- equal buffer-length, 0
429 ¦ ¦ ¦ ¦ break-if buffer-empty?
430 ¦ ¦ ¦ ¦ buffer-length <- subtract buffer-length, 1
431 ¦ ¦ ¦ ¦ *line <- put *line, length:offset, buffer-length
432 ¦ ¦ ¦ }
433 ¦ ¦ ¦
434 ¦ ¦ ¦ loop +next-character
435 ¦ ¦ }
436 ¦ ¦
437 ¦ ¦ line <- append line, c
438 ¦ ¦ line-done?:bool <- equal c, 10/newline
439 ¦ ¦ break-if line-done?
440 ¦ ¦ loop
441 ¦ }
442 ¦
443 ¦ i:num <- copy 0
444 ¦ line-contents:text <- get *line, data:offset
445 ¦ max:num <- get *line, length:offset
446 ¦ {
447 ¦ ¦ done?:bool <- greater-or-equal i, max
448 ¦ ¦ break-if done?
449 ¦ ¦ c:char <- index *line-contents, i
450 ¦ ¦ buffered-out <- write buffered-out, c
451 ¦ ¦ i <- add i, 1
452 ¦ ¦ loop
453 ¦ }
454 ¦ {
455 ¦ ¦ break-unless eof?
456 ¦ ¦ buffered-out <- close buffered-out
457 ¦ ¦ return
458 ¦ }
459 ¦ loop
460 }
461 ]
462
463 scenario buffer-lines-blocks-until-newline [
464 run [
465 ¦ local-scope
466 ¦ source:&:source:char, sink:&:sink:char <- new-channel 10/capacity
467 ¦ _, buffered-stdin:&:sink:char/buffered-stdin <- new-channel 10/capacity
468 ¦ buffered-chan:&:channel:char <- get *buffered-stdin, chan:offset
469 ¦ empty?:bool <- channel-empty? buffered-chan
470 ¦ assert empty?, [
471 F buffer-lines-blocks-until-newline: channel should be empty after init]
472 ¦
473 ¦ buffer-routine:num <- start-running buffer-lines, source, buffered-stdin
474 ¦ wait-for-routine-to-block buffer-routine
475 ¦ empty? <- channel-empty? buffered-chan
476 ¦ assert empty?:bool, [
477 F buffer-lines-blocks-until-newline: channel should be empty after buffer-lines bring-up]
478 ¦
479 ¦ sink <- write sink, 97/a
480 ¦ restart buffer-routine
481 ¦ wait-for-routine-to-block buffer-routine
482 ¦ empty? <- channel-empty? buffered-chan
483 ¦ assert empty?:bool, [
484 F buffer-lines-blocks-until-newline: channel should be empty after writing 'a']
485 ¦
486 ¦ sink <- write sink, 98/b
487 ¦ restart buffer-routine
488 ¦ wait-for-routine-to-block buffer-routine
489 ¦ empty? <- channel-empty? buffered-chan
490 ¦ assert empty?:bool, [
491 F buffer-lines-blocks-until-newline: channel should be empty after writing 'b']
492 ¦
493 ¦ sink <- write sink, 10/newline
494 ¦ restart buffer-routine
495 ¦ wait-for-routine-to-block buffer-routine
496 ¦ empty? <- channel-empty? buffered-chan
497 ¦ data-emitted?:bool <- not empty?
498 ¦ assert data-emitted?, [
499 F buffer-lines-blocks-until-newline: channel should contain data after writing newline]
500 ¦ trace 1, [test], [reached end]
501 ]
502 trace-should-contain [
503 ¦ test: reached end
504 ]
505 ]
506
507 def drain source:&:source:char -> result:text, source:&:source:char [
508 local-scope
509 load-inputs
510 buf:&:buffer:char <- new-buffer 30
511 {
512 ¦ c:char, done?:bool <- read source
513 ¦ break-if done?
514 ¦ buf <- append buf, c
515 ¦ loop
516 }
517 result <- buffer-to-array buf
518 ]