+ ;; Pathname of the source file that the definition was compiled from.
+ ;; This is null if the definition was not compiled from a file.
+ (pathname nil :type (or null pathname))
+ ;; Source-path of the definition within the file.
+ ;; This may be incomplete depending on the debug level at which the
+ ;; source was compiled.
+ (form-path '() :type list)
+ ;; Character offset of the top-level-form containing the definition.
+ ;; This corresponds to the first element of form-path.
+ (character-offset nil :type (or null integer))
+ ;; File-write-date of the source file when compiled.
+ ;; Null if not compiled from a file.
+ (file-write-date nil :type (or null integer))
+ ;; plist from WITH-COMPILATION-UNIT
+ (plist nil))
+
+(defun find-definition-source (object)
+ (etypecase object
+ (method
+ (find-definition-source (or (sb-pcl::method-fast-function object)
+ (sb-pcl:method-function object))))
+ (function
+ (cond ((struct-accessor-p object)
+ (find-definition-source (struct-accessor-structure-class object)))
+ ((struct-predicate-p object)
+ (find-definition-source (struct-predicate-structure-class object)))
+ (t (find-function-definition-source object))))
+ (structure-class
+ (let ((constructor
+ (sb-kernel::structure-classoid-constructor
+ (sb-kernel:classoid-cell-classoid
+ (sb-int:info :type :classoid (class-name object))))))
+ (find-definition-source constructor)))
+ (t
+ (if (valid-function-name-p object)
+ (find-definition-source (or (macro-function object)
+ (fdefinition object)))))))
+
+(defun find-function-definition-source (function)
+ (let* ((debug-info (function-debug-info function))
+ (debug-source (debug-info-source debug-info))
+ (debug-fun (debug-info-debug-function debug-info))
+ (tlf (if debug-fun (sb-c::compiled-debug-fun-tlf-number debug-fun))))
+ (make-definition-source
+ :pathname
+ (if (eql (sb-c::debug-source-from debug-source) :file)
+ (parse-namestring (sb-c::debug-source-name debug-source)))
+ :character-offset
+ (if tlf
+ (elt (sb-c::debug-source-start-positions debug-source) tlf))
+ ;; Unfortunately there is no proper source path available in the
+ ;; debug-source. FIXME: We could use sb-di:code-locations to get
+ ;; a full source path. -luke (12/Mar/2005)
+ :form-path (if tlf (list tlf))
+ :file-write-date (sb-c::debug-source-created debug-source)
+ :plist (sb-c::debug-source-plist debug-source))))