[Git][cmucl/cmucl][issue-69-compile-in-gc-assert] Add function to get and set GC check options

[Raymond Toy]

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/62d029977c6e367cfbef2ec68bbec3e6b5dc7a6b

-- 
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/62d029977c6e367cfbef2ec68bbec3e6b5dc7a6b
You're receiving this email because of your account on gitlab.common-lisp.net.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <https://mailman.common-lisp.net/pipermail/cmucl-cvs/attachments/20180904/d4ed1ebf/attachment-0001.html>