These changes affect any code using the SELECT-REGISTRY-TEST

primitive.  Runtime 14.161 requires this microcode revision or later,
but older bands can run over this microcode.

* Change interface to SELECT-REGISTRY-TEST.  Order or second and third
  arguments is reversed.  Third argument is changed from a select
  registry to a vector.  Primitive returns a nonnegative integer
  indicating the number of descriptors that were stored in the vector,
  or a negative integer indicating that nothing is stored and that
  another interesting condition holds.

* Add new primitive SELECT-DESCRIPTOR, a simplified version of
  SELECT-REGISTRY-TEST that works for a single descriptor and does not
  require consing in the interface.

diff --git a/v7/src/microcode/pruxio.c b/v7/src/microcode/pruxio.c
index fda974b80711b5d43a0e5b217b995fa6d01eeb07..b97daa4815e8eaf5a770a4d25162c8a5a01ac695 100644 (file)
--- a/v7/src/microcode/pruxio.c
+++ b/v7/src/microcode/pruxio.c
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Id: pruxio.c,v 1.3 1993/04/06 22:18:19 cph Exp $
+$Id: pruxio.c,v 1.4 1993/04/27 08:38:14 cph Exp $
 
 Copyright (c) 1993 Massachusetts Institute of Technology
 
@@ -37,6 +37,7 @@ MIT in each case. */
 #include "scheme.h"
 #include "prims.h"
 #include "osio.h"
+#include "ux.h"
 #include "uxselect.h"
 
 #ifndef __hp9000s700
@@ -57,61 +58,102 @@ DEFINE_PRIMITIVE ("SELECT-REGISTRY-LUB", Prim_selreg_lub, 0, 0, 0)
   PRIMITIVE_RETURN (long_to_integer (UX_select_registry_lub ()));
 }
 
-DEFINE_PRIMITIVE ("SELECT-REGISTRY-CLEAR-ALL", Prim_selreg_clear_all,
-                 1, 1, 0)
+DEFINE_PRIMITIVE ("SELECT-REGISTRY-CLEAR-ALL", Prim_selreg_clear_all, 1, 1, 0)
 {
   PRIMITIVE_HEADER (1);
   UX_select_registry_clear_all (STRING_ARG (1));
   PRIMITIVE_RETURN (UNSPECIFIC);
 }
 
-DEFINE_PRIMITIVE ("SELECT-REGISTRY-SET", Prim_selreg_set,
-                 2, 2, 0)
+DEFINE_PRIMITIVE ("SELECT-REGISTRY-SET", Prim_selreg_set, 2, 2, 0)
 {
   PRIMITIVE_HEADER (2);
-  UX_select_registry_set ((STRING_ARG (1)), (arg_integer (2)));
+  UX_select_registry_set ((STRING_ARG (1)), (arg_nonnegative_integer (2)));
   PRIMITIVE_RETURN (UNSPECIFIC);
 }
 
-DEFINE_PRIMITIVE ("SELECT-REGISTRY-CLEAR", Prim_selreg_clear,
-                 2, 2, 0)
+DEFINE_PRIMITIVE ("SELECT-REGISTRY-CLEAR", Prim_selreg_clear, 2, 2, 0)
 {
   PRIMITIVE_HEADER (2);
-  UX_select_registry_clear ((STRING_ARG (1)), (arg_integer (2)));
+  UX_select_registry_clear ((STRING_ARG (1)), (arg_nonnegative_integer (2)));
   PRIMITIVE_RETURN (UNSPECIFIC);
 }
 
-DEFINE_PRIMITIVE ("SELECT-REGISTRY-IS-SET?", Prim_selreg_is_set_p,
-                 2, 2, 0)
+DEFINE_PRIMITIVE ("SELECT-REGISTRY-IS-SET?", Prim_selreg_is_set_p, 2, 2, 0)
 {
   PRIMITIVE_HEADER (2);
   PRIMITIVE_RETURN
-    ((BOOLEAN_TO_OBJECT
-      (UX_select_registry_is_set ((STRING_ARG (1)), (arg_integer (2))))));
+    (BOOLEAN_TO_OBJECT
+     (UX_select_registry_is_set
+      ((STRING_ARG (1)), (arg_nonnegative_integer (2)))));
 }
 
