Overview
Comment: | wip; readonly watchdog not properly starting. |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v1.63-readonly |
Files: | files | file ages | folders |
SHA1: |
a7af13fe190cdd23e35b9234c7ac7a7a |
User & Date: | bjbarcla on 2017-02-21 17:54:33 |
Other Links: | branch diff | manifest | tags |
Context
2017-02-21
| ||
21:06 | wip; readonly watchdog not properly starting. check-in: 1ae7e02473 user: bjbarcla tags: v1.63-readonly | |
17:54 | wip; readonly watchdog not properly starting. check-in: a7af13fe19 user: bjbarcla tags: v1.63-readonly | |
17:10 | fixed bug with loading area from Matt check-in: 8caaed5094 user: bjbarcla tags: v1.63-readonly | |
Changes
Modified common.scm from [3cdabe2c3a] to [dd5b90ba4c].
︙ | ︙ | |||
696 697 698 699 700 701 702 703 | (delay-loop (+ count 1)))) (if (not *time-to-exit*) (loop)))) (if (common:low-noise-print 30) (debug:print-info 0 *default-log-port* "Exiting watchdog timer, *time-to-exit* = " *time-to-exit*" pid="(current-process-id)" this-wd-num="this-wd-num))))))) ;; TODO: for multiple areas, we will have multiple watchdogs; and multiple threads to manage (define (common:watchdog) (BB> "common:watchdog entered.") | > > | > | > | > > | > > | 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 | (delay-loop (+ count 1)))) (if (not *time-to-exit*) (loop)))) (if (common:low-noise-print 30) (debug:print-info 0 *default-log-port* "Exiting watchdog timer, *time-to-exit* = " *time-to-exit*" pid="(current-process-id)" this-wd-num="this-wd-num))))))) ;; TODO: for multiple areas, we will have multiple watchdogs; and multiple threads to manage (define (common:watchdog) ;;#t) (BB> "common:watchdog entered.") (let ((dbstruct (db:setup))) (cond ((dbr:dbstruct-read-only dbstruct) (BB> "loading read-only watchdog") common:readonly-watchdog dbstruct) (else (BB> "loading writable-watchdog.") (common:writable-watchdog dbstruct)))) (BB> "watchdog done.");;) ) (define (std-exit-procedure) (on-exit (lambda () 0)) ;;(BB> "std-exit-procedure called; *time-to-exit*="*time-to-exit*) (let ((no-hurry (if *time-to-exit* ;; hurry up #f |
︙ | ︙ |
Modified dashboard.scm from [b9f4401444] to [6b53dd8ee7].
︙ | ︙ | |||
111 112 113 114 115 116 117 | (begin (print "Failed to find megatest.config, exiting") (exit 1))) ;; create a watch dog to move changes from lt/.db/*.db to megatest.db ;; ;;;(if (file-write-access? (conc *toppath* "/megatest.db")) | > | > | | | | | 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 | (begin (print "Failed to find megatest.config, exiting") (exit 1))) ;; create a watch dog to move changes from lt/.db/*.db to megatest.db ;; ;;;(if (file-write-access? (conc *toppath* "/megatest.db")) ;;(BB> "Before common:watchdog spawn") (thread-start! (make-thread common:watchdog "Watchdog thread")) ;;(BB> "After common:watchdog spawn") (if (not (args:get-arg "-use-db-cache")) (begin (debug:print-info 0 *default-log-port* "Forcing db-cache mode due to read-only access to megatest.db") (hash-table-set! args:arg-hash "-use-db-cache" #t)));;;) ;; data common to all tabs goes here ;; (defstruct dboard:commondat ((curr-tab-num 0) : number) please-update tabdats |
︙ | ︙ |
Modified db.scm from [a536774740] to [47db56d212].
︙ | ︙ | |||
272 273 274 275 276 277 278 | ;; This routine creates the db if not already present. It is only called if the db is not already opened ;; (define (db:open-db dbstruct #!key (areapath #f)) ;; TODO: actually use areapath (let ((tmpdb-stack (dbr:dbstruct-dbstack dbstruct))) ;; RA => Returns the first reference in dbstruct (if (stack? tmpdb-stack) (db:get-db tmpdb-stack) ;; get previously opened db (will create new db handle if all in the stack are already used | | > | | 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 | ;; This routine creates the db if not already present. It is only called if the db is not already opened ;; (define (db:open-db dbstruct #!key (areapath #f)) ;; TODO: actually use areapath (let ((tmpdb-stack (dbr:dbstruct-dbstack dbstruct))) ;; RA => Returns the first reference in dbstruct (if (stack? tmpdb-stack) (db:get-db tmpdb-stack) ;; get previously opened db (will create new db handle if all in the stack are already used (let* ((dbpath (db:dbfile-path )) ;; 0)) (dbexists (file-exists? dbpath)) (dbfexists (file-exists? (conc dbpath "/megatest.db"))) (tmpdb (db:open-megatest-db path: dbpath)) ;; lock-create-open dbpath db:initialize-main-db)) (mtdb (db:open-megatest-db)) (refndb (db:open-megatest-db path: dbpath name: "megatest_ref.db")) (write-access (file-write-access? dbpath))) (BB> "db:open-db>> dbpath="dbpath" dbexists="dbexists" and write-access="write-access) (if (and dbexists (not write-access)) (begin (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 (not dbfexists) |
︙ | ︙ | |||
310 311 312 313 314 315 316 317 318 319 320 321 322 323 | (cond (*dbstruct-db* *dbstruct-db*);; TODO: when multiple areas are supported, this optimization will be a hazard (else ;;(common:on-homehost?) (let* ((dbstruct (make-dbr:dbstruct))) (when (not *toppath*) (launch:setup areapath: areapath)) (db:open-db dbstruct areapath: areapath) (set! *dbstruct-db* dbstruct) dbstruct)))) ;; (else ;; (debug:print 0 *default-log-port* "ERROR: attempt to open database when not on homehost. Exiting. Homehost: " (common:get-homehost)) ;; (exit 1)))) ;; Open the classic megatest.db file (defaults to open in toppath) ;; | > | 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 | (cond (*dbstruct-db* *dbstruct-db*);; TODO: when multiple areas are supported, this optimization will be a hazard (else ;;(common:on-homehost?) (let* ((dbstruct (make-dbr:dbstruct))) (when (not *toppath*) (launch:setup areapath: areapath)) (db:open-db dbstruct areapath: areapath) (set! *dbstruct-db* dbstruct) (BB> "new dbstruct = "(dbr:dbstruct->alist dbstruct)) dbstruct)))) ;; (else ;; (debug:print 0 *default-log-port* "ERROR: attempt to open database when not on homehost. Exiting. Homehost: " (common:get-homehost)) ;; (exit 1)))) ;; Open the classic megatest.db file (defaults to open in toppath) ;; |
︙ | ︙ |