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 (defvar *source-location-thunks* nil)
  16
  17 ;; Should get called only in unusual circumstances. Normally handled
  18 ;; by a compiler macro.
  19 (defun source-location ()
  20   nil)
  21
  22 ;; Will be redefined in src/code/source-location.lisp
  23 #-sb-xc-host
  24 (define-compiler-macro source-location ()
  25   (when (and (boundp '*source-info*)
  26              (symbol-value '*source-info*))
  27     `(cons ,(make-file-info-namestring
  28               *compile-file-pathname*
  29               (source-info-file-info (symbol-value '*source-info*)))
  30            ,(when (boundp '*current-path*)
  31                   (source-path-tlf-number (symbol-value '*current-path*))))))
  32
  33 ;; If the whole source location tracking machinery has been loaded
  34 ;; (detected by the type of SOURCE-LOCATION), execute BODY. Otherwise
  35 ;; wrap it in a lambda and execute later.
  36 (defmacro with-source-location ((source-location) &body body)
  37   `(when ,source-location
  38      (if (consp ,source-location)
  39          (push (lambda ()
  40                  (let ((,source-location
  41                         (make-definition-source-location
  42                          :namestring (car ,source-location)
  43                          :toplevel-form-number (cdr ,source-location))))
  44                    ,@body))
  45                *source-location-thunks*)
  46          ,@body)))