Megatest

Check-in [aaf246854c]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
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: aaf246854cd95cc6116d322675590a51cc0e4460
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
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified common.scm from [df3547d145] to [16b694ea25].

︙
48
49
50
51
52
53
54
55

56
57
58
59
60
61
62

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*  5)
(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





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

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! 60)
		      (if (not res)
			  (if (> numretries 0)
			      (begin
				(debug:print 0 "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)))
   (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))
︙

This page was generated in about 0.128s by Fossil 2.24 [452f8e1ffc] 2024-03-26 15:36:00