* expect.scm (expect-select): correct the millisecond timeout

	arithmetic (from Marko.Kohtala@ntc.nokia.com).
	* boot-9.scm (open-input-pipe, open-output-pipe): defined here
	instead of in libguile.
	(tm:sec etc.) new accessors for broken-down time.
	(set-tm:sec etc.) new setters for broken-down time.

diff --git a/ice-9/ChangeLog b/ice-9/ChangeLog
index 6c5dba4..357cecd 100644 (file)
--- a/ice-9/ChangeLog
+++ b/ice-9/ChangeLog
@@ -1,3 +1,15 @@
+Tue Apr  1 17:46:49 1997  Gary Houston  <ghouston@actrix.gen.nz>
+
+       * expect.scm (expect-select): correct the millisecond timeout
+       arithmetic (from Marko.Kohtala@ntc.nokia.com).
+       
+Mon Mar 31 03:23:19 1997  Gary Houston  <ghouston@actrix.gen.nz>
+
+       * boot-9.scm (open-input-pipe, open-output-pipe): defined here
+       instead of in libguile.
+       (tm:sec etc.) new accessors for broken-down time.
+       (set-tm:sec etc.) new setters for broken-down time.
+
 Thu Mar 27 05:06:00 1997  Gary Houston  <ghouston@actrix.gen.nz>
 
        * boot-9.scm (netent:addrtype, servent:port): added missing

diff --git a/ice-9/boot-9.scm b/ice-9/boot-9.scm
index 470c039..e94f360 100644 (file)
--- a/ice-9/boot-9.scm
+++ b/ice-9/boot-9.scm
@@ -718,9 +718,36 @@
 (define (utsname:version obj) (vector-ref obj 3))
 (define (utsname:machine obj) (vector-ref obj 4))
 
+(define (tm:sec obj) (vector-ref obj 0))
+(define (tm:min obj) (vector-ref obj 1))
+(define (tm:hour obj) (vector-ref obj 2))
+(define (tm:mday obj) (vector-ref obj 3))
+(define (tm:mon obj) (vector-ref obj 4))
+(define (tm:year obj) (vector-ref obj 5))
+(define (tm:wday obj) (vector-ref obj 6))
+(define (tm:yday obj) (vector-ref obj 7))
+(define (tm:isdst obj) (vector-ref obj 8))
+(define (tm:gmtoff obj) (vector-ref obj 9))
+(define (tm:zone obj) (vector-ref obj 10))
+
+(define (set-tm:sec obj val) (vector-set! obj 0 val))
+(define (set-tm:min obj val) (vector-set! obj 1 val))
+(define (set-tm:hour obj val) (vector-set! obj 2 val))
+(define (set-tm:mday obj val) (vector-set! obj 3 val))
+(define (set-tm:mon obj val) (vector-set! obj 4 val))
+(define (set-tm:year obj val) (vector-set! obj 5 val))
+(define (set-tm:wday obj val) (vector-set! obj 6 val))
+(define (set-tm:yday obj val) (vector-set! obj 7 val))
+(define (set-tm:isdst obj val) (vector-set! obj 8 val))
+(define (set-tm:gmtoff obj val) (vector-set! obj 9 val))
+(define (set-tm:zone obj val) (vector-set! obj 10 val))
+
 (define (file-position . args) (apply ftell args))
 (define (file-set-position . args) (apply fseek args))
 
+(define (open-input-pipe command) (open-pipe command OPEN_READ))
+(define (open-output-pipe command) (open-pipe command OPEN_WRITE))
+
 (define (move->fdes port fd)
   (primitive-move->fdes port fd)
   (set-port-revealed! port 1)

diff --git a/ice-9/expect.scm b/ice-9/expect.scm
index 6d25c8b..9ac851f 100644 (file)
--- a/ice-9/expect.scm
+++ b/ice-9/expect.scm
@@ -113,12 +113,11 @@
 ;;; simplified select: returns #t if input is waiting or #f if timed out.
 ;;; timeout is absolute in terms of get-internal-real-time.
 (define (expect-select port timeout)
-  (let* ((relative (- timeout (get-internal-real-time)))
-        (relative-s (inexact->exact
-                     (floor (/ relative internal-time-units-per-second))))
+  (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)
-                                internal-time-units-per-second)))))
+                      (round (* (- relative relative-s) 1000)))))
     (and (> relative 0)
         (pair? (car (select (list port) () ()
                             relative-s