X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fmain.lisp;h=516da032ee47bcc5854f152c7969801614fdab3f;hb=411c3cae7ab69dc023912d87d891e75d9aa083b4;hp=d77ff04ba15ba370333acc9d7c7c47940f3c52dd;hpb=414b35ffb1a699cc6469f80d029b9c4a887373b2;p=sbcl.git

diff --git a/src/compiler/main.lisp b/src/compiler/main.lisp
index d77ff04..516da03 100644
--- a/src/compiler/main.lisp
+++ b/src/compiler/main.lisp
@@ -116,6 +116,18 @@
 (declaim (type object *compile-object*))
 
 (defvar *fopcompile-label-counter*)
+
+;; Used during compilation to map code paths to the matching
+;; instrumentation conses.
+(defvar *code-coverage-records* nil)
+;; Used during compilation to keep track of with source paths have been
+;; instrumented in which blocks.
+(defvar *code-coverage-blocks* nil)
+;; Stores the code coverage instrumentation results. Keys are namestrings,
+;; the value is a list of (CONS PATH STATE), where STATE is NIL for
+;; a path that has not been visited, and T for one that has.
+(defvar *code-coverage-info* (make-hash-table :test 'equal))
+
 
 ;;;; WITH-COMPILATION-UNIT and WITH-COMPILATION-VALUES
 
@@ -1315,7 +1327,7 @@
 (defun compile-load-time-stuff (form for-value)
   (with-ir1-namespace
    (let* ((*lexenv* (make-null-lexenv))
-          (lambda (ir1-toplevel form *current-path* for-value)))
+          (lambda (ir1-toplevel form *current-path* for-value nil)))
      (compile-toplevel (list lambda) t)
      lambda)))
 
@@ -1478,6 +1490,8 @@
         (sb!xc:*compile-file-pathname* nil) ; really bound in
         (sb!xc:*compile-file-truename* nil) ; SUB-SUB-COMPILE-FILE
         (*policy* *policy*)
+        (*code-coverage-records* (make-hash-table :test 'equal))
+        (*code-coverage-blocks* (make-hash-table :test 'equal))
         (*handled-conditions* *handled-conditions*)
         (*disabled-package-locks* *disabled-package-locks*)
         (*lexenv* (make-null-lexenv))
@@ -1513,6 +1527,19 @@
 
                 (sub-sub-compile-file info)
 
+                (unless (zerop (hash-table-count *code-coverage-records*))
+                  ;; Dump the code coverage records into the fasl.
+                  (fopcompile `(record-code-coverage
+                                ',(namestring *compile-file-pathname*)
+                                ',(let (list)
+                                       (maphash (lambda (k v)
+                                                  (declare (ignore k))
+                                                  (push v list))
+                                                *code-coverage-records*)
+                                       list))
+                              nil
+                              nil))
+
                 (finish-block-compilation)
                 (let ((object *compile-object*))
                   (etypecase object