sb-cover: Stop dumping +code-coverage-unmarked+.

There's no need to dump conses of the form (path
. +code-coverage-unmarked+) into the fasl file itself. Just dump the
paths and create the fresh conses in the loader. This avoids problems
with list coalescing so that we can just use NIL as the unmarked
marker now, allowing us to remove a lot of pointless abstractions. It
also shrinks the fasl size.

We can also now move a bunch of sb-cover stuff out of the compiler and
the compiler package into the contrib proper.

Author: karlosz

contrib/sb-cover/cover.lisp

@@ -18,7 +18,14 @@
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (setf (sb-int:system-package-p *package*) t))
 
-(defmacro code-coverage-hashtable () `(car sb-c:*code-coverage-info*))
+(defmacro code-coverage-hashtable () `(car sb-int:*code-coverage-info*))
+
+(defun reset-code-coverage ()
+  (maphash (lambda (info cc)
+             (declare (ignore info))
+             (dolist (cc-entry cc)
+               (setf (cdr cc-entry) nil)))
+           (car sb-int:*code-coverage-info*)))
 
 ;;;; New coverage representation.
 ;;;; One byte per coverage mark is stored in the unboxed constants of the code.
@@ -77,13 +84,14 @@
 into the database when the FASL files (produced by compiling
 STORE-COVERAGE-DATA optimization policy set to 3) are loaded again into the
 image."
