From cafa4c681eaa612c24563bcaef94e236e2539701 Mon Sep 17 00:00:00 2001
From: Gary Houston <ghouston@arglist.com>
Date: Thu, 15 May 1997 08:48:38 +0000
Subject: [PATCH] * expect.scm: use gettimeofday instead of
 get-internal-real-time and use a floating point timeout when calling select. 
 Untested, since the regex library is currently AWOL.

---
 ice-9/ChangeLog  |  6 ++++++
 ice-9/expect.scm | 23 +++++++++++++----------
 2 files changed, 19 insertions(+), 10 deletions(-)

diff --git a/ice-9/ChangeLog b/ice-9/ChangeLog
index 7d0286355..95722c618 100644
--- a/ice-9/ChangeLog
+++ b/ice-9/ChangeLog
@@ -1,3 +1,9 @@
+Thu May 15 07:56:08 1997  Gary Houston  <ghouston@actrix.gen.nz>
+
+	* expect.scm: use gettimeofday instead of get-internal-real-time
+	and use a floating point timeout when calling select.  Untested,
+	since the regex library is currently AWOL.
+
 Wed May 14 21:00:30 1997  Jim Blandy  <jimb@floss.cyclic.com>
 
 	* boot-9.scm (eval-string): Function deleted; it was already
diff --git a/ice-9/expect.scm b/ice-9/expect.scm
index 9ac851f89..b11c90ab1 100644
--- a/ice-9/expect.scm
+++ b/ice-9/expect.scm
@@ -38,9 +38,13 @@
 	(timeout (gentemp)))
     `(let ((,s "")
 	   (,port (or expect-port (current-input-port)))
+	   ;; when timeout occurs, in floating point seconds.
 	   (,timeout (if expect-timeout
-			 (+ (* expect-timeout internal-time-units-per-second)
-			    (get-internal-real-time))
+			 (let* ((secs-usecs (gettimeofday)))
+			   (+ (car secs-usecs)
+			      expect-timeout
+			      (/ (cdr secs-usecs)
+				 1000000))) ; one million.
 			 #f)))
        (let next-char ()
 	 (if (and expect-timeout
@@ -111,14 +115,13 @@
 				      body))))))))
 
 ;;; simplified select: returns #t if input is waiting or #f if timed out.
-;;; timeout is absolute in terms of get-internal-real-time.
+;;; timeout is an absolute time in floating point seconds.
 (define (expect-select port timeout)
-  (let* ((relative (/ (- timeout (get-internal-real-time))
-		      internal-time-units-per-second))
-	 (relative-s (inexact->exact (floor relative)))
-	 (relative-ms (inexact->exact
-		       (round (* (- relative relative-s) 1000)))))
+  (let* ((secs-usecs (gettimeofday))
+	 (relative (- timeout 
+		      (car secs-usecs)
+		      (/ (cdr secs-usecs)
+			 1000000))))	; one million.
     (and (> relative 0)
 	 (pair? (car (select (list port) () ()
-			     relative-s
-			     relative-ms))))))
+			     relative))))))