Index: rmt.scm ================================================================== --- rmt.scm +++ rmt.scm @@ -26,10 +26,13 @@ (include "common_records.scm") (declare (uses rmtmod)) (import rmtmod) +(define (member:print msg x lst) + (print "member: " msg " x=" x " lst=" lst) + (member x lst)) ;; ;; THESE ARE ALL CALLED ON THE CLIENT SIDE!!! ;; @@ -69,11 +72,11 @@ (if (not runremote) ;; can remove this one. should never get here. (begin (set! *runremote* (make-remote)) (set! runremote *runremote*))) ;; new runremote will come from this on next iteration - (if (member cmd '(blah)) + (if (member:print "#2" cmd '(blah)) (begin (mutex-lock! *send-receive-mutex*) (if (not *runremote*)(set! *runremote* (make-remote))) (let ((ulex:conn (remote-ulex:conn *runremote*))) (if (not ulex:conn)(remote-ulex:conn-set! *runremote* (rmtmod:setup-ulex *toppath*))) @@ -114,11 +117,11 @@ (debug:print 0 log-port "ERROR: 15 tries to start/connect to server. Giving up.") (exit 1)) ;; readonly mode, read request- handle it - case 2 ((and readonly-mode - (member cmd api:read-only-queries)) + (member:print "#3" cmd api:read-only-queries)) ;; (mutex-unlock! rmt-mutex) (debug:print-info 12 log-port "rmt:send-receive, case 2") (rmt:open-qry-close-locally log-port multi-sync-mutex cmd 0 params ro-queries: api:read-only-queries) ) @@ -143,18 +146,18 @@ ;; on homehost and this is a read ((and (not (remote-force-server runremote)) ;; honor forced use of server, i.e. server NOT required (cdr (remote-hh-dat runremote)) ;; on homehost - (member cmd api:read-only-queries)) ;; this is a read + (member:print "#4" cmd api:read-only-queries)) ;; this is a read ;; (mutex-unlock! rmt-mutex) (debug:print-info 12 log-port "rmt:send-receive, case 5") (rmt:open-qry-close-locally log-port multi-sync-mutex cmd 0 params ro-queries: api:read-only-queries)) ;; on homehost and this is a write, we already have a server, but server has died ((and (cdr (remote-hh-dat runremote)) ;; on homehost - (not (member cmd api:read-only-queries)) ;; this is a write + (not (member:print "#5" cmd api:read-only-queries)) ;; this is a write (remote-server-url runremote) ;; have a server (not (server:ping (remote-server-url runremote)))) ;; server has died. NOTE: this is not a cheap call! Need better approach. (set! *runremote* (make-remote)) (remote-force-server-set! runremote (common:force-server?)) ;; (mutex-unlock! rmt-mutex) @@ -162,21 +165,21 @@ (rmt:send-receive-orig log-port runremote rmt-mutex toppath multi-sync-mutex cmd rid params attemptnum: attemptnum)) ;; on homehost and this is a write, we already have a server ((and (not (remote-force-server runremote)) ;; honor forced use of server, i.e. server NOT required (cdr (remote-hh-dat runremote)) ;; on homehost - (not (member cmd api:read-only-queries)) ;; this is a write + (not (member:print "#6" cmd api:read-only-queries)) ;; this is a write (remote-server-url runremote)) ;; have a server ;;(mutex-unlock! rmt-mutex) (debug:print-info 12 log-port "rmt:send-receive, case 4.1") (rmt:open-qry-close-locally log-port multi-sync-mutex cmd 0 params ro-queries: api:read-only-queries)) ;; on homehost, no server contact made and this is a write, passively start a server ((and (not (remote-force-server runremote)) ;; honor forced use of server, i.e. server NOT required (cdr (remote-hh-dat runremote)) ;; have homehost (not (remote-server-url runremote)) ;; no connection yet - (not (member cmd api:read-only-queries))) ;; not a read-only query + (not (member:print "#7" cmd api:read-only-queries))) ;; not a read-only query (debug:print-info 12 log-port "rmt:send-receive, case 8") (let ((server-url (server:check-if-running toppath))) ;; (server:read-dotserver->url toppath))) ;; (server:check-if-running toppath))) ;; Do NOT want to run server:check-if-running - very expensive to do for every write call (if server-url (remote-server-url-set! runremote server-url) ;; the string can be consumed by the client setup if needed (if (common:force-server?) @@ -497,11 +500,11 @@ '() (let loop ((hed (car run-id-list)) (tal (cdr run-id-list)) (threads '())) (if (> (length threads) 5) - (loop hed tal (filter (lambda (th)(not (member (thread-state th) '(terminated dead)))) threads)) + (loop hed tal (filter (lambda (th)(not (member:print "#8" (thread-state th) '(terminated dead)))) threads)) (let* ((newthread (make-thread (lambda () (let ((res (rmt:send-receive 'get-tests-for-run-mindata hed (list hed testpatt states status not-in)))) (if (list? res) (begin Index: rmtmod.scm ================================================================== --- rmtmod.scm +++ rmtmod.scm @@ -27,10 +27,13 @@ (import scheme chicken data-structures extras) (import (prefix sqlite3 sqlite3:) posix typed-records srfi-18) (import commonmod) (use (prefix ulex ulex:)) +(define (member:print msg x lst) + (print "member-" msg ": x=" x " lst=" lst) + (member x lst)) ;; Hack to make these functions visible to the refactored code, goal is to eliminate these over time. (define (rmt:send-receive . params) #f) (define (http-transport:close-connections . params) #f) ;; from remote defstruct in common.scm @@ -44,11 +47,10 @@ (define (debug:print-info . params) #f) (define (debug:print-error . params) #f) (define (db:dbfile-path . params) #f) (define (db:setup . params) #f) (define (api:execute-requests . params) #f) -(define (api:read-only-queries . params) #f) (define (set-functions send-receive rsus close-connections rcs dbgp dbgpinfo dbgperr @@ -73,15 +75,14 @@ (set! remote-ro-mode-checked ro-mode-checked) ;; db stuff for local db access (set! db:dbfile-path dbfile-path) (set! db:setup dbsetup) (set! apt:execute-requests exec-req) - (set! api:read-only-queries read-only-queries) ) (define (rmt:open-qry-close-locally log-port multi-sync-mutex cmd run-id params #!key (ro-queries '())(remretries 5)) - (let* ((qry-is-write (not (member cmd ro-queries))) + (let* ((qry-is-write (not (member:print "#1" cmd ro-queries))) (db-file-path (db:dbfile-path)) ;; 0)) (dbstruct-local (db:setup #t)) ;; make-dbr:dbstruct path: dbdir local: #t))) (read-only (not (file-write-access? db-file-path))) (start (current-milliseconds)) (resdat (if (not (and read-only qry-is-write)) @@ -195,9 +196,8 @@ (define (rmtmod:send-receive-ulex ulex:conn cmd rid params attemptnum area-dat) #f) (use trace)(trace-call-sites #t) -(trace member rmtmod:calc-ro-mode rmt:open-qry-close-locally) - +(trace member rmtmod:calc-ro-mode rmt:open-qry-close-locally member:print) )