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

add `filesystem-change-evt'

Browse Source 
The `filesystem-change-evt' function takes a path to a file
or directory and returns an event that becomes ready when
the file or directory changes (conservatively, so false
positives are possible).

These events are supported on Linux, Mac OS X and other BSD
variants with kqueue(), and Windows.
This commit is contained in:
Matthew Flatt 2013-07-06 12:52:17 -06:00
parent 5d58b2d14d
commit 3b0566ea0a
18 changed files with 1436 additions and 836 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

67
pkgs/racket-pkgs/racket-doc/scribblings/reference/filesystem.scrbl
View File

@ -473,6 +473,73 @@ On Windows, an element of the result list may start with
Returns a list of all current root directories. Obtaining this list
can be particularly slow on Windows.}
@;------------------------------------------------------------------------
@section[#:tag "filesystem-change"]{Detecting Filesystem Changes}
Many operating systems provide notifications for filesystem changes,
and those notifications are reflected in Racket by @tech{filesystem
change events}.
@defproc[(filesystem-change-evt? [v any/c]) boolean?]{
Returns @racket[#f] if @racket[v] is a @tech{filesystem change
event}, @racket[#f] otherwise.}
@defproc*[([(filesystem-change-evt [path path-string?])
filesystem-change-evt?]
[(filesystem-change-evt [path path-string?]
[failure-thunk (-> any)])
any])]{
Creates a @deftech{filesystem change event}, which is
@tech{synchronizable event} that becomes @tech{ready for
synchronization} after a change to @racket[path]:
@itemlist[
@item{If @racket[path] refers to a file, the event becomes
@tech{ready for synchronization} when the file's content or
attributes change, or when the file is deleted.}
@item{If @racket[path] refers to a directory, the event becomes
@tech{ready for synchronization} if a file or subdirectory is
added, renamed, or removed within the directory.}
]
The event also becomes @tech{ready for synchronization} if
it is passed to @racket[filesystem-change-evt-cancel].
Finally, depending on the precision of information available from the
operating system, the event may become @tech{ready for
synchronization} under other circumstances. For example, on
Windows, an event for a file becomes ready when any file changes
within in the same directory as the file.
If the current platform does not support filesystem-change
notifications, then the @exnraise[exn:fail:unsupported] if
@racket[failure-thunk] is not provided, or @racket[failure-thunk] is
called in tail position if provided. Similarly, if there is any
operating-system error when creating the event (such as a non-existent
file), then the @exnraise[exn:fail:filesystem] or @racket[failure-thunk]
is called.
A @tech{filesystem change event} is placed under the management of the
@tech{current custodian} when it is created. If the @tech{custodian}
is shut down, @racket[filesystem-change-evt-cancel] is applied to the
event.}
@defproc[(filesystem-change-evt-cancel [evt filesystem-change-evt?])
void?]{
Causes @racket[evt] to become immediately @tech{ready for
synchronization}, whether it was ready or before not, and releases and
resources (at the operating system level) for tracking filesystem
changes.}
@;------------------------------------------------------------------------
@section[#:tag "runtime-path"]{Declaring Paths Needed at Run Time}

87
pkgs/racket-pkgs/racket-test/tests/racket/file.rktl
View File

@ -1378,6 +1378,93 @@
'(close-input-port r2))))
(tcp-close l))
;;----------------------------------------------------------------------
;; Filesystem-change events
(test #f filesystem-change-evt? 'evt)
(let ([dir (make-temporary-file "change~a" 'directory)])
(define known-file-supported?
(case (system-type)
[(macosx) #t]
[else #f]))
(define known-supported?
(or known-file-supported?
(case (system-type)
[(windows) #t]
[else #f])))
(define (check-supported evt file?)
(when (if file?
known-file-supported?
known-supported?)
(test #t filesystem-change-evt? evt)))
(define (check f1-name f2-name as-file? known-x-supported?)
(printf "checking ~s, ~s as ~a\n" f1-name f2-name (if as-file? "file" "dir"))
(define f1 (build-path dir f1-name))
(define f2 (build-path dir f2-name))
(define dir-e (filesystem-change-evt dir (lambda () #f)))
(check-supported dir-e #f)
(if as-file?
(call-with-output-file* f1 (lambda (o) (fprintf o "1\n")))
(make-directory f1))
(when dir-e
(test dir-e sync dir-e)
(test dir-e sync dir-e))
(if as-file?
(call-with-output-file* f2 (lambda (o) (fprintf o "2\n")))
(make-directory f2))
(define f1-e (filesystem-change-evt f1 (lambda () #f)))
(define f2-e (filesystem-change-evt f2 (lambda () #f)))
(check-supported f1-e #t)
(check-supported f2-e #t)
(when f1-e
(test #f sync/timeout 0 f1-e)
(test #f sync/timeout 0 f2-e)
(call-with-output-file (if as-file?
f1
(build-path f1 "x"))
#:exists 'append
(lambda (o) (newline o)))
(test f1-e sync f1-e)
(when known-x-supported?
(test #f sync/timeout 0 f2-e))
(call-with-output-file (if as-file?
f2
(build-path f2 "y"))
#:exists 'append
(lambda (o) (newline o)))
(test f2-e sync/timeout 0 f2-e)
(test f2-e sync f2-e)
(test f1-e sync f1-e)
(define f1-e2 (filesystem-change-evt f1 (lambda () #f)))
(when known-x-supported?
(test #f sync/timeout 0 f1-e2))
(test f1-e sync/timeout 0 f1-e)
(test f1-e sync f1-e)
(filesystem-change-evt-cancel f1-e2)
(test f1-e2 sync/timeout 0 f1-e2)
(define cust (make-custodian))
(define f1-e3 (parameterize ([current-custodian cust])
(filesystem-change-evt f2 (lambda () #f))))
(when known-x-supported?
(test #f sync/timeout 0 f1-e3))
(custodian-shutdown-all cust)
(test f1-e3 sync/timeout 0 f1-e3)))
(check "f1" "f2" #t known-file-supported?)
(check "f1d" "f2d" #f known-supported?)
(delete-directory/files dir))
;;----------------------------------------------------------------------
;; TCP

4
racket/lib/collects/racket/HISTORY.txt
View File

@ -1,3 +1,7 @@
Version 5.3.900.4
Added filesystem-change-evt, filesystem-change-evt?, and
filesystem-change-evt-cancel
Version 5.3.900.2
Changed link-file handling to separate "user" and "shared" modes;
removed 'links-file mode for find-system-path, PLTLINKSFILE

56
racket/src/configure vendored
View File

@ -4080,6 +4080,7 @@ case "$host_os" in
DYN_CFLAGS="-fPIC"
try_poll_syscall=yes
try_epoll_syscall=yes
try_inotify_syscall=yes
case "$host_cpu" in
#Required for CentOS 4.6
x86_64)
@ -5473,6 +5474,61 @@ _ACEOF
fi
fi
if test "${try_inotify_syscall}" = "yes" ; then
msg="for inotify"
{ echo "$as_me:$LINENO: checking $msg" >&5
echo $ECHO_N "checking $msg... $ECHO_C" >&6; }
cat >conftest.$ac_ext <<_ACEOF
#include <sys/inotify.h>
int main() {
int fd;
int wd;
fd = inotify_init();
wd = inotify_add_watch(fd, "/tmp",
(IN_CREATE | IN_DELETE | IN_DELETE_SELF
| IN_MODIFY | IN_MOVE_SELF | IN_MOVED_TO));
return 0;
}
_ACEOF
rm -f conftest.$ac_objext conftest$ac_exeext
if { (ac_try="$ac_link"
case "(($ac_try" in
*\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
*) ac_try_echo=$ac_try;;
esac
eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
(eval "$ac_link") 2>conftest.er1
ac_status=$?
grep -v '^ *+' conftest.er1 >conftest.err
rm -f conftest.er1
cat conftest.err >&5
echo "$as_me:$LINENO: \$? = $ac_status" >&5
(exit $ac_status); } && {
test -z "$ac_c_werror_flag" ||
test ! -s conftest.err
} && test -s conftest$ac_exeext &&
$as_test_x conftest$ac_exeext; then
use_inotify=yes
else
echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5
use_inotify=no
fi
rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \
conftest$ac_exeext conftest.$ac_ext
{ echo "$as_me:$LINENO: result: $use_inotify" >&5
echo "${ECHO_T}$use_inotify" >&6; }
if test "${use_inotify}" = "yes" ; then
cat >>confdefs.h <<\_ACEOF
#define HAVE_INOTIFY_SYSCALL 1
_ACEOF
fi
fi
if test "${try_kqueue_syscall}" = "yes" ; then
msg="for kqueue"
{ echo "$as_me:$LINENO: checking $msg" >&5

21
racket/src/racket/configure.ac
View File

@ -579,6 +579,7 @@ case "$host_os" in
DYN_CFLAGS="-fPIC"
try_poll_syscall=yes
try_epoll_syscall=yes
try_inotify_syscall=yes
case "$host_cpu" in
#Required for CentOS 4.6
x86_64)
@ -964,6 +965,26 @@ if test "${try_epoll_syscall}" = "yes" ; then
fi
fi
if test "${try_inotify_syscall}" = "yes" ; then
[ msg="for inotify" ]
AC_MSG_CHECKING($msg)
AC_LINK_IFELSE(
[ #include <sys/inotify.h> ]
int main() {
int fd;
int wd;
fd = inotify_init();
wd = inotify_add_watch(fd, "/tmp",
(IN_CREATE | IN_DELETE | IN_DELETE_SELF
| IN_MODIFY | IN_MOVE_SELF | IN_MOVED_TO));
return 0;
}, use_inotify=yes, use_inotify=no)
AC_MSG_RESULT($use_inotify)
if test "${use_inotify}" = "yes" ; then
AC_DEFINE(HAVE_INOTIFY_SYSCALL,1,[Have inotify])
fi
fi
if test "${try_kqueue_syscall}" = "yes" ; then
[ msg="for kqueue" ]
AC_MSG_CHECKING($msg)

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

@ -2105,6 +2105,8 @@ extern Scheme_Extension_Table *scheme_extension_table;
#define MZFD_CHECK_READ 3
#define MZFD_CHECK_WRITE 4
#define MZFD_REMOVE 5
#define MZFD_CREATE_VNODE 6
#define MZFD_CHECK_VNODE 7
/*========================================================================*/

3
racket/src/racket/mzconfig.h.in
View File

@ -56,9 +56,10 @@ typedef unsigned long uintptr_t;
/* Whether pthread_rwlock is available. */
#undef HAVE_PTHREAD_RWLOCK
/* When poll(), epoll(), and/or kqueue() is available: */
/* When poll(), epoll(), kqueue(), etc. is available: */
#undef HAVE_POLL_SYSCALL
#undef HAVE_EPOLL_SYSCALL
#undef HAVE_INOTIFY_SYSCALL
#undef HAVE_KQUEUE_SYSCALL
/* When mmap() and mprotect() are available: */

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

File diff suppressed because it is too large Load Diff

25
racket/src/racket/src/mzmark_port.inc
View File

@ -201,3 +201,28 @@ static int mark_read_write_evt_FIXUP(void *p, struct NewGC *gc) {
#define mark_read_write_evt_IS_CONST_SIZE 1
static int mark_filesystem_change_evt_SIZE(void *p, struct NewGC *gc) {
return
gcBYTES_TO_WORDS(sizeof(Scheme_Filesystem_Change_Evt));
}
static int mark_filesystem_change_evt_MARK(void *p, struct NewGC *gc) {
Scheme_Filesystem_Change_Evt *fc = (Scheme_Filesystem_Change_Evt *)p;
gcMARK2(fc->sema, gc);
gcMARK2(fc->mref, gc);
return
gcBYTES_TO_WORDS(sizeof(Scheme_Filesystem_Change_Evt));
}
static int mark_filesystem_change_evt_FIXUP(void *p, struct NewGC *gc) {
Scheme_Filesystem_Change_Evt *fc = (Scheme_Filesystem_Change_Evt *)p;
gcFIXUP2(fc->sema, gc);
gcFIXUP2(fc->mref, gc);
return
gcBYTES_TO_WORDS(sizeof(Scheme_Filesystem_Change_Evt));
}
#define mark_filesystem_change_evt_IS_ATOMIC 0
#define mark_filesystem_change_evt_IS_CONST_SIZE 1

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

@ -1738,6 +1738,15 @@ mark_read_write_evt {
gcBYTES_TO_WORDS(sizeof(Scheme_Read_Write_Evt));
}
mark_filesystem_change_evt {
mark:
Scheme_Filesystem_Change_Evt *fc = (Scheme_Filesystem_Change_Evt *)p;
gcMARK2(fc->sema, gc);
gcMARK2(fc->mref, gc);
size:
gcBYTES_TO_WORDS(sizeof(Scheme_Filesystem_Change_Evt));
}
END port;
/**********************************************************************/

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

@ -51,6 +51,9 @@
# ifdef HAVE_POLL_SYSCALL
# include <poll.h>
# endif
# ifdef HAVE_INOTIFY_SYSCALL
# include <sys/inotify.h>
# endif
#endif
#ifdef USE_ITIMER
# include <sys/types.h>
@ -443,6 +446,14 @@ 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 int filesystem_change_evt_ready(Scheme_Object *evt, Scheme_Schedule_Info *sinfo);
#ifdef DOS_FILE_SYSTEM
static void filesystem_change_evt_need_wakeup (Scheme_Object *port, void *fds);
#else
# define filesystem_change_evt_need_wakeup NULL
#endif
static Scheme_Object *
_scheme_make_named_file_input_port(FILE *fp, Scheme_Object *name, int regfile);
@ -483,6 +494,13 @@ THREAD_LOCAL_DECL(static char *read_string_byte_buffer);
#include "schwinfd.h"
typedef struct Scheme_Filesystem_Change_Evt {
Scheme_Object so;
intptr_t fd;
Scheme_Object *sema;
Scheme_Custodian_Reference *mref;
} Scheme_Filesystem_Change_Evt;
/*========================================================================*/
/* initialization */
/*========================================================================*/
@ -627,6 +645,8 @@ void scheme_init_port_wait()
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);
scheme_add_evt(scheme_filesystem_change_evt_type, (Scheme_Ready_Fun)filesystem_change_evt_ready,
filesystem_change_evt_need_wakeup, NULL, 1);
}
void scheme_init_port_places(void)
@ -5952,6 +5972,243 @@ Scheme_Object *scheme_file_unlock(int argc, Scheme_Object **argv)
return scheme_void;
}
/*========================================================================*/
/* filesystem change events */
/*========================================================================*/
Scheme_Object *scheme_filesystem_change_evt(Scheme_Object *path, int flags, int signal_errs)
{
char *filename;
int ok = 0, errid = 0;
intptr_t fd;
filename = scheme_expand_string_filename(path,
"filesystem-change-evt",
NULL,
SCHEME_GUARD_FILE_EXISTS);
#if defined(HAVE_KQUEUE_SYSCALL)
do {
fd = open(filename, flags | MZ_BINARY, 0666);
} while ((fd == -1) && (errno == EINTR));
if (fd == -1)
errid = errno;
else
ok = 1;
#elif defined(HAVE_INOTIFY_SYSCALL)
/* This implementation uses a file descriptor for every event,
instead of using a watch descriptor for every event. This could
be improved, but note that the kqueue() implementation needs a
file descriptor per event, anyway. */
fd = inotify_init();
if (fd == -1)
errid = errno;
else {
int wd;
wd = inotify_add_watch(fd, filename,
(IN_CREATE | IN_DELETE | IN_DELETE_SELF
| IN_MODIFY | IN_MOVE_SELF | IN_MOVED_TO
| IN_ATTRIB | IN_ONESHOT));
if (wd == -1) {
errid = errno;
scheme_close_file_fd(fd);
} else {
ok = 1;
fcntl(fd, F_SETFL, MZ_NONBLOCKING);
}
}
#elif defined(DOS_FILE_SYSTEM)
{
HANDLE h;
char *try_filename = filename;
while (1) {
h = FindFirstChangeNotification(try_filename, FALSE,
(FILE_NOTIFY_CHANGE_FILE_NAME
| FILE_NOTIFY_CHANGE_DIR_NAME
| FILE_NOTIFY_CHANGE_SIZE
| FILE_NOTIFY_CHANGE_LAST_WRITE
| FILE_NOTIFY_CHANGE_ATTRIBUTES));
if (h == INVALID_HANDLE_VALUE) {
/* If `filename' refers to a file, then monitor its enclosing directory. */
errid = GetLastError();
if ((try_filename == filename) && scheme_file_exists(filename)) {
Scheme_Object *base, *name;
int is_dir;
name = scheme_split_path(filename, strlen(filename), &base, &is_dir, SCHEME_PLATFORM_PATH_KIND);
try_filename = scheme_expand_string_filename(base,
"filesystem-change-evt",
NULL,
SCHEME_GUARD_FILE_EXISTS);
} else
break;
} else {
fd = (intptr_t)h;
ok = 1;
break;
}
}
}
#else
# define NO_FILESYSTEM_CHANGE_EVTS
ok = 0;
errid = -1;
#endif
if (!ok) {
if (signal_errs) {
#ifdef NO_FILESYSTEM_CHANGE_EVTS
scheme_raise_exn(MZEXN_FAIL_UNSUPPORTED,
"filesystem-change-evt: " NOT_SUPPORTED_STR "\n"
" path: %q\n",
filename);
#else
scheme_raise_exn(MZEXN_FAIL_FILESYSTEM,
"filesystem-change-evt: error generating event\n"
" path: %q\n"
" system error: %E",
filename,
errid);
#endif
}
return NULL;
}
#if defined(NO_FILESYSTEM_CHANGE_EVTS)
return NULL;
#elif defined(DOS_FILE_SYSTEM)
{
Scheme_Filesystem_Change_Evt *fc;
Scheme_Custodian_Reference *mref;
fc = MALLOC_ONE_TAGGED(Scheme_Filesystem_Change_Evt);
fc->so.type = scheme_filesystem_change_evt_type;
fc->fd = fd;
mref = scheme_add_managed(NULL, (Scheme_Object *)fc, scheme_filesystem_change_evt_cancel, NULL, 1);
fc->mref = mref;
return (Scheme_Object *)fc;
}
#else
{
Scheme_Filesystem_Change_Evt *fc;
Scheme_Object *sema;
Scheme_Custodian_Reference *mref;
sema = scheme_fd_to_semaphore(fd, MZFD_CREATE_VNODE, 0);
if (!sema) {
const char *reason = "";
#if defined(HAVE_KQUEUE_SYSCALL)
if (!scheme_fd_regular_file(fd, 1))
reason = ";\n not a regular file or directory";
#endif
scheme_close_file_fd(fd);
if (signal_errs) {
scheme_raise_exn(MZEXN_FAIL_FILESYSTEM,
"filesystem-change-evt: cannot generate event%s\n"
" path: %q",
reason,
filename);
}
return NULL;
}
fc = MALLOC_ONE_TAGGED(Scheme_Filesystem_Change_Evt);
fc->so.type = scheme_filesystem_change_evt_type;
fc->fd = fd;
fc->sema = sema;
mref = scheme_add_managed(NULL, (Scheme_Object *)fc, scheme_filesystem_change_evt_cancel, NULL, 1);
fc->mref = mref;
return (Scheme_Object *)fc;
}
#endif
}
void scheme_filesystem_change_evt_cancel(Scheme_Object *evt, void *ignored_data)
{
#ifndef NO_FILESYSTEM_CHANGE_EVTS
Scheme_Filesystem_Change_Evt *fc = (Scheme_Filesystem_Change_Evt *)evt;
if (fc->mref) {
# if defined(DOS_FILE_SYSTEM)
if (fc->fd) {
FindCloseChangeNotification((HANDLE)fc->fd);
fc->fd = 0;
}
# else
(void)scheme_fd_to_semaphore(fc->fd, MZFD_REMOVE, 0);
scheme_close_file_fd(fc->fd);
scheme_post_sema_all(fc->sema);
# endif
scheme_remove_managed(fc->mref, (Scheme_Object *)fc);
fc->mref = NULL;
}
#endif
}
static int filesystem_change_evt_ready(Scheme_Object *evt, Scheme_Schedule_Info *sinfo)
{
#ifndef NO_FILESYSTEM_CHANGE_EVTS
Scheme_Filesystem_Change_Evt *fc = (Scheme_Filesystem_Change_Evt *)evt;
# if defined(DOS_FILE_SYSTEM)
if (fc->fd) {
if (WaitForSingleObject((HANDLE)fc->fd, 0) == WAIT_OBJECT_0) {
FindCloseChangeNotification((HANDLE)fc->fd);
fc->fd = 0;
}
}
return !fc->fd;
# else
if (scheme_try_plain_sema(fc->sema))
scheme_filesystem_change_evt_cancel((Scheme_Object *)fc, NULL);
else
scheme_check_fd_semaphores();
scheme_set_sync_target(sinfo, fc->sema, evt, NULL, 0, 1, NULL);
# endif
#endif
return 0;
}
#ifdef DOS_FILE_SYSTEM
static void filesystem_change_evt_need_wakeup (Scheme_Object *evt, void *fds)
{
Scheme_Filesystem_Change_Evt *fc = (Scheme_Filesystem_Change_Evt *)evt;
if (fc->fd)
scheme_add_fd_handle((void *)fc->fd, fds, 0);
}
#endif
int scheme_fd_regular_file(intptr_t fd, int dir_ok)
{
#if defined(USE_FD_PORTS) && !defined(DOS_FILE_SYSTEM)
int ok;
struct stat buf;
do {
ok = fstat(fd, &buf);
} while ((ok == -1) && (errno == EINTR));
if (!S_ISREG(buf.st_mode)
&& (!dir_ok || !S_ISDIR(buf.st_mode)))
return 0;
return 1;
#else
return 0;
#endif
}
/*========================================================================*/
/* FILE input ports */
/*========================================================================*/
@ -10861,6 +11118,8 @@ static void register_traversers(void)
GC_REG_TRAV(scheme_subprocess_type, mark_subprocess);
GC_REG_TRAV(scheme_write_evt_type, mark_read_write_evt);
GC_REG_TRAV(scheme_filesystem_change_evt_type, mark_filesystem_change_evt);
}
END_XFORM_SKIP;

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

@ -126,6 +126,10 @@ static Scheme_Object *port_counts_lines_p(int, Scheme_Object **args);
static Scheme_Object *port_next_location(int, Scheme_Object **args);
static Scheme_Object *set_port_next_location(int, Scheme_Object **args);
static Scheme_Object *filesystem_change_evt(int, Scheme_Object **args);
static Scheme_Object *filesystem_change_evt_p(int, Scheme_Object **args);
static Scheme_Object *filesystem_change_evt_cancel(int, Scheme_Object **args);
static Scheme_Object *sch_default_read_handler(void *ignore, int argc, Scheme_Object *argv[]);
static Scheme_Object *sch_default_display_handler(int argc, Scheme_Object *argv[]);
static Scheme_Object *sch_default_write_handler(int argc, Scheme_Object *argv[]);
@ -260,6 +264,10 @@ scheme_init_port_fun(Scheme_Env *env)
GLOBAL_PRIM_W_ARITY2("port-next-location", port_next_location, 1, 1, 3, 3, env);
GLOBAL_PRIM_W_ARITY("set-port-next-location!", set_port_next_location, 4, 4, env);
GLOBAL_PRIM_W_ARITY("filesystem-change-evt", filesystem_change_evt, 1, 2, env);
GLOBAL_NONCM_PRIM("filesystem-change-evt?", filesystem_change_evt_p, 1, 1, env);
GLOBAL_NONCM_PRIM("filesystem-change-evt-cancel", filesystem_change_evt_cancel, 1, 1, env);
GLOBAL_NONCM_PRIM("read", read_f, 0, 1, env);
GLOBAL_NONCM_PRIM("read/recursive", read_recur_f, 0, 4, env);
GLOBAL_NONCM_PRIM("read-syntax", read_syntax_f, 0, 2, env);
@ -4319,6 +4327,40 @@ static Scheme_Object *set_port_next_location(int argc, Scheme_Object *argv[])
return scheme_void;
}
static Scheme_Object *filesystem_change_evt(int argc, Scheme_Object *argv[])
{
Scheme_Object *e;
if (!SCHEME_PATH_STRINGP(argv[0]))
scheme_wrong_contract("filesystem-change-evt", "path-string?", 0, argc, argv);
if (argc > 1)
scheme_check_proc_arity("filesystem-change-evt", 0, 1, argc, argv);
e = scheme_filesystem_change_evt(argv[0], 0, (argc < 2));
if (!e)
return _scheme_tail_apply(argv[1], 0, NULL);
else
return e;
}
static Scheme_Object *filesystem_change_evt_p(int argc, Scheme_Object **argv)
{
return (SAME_TYPE(scheme_filesystem_change_evt_type, SCHEME_TYPE(argv[0]))
? scheme_true
: scheme_false);
}
static Scheme_Object *filesystem_change_evt_cancel(int argc, Scheme_Object **argv)
{
if (!SAME_TYPE(scheme_filesystem_change_evt_type, SCHEME_TYPE(argv[0])))
scheme_wrong_contract("filesystem-change-evt-cancel", "filesystem-change-evt?", 0, argc, argv);
scheme_filesystem_change_evt_cancel(argv[0], NULL);
return scheme_void;
}
static intptr_t get_number(Scheme_Object *port, intptr_t pos)
{
unsigned char buffer[4];

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

@ -14,7 +14,7 @@
#define USE_COMPILED_STARTUP 1
#define EXPECTED_PRIM_COUNT 1105
#define EXPECTED_PRIM_COUNT 1108
#define EXPECTED_UNSAFE_COUNT 100
#define EXPECTED_FLFXNUM_COUNT 69
#define EXPECTED_EXTFL_COUNT 45

6
racket/src/racket/src/schpriv.h
View File

@ -3876,6 +3876,12 @@ intptr_t scheme_redirect_get_or_peek_bytes(Scheme_Input_Port *orig_port,
Scheme_Object *unless,
Scheme_Schedule_Info *sinfo);
Scheme_Object *scheme_filesystem_change_evt(Scheme_Object *path, int flags, int report_errs);
void scheme_filesystem_change_evt_cancel(Scheme_Object *evt, void *ignored_data);
int scheme_fd_regular_file(intptr_t fd, int dir_ok);
void scheme_check_fd_semaphores(void);
/*========================================================================*/
/* memory debugging */
/*========================================================================*/

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

@ -13,12 +13,12 @@
consistently.)
*/
#define MZSCHEME_VERSION "5.3.900.3"
#define MZSCHEME_VERSION "5.3.900.4"
#define MZSCHEME_VERSION_X 5
#define MZSCHEME_VERSION_Y 3
#define MZSCHEME_VERSION_Z 900
#define MZSCHEME_VERSION_W 3
#define MZSCHEME_VERSION_W 4
#define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y)
#define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)

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

@ -209,83 +209,84 @@ enum {
scheme_struct_proc_shape_type, /* 185 */
scheme_phantom_bytes_type, /* 186 */
scheme_environment_variables_type, /* 187 */
scheme_filesystem_change_evt_type, /* 188 */
#ifdef MZTAG_REQUIRED
_scheme_last_normal_type_, /* 188 */
_scheme_last_normal_type_, /* 189 */
scheme_rt_weak_array, /* 189 */
scheme_rt_weak_array, /* 190 */
scheme_rt_comp_env, /* 190 */
scheme_rt_constant_binding, /* 191 */
scheme_rt_resolve_info, /* 192 */
scheme_rt_unresolve_info, /* 193 */
scheme_rt_optimize_info, /* 194 */
scheme_rt_compile_info, /* 195 */
scheme_rt_cont_mark, /* 196 */
scheme_rt_saved_stack, /* 197 */
scheme_rt_reply_item, /* 198 */
scheme_rt_closure_info, /* 199 */
scheme_rt_overflow, /* 200 */
scheme_rt_overflow_jmp, /* 201 */
scheme_rt_meta_cont, /* 202 */
scheme_rt_dyn_wind_cell, /* 203 */
scheme_rt_dyn_wind_info, /* 204 */
scheme_rt_dyn_wind, /* 205 */
scheme_rt_dup_check, /* 206 */
scheme_rt_thread_memory, /* 207 */
scheme_rt_input_file, /* 208 */
scheme_rt_input_fd, /* 209 */
scheme_rt_oskit_console_input, /* 210 */
scheme_rt_tested_input_file, /* 211 */
scheme_rt_tested_output_file, /* 212 */
scheme_rt_indexed_string, /* 213 */
scheme_rt_output_file, /* 214 */
scheme_rt_load_handler_data, /* 215 */
scheme_rt_pipe, /* 216 */
scheme_rt_beos_process, /* 217 */
scheme_rt_system_child, /* 218 */
scheme_rt_tcp, /* 219 */
scheme_rt_write_data, /* 220 */
scheme_rt_tcp_select_info, /* 221 */
scheme_rt_param_data, /* 222 */
scheme_rt_will, /* 223 */
scheme_rt_linker_name, /* 224 */
scheme_rt_param_map, /* 225 */
scheme_rt_finalization, /* 226 */
scheme_rt_finalizations, /* 227 */
scheme_rt_cpp_object, /* 228 */
scheme_rt_cpp_array_object, /* 229 */
scheme_rt_stack_object, /* 230 */
scheme_rt_preallocated_object, /* 231 */
scheme_thread_hop_type, /* 232 */
scheme_rt_srcloc, /* 233 */
scheme_rt_evt, /* 234 */
scheme_rt_syncing, /* 235 */
scheme_rt_comp_prefix, /* 236 */
scheme_rt_user_input, /* 237 */
scheme_rt_user_output, /* 238 */
scheme_rt_compact_port, /* 239 */
scheme_rt_read_special_dw, /* 240 */
scheme_rt_regwork, /* 241 */
scheme_rt_rx_lazy_string, /* 242 */
scheme_rt_buf_holder, /* 243 */
scheme_rt_parameterization, /* 244 */
scheme_rt_print_params, /* 245 */
scheme_rt_read_params, /* 246 */
scheme_rt_native_code, /* 247 */
scheme_rt_native_code_plus_case, /* 248 */
scheme_rt_jitter_data, /* 249 */
scheme_rt_module_exports, /* 250 */
scheme_rt_delay_load_info, /* 251 */
scheme_rt_marshal_info, /* 252 */
scheme_rt_unmarshal_info, /* 253 */
scheme_rt_runstack, /* 254 */
scheme_rt_sfs_info, /* 255 */
scheme_rt_validate_clearing, /* 256 */
scheme_rt_avl_node, /* 257 */
scheme_rt_lightweight_cont, /* 258 */
scheme_rt_export_info, /* 259 */
scheme_rt_cont_jmp, /* 260 */
scheme_rt_comp_env, /* 191 */
scheme_rt_constant_binding, /* 192 */
scheme_rt_resolve_info, /* 193 */
scheme_rt_unresolve_info, /* 194 */
scheme_rt_optimize_info, /* 195 */
scheme_rt_compile_info, /* 196 */
scheme_rt_cont_mark, /* 197 */
scheme_rt_saved_stack, /* 198 */
scheme_rt_reply_item, /* 199 */
scheme_rt_closure_info, /* 200 */
scheme_rt_overflow, /* 201 */
scheme_rt_overflow_jmp, /* 202 */
scheme_rt_meta_cont, /* 203 */
scheme_rt_dyn_wind_cell, /* 204 */
scheme_rt_dyn_wind_info, /* 205 */
scheme_rt_dyn_wind, /* 206 */
scheme_rt_dup_check, /* 207 */
scheme_rt_thread_memory, /* 208 */
scheme_rt_input_file, /* 209 */
scheme_rt_input_fd, /* 210 */
scheme_rt_oskit_console_input, /* 211 */
scheme_rt_tested_input_file, /* 212 */
scheme_rt_tested_output_file, /* 213 */
scheme_rt_indexed_string, /* 214 */
scheme_rt_output_file, /* 215 */
scheme_rt_load_handler_data, /* 216 */
scheme_rt_pipe, /* 217 */
scheme_rt_beos_process, /* 218 */
scheme_rt_system_child, /* 219 */
scheme_rt_tcp, /* 220 */
scheme_rt_write_data, /* 221 */
scheme_rt_tcp_select_info, /* 222 */
scheme_rt_param_data, /* 223 */
scheme_rt_will, /* 224 */
scheme_rt_linker_name, /* 225 */
scheme_rt_param_map, /* 226 */
scheme_rt_finalization, /* 227 */
scheme_rt_finalizations, /* 228 */
scheme_rt_cpp_object, /* 229 */
scheme_rt_cpp_array_object, /* 230 */
scheme_rt_stack_object, /* 231 */
scheme_rt_preallocated_object, /* 232 */
scheme_thread_hop_type, /* 233 */
scheme_rt_srcloc, /* 234 */
scheme_rt_evt, /* 235 */
scheme_rt_syncing, /* 236 */
scheme_rt_comp_prefix, /* 237 */
scheme_rt_user_input, /* 238 */
scheme_rt_user_output, /* 239 */
scheme_rt_compact_port, /* 240 */
scheme_rt_read_special_dw, /* 241 */
scheme_rt_regwork, /* 242 */
scheme_rt_rx_lazy_string, /* 243 */
scheme_rt_buf_holder, /* 244 */
scheme_rt_parameterization, /* 245 */
scheme_rt_print_params, /* 246 */
scheme_rt_read_params, /* 247 */
scheme_rt_native_code, /* 248 */
scheme_rt_native_code_plus_case, /* 249 */
scheme_rt_jitter_data, /* 250 */
scheme_rt_module_exports, /* 251 */
scheme_rt_delay_load_info, /* 252 */
scheme_rt_marshal_info, /* 253 */
scheme_rt_unmarshal_info, /* 254 */
scheme_rt_runstack, /* 255 */
scheme_rt_sfs_info, /* 256 */
scheme_rt_validate_clearing, /* 257 */
scheme_rt_avl_node, /* 258 */
scheme_rt_lightweight_cont, /* 259 */
scheme_rt_export_info, /* 260 */
scheme_rt_cont_jmp, /* 261 */
#endif
_scheme_last_type_

39
racket/src/racket/src/thread.c
View File

@ -3480,8 +3480,10 @@ Scheme_Object *scheme_fd_to_semaphore(intptr_t fd, int mode, int is_socket)
return NULL;
# ifdef HAVE_KQUEUE_SYSCALL
if (!is_socket)
return NULL; /* kqueue() might not work on devices, such as ttys */
if (!is_socket) {
if (!scheme_fd_regular_file(fd, 10))
return NULL; /* kqueue() might not work on devices, such as ttys */
}
if (scheme_semaphore_fd_kqueue < 0) {
scheme_semaphore_fd_kqueue = kqueue();
if (scheme_semaphore_fd_kqueue < 0) {
@ -3504,6 +3506,7 @@ Scheme_Object *scheme_fd_to_semaphore(intptr_t fd, int mode, int is_socket)
v = scheme_hash_get(scheme_semaphore_fd_mapping, key);
if (!v && ((mode == MZFD_CHECK_READ)
|| (mode == MZFD_CHECK_WRITE)
|| (mode == MZFD_CHECK_VNODE)
|| (mode == MZFD_REMOVE)))
return NULL;
@ -3529,13 +3532,14 @@ Scheme_Object *scheme_fd_to_semaphore(intptr_t fd, int mode, int is_socket)
scheme_hash_set(scheme_semaphore_fd_mapping, key, NULL);
# ifdef HAVE_KQUEUE_SYSCALL
{
GC_CAN_IGNORE struct kevent kev[2];
GC_CAN_IGNORE struct kevent kev[3];
struct timespec timeout = {0, 0};
int kr;
EV_SET(kev, fd, EVFILT_READ, EV_DELETE, 0, 0, NULL);
EV_SET(&kev[1], fd, EVFILT_READ, EV_DELETE, 0, 0, NULL);
EV_SET(&kev[1], fd, EVFILT_WRITE, EV_DELETE, 0, 0, NULL);
EV_SET(&kev[2], fd, EVFILT_VNODE, EV_DELETE, 0, 0, NULL);
do {
kr = kevent(scheme_semaphore_fd_kqueue, kev, 2, NULL, 0, &timeout);
kr = kevent(scheme_semaphore_fd_kqueue, kev, 3, NULL, 0, &timeout);
} while ((kr == -1) && (errno == EINTR));
log_kqueue_error("remove", kr);
}
@ -3552,10 +3556,13 @@ Scheme_Object *scheme_fd_to_semaphore(intptr_t fd, int mode, int is_socket)
# endif
s = NULL;
} else if ((mode == MZFD_CHECK_READ)
|| (mode == MZFD_CREATE_READ)) {
|| (mode == MZFD_CREATE_READ)
|| (mode == MZFD_CHECK_VNODE)
|| (mode == MZFD_CREATE_VNODE)) {
s = SCHEME_VEC_ELS(v)[0];
if (SCHEME_FALSEP(s)) {
if (mode == MZFD_CREATE_READ) {
if ((mode == MZFD_CREATE_READ)
|| (mode == MZFD_CREATE_VNODE)) {
s = scheme_make_sema(0);
SCHEME_VEC_ELS(v)[0] = s;
# ifdef HAVE_KQUEUE_SYSCALL
@ -3563,7 +3570,13 @@ Scheme_Object *scheme_fd_to_semaphore(intptr_t fd, int mode, int is_socket)
GC_CAN_IGNORE struct kevent kev;
struct timespec timeout = {0, 0};
int kr;
EV_SET(&kev, fd, EVFILT_READ, EV_ADD | EV_ONESHOT, 0, 0, NULL);
if (mode == MZFD_CREATE_READ)
EV_SET(&kev, fd, EVFILT_READ, EV_ADD | EV_ONESHOT, 0, 0, NULL);
else
EV_SET(&kev, fd, EVFILT_VNODE, EV_ADD | EV_ONESHOT,
(NOTE_DELETE | NOTE_WRITE | NOTE_EXTEND
| NOTE_RENAME | NOTE_ATTRIB),
0, NULL);
do {
kr = kevent(scheme_semaphore_fd_kqueue, &kev, 1, NULL, 0, &timeout);
} while ((kr == -1) && (errno == EINTR));
@ -3586,7 +3599,8 @@ Scheme_Object *scheme_fd_to_semaphore(intptr_t fd, int mode, int is_socket)
} else
s = NULL;
}
} else {
} else if ((mode == MZFD_CHECK_WRITE)
|| (mode == MZFD_CREATE_WRITE)) {
s = SCHEME_VEC_ELS(v)[1];
if (SCHEME_FALSEP(s)) {
if (mode == MZFD_CREATE_WRITE) {
@ -3650,7 +3664,7 @@ static int check_fd_semaphores()
key = scheme_make_integer_value(kev.ident);
v = scheme_hash_get(scheme_semaphore_fd_mapping, key);
if (v) {
if (kev.filter == EVFILT_READ) {
if ((kev.filter == EVFILT_READ) || (kev.filter == EVFILT_VNODE)) {
s = SCHEME_VEC_ELS(v)[0];
if (!SCHEME_FALSEP(s)) {
scheme_post_sema_all(s);
@ -3849,6 +3863,11 @@ static int check_fd_semaphores()
#endif
}
void scheme_check_fd_semaphores(void)
{
(void)check_fd_semaphores();
}
typedef struct {
int running;
double sleep_end;

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

@ -209,6 +209,7 @@ scheme_init_type ()
set_name(scheme_struct_type_type, "<struct-type>");
set_name(scheme_listener_type, "<tcp-listener>");
set_name(scheme_tcp_accept_evt_type, "<tcp-accept-evt>");
set_name(scheme_filesystem_change_evt_type, "<filesystem-change-evt>");
set_name(scheme_namespace_type, "<namespace>");
set_name(scheme_config_type, "<parameterization>");
set_name(scheme_will_executor_type, "<will-executor>");
@ -613,7 +614,7 @@ void scheme_register_traversers(void)
GC_REG_TRAV(scheme_unix_path_type, bstring_obj);
GC_REG_TRAV(scheme_windows_path_type, bstring_obj);
GC_REG_TRAV(scheme_symbol_type, symbol_obj);
#ifdef MZ_USE_PLACES
#ifdef MZ_USE_PLACES
GC_REG_TRAV(scheme_serialized_symbol_type, bstring_obj);
GC_REG_TRAV(scheme_serialized_keyword_type, bstring_obj);
GC_REG_TRAV(scheme_place_dead_type, small_object);