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
|
(db:initialize db))
(db:set-sync db)
db))
;; keeping it around for debugging purposes only
(define (open-run-close-no-exception-handling proc idb . params)
(debug:print-info 11 "open-run-close-no-exception-handling START given a db=" (if idb "yes " "no ") ", params=" params)
(let* ((db (if idb idb (open-db)))
(res #f))
(set! res (apply proc db params))
(if (not idb)(sqlite3:finalize! db))
(debug:print-info 11 "open-run-close-no-exception-handling END" )
res))
(define (open-run-close-exception-handling proc idb . params)
(debug:print-info 11 "open-run-close-exception-handling START, idb=" idb ", params=" params)
(let ((runner (lambda ()
(let* ((db (if idb idb (open-db)))
(res #f))
(set! res (apply proc db params))
(if (not idb)(sqlite3:finalize! db))
(debug:print-info 11 "open-run-close-no-exception-handling END" )
res))))
(handle-exceptions
exn
(begin
(debug:print 0 "EXCEPTION: database probably overloaded?")
(debug:print 0 " " ((condition-property-accessor 'exn 'message) exn))
(print-call-chain)
(thread-sleep! (random 120))
(debug:print-info 0 "trying db call one more time....")
(runner))
(runner))))
|
|
>
>
>
>
<
<
<
<
<
<
<
<
|
|
|
|
|
|
|
|
<
<
>
>
|
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
|
(db:initialize db))
(db:set-sync db)
db))
;; keeping it around for debugging purposes only
(define (open-run-close-no-exception-handling proc idb . params)
(debug:print-info 11 "open-run-close-no-exception-handling START given a db=" (if idb "yes " "no ") ", params=" params)
(let* ((db (if idb
(if (procedure? idb)
(idb)
idb)
(open-db)))
(res #f))
(set! res (apply proc db params))
(if (not idb)(sqlite3:finalize! db))
(debug:print-info 11 "open-run-close-no-exception-handling END" )
res))
(define (open-run-close-exception-handling proc idb . params)
(handle-exceptions
exn
(begin
(debug:print 0 "EXCEPTION: database probably overloaded?")
(debug:print 0 " " ((condition-property-accessor 'exn 'message) exn))
(print-call-chain)
(thread-sleep! (random 120))
(debug:print-info 0 "trying db call one more time....")
(apply open-run-close-no-exception-handling proc idb params))
(apply open-run-close-no-exception-handling proc idb params)))
(define open-run-close open-run-close-exception-handling)
(define *global-delta* 0)
(define *last-global-delta-printed* 0)
(define (open-run-close-measure proc idb . params)
|