src/code/early-source-location.lisp

   1 ;;;; Minimal implementation of the source-location tracking machinery, which
   2 ;;;; defers the real work to until source-location.lisp
   3
   4 ;;;; This software is part of the SBCL system. See the README file for
   5 ;;;; more information.
   6 ;;;;
   7 ;;;; This software is derived from the CMU CL system, which was
   8 ;;;; written at Carnegie Mellon University and released into the
   9 ;;;; public domain. The software is in the public domain and is
  10 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
  11 ;;;; files for more information.
  12
  13 (in-package "SB!C")
  14
  15 ;;; Used as the CDR of the code coverage instrumentation records
  16 ;;; (instead of NIL) to ensure that any well-behaving user code will
  17 ;;; not have constants EQUAL to that record. This avoids problems with
  18 ;;; the records getting coalesced with non-record conses, which then
  19 ;;; get mutated when the instrumentation runs. Note that it's
  20 ;;; important for multiple records for the same location to be
  21 ;;; coalesced. -- JES, 2008-01-02
  22 (defconstant +code-coverage-unmarked+ '%code-coverage-unmarked%)
  23
  24 (defvar *source-location-thunks* nil)
  25
  26 ;; Will be redefined in src/code/source-location.lisp.
  27 (defun source-location ()
  28   nil)
  29
  30 ;; Will be redefined in src/code/source-location.lisp
  31 #-sb-xc-host
  32 (define-compiler-macro source-location ()
  33   (when (and (boundp '*source-info*)
  34              (symbol-value '*source-info*))
  35     `(cons ,(make-file-info-namestring
  36               *compile-file-pathname*
  37               (sb!c:get-toplevelish-file-info (symbol-value '*source-info*)))
  38            ,(when (boundp '*current-path*)
  39                   (source-path-tlf-number (symbol-value '*current-path*))))))
  40
  41 ;; If the whole source location tracking machinery has been loaded
  42 ;; (detected by the type of SOURCE-LOCATION), execute BODY. Otherwise
  43 ;; wrap it in a lambda and execute later.
  44 (defmacro with-source-location ((source-location) &body body)
  45   `(when ,source-location
  46      (if (consp ,source-location)
  47          (push (lambda ()
  48                  (let ((,source-location
  49                         (make-definition-source-location
  50                          :namestring (car ,source-location)
  51                          :toplevel-form-number (cdr ,source-location))))
  52                    ,@body))
  53                *source-location-thunks*)
  54          ,@body)))