`filesystem-change-evt' and use repairs

This commit is contained in:
Matthew Flatt 2013-07-07 08:00:09 -06:00
parent 22ab892143
commit 7ef5048961
4 changed files with 861 additions and 871 deletions

File diff suppressed because it is too large Load Diff

View File

@ -5976,6 +5976,11 @@ Scheme_Object *scheme_file_unlock(int argc, Scheme_Object **argv)
/* filesystem change events */
/*========================================================================*/
static void filesystem_change_evt_fnl(void *fc, void *data)
{
scheme_filesystem_change_evt_cancel((Scheme_Object *)fc, NULL);
}
Scheme_Object *scheme_filesystem_change_evt(Scheme_Object *path, int flags, int signal_errs)
{
char *filename;
@ -6089,6 +6094,7 @@ Scheme_Object *scheme_filesystem_change_evt(Scheme_Object *path, int flags, int
mref = scheme_add_managed(NULL, (Scheme_Object *)fc, scheme_filesystem_change_evt_cancel, NULL, 1);
fc->mref = mref;
scheme_add_finalizer(fc, filesystem_change_evt_fnl, NULL);
return (Scheme_Object *)fc;
}
@ -6127,6 +6133,8 @@ Scheme_Object *scheme_filesystem_change_evt(Scheme_Object *path, int flags, int
mref = scheme_add_managed(NULL, (Scheme_Object *)fc, scheme_filesystem_change_evt_cancel, NULL, 1);
fc->mref = mref;
scheme_add_finalizer(fc, filesystem_change_evt_fnl, NULL);
return (Scheme_Object *)fc;
}
#endif
@ -6161,10 +6169,8 @@ static int filesystem_change_evt_ready(Scheme_Object *evt, Scheme_Schedule_Info
# if defined(DOS_FILE_SYSTEM)
if (fc->fd) {
if (WaitForSingleObject((HANDLE)fc->fd, 0) == WAIT_OBJECT_0) {
FindCloseChangeNotification((HANDLE)fc->fd);
fc->fd = 0;
}
if (WaitForSingleObject((HANDLE)fc->fd, 0) == WAIT_OBJECT_0)
scheme_filesystem_change_evt_cancel((Scheme_Object *)fc, NULL);
}
return !fc->fd;

View File

@ -473,11 +473,6 @@
"(lambda()(close-input-port p))))"
" evt))))))"
" stamp-prompt-tag)))))"
"(define-values(stamp=?)"
"(lambda(a b)"
"(if(and(pair? a)(pair? b))"
"(equal?(car a)(car b))"
"(equal? a b))))"
"(define-values(no-file-stamp?)"
"(lambda(a)"
"(or(not a)"
@ -527,7 +522,7 @@
"(shared? shared-links-stamp)"
"(else(vector-ref links-stamps ii))))"
"(ts(file->stamp a-links-path a-links-stamp)))"
"(if(not(stamp=? ts a-links-stamp))"
"(if(not(equal? ts a-links-stamp))"
"(with-continuation-mark"
" exception-handler-key"
"(make-handler ts)"

View File

@ -560,12 +560,6 @@
evt))))))
stamp-prompt-tag)])))
(define-values (stamp=?)
(lambda (a b)
(if (and (pair? a) (pair? b))
(equal? (car a) (car b))
(equal? a b))))
(define-values (no-file-stamp?)
(lambda (a)
(or (not a)
@ -617,7 +611,7 @@
[shared? shared-links-stamp]
[else (vector-ref links-stamps ii)])]
[ts (file->stamp a-links-path a-links-stamp)])
(if (not (stamp=? ts a-links-stamp))
(if (not (equal? ts a-links-stamp))
(with-continuation-mark
exception-handler-key
(make-handler ts)