239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
|
(vector-set! vec 5 (current-seconds))
(begin
(print-call-chain (current-error-port))
(debug:print-error 0 *default-log-port* "call to rpc-transport:server-dat-update-last-access with non-vector!!"))))
(define *api-exec-ht* (make-hash-table))
;; let's see if caching the rpc stub curbs thread-profusion on server side
(define (rpc-transport:get-api-exec iface port)
(let* ((lu (hash-table-ref/default *api-exec-ht* (cons iface port) #f)))
(if lu
lu
(let ((res (rpc:procedure 'api-exec iface port)))
(hash-table-set! *api-exec-ht* (cons iface port) res)
res))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; this client-side procedure makes rpc call to server and returns result
;;
(define (rpc-transport:client-api-send-receive run-id serverdat cmd params #!key (numretries 3))
;;(BB> "entered rpc-transport:client-api-send-receive with run-id="run-id " serverdat="serverdat" cmd="cmd" params="params" numretries="numretries)
|
|
>
>
>
|
>
|
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
|
(vector-set! vec 5 (current-seconds))
(begin
(print-call-chain (current-error-port))
(debug:print-error 0 *default-log-port* "call to rpc-transport:server-dat-update-last-access with non-vector!!"))))
(define *api-exec-ht* (make-hash-table))
(define *api-exec-mutex* (make-mutex))
;; let's see if caching the rpc stub curbs thread-profusion on server side
(define (rpc-transport:get-api-exec iface port)
(mutex-lock! *api-exec-mutex*)
(let* ((lu (hash-table-ref/default *api-exec-ht* (cons iface port) #f)))
(if lu
(begin
(mutex-unlock! *api-exec-mutex*)
lu)
(let ((res (rpc:procedure 'api-exec iface port)))
(hash-table-set! *api-exec-ht* (cons iface port) res)
(mutex-unlock! *api-exec-mutex*)
res))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; this client-side procedure makes rpc call to server and returns result
;;
(define (rpc-transport:client-api-send-receive run-id serverdat cmd params #!key (numretries 3))
;;(BB> "entered rpc-transport:client-api-send-receive with run-id="run-id " serverdat="serverdat" cmd="cmd" params="params" numretries="numretries)
|
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
|
;;(vector #t (run-remote cmd params))
(vector 'success (api-exec cmd params))
[x (exn i/o net) (vector 'comms-fail (conc "communications fail ["(->string x)"]") x)]
[x () (vector 'other-fail "other fail ["(->string x)"]" x)]))
chatty: #f
accept-result?: (lambda(x)
(and (vector? x) (vector-ref x 0)))
retries: 4
back-off-factor: 1.5
random-wait: 0.2
retry-delay: 0.1
final-failure-returns-actual: #t))
;;(BB> "HEY res="res)
res
))
|
|
|
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
|
;;(vector #t (run-remote cmd params))
(vector 'success (api-exec cmd params))
[x (exn i/o net) (vector 'comms-fail (conc "communications fail ["(->string x)"]") x)]
[x () (vector 'other-fail "other fail ["(->string x)"]" x)]))
chatty: #f
accept-result?: (lambda(x)
(and (vector? x) (vector-ref x 0)))
retries: 8
back-off-factor: 1.5
random-wait: 0.2
retry-delay: 0.1
final-failure-returns-actual: #t))
;;(BB> "HEY res="res)
res
))
|
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
|
(thread-join! th1)
(thread-terminate! th2)
;;(BB> "alt got res="res)
(debug:print-info 11 *default-log-port* "got res=" res)
(if (vector? res)
(case (vector-ref res 0)
((success) (vector #t (vector-ref res 1)))
((comms-fail)
(debug:print 0 *default-log-port* "WARNING: comms failure for rpc request >>"res"<<")
;;(debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn))
(vector #f (vector-ref res 1)))
(else
(debug:print-error 0 *default-log-port* "error occured at server, info=" (vector-ref res 1))
(debug:print 0 *default-log-port* " client call chain:")
(print-call-chain (current-error-port))
|
>
>
|
|
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
|
(thread-join! th1)
(thread-terminate! th2)
;;(BB> "alt got res="res)
(debug:print-info 11 *default-log-port* "got res=" res)
(if (vector? res)
(case (vector-ref res 0)
((success) (vector #t (vector-ref res 1)))
(
(comms-fail other-fail)
;;(comms-fail)
(debug:print 0 *default-log-port* "WARNING: comms failure for rpc request >>"res"<<")
;;(debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn))
(vector #f (vector-ref res 1)))
(else
(debug:print-error 0 *default-log-port* "error occured at server, info=" (vector-ref res 1))
(debug:print 0 *default-log-port* " client call chain:")
(print-call-chain (current-error-port))
|