Overview
Context
Changes
Modified common.scm
from [5f4ffd9564]
to [cd37d26c89].
︙ | | |
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092
2093
2094
2095
2096
|
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092
2093
2094
2095
2096
2097
|
-
+
+
|
(first (car loadavg))
(next (cadr loadavg))
(adjmaxload (* maxload (max 1 numcpus))) ;; possible bug where
;; numcpus (or could be
;; maxload) is zero,
;; crude fallback is to
;; at least use 1
(loadjmp (- first (if (> next (* numcpus 0.7))
(loadjmp (- first (if (> next (* numcpus 0.7)) ;; could do something with average of first and next?
0
next))) ;; we will force a conservative calculation any time next is large.
(first-next-avg (/ (+ first next) 2))
;; add some randomness to the time to break any alignment
;; where netbatch dumps many jobs to machines simultaneously
(adjwait (min (+ 300 (random 10)) (abs (* (+ (random 10)
(/ (- 1000 count) 10)
waitdelay)
(- first adjmaxload) )) )))
;; let's let the user know once in a long while that load checking
|
︙ | | |
Modified db.scm
from [b17ec00910]
to [62ab492ea6].
︙ | | |
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
|
37
38
39
40
41
42
43
44
45
46
47
48
49
50
|
-
|
(declare (uses mt))
(include "common_records.scm")
(include "db_records.scm")
(include "key_records.scm")
(include "run_records.scm")
(define *rundb-mutex* (make-mutex)) ;; prevent problems opening/closing rundb's
(define *number-of-writes* 0)
(define *number-non-write-queries* 0)
;;======================================================================
;; R E C O R D S
;;======================================================================
|
︙ | | |
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
|
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
|
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
|
dbdat))
(define (db:dbdat-get-path dbdat)
(if (pair? dbdat)
(cdr dbdat)
#f))
;; mod-read:
;; 'mod modified data
;; 'read read data
;; Locks the mutex and depending on 'mod or 'read passed, sets the last timestamp in dbstruct
;;
;; (define (db:done-with dbstruct run-id mod-read)
;; (if (not (sqlite3:database? dbstruct))
;; (begin
;; (mutex-lock! *rundb-mutex*)
;; (if (eq? mod-read 'mod)
;; (dbr:dbstruct-mtime-set! dbstruct (current-milliseconds))
;; (dbr:dbstruct-rtime-set! dbstruct (current-milliseconds)))
;; (dbr:dbstruct-inuse-set! dbstruct #f)
;; (mutex-unlock! *rundb-mutex*))))
(define-inline (db:generic-error-printout exn . message)
(print-call-chain (current-error-port))
(apply debug:print-error 0 *default-log-port* message)
(debug:print-error 0 *default-log-port* " params: " params
", error: " ((condition-property-accessor 'exn 'message) exn)
", arguments: " ((condition-property-accessor 'exn 'arguments) exn)
", location: " ((condition-property-accessor 'exn 'location) exn)
))
(print-call-chain (current-error-port))
;; (db:with-db dbstruct run-id sqlite3:exec "select blah fgrom blaz;")
;; r/w is a flag to indicate if the db is modified by this query #t = yes, #f = no
;;
(define (db:with-db dbstruct run-id r/w proc . params)
(let* ((have-struct (dbr:dbstruct? dbstruct))
(dbdat (if have-struct
(db:get-db dbstruct)
|
︙ | | |
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
|
360
361
362
363
364
365
366
367
368
369
370
371
372
373
|
-
|
(set! *db-write-access* #f)
(dbr:dbstruct-read-only-set! dbstruct #t)))
(dbr:dbstruct-mtdb-set! dbstruct mtdb)
(dbr:dbstruct-tmpdb-set! dbstruct tmpdb)
(dbr:dbstruct-dbstack-set! dbstruct (make-stack)) ;; BB: why a stack? Why would the number of db's be indeterminate? Is this a legacy of 1.db 2.db .. ?
(stack-push! (dbr:dbstruct-dbstack dbstruct) tmpdb) ;; olddb is already a (cons db path)
(dbr:dbstruct-refndb-set! dbstruct refndb)
;; (mutex-unlock! *rundb-mutex*)
(if (and (or (not dbfexists)
(and modtimedelta
(> modtimedelta max-stale-tmp))) ;; if db in tmp is over ten seconds older than the file in MTRA then do a sync back
do-sync)
(begin
(debug:print 1 *default-log-port* "filling db " (db:dbdat-get-path tmpdb) " with data \n from " (db:dbdat-get-path mtdb) " mod time delta: " modtimedelta)
(db:sync-tables (db:sync-all-tables-list dbstruct) #f mtdb refndb tmpdb)
|
︙ | | |