From: Chris Hanson <org/chris-hanson/cph>
Date: Wed, 22 Nov 2006 18:50:48 +0000 (+0000)
Subject: Add SHUTDOWN-SOCKET primitive.
X-Git-Tag: 20090517-FFI~837
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=d107f634d9c85df77a987596705055460d6a5a25;p=mit-scheme.git

Add SHUTDOWN-SOCKET primitive.
---

diff --git a/v7/src/microcode/pruxsock.c b/v7/src/microcode/pruxsock.c
index a4baffa9e..578d4a41b 100644
--- a/v7/src/microcode/pruxsock.c
+++ b/v7/src/microcode/pruxsock.c
@@ -1,8 +1,9 @@
 /* -*-C-*-
 
-$Id: pruxsock.c,v 1.22 2003/02/14 18:28:23 cph Exp $
+$Id: pruxsock.c,v 1.23 2006/11/22 18:50:41 cph Exp $
 
-Copyright (c) 1990-2001 Massachusetts Institute of Technology
+Copyright 1990,1991,1992,1993,1996,1997 Massachusetts Institute of Technology
+Copyright 1998,1999,2000,2001,2006 Massachusetts Institute of Technology
 
 This file is part of MIT/GNU Scheme.
 
@@ -63,6 +64,16 @@ DEFUN (arg_host, (arg), unsigned int arg)
   return (STRING_LOC ((ARG_REF (arg)), 0));
 }
 
+static Tchannel
+DEFUN (arg_client_socket, (arg), unsigned int arg)
+{
+  Tchannel socket = (arg_nonnegative_integer (arg));
+  if (! (((OS_channel_type (socket)) == channel_type_tcp_stream_socket)
+	 || ((OS_channel_type (socket)) == channel_type_unix_stream_socket)))
+    error_bad_range_arg (arg);
+  return (socket);
+}
+
 static Tchannel
 DEFUN (arg_server_socket, (arg), unsigned int arg)
 {
@@ -249,6 +260,14 @@ The opened socket is stored in the cdr of WEAK-PAIR.")
 #endif
   PRIMITIVE_RETURN (SHARP_T);
 }
+
+DEFINE_PRIMITIVE ("SHUTDOWN-SOCKET", Prim_shutdown_socket, 2, 2, "")
+{
+  PRIMITIVE_HEADER (2);
+  OS_shutdown_socket ((arg_client_socket (1)),
+		      (arg_integer_in_range (2, 1, 4)));
+  PRIMITIVE_RETURN (UNSPECIFIC);
+}
 
 DEFINE_PRIMITIVE ("NEW-OPEN-TCP-SERVER-SOCKET", Prim_new_open_tcp_server_socket, 2, 2,
   "Given PORT-NUMBER, open TCP server socket.\n\
diff --git a/v7/src/microcode/syscall.h b/v7/src/microcode/syscall.h
index 77fac4dcf..1e5a89dc4 100644
--- a/v7/src/microcode/syscall.h
+++ b/v7/src/microcode/syscall.h
@@ -1,9 +1,9 @@
 /* -*-C-*-
 
-$Id: syscall.h,v 1.17 2003/07/09 22:53:51 cph Exp $
+$Id: syscall.h,v 1.18 2006/11/22 18:50:43 cph Exp $
 
 Copyright 1993,1994,1995,1996,1997,1999 Massachusetts Institute of Technology
-Copyright 2000,2003 Massachusetts Institute of Technology
+Copyright 2000,2003,2006 Massachusetts Institute of Technology
 
 This file is part of MIT/GNU Scheme.
 
@@ -24,12 +24,10 @@ USA.
 
 */
 
-/* OS system calls and errors.
-   Must match utabmd.scm
- */
+/* OS system calls and errors.  */
 
 #ifndef SCM_SYSCALL_H
-#define  SCM_SYSCALL_H
+#define SCM_SYSCALL_H 1
 
 #include "config.h"
 
@@ -48,6 +46,8 @@ USA.
 
 #else /* not __WIN32__ */
 
