(when (eq (block-info block) 2block)
(unless (eql (source-path-tlf-number
(node-source-path
- (continuation-next
- (block-start block))))
+ (block-start-node block)))
res)
(setq res nil)))
-
+
(dolist (loc (ir2-block-locations 2block))
(unless (eql (source-path-tlf-number
(node-source-path
(write-var-integer (length locations) *byte-buffer*)
(let ((2block (block-info block)))
(write-var-integer (+ (length locations) 1) *byte-buffer*)
- (dump-1-location (continuation-next (block-start block))
+ (dump-1-location (block-start-node block)
2block :block-start tlf-num
(ir2-block-%label 2block)
(ir2-block-live-out 2block)
(let* ((untruename (file-info-untruename file-info))
(dir (pathname-directory untruename)))
(setf (debug-source-name res)
+ #+sb-xc-host
+ (let ((src (position "src" dir :test #'string= :from-end t)))
+ (if src
+ (format nil "SYS:~{~:@(~A~);~}~:@(~A~).LISP"
+ (subseq dir src) (pathname-name untruename))
+ ;; FIXME: just output/stuff-groveled-from-headers.lisp
+ (namestring untruename)))
+ #-sb-xc-host
(namestring
(if (and dir (eq (first dir) :absolute))
untruename
(setf (compiled-debug-fun-arguments dfun)
(compute-args fun var-locs))))
- (when (>= level 2)
- (multiple-value-bind (blocks tlf-num) (compute-debug-blocks fun var-locs)
- (setf (compiled-debug-fun-tlf-number dfun) tlf-num)
- (setf (compiled-debug-fun-blocks dfun) blocks)))
+ (if (>= level 2)
+ (multiple-value-bind (blocks tlf-num)
+ (compute-debug-blocks fun var-locs)
+ (setf (compiled-debug-fun-tlf-number dfun) tlf-num)
+ (setf (compiled-debug-fun-blocks dfun) blocks))
+ (setf (compiled-debug-fun-tlf-number dfun) (find-tlf-number fun)))
(if (xep-p fun)
(setf (compiled-debug-fun-returns dfun) :standard)