projects
/
sbcl.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
0.8.0.60:
[sbcl.git]
/
src
/
compiler
/
debug.lisp
diff --git
a/src/compiler/debug.lisp
b/src/compiler/debug.lisp
index
7f67f0f
..
b9b8cb3
100644
(file)
--- a/
src/compiler/debug.lisp
+++ b/
src/compiler/debug.lisp
@@
-528,6
+528,8
@@
(barf "IF not at block end: ~S" node)))
(cset
(check-dest (set-value node) node))
(barf "IF not at block end: ~S" node)))
(cset
(check-dest (set-value node) node))
+ (cast
+ (check-dest (cast-value node) node))
(bind
(check-fun-reached (bind-lambda node) node))
(creturn
(bind
(check-fun-reached (bind-lambda node) node))
(creturn
@@
-963,7
+965,8
@@
(ref (print-leaf (ref-leaf node)))
(basic-combination
(let ((kind (basic-combination-kind node)))
(ref (print-leaf (ref-leaf node)))
(basic-combination
(let ((kind (basic-combination-kind node)))
- (format t "~(~A ~A~) c~D"
+ (format t "~(~A~A ~A~) c~D"
+ (if (node-tail-p node) "tail " "")
(if (fun-info-p kind) "known" kind)
(type-of node)
(cont-num (basic-combination-fun node)))
(if (fun-info-p kind) "known" kind)
(type-of node)
(cont-num (basic-combination-fun node)))
@@
-981,7
+984,9
@@
(print-continuation (block-start (if-alternative node))))
(bind
(write-string "bind ")
(print-continuation (block-start (if-alternative node))))
(bind
(write-string "bind ")
- (print-leaf (bind-lambda node)))
+ (print-leaf (bind-lambda node))
+ (when (functional-kind (bind-lambda node))
+ (format t " ~S ~S" :kind (functional-kind (bind-lambda node)))))
(creturn
(format t "return c~D " (cont-num (return-result node)))
(print-leaf (return-lambda node)))
(creturn
(format t "return c~D " (cont-num (return-result node)))
(print-leaf (return-lambda node)))
@@
-994,7
+999,13
@@
((exit-entry node)
(format t "exit <no value>"))
(t
((exit-entry node)
(format t "exit <no value>"))
(t
- (format t "exit <degenerate>"))))))
+ (format t "exit <degenerate>")))))
+ (cast
+ (let ((value (cast-value node)))
+ (format t "cast c~D ~A[~S -> ~S]" (cont-num value)
+ (if (cast-%type-check node) #\+ #\-)
+ (cast-type-to-check node)
+ (cast-asserted-type node)))))
(pprint-newline :mandatory)
(when (eq node last) (return)))))
(pprint-newline :mandatory)
(when (eq node last) (return)))))
@@
-1134,8
+1145,8
@@
(defvar *list-conflicts-table* (make-hash-table :test 'eq))
(defvar *list-conflicts-table* (make-hash-table :test 'eq))
-;;; Add all ALWAYS-LIVE TNs in Block to the conflicts. TN is ignored when
-;;; it appears in the global conflicts.
+;;; Add all ALWAYS-LIVE TNs in BLOCK to the conflicts. TN is ignored
+;;; when it appears in the global conflicts.
(defun add-always-live-tns (block tn)
(declare (type ir2-block block) (type tn tn))
(do ((conf (ir2-block-global-tns block)
(defun add-always-live-tns (block tn)
(declare (type ir2-block block) (type tn tn))
(do ((conf (ir2-block-global-tns block)
@@
-1147,7
+1158,7
@@
(setf (gethash btn *list-conflicts-table*) t)))))
(values))
(setf (gethash btn *list-conflicts-table*) t)))))
(values))
-;;; Add all local TNs in block to the conflicts.
+;;; Add all local TNs in BLOCK to the conflicts.
(defun add-all-local-tns (block)
(declare (type ir2-block block))
(let ((ltns (ir2-block-local-tns block)))
(defun add-all-local-tns (block)
(declare (type ir2-block block))
(let ((ltns (ir2-block-local-tns block)))
@@
-1176,7
+1187,8
@@
(do ((conf confs (global-conflicts-next-tnwise conf)))
((null conf))
(format t "~&#<block ~D kind ~S>~%"
(do ((conf confs (global-conflicts-next-tnwise conf)))
((null conf))
(format t "~&#<block ~D kind ~S>~%"
- (block-number (ir2-block-block (global-conflicts-block conf)))
+ (block-number (ir2-block-block (global-conflicts-block
+ conf)))
(global-conflicts-kind conf))
(let ((block (global-conflicts-block conf)))
(add-always-live-tns block tn)
(global-conflicts-kind conf))
(let ((block (global-conflicts-block conf)))
(add-always-live-tns block tn)