+/* Unix case, inline for historical reasons.  Must match "uxtop.c".  */
+
 enum syscall_names
 {
   syscall_accept,
@@ -86,6 +86,7 @@ enum syscall_names
   syscall_select,
   syscall_setitimer,
   syscall_setpgid,
+  syscall_shutdown,
   syscall_sighold,
   syscall_sigprocmask,
   syscall_sigsuspend,
diff --git a/v7/src/microcode/uxsock.c b/v7/src/microcode/uxsock.c
index 8b6852db7..5ef32529f 100644
--- a/v7/src/microcode/uxsock.c
+++ b/v7/src/microcode/uxsock.c
@@ -1,9 +1,9 @@
 /* -*-C-*-
 
-$Id: uxsock.c,v 1.31 2003/07/09 22:53:38 cph Exp $
+$Id: uxsock.c,v 1.32 2006/11/22 18:50:44 cph Exp $
 
 Copyright 1993,1996,1997,1998,1999,2000 Massachusetts Institute of Technology
-Copyright 2001,2003 Massachusetts Institute of Technology
+Copyright 2001,2003,2006 Massachusetts Institute of Technology
 
 This file is part of MIT/GNU Scheme.
 
@@ -119,6 +119,21 @@ do_connect (int s, struct sockaddr * address, socklen_t addr_len)
     }
 }
 
+void
+DEFUN (OS_shutdown_socket, (channel, stype),
+       Tchannel channel AND
+       unsigned long stype)
+{
+  STD_VOID_SYSTEM_CALL
+    (syscall_shutdown,
+     (shutdown ((CHANNEL_DESCRIPTOR (channel)),
+		(((stype & 0x3) == 0x1)
+		 ? SHUT_RD
+		 : ((stype & 0x3) == 0x2)
+		 ? SHUT_WR
+		 : SHUT_RDWR))));
+}
+
 int
 DEFUN (OS_get_service_by_name, (service_name, protocol_name),
        CONST char * service_name AND
diff --git a/v7/src/microcode/uxsock.h b/v7/src/microcode/uxsock.h
index 5ca9c9cbc..e4bd98bb8 100644
--- a/v7/src/microcode/uxsock.h
+++ b/v7/src/microcode/uxsock.h
@@ -1,8 +1,9 @@
 /* -*-C-*-
 
-$Id: uxsock.h,v 1.12 2003/02/14 18:28:24 cph Exp $
+$Id: uxsock.h,v 1.13 2006/11/22 18:50:46 cph Exp $
 
-Copyright (c) 1990-2001 Massachusetts Institute of Technology
+Copyright 1990,1992,1993,1997,1998,1999 Massachusetts Institute of Technology
+Copyright 2001,2006 Massachusetts Institute of Technology
 
 This file is part of MIT/GNU Scheme.
 
@@ -29,6 +30,7 @@ USA.
 #include "osio.h"
 
 extern Tchannel EXFUN (OS_open_tcp_stream_socket, (PTR, unsigned int));
+extern void EXFUN (OS_shutdown_socket, (Tchannel, unsigned long));
 extern int EXFUN (OS_get_service_by_name, (CONST char *, CONST char *));
 extern unsigned long EXFUN (OS_get_service_by_number, (CONST unsigned long));
 extern unsigned int EXFUN (OS_host_address_length, (void));
diff --git a/v7/src/microcode/uxtop.c b/v7/src/microcode/uxtop.c
index 28653b860..47f97a14c 100644
--- a/v7/src/microcode/uxtop.c
+++ b/v7/src/microcode/uxtop.c
@@ -1,9 +1,10 @@
 /* -*-C-*-
 
-$Id: uxtop.c,v 1.30 2003/07/09 22:53:55 cph Exp $
+$Id: uxtop.c,v 1.31 2006/11/22 18:50:48 cph Exp $
 
 Copyright 1990,1991,1992,1993,1994,1995 Massachusetts Institute of Technology
 Copyright 1996,1997,1999,2000,2002,2003 Massachusetts Institute of Technology
+Copyright 2006 Massachusetts Institute of Technology
 
 This file is part of MIT/GNU Scheme.
 
@@ -363,6 +364,7 @@ static char * syscall_names_table [] =
   "select",
   "setitimer",
   "setpgid",
+  "shutdown",
   "sighold",
   "sigprocmask",
   "sigsuspend",