Overview
Comment: | Initial attempt at runner throttle. NOT WORKING QUITE RIGHT |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v1.65 |
Files: | files | file ages | folders |
SHA1: |
5c5398b2f239681d68f86cf57594972e |
User & Date: | mrwellan on 2020-08-11 00:37:46 |
Other Links: | branch diff | manifest | tags |
Context
2020-08-11
| ||
23:26 | several tries later ... check-in: 7308f2111f user: mrwellan tags: v1.65 | |
00:37 | Initial attempt at runner throttle. NOT WORKING QUITE RIGHT check-in: 5c5398b2f2 user: mrwellan tags: v1.65 | |
2020-08-10
| ||
10:52 | Added MT_STEP_NAME check-in: 0e49a44c95 user: mrwellan tags: v1.65 | |
Changes
Modified api.scm from [a15c0cd809] to [70cdbd0f27].
︙ | |||
210 211 212 213 214 215 216 217 218 219 220 221 222 223 | 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 | + + | ((register-run) (apply db:register-run dbstruct params)) ((set-tests-state-status) (apply db:set-tests-state-status dbstruct params)) ((delete-run) (apply db:delete-run dbstruct params)) ((lock/unlock-run) (apply db:lock/unlock-run dbstruct params)) ((update-run-event_time) (apply db:update-run-event_time dbstruct params)) ((update-run-stats) (apply db:update-run-stats dbstruct params)) ((set-var) (apply db:set-var dbstruct params)) ((inc-var) (apply db:inc-var dbstruct params)) ((dec-var) (apply db:dec-var dbstruct params)) ((del-var) (apply db:del-var dbstruct params)) ;; STEPS ((teststep-set-status!) (apply db:teststep-set-status! dbstruct params)) ((delete-steps-for-test!) (apply db:delete-steps-for-test! dbstruct params)) ;; TEST DATA |
︙ |
Modified db.scm from [b66b42236f] to [b0064c2033].
︙ | |||
1952 1953 1954 1955 1956 1957 1958 1959 1960 1961 1962 1963 1964 1965 | 1952 1953 1954 1955 1956 1957 1958 1959 1960 1961 1962 1963 1964 1965 1966 1967 1968 1969 1970 1971 1972 1973 1974 1975 | + + + + + + + + + + | "SELECT val FROM metadat WHERE var=?;" var) ;; convert to number if can (if (string? res) (let ((valnum (string->number res))) (if valnum (set! res valnum)))) res)))) (define (db:inc-var dbstruct var) (db:with-db dbstruct #f #t (lambda (db) (sqlite3:execute db "UPDATE metadat SET val=val+1 WHERE var=?;" var)))) (define (db:dec-var dbstruct var) (db:with-db dbstruct #f #t (lambda (db) (sqlite3:execute db "UPDATE metadat SET val=val-1 WHERE var=?;" var)))) ;; This was part of db:get-var. It was used to estimate the load on ;; the database files. ;; ;; scale by 10, average with current value. ;; (set! *global-delta* (/ (+ *global-delta* (* (- (current-milliseconds) start-ms) ;; (if throttle throttle 0.01))) ;; 2)) |
︙ |
Modified ezsteps.scm from [9d1b48037c] to [59d2b04420].
︙ | |||
33 34 35 36 37 38 39 | 33 34 35 36 37 38 39 40 41 42 43 44 45 46 | - - | (include "key_records.scm") (include "db_records.scm") (include "run_records.scm") ;;(rmt:get-test-info-by-id run-id test-id) -> testdat |
︙ | |||
92 93 94 95 96 97 98 99 100 101 102 103 104 105 | 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 | + | (proceed-with-this-step (or (not start-step-name) (equal? stepname start-step-name) (and saw-start-step-name (not run-one)) saw-start-step-name-next (and start-step-name (equal? stepname start-step-name)))) ) (setenv "MT_STEP_NAME" stepname) (set! do-update-test-state-status (and proceed-with-this-step (null? tal))) ;;(BB> "stepname="stepname" proceed-with-this-step="proceed-with-this-step " do-update-test-state-status="do-update-test-state-status " orig-test-state="orig-test-state" orig-test-status="orig-test-status) (cond ((and (not proceed-with-this-step) (null? tal)) 'done) ((not proceed-with-this-step) (loop (car tal) |
︙ |
Modified rmt.scm from [e52432dc0d] to [c90382995e].
︙ | |||
786 787 788 789 790 791 792 | 786 787 788 789 790 791 792 793 794 795 796 797 798 799 | - | (define (rmt:set-run-status run-id run-status #!key (msg #f)) (rmt:send-receive 'set-run-status #f (list run-id run-status msg))) (define (rmt:set-run-state-status run-id state status ) (rmt:send-receive 'set-run-state-status #f (list run-id state status))) |
︙ | |||
809 810 811 812 813 814 815 816 817 818 819 820 821 822 | 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 | + + + + + + | (define (rmt:del-var varname) (rmt:send-receive 'del-var #f (list varname))) (define (rmt:set-var varname value) (rmt:send-receive 'set-var #f (list varname value))) (define (rmt:inc-var varname) (rmt:send-receive 'inc-var #f (list varname))) (define (rmt:dec-var varname) (rmt:send-receive 'dec-var #f (list varname))) ;;====================================================================== ;; M U L T I R U N Q U E R I E S ;;====================================================================== ;; Need to move this to multi-run section and make associated changes (define (rmt:find-and-mark-incomplete-all-runs #!key (ovr-deadtime #f)) (let ((run-ids (rmt:get-all-run-ids))) |
︙ |
Modified runs.scm from [8eb0eeffbc] to [d0362390bc].
︙ | |||
44 45 46 47 48 49 50 | 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 | - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + | (defstruct runs:dat reglen regfull runname max-concurrent-jobs run-id test-patts required-tests test-registry registry-mutex flags keyvals run-info all-tests-registry can-run-more-tests |
︙ | |||
1544 1545 1546 1547 1548 1549 1550 1551 1552 1553 1554 1555 1556 1557 | 1651 1652 1653 1654 1655 1656 1657 1658 1659 1660 1661 1662 1663 1664 1665 1666 | + + | "\n waitons: " waitons "\n num-retries: " num-retries "\n reruns: " reruns "\n regfull: " regfull "\n reglen: " reglen "\n length reg: " (length reg) ) (runs:parallel-runners-mgmt runsdat) ;; check for hed in waitons => this would be circular, remove it and issue an ;; error (if (member test-name waitons) (begin (debug:print-error 0 *default-log-port* "test " test-name " has listed itself as a waiton, please correct this!") (set! waiton (filter (lambda (x)(not (equal? x hed))) waitons)))) |
︙ |