From: Chris Hanson Date: Wed, 22 Jan 2003 02:04:19 +0000 (+0000) Subject: Implement new primitives for I/O synchronization. These new X-Git-Tag: 20090517-FFI~2060 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=074e61812084bb441964d6bba2a83b1ac4e67d65;p=mit-scheme.git Implement new primitives for I/O synchronization. These new primitives have a uniform interface for all operating systems, and support detection of write-ready events as well as read-ready. (Note that the Win32 and OS/2 primitives aren't yet written.) --- diff --git a/v7/src/microcode/osio.h b/v7/src/microcode/osio.h index fa268c5a1..ce70c2e4c 100644 --- a/v7/src/microcode/osio.h +++ b/v7/src/microcode/osio.h @@ -1,8 +1,9 @@ /* -*-C-*- -$Id: osio.h,v 1.16 2002/11/20 19:46:12 cph Exp $ +$Id: osio.h,v 1.17 2003/01/22 02:03:59 cph Exp $ -Copyright (c) 1990-2000 Massachusetts Institute of Technology +Copyright 1990,1991,1993,1994,1995,1997 Massachusetts Institute of Technology +Copyright 2000,2003 Massachusetts Institute of Technology This file is part of MIT Scheme. @@ -72,6 +73,8 @@ extern void EXFUN extern int EXFUN (OS_channel_nonblocking_p, (Tchannel channel)); extern void EXFUN (OS_channel_nonblocking, (Tchannel channel)); extern void EXFUN (OS_channel_blocking, (Tchannel channel)); + +/* Interface to poll(2) or select(2) */ #ifdef __WIN32__ extern int OS_have_select_p; @@ -79,4 +82,32 @@ extern int OS_have_select_p; extern CONST int OS_have_select_p; #endif +typedef PTR select_registry_t; +#define SELECT_MODE_READ 1 +#define SELECT_MODE_WRITE 2 + +#define SELECT_INTERRUPT (-1) +#define SELECT_PROCESS_STATUS_CHANGE (-2) + +extern select_registry_t EXFUN + (OS_allocate_select_registry, (void)); +extern void EXFUN + (OS_deallocate_select_registry, (select_registry_t registry)); +extern void EXFUN + (OS_add_to_select_registry, + (select_registry_t registry, int fd, unsigned int mode)); +extern void EXFUN + (OS_remove_from_select_registry, + (select_registry_t registry, int fd, unsigned int mode)); +extern unsigned int EXFUN + (OS_select_registry_length, (select_registry_t registry)); +extern void EXFUN + (OS_select_registry_result, + (select_registry_t registry, unsigned int index, + int * fd_r, unsigned int * mode_r)); +extern int EXFUN + (OS_test_select_registry, (select_registry_t registry, int blockp)); +extern int EXFUN + (OS_test_select_descriptor, (int fd, int blockp, unsigned int mode)); + #endif /* SCM_OSIO_H */ diff --git a/v7/src/microcode/prosio.c b/v7/src/microcode/prosio.c index 54560df0b..646aebec0 100644 --- a/v7/src/microcode/prosio.c +++ b/v7/src/microcode/prosio.c @@ -1,8 +1,9 @@ /* -*-C-*- -$Id: prosio.c,v 1.19 2002/11/20 19:46:13 cph Exp $ +$Id: prosio.c,v 1.20 2003/01/22 02:04:06 cph Exp $ -Copyright (c) 1987-1999 Massachusetts Institute of Technology +Copyright 1987,1990,1991,1992,1993,1994 Massachusetts Institute of Technology +Copyright 1996,1997,2001,2003 Massachusetts Institute of Technology This file is part of MIT Scheme. @@ -217,7 +218,7 @@ DEFINE_PRIMITIVE ("CHANNEL-BLOCKING", Prim_channel_blocking, 1, 1, OS_channel_blocking (arg_channel (1)); PRIMITIVE_RETURN (UNSPECIFIC); } - + DEFINE_PRIMITIVE ("MAKE-PIPE", Prim_make_pipe, 0, 0, "Return a cons of two channels, the reader and writer of a pipe.") { @@ -232,9 +233,126 @@ DEFINE_PRIMITIVE ("MAKE-PIPE", Prim_make_pipe, 0, 0, PRIMITIVE_RETURN (result); } } + +/* Select registry */ + +static select_registry_t +DEFUN (arg_select_registry, (arg_number), int arg_number) +{ + return ((select_registry_t) (arg_ulong_integer (arg_number))); +} + +static unsigned int +DEFUN (arg_sr_mode, (arg_number), int arg_number) +{ + unsigned long n = (arg_ulong_integer (arg_number)); + if (! ((n >= 1) && (n <= 3))) + error_bad_range_arg (arg_number); + return (n); +} DEFINE_PRIMITIVE ("HAVE-SELECT?", Prim_have_select_p, 0, 0, 0) { PRIMITIVE_HEADER (0); PRIMITIVE_RETURN (BOOLEAN_TO_OBJECT (OS_have_select_p)); } + +DEFINE_PRIMITIVE ("ALLOCATE-SELECT-REGISTRY", Prim_alloc_selreg, 0, 0, 0) +{ + PRIMITIVE_HEADER (0); + PRIMITIVE_RETURN + (ulong_to_integer + ((unsigned long) (OS_allocate_select_registry ()))); +} + +DEFINE_PRIMITIVE ("DEALLOCATE-SELECT-REGISTRY", Prim_dealloc_selreg, 1, 1, 0) +{ + PRIMITIVE_HEADER (1); + OS_deallocate_select_registry (arg_select_registry (1)); + PRIMITIVE_RETURN (UNSPECIFIC); +} + +DEFINE_PRIMITIVE ("ADD-TO-SELECT-REGISTRY", Prim_add_to_selreg, 3, 3, 0) +{ + PRIMITIVE_HEADER (3); + OS_add_to_select_registry ((arg_select_registry (1)), + (arg_nonnegative_integer (2)), + (arg_sr_mode (3))); + PRIMITIVE_RETURN (UNSPECIFIC); +} + +DEFINE_PRIMITIVE ("REMOVE-FROM-SELECT-REGISTRY", Prim_rem_from_selreg, 3, 3, 0) +{ + PRIMITIVE_HEADER (3); + OS_remove_from_select_registry ((arg_select_registry (1)), + (arg_nonnegative_integer (2)), + (arg_sr_mode (3))); + PRIMITIVE_RETURN (UNSPECIFIC); +} + +DEFINE_PRIMITIVE ("SELECT-REGISTRY-LENGTH", Prim_selreg_length, 1, 1, 0) +{ + PRIMITIVE_HEADER (1); + PRIMITIVE_RETURN + (ulong_to_integer (OS_select_registry_length (arg_select_registry (1)))); +} + +DEFINE_PRIMITIVE ("TEST-SELECT-REGISTRY", Prim_test_selreg, 4, 4, 0) +{ + PRIMITIVE_HEADER (4); + { + select_registry_t r = (arg_select_registry (1)); + unsigned int rl = (OS_select_registry_length (r)); + int blockp = (BOOLEAN_ARG (2)); + SCHEME_OBJECT vr = (VECTOR_ARG (3)); + SCHEME_OBJECT vw = (VECTOR_ARG (4)); + int result; + + if ((VECTOR_LENGTH (vr)) < (rl + 1)) + error_bad_range_arg (3); + if ((VECTOR_LENGTH (vw)) < (rl + 1)) + error_bad_range_arg (4); + result = (OS_test_select_registry (r, blockp)); + if (result > 0) + { + unsigned int i = 0; + unsigned int ir = 1; + unsigned int iw = 1; + while (i < rl) + { + int fd; + unsigned int mode; + + OS_select_registry_result (r, i, (&fd), (&mode)); + if (mode > 0) + { + SCHEME_OBJECT sfd = (long_to_integer (fd)); + if ((mode & SELECT_MODE_READ) != 0) + { + VECTOR_SET (vr, ir, sfd); + ir += 1; + } + if ((mode & SELECT_MODE_WRITE) != 0) + { + VECTOR_SET (vw, iw, sfd); + iw += 1; + } + } + i += 1; + } + VECTOR_SET (vr, 0, (ulong_to_integer (ir - 1))); + VECTOR_SET (vw, 0, (ulong_to_integer (iw - 1))); + } + PRIMITIVE_RETURN (long_to_integer (result)); + } +} + +DEFINE_PRIMITIVE ("TEST-SELECT-DESCRIPTOR", Prim_test_sel_desc, 3, 3, 0) +{ + PRIMITIVE_HEADER (3); + PRIMITIVE_RETURN + (long_to_integer + (OS_test_select_descriptor ((arg_nonnegative_integer (1)), + (BOOLEAN_ARG (2)), + (arg_sr_mode (3))))); +} diff --git a/v7/src/microcode/uxio.c b/v7/src/microcode/uxio.c index 4a5ec89c6..848579777 100644 --- a/v7/src/microcode/uxio.c +++ b/v7/src/microcode/uxio.c @@ -1,8 +1,9 @@ /* -*-C-*- -$Id: uxio.c,v 1.47 2002/11/20 19:46:15 cph Exp $ +$Id: uxio.c,v 1.48 2003/01/22 02:04:13 cph Exp $ -Copyright (c) 1990-2001 Massachusetts Institute of Technology +Copyright 1990,1991,1992,1993,1994,1995 Massachusetts Institute of Technology +Copyright 1996,1997,1998,2000,2001,2003 Massachusetts Institute of Technology This file is part of MIT Scheme. @@ -303,7 +304,7 @@ DEFUN (OS_channel_nonblocking, (channel), Tchannel channel) sets driver's FIONBIO flag for FNDELAY, but not FNBLOCK. Note that driver will return EWOULDBLOCK, rather than EAGAIN. */ int true = 1; - ioctl(fd,FIONBIO,&true); + ioctl (fd, FIONBIO, (&true)); } #endif (CHANNEL_NONBLOCKING (channel)) = 1; @@ -350,9 +351,391 @@ DEFUN (OS_channel_blocking, (channel), Tchannel channel) #ifdef HAVE_POLL -/* poll(2) */ +CONST int OS_have_select_p = 1; + +struct select_registry_s +{ + unsigned int length; + unsigned int n_fds; + struct pollfd * entries; +}; + +#define MIN_SR_LENGTH 4 +#define SR_BYTES(length) ((sizeof (struct pollfd)) * (length)) + +#define SR_LENGTH(r) ((r) -> length) +#define SR_N_FDS(r) ((r) -> n_fds) +#define SR_ENTRIES(r) ((r) -> entries) +#define SR_ENTRY(r, i) ((SR_ENTRIES (r)) + (i)) + +#define DECODE_MODE(mode) \ +(((((mode) & SELECT_MODE_READ) != 0) ? POLLIN : 0) \ + | ((((mode) & SELECT_MODE_WRITE) != 0) ? POLLOUT : 0)) + +#define ENCODE_MODE(revents) \ +(((((revents) & POLLIN) != 0) ? SELECT_MODE_READ : 0) \ + | ((((revents) & POLLOUT) != 0) ? SELECT_MODE_WRITE : 0)) + +select_registry_t +DEFUN_VOID (OS_allocate_select_registry) +{ + struct select_registry_s * r + = (UX_malloc (sizeof (struct select_registry_s))); + (SR_LENGTH (r)) = MIN_SR_LENGTH; + (SR_N_FDS (r)) = 0; + (SR_ENTRIES (r)) = (UX_malloc (SR_BYTES (MIN_SR_LENGTH))); + return (r); +} + +void +DEFUN (OS_deallocate_select_registry, (registry), select_registry_t registry) +{ + struct select_registry_s * r = registry; + UX_free (SR_ENTRIES (r)); + UX_free (r); +} + +void +DEFUN (OS_add_to_select_registry, (registry, fd, mode), + select_registry_t registry AND + int fd AND + unsigned int mode) +{ + struct select_registry_s * r = registry; + unsigned int i = 0; + while (i < (SR_N_FDS (r))) + { + if (((SR_ENTRY (r, i)) -> fd) == fd) + { + ((SR_ENTRY (r, i)) -> events) |= (DECODE_MODE (mode)); + return; + } + i += 1; + } + if (i == (SR_LENGTH (r))) + { + unsigned int length = ((SR_LENGTH (r)) * 2); + (SR_ENTRIES (r)) = (UX_realloc ((SR_ENTRIES (r)), (SR_BYTES (length)))); + (SR_LENGTH (r)) = length; + } + ((SR_ENTRY (r, i)) -> fd) = fd; + ((SR_ENTRY (r, i)) -> events) = (DECODE_MODE (mode)); + (SR_N_FDS (r)) += 1; +} + +void +DEFUN (OS_remove_from_select_registry, (registry, fd, mode), + select_registry_t registry AND + int fd AND + unsigned int mode) +{ + struct select_registry_s * r = registry; + unsigned int i = 0; + while (1) + { + if (i == (SR_N_FDS (r))) + return; + if (((SR_ENTRY (r, i)) -> fd) == fd) + { + ((SR_ENTRY (r, i)) -> events) &=~ (DECODE_MODE (mode)); + if (((SR_ENTRY (r, i)) -> events) == 0) + break; + return; + } + i += 1; + } + (SR_N_FDS (r)) -= 1; + while (i < (SR_N_FDS (r))) + { + (* (SR_ENTRY (r, i))) = (* (SR_ENTRY (r, (i + 1)))); + i += 1; + } + if ((i < ((SR_LENGTH (r)) / 2)) + && ((SR_LENGTH (r)) > MIN_SR_LENGTH)) + { + unsigned int length = ((SR_LENGTH (r)) / 2); + (SR_ENTRIES (r)) = (UX_realloc ((SR_ENTRIES (r)), (SR_BYTES (length)))); + (SR_LENGTH (r)) = length; + } +} + +unsigned int +DEFUN (OS_select_registry_length, (registry), + select_registry_t registry) +{ + struct select_registry_s * r = registry; + return (SR_N_FDS (r)); +} + +void +DEFUN (OS_select_registry_result, (registry, index), + select_registry_t registry AND + unsigned int index AND + int * fd_r AND + unsigned int * mode_r) +{ + struct select_registry_s * r = registry; + (*fd_r) = ((SR_ENTRY (r, index)) -> fd); + (*mode_r) = (ENCODE_MODE ((SR_ENTRY (r, index)) -> revents)); +} + +int +DEFUN (OS_test_select_registry, (registry, blockp), + select_registry_t registry AND + int blockp) +{ + struct select_registry_s * r = registry; + while (1) + { + int nfds + = (poll ((SR_ENTRIES (r)), + (SR_N_FDS (r)), + (blockp ? INFTIM : 0))); + if (nfds >= 0) + return (nfds); + if (errno != EINTR) + error_system_call (errno, syscall_select); + if (OS_process_any_status_change ()) + return (SELECT_PROCESS_STATUS_CHANGE); + if (pending_interrupts_p ()) + return (SELECT_INTERRUPT); + } +} + +int +DEFUN (OS_test_select_descriptor, (fd, blockp, mode), + int fd AND + int blockp AND + unsigned int mode) +{ + struct pollfd pfds [1]; + ((pfds [0]) . fd) = fd; + ((pfds [0]) . events) = (DECODE_MODE (mode)); + while (1) + { + int nfds = (poll (pfds, 1, (blockp ? INFTIM : 0))); + if (nfds > 0) + return (ENCODE_MODE ((pfds [0]) . revents)); + if (nfds == 0) + return (0); + if (errno != EINTR) + error_system_call (errno, syscall_select); + if (OS_process_any_status_change ()) + return (SELECT_PROCESS_STATUS_CHANGE); + if (pending_interrupts_p ()) + return (SELECT_INTERRUPT); + } +} +#else /* not HAVE_POLL */ + +#ifdef HAVE_SELECT CONST int OS_have_select_p = 1; +#else +CONST int OS_have_select_p = 0; +#endif + +struct select_registry_s +{ + SELECT_TYPE qreaders; + SELECT_TYPE qwriters; + SELECT_TYPE rreaders; + SELECT_TYPE rwriters; + unsigned int n_fds; +}; + +#define SR_QREADERS(r) (& ((r) -> qreaders)) +#define SR_QWRITERS(r) (& ((r) -> qwriters)) +#define SR_RREADERS(r) (& ((r) -> rreaders)) +#define SR_RWRITERS(r) (& ((r) -> rwriters)) +#define SR_N_FDS(r) ((r) -> n_fds) + +#define SR_FD_ISSET(fd, r) \ +((FD_ISSET ((fd), (SR_QREADERS (r)))) \ + || (FD_ISSET ((fd), (SR_QWRITERS (r))))) + +#define SR_RMODE(r, fd) \ +(((FD_ISSET ((fd), (SR_RREADERS (r)))) ? SELECT_MODE_READ : 0) \ + | ((FD_ISSET ((fd), (SR_RWRITERS (r)))) ? SELECT_MODE_WRITE : 0)) + +select_registry_t +DEFUN_VOID (OS_allocate_select_registry) +{ + struct select_registry_s * r + = (UX_malloc (sizeof (struct select_registry_s))); + FD_ZERO (SR_QREADERS (r)); + FD_ZERO (SR_QWRITERS (r)); + FD_ZERO (SR_RREADERS (r)); + FD_ZERO (SR_RWRITERS (r)); + (SR_N_FDS (r)) = 0; + return (r); +} + +void +DEFUN (OS_deallocate_select_registry, (registry), select_registry_t registry) +{ + struct select_registry_s * r = registry; + UX_free (r); +} + +void +DEFUN (OS_add_to_select_registry, (registry, fd, mode), + select_registry_t registry AND + int fd AND + unsigned int mode) +{ + struct select_registry_s * r = registry; + int was_set = (SR_FD_ISSET (fd, r)); + if ((mode & SELECT_MODE_READ) != 0) + FD_SET (fd, (SR_QREADERS (r))); + if ((mode & SELECT_MODE_WRITE) != 0) + FD_SET (fd, (SR_QWRITERS (r))); + if ((!was_set) && (SR_FD_ISSET (fd, r))) + (SR_N_FDS (r)) += 1; +} + +void +DEFUN (OS_remove_from_select_registry, (registry, fd, mode), + select_registry_t registry AND + int fd AND + unsigned int mode) +{ + struct select_registry_s * r = registry; + int was_set = (SR_FD_ISSET (fd, r)); + if ((mode & SELECT_MODE_READ) != 0) + FD_CLR (fd, (SR_QREADERS (r))); + if ((mode & SELECT_MODE_WRITE) != 0) + FD_CLR (fd, (SR_QWRITERS (r))); + if (was_set && (!SR_FD_ISSET (fd, r))) + (SR_N_FDS (r)) -= 1; +} + +unsigned int +DEFUN (OS_select_registry_length, (registry), + select_registry_t registry) +{ + struct select_registry_s * r = registry; + return (SR_N_FDS (r)); +} + +void +DEFUN (OS_select_registry_result, (registry, index), + select_registry_t registry AND + unsigned int index AND + int * fd_r AND + unsigned int * mode_r) +{ + struct select_registry_s * r = registry; + unsigned int i = 0; + int fd; + + while (fd = 0; (fd < FD_SETSIZE); fd += 1) + { + if (SR_FD_ISSET (fd, r)) + { + if (i < index) + i += 1; + else + { + (*fd_r) = fd; + (*mode_r) = (SR_RMODE (r, fd)); + return; + } + } + } +} + +int +DEFUN (OS_test_select_registry, (registry, blockp), + select_registry_t registry AND + int blockp) +{ +#ifdef HAVE_SELECT + struct select_registry_s * r = registry; + while (1) + { + int nfds; + + (* (SR_RREADERS (r))) = (* (SR_QREADERS (r))); + (* (SR_RWRITERS (r))) = (* (SR_QWRITERS (r))); + INTERRUPTABLE_EXTENT + (nfds, + ((OS_process_any_status_change ()) + ? ((errno = EINTR), (-1)) + : (UX_select (FD_SETSIZE, + (SR_RREADERS (r)), + (SR_RWRITERS (r)), + 0, + (blockp ? 0 : (&zero_timeout)))))); + if (nfds >= 0) + return (nfds); + if (errno != EINTR) + error_system_call (errno, syscall_select); + if (OS_process_any_status_change ()) + return (SELECT_PROCESS_STATUS_CHANGE); + if (pending_interrupts_p ()) + return (SELECT_INTERRUPT); + } +#else + error_system_call (ENOSYS, syscall_select); + return (1); +#endif +} + +int +DEFUN (OS_test_select_descriptor, (fd, blockp, mode), + int fd AND + int blockp AND + unsigned int mode) +{ +#ifdef HAVE_SELECT + while (1) + { + SELECT_TYPE readable; + SELECT_TYPE writeable; + int nfds; + + FD_ZERO (&readable); + if ((mode & SELECT_MODE_READ) != 0) + FD_SET (fd, (&readable)); + + FD_ZERO (&writeable); + if ((mode & SELECT_MODE_WRITE) != 0) + FD_SET (fd, (&writeable)); + + INTERRUPTABLE_EXTENT + (nfds, + ((OS_process_any_status_change ()) + ? ((errno = EINTR), (-1)) + : (UX_select (1, + (&readable), + (&writeable), + 0, + (blockp ? 0 : (&zero_timeout)))))); + if (nfds > 0) + return + (((FD_ISSET (fd, (&readable))) ? SELECT_MODE_READ : 0) + | ((FD_ISSET (fd, (&writeable))) ? SELECT_MODE_WRITE : 0)); + if (nfds == 0) + return (0); + if (errno != EINTR) + error_system_call (errno, syscall_select); + if (OS_process_any_status_change ()) + return (SELECT_PROCESS_STATUS_CHANGE); + if (pending_interrupts_p ()) + return (SELECT_INTERRUPT); + } +#else + error_system_call (ENOSYS, syscall_select); + return (1); +#endif +} + +#endif /* not HAVE_POLL */ + +#ifdef HAVE_POLL + +/* poll(2) */ unsigned int DEFUN_VOID (UX_select_registry_size) @@ -517,12 +900,6 @@ DEFUN (UX_select_input, (fd, blockp), int fd AND int blockp) /* select(2) */ -#ifdef HAVE_SELECT -CONST int OS_have_select_p = 1; -#else -CONST int OS_have_select_p = 0; -#endif - unsigned int DEFUN_VOID (UX_select_registry_size) { diff --git a/v7/src/microcode/version.h b/v7/src/microcode/version.h index bf9fc7d35..f8d099b61 100644 --- a/v7/src/microcode/version.h +++ b/v7/src/microcode/version.h @@ -1,8 +1,10 @@ /* -*-C-*- -$Id: version.h,v 11.186 2002/11/20 19:46:16 cph Exp $ +$Id: version.h,v 11.187 2003/01/22 02:04:19 cph Exp $ -Copyright (c) 1988-2002 Massachusetts Institute of Technology +Copyright 1986,1987,1988,1989,1990,1991 Massachusetts Institute of Technology +Copyright 1993,1994,1995,1996,1997,1999 Massachusetts Institute of Technology +Copyright 2000,2001,2002,2003 Massachusetts Institute of Technology This file is part of MIT Scheme. @@ -36,5 +38,5 @@ Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. # define SCHEME_VERSION 14 #endif #ifndef SCHEME_SUBVERSION -# define SCHEME_SUBVERSION 10 +# define SCHEME_SUBVERSION 11 #endif