From: Chris Hanson <org/chris-hanson/cph>
Date: Mon, 13 Nov 1995 07:22:06 +0000 (+0000)
Subject: Disable the thread timer while doing hostname lookups, as it can cause
X-Git-Tag: 20090517-FFI~5732
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=30856c70aaf5e684eb14068daacb2ebdb1dbd67c;p=mit-scheme.git

Disable the thread timer while doing hostname lookups, as it can cause
the nameserver request to fail if the timer signal arrives while
waiting for the nameserver reply.
---

diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg
index bd3e1cf96..17fe0a3cf 100644
--- a/v7/src/runtime/runtime.pkg
+++ b/v7/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: runtime.pkg,v 14.264 1995/11/04 02:39:34 cph Exp $
+$Id: runtime.pkg,v 14.265 1995/11/13 07:21:53 cph Exp $
 
 Copyright (c) 1988-95 Massachusetts Institute of Technology
 
@@ -2132,7 +2132,9 @@ MIT in each case. |#
 	  close-tcp-server-socket
 	  open-tcp-server-socket
 	  open-tcp-stream-socket
+	  open-tcp-stream-socket-channel
 	  open-unix-stream-socket
+	  open-unix-stream-socket-channel
 	  tcp-server-connection-accept))
 
 (define-package (runtime subprocess)
@@ -3065,6 +3067,7 @@ MIT in each case. |#
 	  unlock-thread-mutex
 	  with-create-thread-continuation
 	  with-thread-mutex-locked
+	  with-thread-timer-stopped
 	  yield-current-thread)
   (export (runtime interrupt-handler)
 	  thread-timer-interrupt-handler)
diff --git a/v7/src/runtime/socket.scm b/v7/src/runtime/socket.scm
index 10352421c..5f1497e8e 100644
--- a/v7/src/runtime/socket.scm
+++ b/v7/src/runtime/socket.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/socket.scm,v 1.5 1992/06/15 22:22:35 cph Exp $
+$Id: socket.scm,v 1.6 1995/11/13 07:20:52 cph Exp $
 
-Copyright (c) 1990-92 Massachusetts Institute of Technology
+Copyright (c) 1990-95 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -38,24 +38,33 @@ MIT in each case. |#
 (declare (usual-integrations))
 
 (define (open-tcp-stream-socket host-name service)
-  (socket-ports
-   (let ((host (vector-ref ((ucode-primitive get-host-by-name 1) host-name) 0))
-	 (port (tcp-service->port service)))
-     (without-interrupts
-      (lambda ()
-	(make-channel
-	 ((ucode-primitive open-tcp-stream-socket 2) host port)))))))
+  (socket-ports (open-tcp-stream-socket-channel host-name service)))
 
 (define (open-unix-stream-socket filename)
-  (socket-ports
-   (without-interrupts
-    (lambda ()
-      (make-channel ((ucode-primitive open-unix-stream-socket 1) filename))))))
+  (socket-ports (open-unix-stream-socket-channel filename)))
 
 (define (socket-ports channel)
   (let ((port (make-generic-i/o-port channel channel 64 64)))
     (values port port)))
 
+(define (open-tcp-stream-socket-channel host-name service)
+  (let ((host (vector-ref (get-host-by-name host-name) 0))
+	(port (tcp-service->port service)))
+    (without-interrupts
+     (lambda ()
+       (make-channel
+	((ucode-primitive open-tcp-stream-socket 2) host port))))))
+
+(define (get-host-by-name host-name)
+  (with-thread-timer-stopped
+    (lambda ()
+      ((ucode-primitive get-host-by-name 1) host-name))))
+
+(define (open-unix-stream-socket-channel filename)
+  (without-interrupts
+   (lambda ()
+     (make-channel ((ucode-primitive open-unix-stream-socket 1) filename)))))
+
 (define (open-tcp-server-socket service)
   (without-interrupts
    (lambda ()
diff --git a/v7/src/runtime/thread.scm b/v7/src/runtime/thread.scm
index dc12807fb..89a871e53 100644
--- a/v7/src/runtime/thread.scm
+++ b/v7/src/runtime/thread.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: thread.scm,v 1.21 1993/12/23 06:58:54 cph Exp $
+$Id: thread.scm,v 1.22 1995/11/13 07:21:35 cph Exp $
 
-Copyright (c) 1991-1993 Massachusetts Institute of Technology
+Copyright (c) 1991-95 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -761,6 +761,9 @@ MIT in each case. |#
 (define (stop-thread-timer)
   (without-interrupts %stop-thread-timer))
 
+(define (with-thread-timer-stopped thunk)
+  (dynamic-wind %stop-thread-timer thunk %maybe-toggle-thread-timer))
+
 (define (%maybe-toggle-thread-timer)
   (cond ((and timer-interval
 	      (let ((current-thread first-running-thread))
diff --git a/v8/src/runtime/runtime.pkg b/v8/src/runtime/runtime.pkg
index e8ec79248..88065533c 100644
--- a/v8/src/runtime/runtime.pkg
+++ b/v8/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: runtime.pkg,v 14.266 1995/11/04 02:34:03 cph Exp $
+$Id: runtime.pkg,v 14.267 1995/11/13 07:22:06 cph Exp $
 
 Copyright (c) 1988-95 Massachusetts Institute of Technology
 
@@ -2131,7 +2131,9 @@ MIT in each case. |#
 	  close-tcp-server-socket
 	  open-tcp-server-socket
 	  open-tcp-stream-socket
+	  open-tcp-stream-socket-channel
 	  open-unix-stream-socket
+	  open-unix-stream-socket-channel
 	  tcp-server-connection-accept))
 
 (define-package (runtime subprocess)
@@ -3064,6 +3066,7 @@ MIT in each case. |#
 	  unlock-thread-mutex
 	  with-create-thread-continuation
 	  with-thread-mutex-locked
+	  with-thread-timer-stopped
 	  yield-current-thread)
   (export (runtime interrupt-handler)
 	  thread-timer-interrupt-handler)