File: qa-pipefork

package info (click to toggle)
newlisp 10.7.5-2
  • links: PTS, VCS
  • area: main
  • in suites: bookworm, bullseye, forky, sid, trixie
  • size: 6,248 kB
  • sloc: ansic: 33,280; lisp: 4,181; sh: 609; makefile: 215
file content (36 lines) | stat: -rwxr-xr-x 804 bytes parent folder | download | duplicates (2)
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
#!/usr/bin/env newlisp
#
# two forked processes communicating via pipes

(when (find ostype '("Windows"))
    (println "fork not available on Windows")
	(exit))


(println)
(println "Testing/benchmarking  pipes with forked processes")

(set 'start (time-of-day))
(set 'N 1000)

(define (count-down-proc x channel)
  (while (!= x 0)
      (write-line channel (string x))
      (dec x)))

(define (observer-proc channel)
  (do-until (= i "1")
    (print "read " (setq i (read-line channel)) "\r")
))

(map set '(in out) (pipe))
(set 'observer (fork (observer-proc in)))
(set 'counter (fork (count-down-proc N out)))

; avoid zombies
(wait-pid observer)
(wait-pid counter)

(println ">>>>> " (div (- (time-of-day) start)  N) 
" ms per write->read pipe/fork (0.0356 ms Mac OSX, 1.83 GHz Core 2 Duo)")
(exit)