add `port-closed-evt'

collects/scribblings/reference/evts.scrbl

@@ -74,6 +74,10 @@ generate events (see @racket[prop:evt]).
  @racket[write-bytes-avail*] can flush part of the buffer (although
  @racket[write-bytes-avail] might block). @ResultItself[_output-port].}
 
+ @item{@racket[_closed] --- an event produced by
+ @racket[port-closed-evt] applied to @racket[_port] is ready after
+ @racket[_port] is closed. @ResultItself[_closed].}
+
  @item{@racket[_progress] --- an event produced by
  @racket[port-progress-evt] applied to @racket[_input-port] is ready after
  any subsequent read from @racket[_input-port]. @ResultItself[_progress].}

collects/scribblings/reference/port-procs.scrbl

@@ -29,6 +29,10 @@ already closed, @racket[close-output-port] has no effect.}
 Returns @racket[#t] if the input or output port @racket[port] is
 closed, @racket[#f] otherwise.}
 
+@defproc[(port-closed-evt [port port?]) evt?]{
+Return a @tech{synchronizable event} that becomes ready when @racket[port] is 
+closed.}
+
 @defparam[current-input-port in input-port?]{A parameter that
 determines a default input port for many operations, such as
 @racket[read].}

collects/scribblings/reference/string-input.scrbl

@@ -329,7 +329,7 @@ like @racket[peek-bytes-avail!].}
 @defproc[(port-progress-evt [in input-port? (current-input-port)])
          evt?]{
 
-Returns an event that becomes ready after any subsequent read from
+Returns a @tech{synchronizable event} that becomes ready after any subsequent read from
 @racket[in], or after @racket[in] is closed. After the event becomes
 ready, it remains ready.  If progress events are unavailable for
 @racket[in] (as reported by @racket[port-provides-progress-evts?]), then the

collects/tests/racket/port.rktl

@@ -695,6 +695,28 @@
   (check-all void)
   (check-all port-count-lines!))
 
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; port-closed events
+
+(let ()
+  (define-values (i o) (make-pipe))
+  (define ic (port-closed-evt i))
+  (define oc (port-closed-evt o))
+  (test #f sync/timeout 0 ic oc)
+  (define t (thread (lambda () (sync ic))))
+  (sync (system-idle-evt))
+  (test #f sync/timeout 0 ic oc t)
+  (close-input-port i)
+  (test t sync t)
+  (test ic sync/timeout 0 ic oc)
+  (test #f sync/timeout 0 oc)
+  (define t2 (thread (lambda () (sync oc))))
+  (sync (system-idle-evt))
+  (test #f sync/timeout 0 oc t2)
+  (close-output-port o)
+  (test t2 sync t2)
+  (test oc sync/timeout 0 oc))
+
 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (report-errs)

doc/release-notes/racket/HISTORY.txt

@@ -1,3 +1,7 @@
+Version 5.2.2
+Added port-closed-evt
+Changed I/O scheduling to use epoll()/kqueue() when available
+
 Version 5.2, November 2011
 Generalized begin-with-syntax to allow phase-N definitions,
  both variable and syntax, within a module for all N >= 0;

src/racket/include/scheme.h

@@ -1377,6 +1377,7 @@ struct Scheme_Input_Port
   char slow; /* 0 => no line count, no ungotten, etc.: can call get_string_fun directly */
   char closed, pending_eof;
   Scheme_Object *sub_type;
+  Scheme_Object *closed_evt;
   Scheme_Custodian_Reference *mref;
   void *port_data;
   Scheme_Get_String_Fun get_string_fun;
@@ -1402,6 +1403,7 @@ struct Scheme_Output_Port
   struct Scheme_Port p;
   short closed;
   Scheme_Object *sub_type;
+  Scheme_Object *closed_evt;
   Scheme_Custodian_Reference *mref;
   void *port_data;
   Scheme_Write_String_Evt_Fun write_string_evt_fun;

src/racket/src/mzmark_type.inc

@@ -1544,6 +1544,7 @@ static int input_port_MARK(void *p, struct NewGC *gc) {
   gcMARK2(ip->peeked_read, gc);
   gcMARK2(ip->peeked_write, gc);
   gcMARK2(ip->read_handler, gc);
+  gcMARK2(ip->closed_evt, gc);
   gcMARK2(ip->mref, gc);
   gcMARK2(ip->output_half, gc);
   gcMARK2(ip->special, gc);
@@ -1569,6 +1570,7 @@ static int input_port_FIXUP(void *p, struct NewGC *gc) {
   gcFIXUP2(ip->peeked_read, gc);
   gcFIXUP2(ip->peeked_write, gc);
   gcFIXUP2(ip->read_handler, gc);
+  gcFIXUP2(ip->closed_evt, gc);
   gcFIXUP2(ip->mref, gc);
   gcFIXUP2(ip->output_half, gc);
   gcFIXUP2(ip->special, gc);
@@ -1603,6 +1605,7 @@ static int output_port_MARK(void *p, struct NewGC *gc) {
   gcMARK2(op->display_handler, gc);
   gcMARK2(op->write_handler, gc);
   gcMARK2(op->print_handler, gc);
+  gcMARK2(op->closed_evt, gc);
   gcMARK2(op->mref, gc);
   gcMARK2(op->input_half, gc);
 
@@ -1619,6 +1622,7 @@ static int output_port_FIXUP(void *p, struct NewGC *gc) {
   gcFIXUP2(op->display_handler, gc);
   gcFIXUP2(op->write_handler, gc);
   gcFIXUP2(op->print_handler, gc);
+  gcFIXUP2(op->closed_evt, gc);
   gcFIXUP2(op->mref, gc);
   gcFIXUP2(op->input_half, gc);
 

src/racket/src/mzmarksrc.c

@@ -595,6 +595,7 @@ input_port {
   gcMARK2(ip->peeked_read, gc);
   gcMARK2(ip->peeked_write, gc);
   gcMARK2(ip->read_handler, gc);
+  gcMARK2(ip->closed_evt, gc);
   gcMARK2(ip->mref, gc);
   gcMARK2(ip->output_half, gc);
   gcMARK2(ip->special, gc);
@@ -621,6 +622,7 @@ output_port {
   gcMARK2(op->display_handler, gc);
   gcMARK2(op->write_handler, gc);
   gcMARK2(op->print_handler, gc);
+  gcMARK2(op->closed_evt, gc);
   gcMARK2(op->mref, gc);
   gcMARK2(op->input_half, gc);
 

src/racket/src/port.c

@@ -434,6 +434,7 @@ static int rw_evt_ready(Scheme_Object *rww, Scheme_Schedule_Info *sinfo);
 static void rw_evt_wakeup(Scheme_Object *rww, void *fds);
 
 static int progress_evt_ready(Scheme_Object *rww, Scheme_Schedule_Info *sinfo);
+static int closed_evt_ready(Scheme_Object *rww, Scheme_Schedule_Info *sinfo);
 
 static Scheme_Object *
 _scheme_make_named_file_input_port(FILE *fp, Scheme_Object *name, int regfile);
@@ -613,9 +614,9 @@ scheme_init_port (Scheme_Env *env)
 
   scheme_add_global_constant("shell-execute", scheme_make_prim_w_arity(sch_shell_execute, "shell-execute", 5, 5), env);
 
-
   scheme_add_evt(scheme_progress_evt_type, (Scheme_Ready_Fun)progress_evt_ready, NULL, NULL, 1);
   scheme_add_evt(scheme_write_evt_type, (Scheme_Ready_Fun)rw_evt_ready, rw_evt_wakeup, NULL, 1);
+  scheme_add_evt(scheme_port_closed_evt_type, (Scheme_Ready_Fun)closed_evt_ready, NULL, NULL, 1);
 }
 
 void scheme_init_port_places(void)
@@ -2918,6 +2919,12 @@ static int progress_evt_ready(Scheme_Object *evt, Scheme_Schedule_Info *sinfo)
   return 0;
 }
 
+static int closed_evt_ready(Scheme_Object *evt, Scheme_Schedule_Info *sinfo)
+{
+  scheme_set_sync_target(sinfo, SCHEME_PTR_VAL(evt), evt, NULL, 0, 1, NULL);
+  return 0;
+}
+
 intptr_t scheme_get_char_string(const char *who,
 			    Scheme_Object *port,
 			    mzchar *buffer, intptr_t offset, intptr_t size,
@@ -4004,6 +4011,8 @@ scheme_close_input_port (Scheme_Object *port)
     ip->slow = 1;
     ip->ungotten_count = 0;
     ip->ungotten_special = NULL;
+    if (ip->closed_evt)
+      scheme_post_sema_all(SCHEME_PTR_VAL(ip->closed_evt));
   }
 }
 
@@ -4151,6 +4160,8 @@ scheme_close_output_port(Scheme_Object *port)
     }
     
     op->closed = 1;
+    if (op->closed_evt)
+      scheme_post_sema_all(SCHEME_PTR_VAL(op->closed_evt));
   }
 }
 

src/racket/src/portfun.c

@@ -88,6 +88,7 @@ static Scheme_Object *char_ready_p (int, Scheme_Object *[]);
 static Scheme_Object *byte_ready_p (int, Scheme_Object *[]);
 static Scheme_Object *peeked_read(int argc, Scheme_Object *argv[]);
 static Scheme_Object *progress_evt (int argc, Scheme_Object *argv[]);
+static Scheme_Object *closed_evt (int argc, Scheme_Object *argv[]);
 static Scheme_Object *write_bytes_avail_evt(int argc, Scheme_Object *argv[]);
 static Scheme_Object *write_special_evt(int argc, Scheme_Object *argv[]);
 static Scheme_Object *sch_write (int, Scheme_Object *[]);
@@ -299,6 +300,7 @@ scheme_init_port_fun(Scheme_Env *env)
   GLOBAL_NONCM_PRIM("write-byte",                     write_byte,                     1, 2, env);
   GLOBAL_NONCM_PRIM("port-commit-peeked",             peeked_read,                    3, 4, env);
   GLOBAL_NONCM_PRIM("port-progress-evt",              progress_evt,                   0, 1, env);
+  GLOBAL_NONCM_PRIM("port-closed-evt",                closed_evt,                     0, 1, env);
   GLOBAL_NONCM_PRIM("write-bytes-avail-evt",          write_bytes_avail_evt,          1, 4, env);
   GLOBAL_NONCM_PRIM("write-special-evt",              write_special_evt,              2, 2, env);
   GLOBAL_NONCM_PRIM("port-read-handler",              port_read_handler,              1, 2, env);
@@ -3464,6 +3466,48 @@ progress_evt(int argc, Scheme_Object *argv[])
     return v;
 }
 
+static Scheme_Object *make_closed_evt(int already_closed)
+{
+  Scheme_Object *evt, *sema;
+
+  sema = scheme_make_sema(0);
+  if (already_closed)
+    scheme_post_sema_all(sema);
+  evt = scheme_alloc_small_object();
+  evt->type = scheme_port_closed_evt_type;
+  SCHEME_PTR_VAL(evt) = sema;
+
+  return evt;
+}
+
+static Scheme_Object *
+closed_evt(int argc, Scheme_Object *argv[])
+{
+  Scheme_Object *v = argv[0];
+  if (SCHEME_INPUT_PORTP(v)) {
+    Scheme_Input_Port *ip;
+    ip = scheme_input_port_record(v);
+    if (!ip->closed_evt) {
+      v = make_closed_evt(ip->closed);
+      ip->closed_evt = v;
+    } else
+      v = ip->closed_evt;
+    return v;
+  } else if (SCHEME_OUTPUT_PORTP(v)) {
+    Scheme_Output_Port *op;
+    op = scheme_output_port_record(v);
+    if (!op->closed_evt) {
+      v = make_closed_evt(op->closed);
+      op->closed_evt = v;
+    } else
+      v = op->closed_evt;
+    return v;
+  } else {
+    scheme_wrong_type("port-closed-evt", "input-port or output-port", 0, argc, argv);
+    return NULL;
+  }
+}
+
 static Scheme_Object *
 do_write_bytes_avail(int as_bytes, const char *who,
 		     int argc, Scheme_Object *argv[],

src/racket/src/schminc.h

@@ -13,7 +13,7 @@
 
 #define USE_COMPILED_STARTUP 1
 
-#define EXPECTED_PRIM_COUNT 1038
+#define EXPECTED_PRIM_COUNT 1039
 #define EXPECTED_UNSAFE_COUNT 78
 #define EXPECTED_FLFXNUM_COUNT 68
 #define EXPECTED_FUTURES_COUNT 11

src/racket/src/schvers.h

@@ -13,12 +13,12 @@
    consistently.)
 */
 
-#define MZSCHEME_VERSION "5.2.0.1"
+#define MZSCHEME_VERSION "5.2.0.2"
 
 #define MZSCHEME_VERSION_X 5
 #define MZSCHEME_VERSION_Y 2
 #define MZSCHEME_VERSION_Z 0
-#define MZSCHEME_VERSION_W 1
+#define MZSCHEME_VERSION_W 2
 
 #define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y)
 #define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)

src/racket/src/stypes.h

@@ -195,82 +195,83 @@ enum {
   scheme_fsemaphore_type,               /* 175 */
   scheme_serialized_tcp_fd_type,        /* 176 */
   scheme_serialized_file_fd_type,       /* 177 */
+  scheme_port_closed_evt_type,          /* 178 */
 
 #ifdef MZTAG_REQUIRED
-  _scheme_last_normal_type_,            /* 178 */
+  _scheme_last_normal_type_,            /* 179 */
 
-  scheme_rt_weak_array,                 /* 179 */
+  scheme_rt_weak_array,                 /* 180 */
 
-  scheme_rt_comp_env,                   /* 180 */
+  scheme_rt_comp_env,                   /* 181 */
-  scheme_rt_constant_binding,           /* 181 */
+  scheme_rt_constant_binding,           /* 182 */
-  scheme_rt_resolve_info,               /* 182 */
+  scheme_rt_resolve_info,               /* 183 */
-  scheme_rt_optimize_info,              /* 183 */
+  scheme_rt_optimize_info,              /* 184 */
-  scheme_rt_compile_info,               /* 184 */
+  scheme_rt_compile_info,               /* 185 */
-  scheme_rt_cont_mark,                  /* 185 */
+  scheme_rt_cont_mark,                  /* 186 */
-  scheme_rt_saved_stack,                /* 186 */
+  scheme_rt_saved_stack,                /* 187 */
-  scheme_rt_reply_item,                 /* 187 */
+  scheme_rt_reply_item,                 /* 188 */
-  scheme_rt_closure_info,               /* 188 */
+  scheme_rt_closure_info,               /* 189 */
-  scheme_rt_overflow,                   /* 189 */
+  scheme_rt_overflow,                   /* 190 */
-  scheme_rt_overflow_jmp,               /* 190 */
+  scheme_rt_overflow_jmp,               /* 191 */
-  scheme_rt_meta_cont,                  /* 191 */
+  scheme_rt_meta_cont,                  /* 192 */
-  scheme_rt_dyn_wind_cell,              /* 192 */
+  scheme_rt_dyn_wind_cell,              /* 193 */
-  scheme_rt_dyn_wind_info,              /* 193 */
+  scheme_rt_dyn_wind_info,              /* 194 */
-  scheme_rt_dyn_wind,                   /* 194 */
+  scheme_rt_dyn_wind,                   /* 195 */
-  scheme_rt_dup_check,                  /* 195 */
+  scheme_rt_dup_check,                  /* 196 */
-  scheme_rt_thread_memory,              /* 196 */
+  scheme_rt_thread_memory,              /* 197 */
-  scheme_rt_input_file,                 /* 197 */
+  scheme_rt_input_file,                 /* 198 */
-  scheme_rt_input_fd,                   /* 198 */
+  scheme_rt_input_fd,                   /* 199 */
-  scheme_rt_oskit_console_input,        /* 199 */
+  scheme_rt_oskit_console_input,        /* 200 */
-  scheme_rt_tested_input_file,          /* 100 */
+  scheme_rt_tested_input_file,          /* 201 */
-  scheme_rt_tested_output_file,         /* 101 */
+  scheme_rt_tested_output_file,         /* 202 */
-  scheme_rt_indexed_string,             /* 202 */
+  scheme_rt_indexed_string,             /* 203 */
-  scheme_rt_output_file,                /* 203 */
+  scheme_rt_output_file,                /* 204 */
-  scheme_rt_load_handler_data,          /* 204 */
+  scheme_rt_load_handler_data,          /* 205 */
-  scheme_rt_pipe,                       /* 205 */
+  scheme_rt_pipe,                       /* 206 */
-  scheme_rt_beos_process,               /* 206 */
+  scheme_rt_beos_process,               /* 207 */
-  scheme_rt_system_child,               /* 207 */
+  scheme_rt_system_child,               /* 208 */
-  scheme_rt_tcp,                        /* 208 */
+  scheme_rt_tcp,                        /* 209 */
-  scheme_rt_write_data,                 /* 209 */
+  scheme_rt_write_data,                 /* 210 */
-  scheme_rt_tcp_select_info,            /* 210 */
+  scheme_rt_tcp_select_info,            /* 211 */
-  scheme_rt_param_data,                 /* 211 */
+  scheme_rt_param_data,                 /* 212 */
-  scheme_rt_will,                       /* 212 */
+  scheme_rt_will,                       /* 213 */
-  scheme_rt_struct_proc_info,           /* 213 */
+  scheme_rt_struct_proc_info,           /* 214 */
-  scheme_rt_linker_name,                /* 214 */
+  scheme_rt_linker_name,                /* 215 */
-  scheme_rt_param_map,                  /* 215 */
+  scheme_rt_param_map,                  /* 216 */
-  scheme_rt_finalization,               /* 216 */
+  scheme_rt_finalization,               /* 217 */
-  scheme_rt_finalizations,              /* 217 */
+  scheme_rt_finalizations,              /* 218 */
-  scheme_rt_cpp_object,                 /* 218 */
+  scheme_rt_cpp_object,                 /* 219 */
-  scheme_rt_cpp_array_object,           /* 219 */
+  scheme_rt_cpp_array_object,           /* 220 */
-  scheme_rt_stack_object,               /* 220 */
+  scheme_rt_stack_object,               /* 221 */
-  scheme_rt_preallocated_object,        /* 221 */
+  scheme_rt_preallocated_object,        /* 222 */
-  scheme_thread_hop_type,               /* 222 */
+  scheme_thread_hop_type,               /* 223 */
-  scheme_rt_srcloc,                     /* 223 */
+  scheme_rt_srcloc,                     /* 224 */
-  scheme_rt_evt,                        /* 224 */
+  scheme_rt_evt,                        /* 225 */
-  scheme_rt_syncing,                    /* 225 */
+  scheme_rt_syncing,                    /* 226 */
-  scheme_rt_comp_prefix,                /* 226 */
+  scheme_rt_comp_prefix,                /* 227 */
-  scheme_rt_user_input,                 /* 227 */
+  scheme_rt_user_input,                 /* 228 */
-  scheme_rt_user_output,                /* 228 */
+  scheme_rt_user_output,                /* 229 */
-  scheme_rt_compact_port,               /* 229 */
+  scheme_rt_compact_port,               /* 230 */
-  scheme_rt_read_special_dw,            /* 230 */
+  scheme_rt_read_special_dw,            /* 231 */
-  scheme_rt_regwork,                    /* 231 */
+  scheme_rt_regwork,                    /* 232 */
-  scheme_rt_rx_lazy_string,             /* 232 */
+  scheme_rt_rx_lazy_string,             /* 233 */
-  scheme_rt_buf_holder,                 /* 233 */
+  scheme_rt_buf_holder,                 /* 234 */
-  scheme_rt_parameterization,           /* 234 */
+  scheme_rt_parameterization,           /* 235 */
-  scheme_rt_print_params,               /* 235 */
+  scheme_rt_print_params,               /* 236 */
-  scheme_rt_read_params,                /* 236 */
+  scheme_rt_read_params,                /* 237 */
-  scheme_rt_native_code,                /* 237 */
+  scheme_rt_native_code,                /* 238 */
-  scheme_rt_native_code_plus_case,      /* 238 */
+  scheme_rt_native_code_plus_case,      /* 239 */
-  scheme_rt_jitter_data,                /* 239 */
+  scheme_rt_jitter_data,                /* 240 */
-  scheme_rt_module_exports,             /* 240 */
+  scheme_rt_module_exports,             /* 241 */
-  scheme_rt_delay_load_info,            /* 241 */
+  scheme_rt_delay_load_info,            /* 242 */
-  scheme_rt_marshal_info,               /* 242 */
+  scheme_rt_marshal_info,               /* 243 */
-  scheme_rt_unmarshal_info,             /* 243 */
+  scheme_rt_unmarshal_info,             /* 244 */
-  scheme_rt_runstack,                   /* 244 */
+  scheme_rt_runstack,                   /* 245 */
-  scheme_rt_sfs_info,                   /* 245 */
+  scheme_rt_sfs_info,                   /* 246 */
-  scheme_rt_validate_clearing,          /* 246 */
+  scheme_rt_validate_clearing,          /* 247 */
-  scheme_rt_rb_node,                    /* 247 */
+  scheme_rt_rb_node,                    /* 248 */
-  scheme_rt_lightweight_cont,           /* 248 */
+  scheme_rt_lightweight_cont,           /* 249 */
-  scheme_rt_export_info,                /* 249 */
+  scheme_rt_export_info,                /* 250 */
 #endif
 
   _scheme_last_type_

src/racket/src/type.c

@@ -263,6 +263,7 @@ scheme_init_type ()
   set_name(scheme_always_evt_type, "<always-evt>");
   set_name(scheme_never_evt_type, "<never-evt>");
   set_name(scheme_thread_recv_evt_type, "<thread-receive-evt>");
+  set_name(scheme_port_closed_evt_type, "<port-closed-evt>");
 
   set_name(scheme_thread_resume_type, "<thread-resume-evt>");
   set_name(scheme_thread_suspend_type, "<thread-suspend-evt>");
@@ -670,6 +671,7 @@ void scheme_register_traversers(void)
   GC_REG_TRAV(scheme_always_evt_type, char_obj);
   GC_REG_TRAV(scheme_never_evt_type, char_obj);
   GC_REG_TRAV(scheme_thread_recv_evt_type, char_obj);
+  GC_REG_TRAV(scheme_port_closed_evt_type, small_object);
 
   GC_REG_TRAV(scheme_inspector_type, mark_inspector);