-DEFINE_PRIMITIVE ("SELECT-REGISTRY-TEST", Prim_selreg_test,
-                 3, 3, 0)
+DEFINE_PRIMITIVE ("CHANNEL-DESCRIPTOR", Prim_channel_descriptor, 1, 1, 0)
 {
-  PRIMITIVE_HEADER (3);
-  switch (UX_select_registry_test ((STRING_ARG (1)), (STRING_ARG (2)),
-                                  (BOOLEAN_ARG (3))))
+  PRIMITIVE_HEADER (1);
+  PRIMITIVE_RETURN (long_to_integer (UX_channel_descriptor (arg_channel (1))));
+}
+\f
+DEFINE_PRIMITIVE ("SELECT-DESCRIPTOR", Prim_select_descriptor, 2, 2, 0)
+{
+  PRIMITIVE_HEADER (2);
+  switch (UX_select_descriptor ((arg_nonnegative_integer (1)),
+                               (BOOLEAN_ARG (2))))
     {
     case select_input_none:
       PRIMITIVE_RETURN (LONG_TO_UNSIGNED_FIXNUM (0));
     case select_input_argument:
       PRIMITIVE_RETURN (LONG_TO_UNSIGNED_FIXNUM (1));
     case select_input_process_status:
-      PRIMITIVE_RETURN (LONG_TO_UNSIGNED_FIXNUM (2));
+      PRIMITIVE_RETURN (LONG_TO_FIXNUM (-1));
     case select_input_interrupt:
-      PRIMITIVE_RETURN (LONG_TO_UNSIGNED_FIXNUM (3));
+      PRIMITIVE_RETURN (LONG_TO_FIXNUM (-2));
     default:
       error_external_return ();
+      PRIMITIVE_RETURN (UNSPECIFIC);
     }
 }
 
-DEFINE_PRIMITIVE ("CHANNEL-DESCRIPTOR", Prim_channel_descriptor, 1, 1, 0)
+DEFINE_PRIMITIVE ("SELECT-REGISTRY-TEST", Prim_selreg_test, 3, 3, 0)
 {
-  PRIMITIVE_HEADER (1);
-  PRIMITIVE_RETURN (long_to_integer (UX_channel_descriptor (arg_channel (1))));
+  PRIMITIVE_HEADER (3);
+  CHECK_ARG (3, VECTOR_P);
+  {
+    PTR position = dstack_position;
+    unsigned int lub = (UX_select_registry_lub ());
+    unsigned int * fds = (dstack_alloc ((sizeof (unsigned int)) * lub));
+    unsigned int nfds;
+    SCHEME_OBJECT result;
+
+    if ((VECTOR_LENGTH (ARG_REF (3))) != lub)
+      error_bad_range_arg (3);
+    switch (UX_select_registry_test ((STRING_ARG (1)), (BOOLEAN_ARG (2)),
+                                    fds, (&nfds)))
+      {
+      case select_input_none:
+       result = (LONG_TO_UNSIGNED_FIXNUM (0));
+       break;
+      case select_input_argument:
+       {
+         unsigned int * scan_fds = fds;
+         unsigned int * end_fds = (scan_fds + nfds);
+         SCHEME_OBJECT * scan_vector = (VECTOR_LOC ((ARG_REF (3)), 0));
+         while (scan_fds < end_fds)
+           (*scan_vector++) = (LONG_TO_UNSIGNED_FIXNUM (*scan_fds++));
+       }
+       result = (LONG_TO_UNSIGNED_FIXNUM (nfds));
+       break;
+      case select_input_process_status:
+       result = (LONG_TO_FIXNUM (-1));
+       break;
+      case select_input_interrupt:
+       result = (LONG_TO_FIXNUM (-2));
+       break;
+      default:
+       error_external_return ();
+       break;
+      }
+    dstack_set_position (position);
+    PRIMITIVE_RETURN (result);
+  }
 }

diff --git a/v7/src/microcode/uxio.c b/v7/src/microcode/uxio.c
index f4ef01f4fee343e9a55bc7f3755aba2a95f3e4e5..998ad851815d5e802009eb9598916f6bf5db3ecd 100644 (file)
--- a/v7/src/microcode/uxio.c
+++ b/v7/src/microcode/uxio.c
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Id: uxio.c,v 1.25 1993/04/06 22:18:45 cph Exp $
+$Id: uxio.c,v 1.26 1993/04/27 08:38:14 cph Exp $
 
 Copyright (c) 1990-93 Massachusetts Institute of Technology
 
