From 30856c70aaf5e684eb14068daacb2ebdb1dbd67c Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Mon, 13 Nov 1995 07:22:06 +0000 Subject: [PATCH] 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. --- v7/src/runtime/runtime.pkg | 5 ++++- v7/src/runtime/socket.scm | 35 ++++++++++++++++++++++------------- v7/src/runtime/thread.scm | 7 +++++-- v8/src/runtime/runtime.pkg | 5 ++++- 4 files changed, 35 insertions(+), 17 deletions(-) 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) -- 2.25.1