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
|
;
; SHPROC.SCM - test the process control capabilities both of PPC and SCHEME
;
(define (send-command proc cmd)
(printf nil "\nSending: %s\n" cmd)
(process-send-line proc cmd)
(display-response proc)
(show-status proc))
(define (show-status proc)
(let* ((stat (process-status proc))
(runs (cdddr stat))
(runp (car runs))
(reason (cadr runs)))
(printf nil
"Status for process \#%d: %s\n"
(car stat)
(cond ((= runp 0) "Running")
((= runp 1) (sprintf "Stopped (%d)" reason))
((= runp 2) (sprintf "Changed (%d)" reason))
((or (= runp 4) (= runp 6))
(sprintf "Exited (%d)" reason))
((or (= runp 8) (= runp 10))
(sprintf "Coredumped (%d)" reason))
((= runp 16) (sprintf "Signaled (%d)" reason))
(else (sprintf "Unkown (%d %d)" runp reason))))))
(define (display-response proc)
(let* ((s (process-read-line proc)))
(if s
(begin (printf nil "| %s" s)
(display-response proc))
(printf nil "\n"))))
(printf nil "Old # read attempts: %d\n" (process-read-tries))
(printf nil "New # read attempts: %d\n" (process-read-tries 10000))
(printf nil "\n")
(define child (process-open "a" "scheme"))
(show-status child)
(display-response child)
(send-command child "(car (list 1 2 3))")
(send-command child "(describe process-status)")
(send-command child "(quit)")
(process-close child)
(printf nil "\n")
(quit)
|
