From dd8e38a7f01e8531bcca8fd1e63d7097d5b63d00 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Sat, 9 Feb 2008 21:56:50 -0600
Subject: [PATCH] Fixing some issues

---
 extra/io/launcher/launcher.factor       |  2 ++
 extra/io/nonblocking/nonblocking.factor |  2 +-
 extra/io/timeouts/timeouts.factor       | 18 +++++++++---------
 3 files changed, 12 insertions(+), 10 deletions(-)

diff --git a/extra/io/launcher/launcher.factor b/extra/io/launcher/launcher.factor
index efcecd50bc..17a3e6fd23 100755
--- a/extra/io/launcher/launcher.factor
+++ b/extra/io/launcher/launcher.factor
@@ -106,6 +106,8 @@ HOOK: kill-process* io-backend ( handle -- )
     t over set-process-killed?
     process-handle [ kill-process* ] when* ;
 
+M: process get-lapse process-lapse ;
+
 M: process timed-out kill-process ;
 
 HOOK: process-stream* io-backend ( desc -- stream process )
diff --git a/extra/io/nonblocking/nonblocking.factor b/extra/io/nonblocking/nonblocking.factor
index 4d8634bde9..72507f26b6 100755
--- a/extra/io/nonblocking/nonblocking.factor
+++ b/extra/io/nonblocking/nonblocking.factor
@@ -17,7 +17,7 @@ lapse
 type eof? ;
 
 ! Ports support the lapse protocol
-M: port lapse port-lapse ;
+M: port get-lapse port-lapse ;
 
 SYMBOL: closed
 
diff --git a/extra/io/timeouts/timeouts.factor b/extra/io/timeouts/timeouts.factor
index 67bc3a4783..ddc92a4bdd 100755
--- a/extra/io/timeouts/timeouts.factor
+++ b/extra/io/timeouts/timeouts.factor
@@ -8,21 +8,21 @@ TUPLE: lapse entry timeout cutoff ;
 
 : <lapse> f 0 0 \ lapse construct-boa ;
 
-GENERIC: lapse ( obj -- lapse )
+GENERIC: get-lapse ( obj -- lapse )
 GENERIC: set-timeout ( ms obj -- )
 
-M: object set-timeout lapse set-lapse-timeout ;
+M: object set-timeout get-lapse set-lapse-timeout ;
 
 M: duplex-stream set-timeout
     2dup
     duplex-stream-in set-timeout
     duplex-stream-out set-timeout ;
 
-: timeout ( obj -- ms ) lapse lapse-timeout ;
-: entry ( obj -- dlist-node ) lapse lapse-entry ;
-: set-entry ( dlist-node -- obj ) lapse set-lapse-entry ;
-: cutoff ( obj -- ms ) lapse lapse-cutoff ;
-: set-cutoff ( ms obj -- ) lapse set-lapse-cutoff ;
+: timeout ( obj -- ms ) get-lapse lapse-timeout ;
+: entry ( obj -- dlist-node ) get-lapse lapse-entry ;
+: set-entry ( obj dlist-node -- ) get-lapse set-lapse-entry ;
+: cutoff ( obj -- ms ) get-lapse lapse-cutoff ;
+: set-cutoff ( ms obj -- ) get-lapse set-lapse-cutoff ;
 
 SYMBOL: timeout-queue
 
@@ -62,6 +62,6 @@ M: object timed-out drop ;
     over begin-timeout keep unqueue-timeout ; inline
 
 : expiry-thread ( -- )
-    expire-timeouts 5000 sleep expire-timeouts ;
+    expire-timeouts 5000 sleep expiry-thread ;
 
-[ expiry-thread ] "io.timeouts" add-init-hook
+[ [ expiry-thread ] in-thread ] "io.timeouts" add-init-hook