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
|
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 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:)
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
(prefix mtargs args:)
;; system-information
)
(setenv #;set-environment-variable! "MT_DEBUG_MODE" (if (list? (verbosity))
(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
|
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: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") " ")
|