killing lutexes, adding timeouts

[sbcl.git] / src / compiler / tn.lisp

diff --git a/src/compiler/tn.lisp b/src/compiler/tn.lisp
index d044d21..2fbfe46 100644 (file)
--- a/src/compiler/tn.lisp
+++ b/src/compiler/tn.lisp
@@ -376,6 +376,11 @@
   (let ((2block (block-info block)))
     (or (ir2-block-%label 2block)
         (setf (ir2-block-%label 2block) (gen-label)))))
+(defun block-trampoline (block)
+  (declare (type cblock block))
+  (let ((2block (block-info block)))
+    (or (ir2-block-%trampoline-label 2block)
+        (setf (ir2-block-%trampoline-label 2block) (gen-label)))))
 
 ;;; Return true if Block is emitted immediately after the block ended by Node.
 (defun drop-thru-p (node block)
@@ -383,6 +388,11 @@
   (let ((next-block (ir2-block-next (block-info (node-block node)))))
     (aver (eq node (block-last (node-block node))))
     (eq next-block (block-info block))))
+(defun register-drop-thru (block)
+  (declare (type cblock block))
+  (let ((2block (block-info block)))
+    (setf (ir2-block-dropped-thru-to 2block) t))
+  nil)
 
 ;;; Link a list of VOPs from First to Last into Block, Before the specified
 ;;; VOP. If Before is NIL, insert at the end.
@@ -442,10 +452,19 @@
 ;;; Return the value of an immediate constant TN.
 (defun tn-value (tn)
   (declare (type tn tn))
-  ;; FIXME: What is :CACHED-CONSTANT?
-  (aver (member (tn-kind tn) '(:constant :cached-constant)))
+  (aver (eq (tn-kind tn) :constant))
   (constant-value (tn-leaf tn)))
 
+(defun immediate-tn-p (tn)
+  (declare (type tn tn))
+  (let ((leaf (tn-leaf tn)))
+    ;; Leaves with KIND :CONSTANT can have NIL as the leaf if they
+    ;; represent load time values.
+    (and leaf
+         (eq (tn-kind tn) :constant)
+         (eq (immediate-constant-sc (constant-value leaf))
+             (sc-number-or-lose 'sb!vm::immediate)))))
+
 ;;; Force TN to be allocated in a SC that doesn't need to be saved: an
 ;;; unbounded non-save-p SC. We don't actually make it a real "restricted" TN,
 ;;; but since we change the SC to an unbounded one, we should always succeed in