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
|
;; if run-id is a string treat it as a filename
;; if db already open - return inmem
;; if db not open, open inmem, rundb and sync then return inmem
;; inuse gets set automatically for rundb's
;;
;; (define db:get-db db:get-subdb)
;; (define (db:get-db subdb #;dbstruct run-id) ;; RENAME TO db:get-dbh
;; ;; (let* ((subdb (dbfile:get-subdb dbstruct run-id)))
;; (if (stack? (dbr:subdb-dbstack subdb))
;; (if (stack-empty? (dbr:subdb-dbstack subdb))
;; (let* ((dbname (db:run-id->dbname run-id))
;; (newdb (db:open-megatest-db path: (db:dbfile-path)
;; name: dbname)))
;; ;; NOTE: pushing on the stack only happens AFTER the handle has been used
;; ;; (stack-push! (dbr:dbstruct-dbstack dbstruct) newdb)
;; newdb)
;; (stack-pop! (dbr:subdb-dbstack subdb)))
;; (db:open-db subdb run-id))) ;; )
|
|
|
<
<
|
<
<
<
|
|
<
|
>
>
>
|
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
|
;; if run-id is a string treat it as a filename
;; if db already open - return inmem
;; if db not open, open inmem, rundb and sync then return inmem
;; inuse gets set automatically for rundb's
;;
;; (define db:get-db db:get-subdb)
(define (db:get-db dbstruct run-id)
(let* ((subdb (dbfile:get-subdb dbstruct run-id))
(dbdat (dbfile:get-dbdat dbstruct run-id)))
(if (dbr:dbdat? dbdat)
dbdat
(dbfile:open-db *dbstruct-dbs* #f db:initialize-main-db)
)
)
)
(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)
|
5086
5087
5088
5089
5090
5091
5092
5093
5094
5095
5096
5097
5098
5099
5100
|
(if (and legacy-sync (not *time-to-exit*))
(begin
(debug:print-info 0 *default-log-port* "Server running, periodic copy-based sync started.")
(let loop ()
;; run the sync and print out durations
(debug:print-info 0 *default-log-port* "Sync durations: "(db:run-lock-and-sync no-sync-db))
;; keep going unless time to exit
;;
(if (not *time-to-exit*)
(let delay-loop ((count 0))
;;(debug:print-info 13 *default-log-port* "delay-loop top; count="count" pid="(current-process-id)" this-wd-num="this-wd-num" *time-to-exit*="*time-to-exit*)
(if (and (not *time-to-exit*)
|
>
>
|
|
5083
5084
5085
5086
5087
5088
5089
5090
5091
5092
5093
5094
5095
5096
5097
5098
5099
|
(if (and legacy-sync (not *time-to-exit*))
(begin
(debug:print-info 0 *default-log-port* "Server running, periodic copy-based sync started.")
(let loop ()
;; run the sync and print out durations
(let* ((changed (db:run-lock-and-sync no-sync-db)))
(if (not (null? changed))
(debug:print-info 0 *default-log-port* "Sync durations: "changed)))
;; keep going unless time to exit
;;
(if (not *time-to-exit*)
(let delay-loop ((count 0))
;;(debug:print-info 13 *default-log-port* "delay-loop top; count="count" pid="(current-process-id)" this-wd-num="this-wd-num" *time-to-exit*="*time-to-exit*)
(if (and (not *time-to-exit*)
|