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
|
work-method ;; parameter; 'threads, 'mailbox, 'limited, 'direct
return-method ;; parameter; 'mailbox, 'polling, 'direct
)
(import scheme
chicken.base
chicken.file
chicken.time
chicken.condition
chicken.string
chicken.sort
chicken.pretty-print
address-info
mailbox
matchable
;; queues
regex
regex-case
s11n
srfi-1
srfi-18
srfi-4
srfi-69
system-information
tcp6
|
>
>
|
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
|
work-method ;; parameter; 'threads, 'mailbox, 'limited, 'direct
return-method ;; parameter; 'mailbox, 'polling, 'direct
)
(import scheme
chicken.base
chicken.file
chicken.io
chicken.time
chicken.condition
chicken.string
chicken.sort
chicken.pretty-print
address-info
mailbox
matchable
;; queues
regex
regex-case
simple-exceptions
s11n
srfi-1
srfi-18
srfi-4
srfi-69
system-information
tcp6
|
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
|
;; dat is a self-contained work block that can be sent or handled locally
(dat (list my-host-port qrykey cmd params #;(cons (current-seconds)(current-milliseconds)))))
(cond
(isme (ulex-handler udata dat)) ;; no transmission needed
(else
(handle-exceptions ;; TODO - MAKE THIS EXCEPTION CMD SPECIFIC?
exn
#f
(deserialize inp))
(begin
(print "ERROR: send called but no receiver has been setup. Please call setup first!")
#f))))
(close-input-port inp)
(close-output-port oup)
|
<
>
>
|
>
<
|
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
|
;; dat is a self-contained work block that can be sent or handled locally
(dat (list my-host-port qrykey cmd params #;(cons (current-seconds)(current-milliseconds)))))
(cond
(isme (ulex-handler udata dat)) ;; no transmission needed
(else
(handle-exceptions ;; TODO - MAKE THIS EXCEPTION CMD SPECIFIC?
exn
(message exn)
(begin
;; (mutex-lock! *send-mutex*)
(let-values (((inp oup)(tcp-connect host-port)))
(let ((res (if (and inp oup)
(begin
(serialize dat oup)
(close-output-port oup)
(deserialize inp)
)
(begin
(print "ERROR: send called but no receiver has been setup. Please call setup first!")
#f))))
(close-input-port inp)
;; (mutex-unlock! *send-mutex*)
res)))))))) ;; res will always be 'ack unless return-method is direct
(define (send-via-polling uconn host-port cmd data)
(let* ((qrykey (make-cookie uconn))
(sres (send uconn host-port qrykey cmd data)))
(case sres
|