@@ -421,10 +421,11 @@ DEFUN (UX_select_registry_is_set, (fds, fd), PTR fds AND unsigned int fd)
 }
 \f
 enum select_input
-DEFUN (UX_select_registry_test, (input_fds, output_fds, blockp),
+DEFUN (UX_select_registry_test, (input_fds, blockp, output_fds, output_nfds),
        PTR input_fds AND
-       PTR output_fds AND
-       int blockp)
+       int blockp AND
+       unsigned int * output_fds AND
+       unsigned int * output_nfds)
 {
 #ifdef HAVE_SELECT
   while (1)
@@ -447,7 +448,20 @@ DEFUN (UX_select_registry_test, (input_fds, output_fds, blockp),
                         : (&zero_timeout))))));
       if (nfds > 0)
        {
-         (* ((SELECT_TYPE *) output_fds)) = readable;
+         unsigned int i = 0;
+         if (output_nfds != 0)
+           (*output_nfds) = nfds;
+         if (output_fds != 0)
+           while (1)
+             {
+               if (FD_ISSET (i, (&readable)))
+                 {
+                   (*output_fds++) = i;
+                   if ((--nfds) == 0)
+                     break;
+                 }
+               i += 1;
+             }
          return (select_input_argument);
        }
       else if (nfds == 0)
@@ -467,6 +481,23 @@ DEFUN (UX_select_registry_test, (input_fds, output_fds, blockp),
   return (select_input_argument);
 #endif
 }
+
+enum select_input
+DEFUN (UX_select_descriptor, (fd, blockp),
+       unsigned int fd AND
+       int blockp)
+{
+#ifdef HAVE_SELECT
+  SELECT_TYPE readable;
+
+  FD_ZERO (&readable);
+  FD_SET (fd, (&readable));
+  return (UX_select_registry_test ((&readable), blockp, 0, 0));
+#else
+  error_system_call (ENOSYS, syscall_select);
+  return (select_input_argument);
+#endif
+}
 \f
 /* Old Global Registry Mechanism */
 

diff --git a/v7/src/microcode/uxselect.h b/v7/src/microcode/uxselect.h
index 1f589e43f7d500cde0eb7e72257944064190f84e..20a4f3971b61c15e87009329aa658d92ab87921d 100644 (file)
--- a/v7/src/microcode/uxselect.h
+++ b/v7/src/microcode/uxselect.h
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Id: uxselect.h,v 1.4 1993/04/06 22:18:54 cph Exp $
+$Id: uxselect.h,v 1.5 1993/04/27 08:38:15 cph Exp $
 
 Copyright (c) 1991-93 Massachusetts Institute of Technology
 
@@ -52,6 +52,10 @@ extern void EXFUN (UX_select_registry_set, (PTR fds, unsigned int fd));
 extern void EXFUN (UX_select_registry_clear, (PTR fds, unsigned int fd));
 extern int EXFUN (UX_select_registry_is_set, (PTR fds, unsigned int fd));
 extern enum select_input EXFUN
-  (UX_select_registry_test, (PTR input_fds, PTR output_fds, int blockp));
+  (UX_select_registry_test,
+   (PTR input_fds, int blockp,
+    unsigned int * output_fds, unsigned int * output_nfds));
+extern enum select_input EXFUN
+  (UX_select_descriptor, (unsigned int fd, int blockp));
 
 #endif /* SCM_UXSELECT_H */

diff --git a/v7/src/microcode/version.h b/v7/src/microcode/version.h
index 007673e6492dccc5894249d96f348db70e41599d..291ad1954bc383a0453af6c62a75eb40c6595ac3 100644 (file)
--- a/v7/src/microcode/version.h
+++ b/v7/src/microcode/version.h
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Id: version.h,v 11.130 1993/04/06 22:23:35 cph Exp $
+$Id: version.h,v 11.131 1993/04/27 08:38:15 cph Exp $
 
 Copyright (c) 1988-1993 Massachusetts Institute of Technology
 
@@ -46,5 +46,5 @@ MIT in each case. */
 #define VERSION                11
 #endif
 #ifndef SUBVERSION
