Overview
Comment: | Fixed performance issue with append in runs.scm |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v1.80 |
Files: | files | file ages | folders |
SHA1: |
0dc6c83d6ebe0bb4430eb79e877059f1 |
User & Date: | matt on 2023-04-06 09:23:58 |
Other Links: | branch diff | manifest | tags |
Context
2023-04-06
| ||
16:25 | Added asserts, improved message/assert on lock failure check-in: eca566d9f9 user: mmgraham tags: v1.80 | |
13:32 | Make server logs not overlap on server.log - this makes debug easier check-in: 3053005860 user: matt tags: v1.80 | |
09:23 | Fixed performance issue with append in runs.scm check-in: 0dc6c83d6e user: matt tags: v1.80 | |
08:01 | Fixed MTLOWEST load check-in: 71f876d389 user: matt tags: v1.80 | |
Changes
Modified dbmod.scm from [8ac607e451] to [51b0a8133b].
︙ | ︙ | |||
231 232 233 234 235 236 237 238 239 240 241 242 243 244 | ;; if last-update specified ("field-name" . time-in-seconds) ;; then sync only records where field-name >= time-in-seconds ;; IFF field-name exists ;; ;; Use (db:sync-all-tables-list keys) to get the tbls input ;; (define (dbmod:sync-tables tbls last-update fromdb todb) (let ((stmts (make-hash-table)) ;; table-field => stmt (all-stmts '()) ;; ( ( stmt1 value1 ) ( stml2 value2 )) (numrecs (make-hash-table)) (start-time (current-milliseconds)) (tot-count 0)) (for-each ;; table (lambda (tabledat) | > > | 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 | ;; if last-update specified ("field-name" . time-in-seconds) ;; then sync only records where field-name >= time-in-seconds ;; IFF field-name exists ;; ;; Use (db:sync-all-tables-list keys) to get the tbls input ;; (define (dbmod:sync-tables tbls last-update fromdb todb) (assert (sqlite3:database? fromdb) "FATAL: dbmod:sync-tables called with fromdb not a database" fromdb) (assert (sqlite3:database? todb) "FATAL: dbmod:sync-tables called with fromdb not a database" todb) (let ((stmts (make-hash-table)) ;; table-field => stmt (all-stmts '()) ;; ( ( stmt1 value1 ) ( stml2 value2 )) (numrecs (make-hash-table)) (start-time (current-milliseconds)) (tot-count 0)) (for-each ;; table (lambda (tabledat) |
︙ | ︙ |
Modified runs.scm from [0489d178f6] to [09906f7b93].
︙ | ︙ | |||
1541 1542 1543 1544 1545 1546 1547 1548 1549 1550 1551 1552 1553 1554 | (registry-mutex (make-mutex)) (num-retries 0) (max-retries (configf:lookup *configdat* "setup" "maxretries")) (max-concurrent-jobs (configf:lookup-number *configdat* "setup" "max_concurrent_jobs" default: 50)) (reglen (if (number? reglen-in) reglen-in 1)) (last-time-incomplete (- (current-seconds) 900)) ;; force at least one clean up cycle (last-time-some-running (current-seconds)) ;; (tdbdat (tasks:open-db)) (runsdat (make-runs:dat ;; hed: hed ;; tal: tal ;; reg: reg ;; reruns: reruns reglen: reglen | > | 1541 1542 1543 1544 1545 1546 1547 1548 1549 1550 1551 1552 1553 1554 1555 | (registry-mutex (make-mutex)) (num-retries 0) (max-retries (configf:lookup *configdat* "setup" "maxretries")) (max-concurrent-jobs (configf:lookup-number *configdat* "setup" "max_concurrent_jobs" default: 50)) (reglen (if (number? reglen-in) reglen-in 1)) (last-time-incomplete (- (current-seconds) 900)) ;; force at least one clean up cycle (last-time-some-running (current-seconds)) (incoming-tests '()) ;; queue up incoming tests here to tack on to tal when it gets low ;; (tdbdat (tasks:open-db)) (runsdat (make-runs:dat ;; hed: hed ;; tal: tal ;; reg: reg ;; reruns: reruns reglen: reglen |
︙ | ︙ | |||
1853 1854 1855 1856 1857 1858 1859 | (newtestname (db:test-make-full-name hed my-item-path))) ;; test names are unique on testname/item-path (tests:testqueue-set-items! new-test-record #f) (tests:testqueue-set-itemdat! new-test-record my-itemdat) (tests:testqueue-set-item_path! new-test-record my-item-path) (hash-table-set! test-records newtestname new-test-record) ;; BUG: This next line sucks up a lot of horsepower | > > > | | > > > | 1854 1855 1856 1857 1858 1859 1860 1861 1862 1863 1864 1865 1866 1867 1868 1869 1870 1871 1872 1873 1874 1875 1876 1877 | (newtestname (db:test-make-full-name hed my-item-path))) ;; test names are unique on testname/item-path (tests:testqueue-set-items! new-test-record #f) (tests:testqueue-set-itemdat! new-test-record my-itemdat) (tests:testqueue-set-item_path! new-test-record my-item-path) (hash-table-set! test-records newtestname new-test-record) ;; BUG: This next line sucks up a lot of horsepower ;; (set! tal (append tal (list newtestname))) ;; (set! tal (cons newtestname tal)) ;; 4/6/2023 - try using cons, does it matter if the test gets added at the beginning? (set! incoming-tests (cons newtestname incoming-tests)) )) ;; since these are itemized create new test names testname/itempath items-in-testpatt))) (if (< (length tal) 20) (begin (set! tal (append tal (reverse incoming-tests))) (set! incoming-tests '()))) ;; At this point we have possibly added items to tal but all must be handed off to ;; INNER COND logic. I think loop without rotating the queue ;; (loop hed tal reg reruns)) ;; (let ((newtal (append tal (list hed)))) ;; We should discard hed as it has been expanded into it's items? Yes, but only if this *is* an itemized test ;; (loop (car newtal)(cdr newtal) reg reruns) (if (null? tal) |
︙ | ︙ |