Overview
| Comment: | Added exception handling to deal with high cpu loads |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | interleaved-queries |
| Files: | files | file ages | folders |
| SHA1: |
aaf246854cd95cc6116d322675590a51 |
| User & Date: | matt on 2012-11-20 20:25:44 |
| Other Links: | branch diff | manifest | tags |
Context
|
2012-11-20
| ||
| 20:54 | Merged from trunk Closed-Leaf check-in: 6e890892da user: matt tags: interleaved-queries | |
| 20:25 | Added exception handling to deal with high cpu loads check-in: aaf246854c user: matt tags: interleaved-queries | |
| 19:47 | Backed out accelerations check-in: 44292aaf12 user: matt tags: interleaved-queries | |
Changes
Modified common.scm from [df3547d145] to [16b694ea25].
| ︙ | ︙ | |||
48 49 50 51 52 53 54 | (define *max-cache-size* 0) (define *logged-in-clients* (make-hash-table)) (define *client-non-blocking-mode* #f) (define *server-id* #f) (define *server-info* #f) (define *time-to-exit* #f) (define *received-response* #f) | | | 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 | (define *max-cache-size* 0) (define *logged-in-clients* (make-hash-table)) (define *client-non-blocking-mode* #f) (define *server-id* #f) (define *server-info* #f) (define *time-to-exit* #f) (define *received-response* #f) (define *default-numtries* 10) (define *target* (make-hash-table)) ;; cache the target here; target is keyval1/keyval2/.../keyvalN (define *keys* (make-hash-table)) ;; cache the keys here (define *keyvals* (make-hash-table)) (define *toptest-paths* (make-hash-table)) ;; cache toptest path settings here (define *test-paths* (make-hash-table)) ;; cache test-id to test run paths here (define *test-ids* (make-hash-table)) ;; cache run-id, testname, and item-path => test-id |
| ︙ | ︙ |
Modified db.scm from [e37e26940d] to [f398e4db4e].
| ︙ | ︙ | |||
1108 1109 1110 1111 1112 1113 1114 | ;; params = 'target cached remparams ;; ;; make-vector-record cdb packet client-sig qtype immediate query-sig params qtime ;; (define (cdb:client-call zmq-sockets qtype immediate numretries . params) (debug:print-info 11 "cdb:client-call zmq-sockets=" zmq-sockets ", qtype=" qtype ", immediate=" immediate ", numretries=" numretries ", params=" params) | > > > > > | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140 1141 1142 1143 1144 1145 1146 1147 1148 1149 1150 1151 1152 1153 1154 1155 1156 1157 1158 1159 1160 1161 1162 1163 1164 1165 1166 1167 1168 1169 |
;; params = 'target cached remparams
;;
;; make-vector-record cdb packet client-sig qtype immediate query-sig params qtime
;;
(define (cdb:client-call zmq-sockets qtype immediate numretries . params)
(debug:print-info 11 "cdb:client-call zmq-sockets=" zmq-sockets ", qtype=" qtype ", immediate=" immediate ", numretries=" numretries ", params=" params)
(handle-exceptions
exn
(begin
(thread-sleep! 5)
(if (> numretries 0)(apply cdb:client-call zmq-sockets qtype immediate (- numretries 1) params)))
(let* ((push-socket (vector-ref zmq-sockets 0))
(sub-socket (vector-ref zmq-sockets 1))
(client-sig (server:get-client-signature))
(query-sig (message-digest-string (md5-primitive) (conc qtype immediate params)))
(zdat (db:obj->string (vector client-sig qtype immediate query-sig params (current-seconds)))) ;; (with-output-to-string (lambda ()(serialize params))))
(res #f)
(send-receive (lambda ()
(debug:print-info 11 "sending message")
(send-message push-socket zdat)
(debug:print-info 11 "message sent")
(let loop ()
;; get the sender info
;; this should match (server:get-client-signature)
;; we will need to process "all" messages here some day
(receive-message* sub-socket)
;; now get the actual message
(let ((myres (db:string->obj (receive-message* sub-socket))))
(if (equal? query-sig (vector-ref myres 1))
(set! res (vector-ref myres 2))
(loop))))))
(timeout (lambda ()
(let loop ((n numretries))
(thread-sleep! 15)
(if (not res)
(if (> numretries 0)
(begin
(debug:print 2 "WARNING: no reply to query " params ", trying resend")
(debug:print-info 11 "re-sending message")
(send-message push-socket zdat)
(debug:print-info 11 "message re-sent")
(loop (- n 1)))
;; (apply cdb:client-call zmq-sockets qtype immediate (- numretries 1) params))
(begin
(debug:print 0 "ERROR: cdb:client-call timed out " params ", exiting.")
(exit 5))))))))
(debug:print-info 11 "Starting threads")
(let ((th1 (make-thread send-receive "send receive"))
(th2 (make-thread timeout "timeout")))
(thread-start! th1)
(thread-start! th2)
(thread-join! th1)
(debug:print-info 11 "cdb:client-call returning res=" res)
res))))
(define (cdb:set-verbosity zmq-socket val)
(cdb:client-call zmq-socket 'set-verbosity #f *default-numtries* val))
(define (cdb:login zmq-sockets keyval signature)
(cdb:client-call zmq-sockets 'login #t *default-numtries* keyval megatest-version signature))
|
| ︙ | ︙ |