-#define SUBVERSION     130
+#define SUBVERSION     131
 #endif

diff --git a/v7/src/microcode/x11base.c b/v7/src/microcode/x11base.c
index 8e6ad848b940d9fd1e21c4cb1c529e982ebda043..9137b7226fe7158cdaafcf5df654d4e5d55be166 100644 (file)
--- a/v7/src/microcode/x11base.c
+++ b/v7/src/microcode/x11base.c
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Id: x11base.c,v 1.48 1993/04/06 22:18:36 cph Exp $
+$Id: x11base.c,v 1.49 1993/04/27 08:38:16 cph Exp $
 
 Copyright (c) 1989-93 Massachusetts Institute of Technology
 
@@ -1135,6 +1135,13 @@ DEFUN (xd_process_events, (xd, non_block_p, use_select_p),
 {
   Display * display = (XD_DISPLAY (xd));
   unsigned int events_queued;
+  SCHEME_OBJECT result;
+  if (x_debug)
+    {
+      fprintf (stderr, "Enter xd_process_events (%s)\n",
+              (non_block_p ? "non-blocking" : "blocking"));
+      fflush (stderr);
+    }
   if (!OS_have_select_p)
     use_select_p = 0;
   if (XD_CACHED_EVENT_P (xd))
@@ -1163,20 +1170,23 @@ DEFUN (xd_process_events, (xd, non_block_p, use_select_p),
                                     (!non_block_p)))
              {
              case select_input_none:
-               return (SHARP_F);
+               result = SHARP_F; goto done;
              case select_input_other:
-               return (LONG_TO_FIXNUM (-2));
+               result = (LONG_TO_FIXNUM (-2)); goto done;
              case select_input_process_status:
-               return (LONG_TO_FIXNUM (-3));
+               result = (LONG_TO_FIXNUM (-3)); goto done;
              case select_input_interrupt:
-               return (LONG_TO_FIXNUM (-4));
+               result = (LONG_TO_FIXNUM (-4)); goto done;
              case select_input_argument:
                ping_server (xd);
                events_queued = (XEventsQueued (display, QueuedAfterReading));
                continue;
              }
          else if (non_block_p)
-           return (SHARP_F);
+           {
+             result = SHARP_F;
+             goto done;
+           }
          ping_server (xd);
        }
       XNextEvent (display, (&event));
@@ -1191,13 +1201,25 @@ DEFUN (xd_process_events, (xd, non_block_p, use_select_p),
       (XD_CACHED_EVENT (xd)) = event;
       (XD_CACHED_EVENT_P (xd)) = 1;
     restart:
-      {
-       SCHEME_OBJECT result = (x_event_to_object (&event));
-       (XD_CACHED_EVENT_P (xd)) = 0;
-       if (result != SHARP_F)
-         return (result);
-      }
+      result = (x_event_to_object (&event));
+      (XD_CACHED_EVENT_P (xd)) = 0;
+      if (result != SHARP_F)
+       goto done;
     }
+ done:
+  if (x_debug)
+    {
+      fprintf (stderr, "Return from xd_process_events: ");
+      if (result == SHARP_F)
+       fprintf (stderr, "#f");
+      else if (FIXNUM_P (result))
+       fprintf (stderr, "%d", (FIXNUM_TO_LONG (result)));
+      else
+       fprintf (stderr, "[vector]");
+      fprintf (stderr, "\n");
+      fflush (stderr);
+    }
+  return (result);
 }
 \f
 /* Open/Close Primitives */

diff --git a/v8/src/microcode/version.h b/v8/src/microcode/version.h
index 007673e6492dccc5894249d96f348db70e41599d..291ad1954bc383a0453af6c62a75eb40c6595ac3 100644 (file)
--- a/v8/src/microcode/version.h
+++ b/v8/src/microcode/version.h
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Id: version.h,v 11.130 1993/04/06 22:23:35 cph Exp $
+$Id: version.h,v 11.131 1993/04/27 08:38:15 cph Exp $
 
 Copyright (c) 1988-1993 Massachusetts Institute of Technology
 
@@ -46,5 +46,5 @@ MIT in each case. */
 #define VERSION                11
 #endif
 #ifndef SUBVERSION
-#define SUBVERSION     130
+#define SUBVERSION     131
 #endif