Raymond Toy pushed to branch issue-69-compile-in-gc-assert at cmucl / cmucl Commits: 62d02997 by Raymond Toy at 2018-09-04T05:05:32Z Add function to get and set GC check options Define GET-GC-ASSERTIONS to get the current GC assertions and SET-GC-ASSERTIONS to set them. These control the whether gc_assert is called; whether a a pre-scan of generation 0 is done before GC; whether we verify the heap after gc_free_heap is called from purify; and the verify pointers to old-space when GCing generations greater than or equal the given generation. Update C code to change boolean variables to int's to make it simple to to access from Lisp. (Don't have c-call:boolean.) - - - - - 2 changed files: - src/code/gc.lisp - src/lisp/gencgc.c Changes: ===================================== src/code/gc.lisp ===================================== @@ -72,14 +72,39 @@ (progn (alien:def-alien-routine get_bytes_allocated_lower c-call:int) (alien:def-alien-routine get_bytes_allocated_upper c-call:int) - ;; Controls GC assertions that are enabled in the runtime. A value - ;; of 0 disables all assertions (the normal default). - (alien:def-alien-variable gc_assert_level c-call:int) - (setf (documentation 'gc-assert-level 'variable) - "Current GC assertion level. Higher values enable more GC assertions") (defun dynamic-usage () (dfixnum:dfixnum-pair-integer - (get_bytes_allocated_upper) (get_bytes_allocated_lower)))) + (get_bytes_allocated_upper) (get_bytes_allocated_lower))) + + ;; Controls GC assertions that are enabled in the runtime. A value + ;; of 0 disables all assertions (the normal default). + (alien:def-alien-variable ("gc_assert_level" gc-assert-level) c-call:int) + (alien:def-alien-variable ("verify_after_free_heap" gc-verify-after-free-heap) c-call:int) + (alien:def-alien-variable ("pre_verify_gen_0" gc-verify-new-objects) c-call:int) + (alien:def-alien-variable ("verify_gens" gc-verify-generations) c-call:int) + (defun get-gc-assertions () + (list :assert-level gc-assert-level + :verify-after-free-heap (not (zerop gc-verify-after-free-heap)) + :verify-generations gc-verify-generations + :verify-new-objects (not (zerop gc-verify-new-objects)))) + (defun set-gc-assertions (&key (assert-level 0 assert-level-p) + (verify-after-free-heap nil verify-after-free-heap-p) + (verify-generations 6 verify-generations-p) + (verify-new-objects nil verify-new-objects-p)) + (declare (type (and fixnum unsigned-byte) assert-level) + (type boolean verify-after-free-heap) + (type (integer 0 6) verify-generation) + (type boolean verify-new-objects)) + (when assert-level-p + (setf gc-assert-level assert-level)) + (when verify-after-free-heap-p + (setf gc-verify-after-free-heap (if verify-after-free-heap 1 0))) + (when verify-generations-p + (setf gc-verify-generations verify-generations)) + (when verify-new-objects-p + (setf gc-verify-new-objects (if verify-new-objects 1 0))) + (values)) + ) #+cgc (c-var-frob dynamic-usage "bytes_allocated") ===================================== src/lisp/gencgc.c ===================================== @@ -260,15 +260,15 @@ int verify_gens = NUM_GENERATIONS; * makes GC very, very slow, so don't enable this unless you really * need it!) */ -boolean pre_verify_gen_0 = FALSE; +int pre_verify_gen_0 = FALSE; /* * Enable checking for bad pointers after gc_free_heap called from purify. */ #if 0 && defined(DARWIN) -boolean verify_after_free_heap = TRUE; +int verify_after_free_heap = TRUE; #else -boolean verify_after_free_heap = FALSE; +int verify_after_free_heap = FALSE; #endif /* @@ -8031,7 +8031,9 @@ collect_garbage(unsigned last_gen) /* Verify the new objects created by lisp code. */ if (pre_verify_gen_0) { - fprintf(stderr, "Pre-Checking generation 0\n"); + if (gencgc_verbose > 0) { + fprintf(stderr, "Pre-Checking generation 0\n"); + } verify_generation(0); } View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/62d029977c6e367cfbef2ec68b... -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/62d029977c6e367cfbef2ec68b... You're receiving this email because of your account on gitlab.common-lisp.net.