35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
|
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
|
+
-
+
+
|
posix typed-records srfi-18 srfi-1
srfi-69
stack
files
ports
commonmod
;; debugprint
)
;; (import debugprint)
(define keep-age-param (make-parameter 10)) ;; qif file age, if over move to attic
(define num-run-dbs (make-parameter 10)) ;; number of db's in .megatest
;;======================================================================
;; R E C O R D S
;;======================================================================
;; a single Megatest area with it's multiple dbs is
;; managed in a dbstruct
|
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
|
192
193
194
195
196
197
198
199
200
201
202
203
204
205
|
-
-
|
;;
(define (dbfile:run-id->path apath run-id)
(conc apath"/"(dbfile:run-id->dbname run-id)))
(define (db:dbname->path apath dbname)
(conc apath"/"dbname))
(define num-run-dbs (make-parameter 4))
(define (dbfile:run-id->dbnum run-id)
(cond
((number? run-id)
(modulo run-id (num-run-dbs)))
((not run-id) "main") ;; 0 or main?
(else run-id)))
|
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
|
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
|
-
+
|
;; return a previously opened db handle to the stack of available handles
(define (dbfile:add-dbdat dbstruct run-id dbdat)
(let* ((subdb (dbfile:get-subdb dbstruct run-id))
(dbstk (dbr:subdb-dbstack subdb))
(count (stack-count dbstk)))
(if (> count 15)
(dbfile:print-err "WARNING: stack for "run-id".db is large."))
(dbfile:print-err "WARNING: stack for "run-id".db is "count"."))
(stack-push! dbstk dbdat)
dbdat))
;; set up a subdb
;;
(define (dbfile:init-subdb dbstruct run-id init-proc)
(let* ((dbname (dbfile:run-id->dbname run-id))
|
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
|
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
|
-
-
|
(let* ((dbdat (dbfile:open-db dbstruct run-id dbinit)))
(set! *db-write-access* (not (dbr:dbdat-read-only dbdat)))
;; (mutex-unlock! *db-open-mutex*)
dbdat))
(define dbfile:db-init-proc (make-parameter #f))
(define keep-age-param (make-parameter 10))
;; in xmaxima this gives a curve close to what I want:
;; plot2d ((exp(x/1.2)-1)/300, [x, 0, 10])$
;; plot2d ((exp(x/1.5)-1)/40, [x, 0, 10])$
;; plot2d ((exp(x/5)-1)/40, [x, 0, 20])$
(define (dbfile:droop x)
(/ (- (exp (/ x 5)) 1) 40))
;; (* numqrys (/ 1 (qif-slope))))
|