Implement and export various host-name manipulating procedures.

Change TCP-SERVER-CONNECTION-ACCEPT to accept the peer address as an
argument and to return only a single value.

diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg
index 255dfac425a97ce9f755b967962793ee0b5a2ca3..d11e92fae57d0d34290bbe808d7720773e9a9a76 100644 (file)
--- a/v7/src/runtime/runtime.pkg
+++ b/v7/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: runtime.pkg,v 14.330 1999/08/09 18:10:41 cph Exp $
+$Id: runtime.pkg,v 14.331 1999/08/13 18:40:43 cph Exp $
 
 Copyright (c) 1988-1999 Massachusetts Institute of Technology
 
@@ -2268,7 +2268,12 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
   (files "socket")
   (parent ())
   (export ()
+         allocate-host-address
+         canonical-host-name
          close-tcp-server-socket
+         get-host-by-address
+         get-host-by-name
+         get-host-name
          open-tcp-server-socket
          open-tcp-stream-socket
          open-tcp-stream-socket-channel

diff --git a/v7/src/runtime/socket.scm b/v7/src/runtime/socket.scm
index 138f216dfcbaf4852d803ce5d3e03f49d01943d8..2b69257f8e6261bb7d7aa7368612636c37b9dfdd 100644 (file)
--- a/v7/src/runtime/socket.scm
+++ b/v7/src/runtime/socket.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: socket.scm,v 1.14 1999/07/26 21:20:44 cph Exp $
+$Id: socket.scm,v 1.15 1999/08/13 18:40:30 cph Exp $
 
 Copyright (c) 1990-1999 Massachusetts Institute of Technology
 
@@ -52,15 +52,6 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
         (lambda ()
           ((ucode-primitive new-open-tcp-stream-socket 3) host port p)))))))
 
-(define (get-host-by-name host-name)
-  (with-thread-timer-stopped
-    (lambda ()
-      ((ucode-primitive get-host-by-name 1) host-name))))
-
-(define (os/hostname)
-  ((ucode-primitive canonical-host-name 1)
-   ((ucode-primitive get-host-name 0))))
-
 (define (open-unix-stream-socket-channel filename)
   (open-channel
    (lambda (p)
@@ -85,23 +76,41 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 (define (close-tcp-server-socket server-socket)
   (channel-close server-socket))
 
+(define (tcp-server-connection-accept server-socket block? peer-address)
+  (let ((channel
+        (with-channel-blocking server-socket block?
+          (lambda ()
+            (open-channel
+             (lambda (p)
+               (with-thread-timer-stopped
+                 (lambda ()
+                   ((ucode-primitive new-tcp-server-connection-accept 3)
+                    (channel-descriptor server-socket)
+                    peer-address
+                    p)))))))))
+    (and channel
+        (make-generic-i/o-port channel channel 64 64))))
+\f
+(define (get-host-by-name host-name)
+  (with-thread-timer-stopped
+    (lambda ()
+      ((ucode-primitive get-host-by-name 1) host-name))))
+
+(define (get-host-by-address host-address)
+  (with-thread-timer-stopped
+    (lambda ()
+      ((ucode-primitive get-host-by-address 1) host-address))))
+
+(define (canonical-host-name host-name)
+  (with-thread-timer-stopped
+    (lambda ()
+      ((ucode-primitive canonical-host-name 1) host-name))))
+
+(define get-host-name
+  (ucode-primitive get-host-name 0))
+
+(define (os/hostname)
+  (canonical-host-name (get-host-name)))
+
 (define (allocate-host-address)
-  (string-allocate ((ucode-primitive host-address-length 0))))
-
-(define (tcp-server-connection-accept server-socket block?)
-  (let ((peer-address (allocate-host-address)))
-    (let ((channel
-          (with-channel-blocking server-socket block?
-            (lambda ()
-              (open-channel
-               (lambda (p)
-                 (with-thread-timer-stopped
-                   (lambda ()
-                     ((ucode-primitive new-tcp-server-connection-accept 3)
-                      (channel-descriptor server-socket)
-                      peer-address
-                      p)))))))))
-      (if channel
-         (let ((port (make-generic-i/o-port channel channel 64 64)))
-           (values port peer-address))
-         (values #f #f)))))
\ No newline at end of file
+  (string-allocate ((ucode-primitive host-address-length 0))))
\ No newline at end of file

diff --git a/v8/src/runtime/runtime.pkg b/v8/src/runtime/runtime.pkg
index c3094c1944e2899089ac1687270e7c6c73033d15..aae7ea1b323783b9a155fac0052a2a5ff1954643 100644 (file)
--- a/v8/src/runtime/runtime.pkg
+++ b/v8/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: runtime.pkg,v 14.335 1999/08/09 18:10:44 cph Exp $
+$Id: runtime.pkg,v 14.336 1999/08/13 18:40:39 cph Exp $
 
 Copyright (c) 1988-1999 Massachusetts Institute of Technology
 
@@ -2272,7 +2272,12 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
   (files "socket")
   (parent ())
   (export ()
+         allocate-host-address
+         canonical-host-name
          close-tcp-server-socket
+         get-host-by-address
+         get-host-by-name
+         get-host-name
          open-tcp-server-socket
          open-tcp-stream-socket
          open-tcp-stream-socket-channel