suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

add `port-closed-evt'

Browse Source
This commit is contained in:
Matthew Flatt 2011-11-10 05:00:33 -07:00
parent eb25a2db47
commit 5139de9cec
15 changed files with 1099 additions and 1003 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
collects/scribblings/reference/evts.scrbl
View File

@ -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].}

4
collects/scribblings/reference/port-procs.scrbl
View File

@ -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].}

2
collects/scribblings/reference/string-input.scrbl
View File

@ -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

22
collects/tests/racket/port.rktl
View File

@ -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)

4
doc/release-notes/racket/HISTORY.txt
View File

@ -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;

2
src/racket/include/scheme.h
View File

@ -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;

1848
src/racket/src/cstartup.inc
View File

File diff suppressed because it is too large Load Diff

4
src/racket/src/mzmark_type.inc
View File

@ -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);

2
src/racket/src/mzmarksrc.c
View File

@ -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);

13
src/racket/src/port.c
View File

@ -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));
}
}

44
src/racket/src/portfun.c
View File

@ -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[],

2
src/racket/src/schminc.h
View File

@ -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

4
src/racket/src/schvers.h
View File

@ -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)

145
src/racket/src/stypes.h
View File

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

2
src/racket/src/type.c
View File

@ -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);