(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
(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)))
(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)))
((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)))))
(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)
(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)))
(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)