-  (sb-c:clear-code-coverage))
+  (clrhash (car sb-int:*code-coverage-info*))
+  (setf (cdr sb-int:*code-coverage-info*) nil))
 
 (macrolet
     ((do-instrumented-code ((var &optional result) &body body)
        ;; Scan list of weak-pointers to all coverage-instrumented code,
        ;; binding VAR to each object, and removing broken weak-pointers.
-       `(let ((predecessor sb-c:*code-coverage-info*))
+       `(let ((predecessor sb-int:*code-coverage-info*))
           (loop
            (let ((cell (cdr predecessor)))
              (unless cell (return ,result))
@@ -141,7 +149,7 @@ image."
         (t                              ; reset everything
          (do-instrumented-code (code)
            (reset-coverage code))
-         (sb-c:reset-code-coverage))))
+         (reset-code-coverage))))
 
 ;;; Transfer data from new-style coverage marks into old-style.
 ;;; Update only data for FILENAME if supplied, or all files if NIL.
@@ -151,7 +159,7 @@ image."
   (declare (ignorable filename))
   ;; NAMESTRING->PATH-TABLES maps a namestring to a hashtable which maps
   ;; source paths to the legacy coverage record for that path in that file,
-  ;;   e.g. (1 4 1) -> ((1 4 1) . SB-C::%CODE-COVERAGE-UNMARKED%)
+  ;;   e.g. (1 4 1) -> ((1 4 1) . NIL)
   (let ((namestring->path-tables (make-hash-table :test 'equal))
         (coverage-records (code-coverage-hashtable))
         (n-marks 0))
@@ -594,7 +602,7 @@ table.summary tr.subheading td { text-align: left; font-weight: bold; padding-le
            unless (member (caar record) '(:then :else))
            collect (list mode
                          (car record)
-                         (if (sb-c:code-coverage-record-marked record)
+                         (if (cdr record)
                              1
                              2))))
     (:branch
@@ -604,7 +612,7 @@ table.summary tr.subheading td { text-align: left; font-weight: bold; padding-le
            (when (member (car path) '(:then :else))
              (setf (gethash (cdr path) hash)
                    (logior (gethash (cdr path) hash 0)
-                           (ash (if (sb-c:code-coverage-record-marked record)
+                           (ash (if (cdr record)
                                     1
                                     2)
                                 (if (eql (car path) :then)

src/code/early-impl.lisp

@@ -59,6 +59,15 @@
 (declaim (type cons sb-kernel::*gc-epoch*))
 (define-load-time-global sb-kernel::*gc-epoch* '(nil . nil))
 
+;;; Stores the code coverage instrumentation results. The CAR is a
+;;; hashtable. The CDR is a list of weak pointers to code objects
+;;; having coverage marks embedded in the unboxed constants. Keys in
+;;; the hashtable are namestrings, the value is a list of (CONS PATH
+;;; VISITED).
+(define-load-time-global *code-coverage-info*
+    (list (make-hash-table :test 'equal :synchronized t)))
+(declaim (type (cons hash-table) *code-coverage-info*))
+
 ;;; Default evaluator mode (interpreter / compiler)
 
 (declaim (type (member :compile #+(or sb-eval sb-fasteval) :interpret)

src/code/load.lisp

@@ -1230,7 +1230,7 @@
         (when (typep (code-header-ref code (1- n-boxed-words))
                      '(cons (eql sb-c::coverage-map)))
           ;; Record this in the global list of coverage-instrumented code.
-          (atomic-push (make-weak-pointer code) (cdr sb-c:*code-coverage-info*)))
+          (atomic-push (make-weak-pointer code) (cdr *code-coverage-info*)))
         (possibly-log-new-code code "load")))))
 
 ;; this gets you an #<fdefn> object, not the result of (FDEFINITION x)
@@ -1310,8 +1310,9 @@
 
 ;;;; fops for code coverage
 
-(define-fop 120 :not-host (fop-record-code-coverage (namestring cc) nil)
-  (setf (gethash namestring (car sb-c:*code-coverage-info*)) cc)
+(define-fop 120 :not-host (fop-record-code-coverage (namestring paths) nil)
+  (setf (gethash namestring (car *code-coverage-info*))
+        (mapcar #'list paths))
   (values))
 
 ;;; Primordial layouts.

src/code/save.lisp

@@ -338,8 +338,8 @@ sufficiently motivated to do lengthy fixes."
     ;; recreate it so that we don't preserve an empty vector taking up 16KB
     (setq sb-kernel::*forward-referenced-layouts* (make-hash-table :test 'equal)))
   ;; Clean up the simulated weak list of covered code components.
-  (rplacd sb-c:*code-coverage-info*
-          (delete-if-not #'weak-pointer-value (cdr sb-c:*code-coverage-info*)))
+  (rplacd *code-coverage-info*
+          (delete-if-not #'weak-pointer-value (cdr *code-coverage-info*)))
   (sb-kernel::rebuild-ctype-hashsets)
   (drop-all-hash-caches)
   (os-deinit)

src/cold/exports.lisp

@@ -960,6 +960,10 @@ possibly temporarily, because it might be used internally.")
    "*REPL-PROMPT-FUN*"
    "*REPL-READ-FORM-FUN*"
 
+   ;; for SB-COVER
+
+   "*CODE-COVERAGE-INFO*"
+
    ;; Character database access
 
    "MISC-INDEX"
@@ -2770,11 +2774,6 @@ be submitted as a CDR")
 
            "BRANCH-IF" "MULTIWAY-BRANCH-IF-EQ"
            "JUMP-TABLE" "CASE-TO-JUMP-TABLE"
-           ;; for SB-COVER
-
-           "*CODE-COVERAGE-INFO*" "CODE-COVERAGE-RECORD-MARKED"
-           "CLEAR-CODE-COVERAGE" "RESET-CODE-COVERAGE"
-           "+CODE-COVERAGE-UNMARKED+"
            ;; for SB-INTROSPECT
 
            "MAP-PACKED-XREF-DATA" "MAP-SIMPLE-FUNS"))

src/compiler/early-c.lisp

@@ -185,27 +185,6 @@
 ;;; 2 implies an even length boxed header; 1 implies no restriction.
 (defconstant code-boxed-words-align (+ 2 #+(or x86 x86-64) -1))
 
-;;; Used as the CDR of the code coverage instrumentation records
-;;; (instead of NIL) to ensure that any well-behaving user code will
-;;; not have constants EQUAL to that record. This avoids problems with
-;;; the records getting coalesced with non-record conses, which then
-;;; get mutated when the instrumentation runs. Note that it's
-;;; important for multiple records for the same location to be
-;;; coalesced. -- JES, 2008-01-02
-(defconstant +code-coverage-unmarked+ '%code-coverage-unmarked%)
-
-;;; Stores the code coverage instrumentation results.
-;;; The CAR is a hashtable. The CDR is a list of weak pointers to code objects
-;;; having coverage marks embedded in the unboxed constants.
-;;; Keys in the hashtable are namestrings, the
-;;; value is a list of (CONS PATH STATE), where STATE is +CODE-COVERAGE-UNMARKED+
-;;; for a path that has not been visited, and T for one that has.
-#-sb-xc-host
-(progn
-  (define-load-time-global *code-coverage-info*
-    (list (make-hash-table :test 'equal :synchronized t)))
-  (declaim (type (cons hash-table) *code-coverage-info*)))
-
 ;;; Unique number assigned into high 4 bytes of 64-bit code size slot
 ;;; so that we can sort the contents of text space in a more-or-less
 ;;; predictable manner based on the order in which code was loaded.

src/compiler/main.lisp

@@ -1685,7 +1685,7 @@ necessary, since type inference may take arbitrarily long to converge.")
                     (dump-code-coverage-records
                      (namestring *compile-file-pathname*)
                      (loop for k being each hash-key of code-coverage-records
-                           collect (cons k +code-coverage-unmarked+))
+                           collect k)
                      *compile-object*)))
                 nil)))
       ;; Some errors are sufficiently bewildering that we just fail

src/compiler/target-main.lisp

@@ -426,22 +426,3 @@ not STYLE-WARNINGs occur during compilation, and NIL otherwise.
                      #'< :key 'caar))))
         (recurse path-to-find (cdaar list) (cdr list))))
     start-char))
-
-;;;; Coverage helpers
-
-(defun clear-code-coverage ()
-  (clrhash (car *code-coverage-info*))
-  (setf (cdr *code-coverage-info*) nil))
-
-(defun reset-code-coverage ()
-  (maphash (lambda (info cc)
-             (declare (ignore info))
-             (dolist (cc-entry cc)
-               (setf (cdr cc-entry) +code-coverage-unmarked+)))
-           (car *code-coverage-info*)))
-
-(defun code-coverage-record-marked (record)
-  (aver (consp record))
-  (ecase (cdr record)
-    ((#.+code-coverage-unmarked+) nil)
-    ((t) t)))