| ... |
... |
@@ -72,14 +72,39 @@ |
|
72
|
72
|
(progn
|
|
73
|
73
|
(alien:def-alien-routine get_bytes_allocated_lower c-call:int)
|
|
74
|
74
|
(alien:def-alien-routine get_bytes_allocated_upper c-call:int)
|
|
75
|
|
- ;; Controls GC assertions that are enabled in the runtime. A value
|
|
76
|
|
- ;; of 0 disables all assertions (the normal default).
|
|
77
|
|
- (alien:def-alien-variable gc_assert_level c-call:int)
|
|
78
|
|
- (setf (documentation 'gc-assert-level 'variable)
|
|
79
|
|
- "Current GC assertion level. Higher values enable more GC assertions")
|
|
80
|
75
|
(defun dynamic-usage ()
|
|
81
|
76
|
(dfixnum:dfixnum-pair-integer
|
|
82
|
|
- (get_bytes_allocated_upper) (get_bytes_allocated_lower))))
|
|
|
77
|
+ (get_bytes_allocated_upper) (get_bytes_allocated_lower)))
|
|
|
78
|
+
|
|
|
79
|
+ ;; Controls GC assertions that are enabled in the runtime. A value
|
|
|
80
|
+ ;; of 0 disables all assertions (the normal default).
|
|
|
81
|
+ (alien:def-alien-variable ("gc_assert_level" gc-assert-level) c-call:int)
|
|
|
82
|
+ (alien:def-alien-variable ("verify_after_free_heap" gc-verify-after-free-heap) c-call:int)
|
|
|
83
|
+ (alien:def-alien-variable ("pre_verify_gen_0" gc-verify-new-objects) c-call:int)
|
|
|
84
|
+ (alien:def-alien-variable ("verify_gens" gc-verify-generations) c-call:int)
|
|
|
85
|
+ (defun get-gc-assertions ()
|
|
|
86
|
+ (list :assert-level gc-assert-level
|
|
|
87
|
+ :verify-after-free-heap (not (zerop gc-verify-after-free-heap))
|
|
|
88
|
+ :verify-generations gc-verify-generations
|
|
|
89
|
+ :verify-new-objects (not (zerop gc-verify-new-objects))))
|
|
|
90
|
+ (defun set-gc-assertions (&key (assert-level 0 assert-level-p)
|
|
|
91
|
+ (verify-after-free-heap nil verify-after-free-heap-p)
|
|
|
92
|
+ (verify-generations 6 verify-generations-p)
|
|
|
93
|
+ (verify-new-objects nil verify-new-objects-p))
|
|
|
94
|
+ (declare (type (and fixnum unsigned-byte) assert-level)
|
|
|
95
|
+ (type boolean verify-after-free-heap)
|
|
|
96
|
+ (type (integer 0 6) verify-generation)
|
|
|
97
|
+ (type boolean verify-new-objects))
|
|
|
98
|
+ (when assert-level-p
|
|
|
99
|
+ (setf gc-assert-level assert-level))
|
|
|
100
|
+ (when verify-after-free-heap-p
|
|
|
101
|
+ (setf gc-verify-after-free-heap (if verify-after-free-heap 1 0)))
|
|
|
102
|
+ (when verify-generations-p
|
|
|
103
|
+ (setf gc-verify-generations verify-generations))
|
|
|
104
|
+ (when verify-new-objects-p
|
|
|
105
|
+ (setf gc-verify-new-objects (if verify-new-objects 1 0)))
|
|
|
106
|
+ (values))
|
|
|
107
|
+ )
|
|
83
|
108
|
|
|
84
|
109
|
#+cgc
|
|
85
|
110
|
(c-var-frob dynamic-usage "bytes_allocated")
|