1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
|
(declare (unit debugprint))
(declare (uses mtargs))
(module debugprint
*
;;(import scheme chicken data-structures extras files ports)
;; scheme
;; chicken.base
;; chicken.string
;; chicken.time
;; chicken.time.posix
;; chicken.port
;; chicken.process-context
;; chicken.process-context.posix
(prefix mtargs args:)
;; system-information
)
;;======================================================================
;; debug stuff
;;======================================================================
(define verbosity (make-parameter '()))
(define *default-log-port* (current-error-port))
(define debug:print-logger (make-parameter #f)) ;; set to a proc to call on every logging print
(setenv #;set-environment-variable! "MT_DEBUG_MODE" (if (list? (verbosity))
(string-intersperse (map conc (verbosity)) ",")
(conc (verbosity)))))))
;; check verbosity, #t is ok
(define (debug:check-verbosity verbosity vstr)
(if (not (or (number? verbosity)
(list? verbosity)))
|
|
>
>
|
>
>
>
>
>
|
|
|
|
|
|
|
|
|
<
>
|
>
|
|
|
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
|
(declare (unit debugprint))
(declare (uses mtargs))
(module debugprint
*
(import scheme)
(cond-expand
(chicken-4
(import
scheme
chicken
data-structures
posix
ports
extras
(prefix mtargs args:)
srfi-1
;; system-information
))
(chicken-5
(import
scheme
chicken.base
chicken.string
chicken.time
chicken.time.posix
chicken.port
chicken.process-context
chicken.process-context.posix
srfi-1
(prefix mtargs args:))
(define setenv set-environment-variable!)
))
;;======================================================================
;; debug stuff
;;======================================================================
(define verbosity (make-parameter '()))
(define *default-log-port* (current-error-port))
(define debug:print-logger (make-parameter #f)) ;; set to a proc to call on every logging print
(define (debug:setup)
(let ((debugstr (or (args:get-arg "-debug")
(args:get-arg "-debug-noprop")
(get-environment-variable "MT_DEBUG_MODE"))))
(verbosity (debug:calc-verbosity debugstr 'q))
(debug:check-verbosity (verbosity) debugstr)
;; if we were handed a bad verbosity rule then we will override it with 1 and continue
(if (not (verbosity))(verbosity 1))
(if (and (not (args:get-arg "-debug-noprop"))
(or (args:get-arg "-debug")
(not (get-environment-variable "MT_DEBUG_MODE"))))
(setenv "MT_DEBUG_MODE" (if (list? (verbosity))
(string-intersperse (map conc (verbosity)) ",")
(conc (verbosity)))))))
;; check verbosity, #t is ok
(define (debug:check-verbosity verbosity vstr)
(if (not (or (number? verbosity)
(list? verbosity)))
|
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
|
(list? n))
(not (null? (lset-intersection! eq? vb n))))
((and (number? vb)
(list? n))
(member vb n))
(else #f))))
(define (debug:handle-remote-logging params)
(if (debug:print-logger) ;; NOTE: turn params into string to keep things simple for now
((debug:print-logger)(conc "REMOTE ("(get-host-name)", pid="(current-process-id)") "
(string-intersperse (map conc params) " ") "; "
(string-intersperse (command-line-arguments) " ")))))
(define debug:enable-timestamp (make-parameter #t))
(define (debug:timestamp)
(if (debug:enable-timestamp)
(conc (time->string
(seconds->local-time (current-seconds)) "%H:%M:%S") " ")
|
|
|
|
|
|
|
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
|
(list? n))
(not (null? (lset-intersection! eq? vb n))))
((and (number? vb)
(list? n))
(member vb n))
(else #f))))
;; (define (debug:handle-remote-logging params)
;; (if (debug:print-logger) ;; NOTE: turn params into string to keep things simple for now
;; ((debug:print-logger)(conc "REMOTE ("(get-host-name)", pid="(current-process-id)") "
;; (string-intersperse (map conc params) " ") "; "
;; (string-intersperse (command-line-arguments) " ")))))
(define debug:enable-timestamp (make-parameter #t))
(define (debug:timestamp)
(if (debug:enable-timestamp)
(conc (time->string
(seconds->local-time (current-seconds)) "%H:%M:%S") " ")
|