Megatest

Check-in [a7af13fe19]
Login
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: a7af13fe190cdd23e35b9234c7ac7a7a6bf43b10
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

704

705

706


707


708
709
710
711
712
713
714
			(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.")

  (let ((dbstruct (db:setup)))

    (if (dbr:dbstruct-read-only dbstruct)

        (common:readonly-watchdog dbstruct)


        (common:writable-watchdog dbstruct))))




(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







>

>
|
>
|
>
|
>
>
|
>
>







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

118

119
120
121
122
123
124
125
126
127
128
129
    (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"))

    (thread-start! (make-thread common:watchdog "Watchdog thread"))

    (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







>
|
>
|
|
|
|







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
279
280
281
282
283
284
285

286
287
288
289
290
291
292
293
294
295

;; 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)))

          (if (and dbexists (not write-access))
              (begin (set! *db-write-access* #f)
                     (dbr:dbstruct-readonly-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)







|






>


|







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)
;;