From e64089fd0a6ec71db86e0d5903a5d6ff7d7127b5 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@oberon.internal.stack-effects.com>
Date: Tue, 12 Feb 2008 02:21:47 -0600
Subject: [PATCH] Mac OS X monitors work in progress
---
extra/core-foundation/core-foundation.factor | 39 ++--
.../core-foundation/fsevents/fsevents.factor | 203 ++++++++++++++++++
extra/io/unix/bsd/bsd.factor | 10 +-
extra/io/unix/freebsd/freebsd.factor | 8 +
extra/io/unix/linux/linux.factor | 2 -
extra/io/unix/macosx/macosx.factor | 27 +++
extra/io/unix/netbsd/netbsd.factor | 8 +
extra/io/unix/openbsd/openbsd.factor | 8 +
extra/io/unix/unix.factor | 9 +-
extra/io/windows/nt/nt.factor | 2 -
10 files changed, 288 insertions(+), 28 deletions(-)
create mode 100644 extra/core-foundation/fsevents/fsevents.factor
create mode 100644 extra/io/unix/freebsd/freebsd.factor
create mode 100644 extra/io/unix/macosx/macosx.factor
create mode 100644 extra/io/unix/netbsd/netbsd.factor
create mode 100644 extra/io/unix/openbsd/openbsd.factor
diff --git a/extra/core-foundation/core-foundation.factor b/extra/core-foundation/core-foundation.factor
index 4abbeafe57..297e4aec87 100644
--- a/extra/core-foundation/core-foundation.factor
+++ b/extra/core-foundation/core-foundation.factor
@@ -1,35 +1,45 @@
-! Copyright (C) 2006 Slava Pestov
+! Copyright (C) 2006, 2008 Slava Pestov
! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.c-types alien.syntax kernel math sequences ;
IN: core-foundation
+TYPEDEF: void* CFAllocatorRef
+TYPEDEF: void* CFArrayRef
+TYPEDEF: void* CFBundleRef
+TYPEDEF: void* CFStringRef
+TYPEDEF: void* CFURLRef
+TYPEDEF: void* CFUUIDRef
+TYPEDEF: void* CFRunLoopRef
+TYPEDEF: bool Boolean
TYPEDEF: int CFIndex
+TYPEDEF: double CFTimeInterval
+TYPEDEF: double CFAbsoluteTime
-FUNCTION: void* CFArrayCreateMutable ( void* allocator, CFIndex capacity, void* callbacks ) ;
+FUNCTION: CFArrayRef CFArrayCreateMutable ( CFAllocatorRef allocator, CFIndex capacity, void* callbacks ) ;
-FUNCTION: void* CFArrayGetValueAtIndex ( void* array, CFIndex idx ) ;
+FUNCTION: void* CFArrayGetValueAtIndex ( CFArrayRef array, CFIndex idx ) ;
-FUNCTION: void CFArraySetValueAtIndex ( void* array, CFIndex index, void* value ) ;
+FUNCTION: void CFArraySetValueAtIndex ( CFArrayRef array, CFIndex index, void* value ) ;
-FUNCTION: CFIndex CFArrayGetCount ( void* array ) ;
+FUNCTION: CFIndex CFArrayGetCount ( CFArrayRef array ) ;
: kCFURLPOSIXPathStyle 0 ;
-FUNCTION: void* CFURLCreateWithFileSystemPath ( void* allocator, void* filePath, int pathStyle, bool isDirectory ) ;
+FUNCTION: CFURLRef CFURLCreateWithFileSystemPath ( CFAllocatorRef allocator, CFStringRef filePath, int pathStyle, Boolean isDirectory ) ;
-FUNCTION: void* CFURLCreateWithString ( void* allocator, void* string, void* base ) ;
+FUNCTION: CFURLRef CFURLCreateWithString ( CFAllocatorRef allocator, CFStringRef string, CFURLRef base ) ;
-FUNCTION: void* CFURLCopyFileSystemPath ( void* url, int pathStyle ) ;
+FUNCTION: CFURLRef CFURLCopyFileSystemPath ( CFURLRef url, int pathStyle ) ;
-FUNCTION: void* CFStringCreateWithCharacters ( void* allocator, ushort* cStr, CFIndex numChars ) ;
+FUNCTION: CFStringRef CFStringCreateWithCharacters ( CFAllocatorRef allocator, ushort* cStr, CFIndex numChars ) ;
-FUNCTION: CFIndex CFStringGetLength ( void* theString ) ;
+FUNCTION: CFIndex CFStringGetLength ( CFStringRef theString ) ;
FUNCTION: void CFStringGetCharacters ( void* theString, CFIndex start, CFIndex length, void* buffer ) ;
-FUNCTION: void* CFBundleCreate ( void* allocator, void* bundleURL ) ;
+FUNCTION: CFBundleRef CFBundleCreate ( CFAllocatorRef allocator, CFURLRef bundleURL ) ;
-FUNCTION: bool CFBundleLoadExecutable ( void* bundle ) ;
+FUNCTION: Boolean CFBundleLoadExecutable ( CFBundleRef bundle ) ;
FUNCTION: void CFRelease ( void* cf ) ;
@@ -52,6 +62,9 @@ FUNCTION: void CFRelease ( void* cf ) ;
: CF>string-array ( alien -- seq )
CF>array [ CF>string ] map ;
+: <CFStringArray> ( seq -- alien )
+ [ <CFString> ] map dup <CFArray> swap [ CFRelease ] each ;
+
: <CFFileSystemURL> ( string dir? -- url )
>r <CFString> f over kCFURLPOSIXPathStyle
r> CFURLCreateWithFileSystemPath swap CFRelease ;
@@ -72,3 +85,5 @@ FUNCTION: void CFRelease ( void* cf ) ;
] [
"Cannot load bundled named " swap append throw
] ?if ;
+
+FUNCTION: CFRunLoopRef CFRunLoopGetMain ( ) ;
diff --git a/extra/core-foundation/fsevents/fsevents.factor b/extra/core-foundation/fsevents/fsevents.factor
new file mode 100644
index 0000000000..73232ad522
--- /dev/null
+++ b/extra/core-foundation/fsevents/fsevents.factor
@@ -0,0 +1,203 @@
+! Copyright (C) 2008 Slava Pestov
+! See http://factorcode.org/license.txt for BSD license.
+USING: alien alien.c-types alien.syntax kernel math sequences
+namespaces assocs init continuations ;
+IN: core-foundation
+
+! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
+! FSEventStream API, Leopard only !
+! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
+
+: kFSEventStreamCreateFlagUseCFTypes 2 ; inline
+: kFSEventStreamCreateFlagWatchRoot 4 ; inline
+
+: kFSEventStreamEventFlagMustScanSubDirs 1 ; inline
+: kFSEventStreamEventFlagUserDropped 2 ; inline
+: kFSEventStreamEventFlagKernelDropped 4 ; inline
+: kFSEventStreamEventFlagEventIdsWrapped 8 ; inline
+: kFSEventStreamEventFlagHistoryDone 16 ; inline
+: kFSEventStreamEventFlagRootChanged 32 ; inline
+: kFSEventStreamEventFlagMount 64 ; inline
+: kFSEventStreamEventFlagUnmount 128 ; inline
+
+TYPEDEF: int FSEventStreamCreateFlags
+TYPEDEF: int FSEventStreamEventFlags
+TYPEDEF: longlong FSEventStreamEventId
+TYPEDEF: void* FSEventStreamRef
+
+C-STRUCT: FSEventStreamContext
+ { "CFIndex" "version" }
+ { "void*" "info" }
+ { "void*" "retain" }
+ { "void*" "release" }
+ { "void*" "copyDescription" } ;
+
+! callback(FSEventStreamRef streamRef, void *clientCallBackInfo, size_t numEvents, void *eventPaths, const FSEventStreamEventFlags eventFlags[], const FSEventStreamEventId eventIds[]);
+TYPEDEF: void* FSEventStreamCallback
+
+: FSEventStreamEventIdSinceNow HEX: FFFFFFFFFFFFFFFF ; inline
+
+FUNCTION: FSEventStreamRef FSEventStreamCreate (
+ CFAllocatorRef allocator,
+ FSEventStreamCallback callback,
+ FSEventStreamContext* context,
+ CFArrayRef pathsToWatch,
+ FSEventStreamEventId sinceWhen,
+ CFTimeInterval latency,
+ FSEventStreamCreateFlags flags ) ;
+
+FUNCTION: FSEventStreamRef FSEventStreamCreateRelativeToDevice (
+ CFAllocatorRef allocator,
+ FSEventStreamCallback callback,
+ FSEventStreamContext* context,
+ dev_t deviceToWatch,
+ CFArrayRef pathsToWatchRelativeToDevice,
+ FSEventStreamEventId sinceWhen,
+ CFTimeInterval latency,
+ FSEventStreamCreateFlags flags ) ;
+
+FUNCTION: FSEventStreamEventId FSEventStreamGetLatestEventId ( FSEventStreamRef streamRef ) ;
+
+FUNCTION: dev_t FSEventStreamGetDeviceBeingWatched ( FSEventStreamRef streamRef ) ;
+
+FUNCTION: CFArrayRef FSEventStreamCopyPathsBeingWatched ( FSEventStreamRef streamRef ) ;
+
+FUNCTION: FSEventStreamEventId FSEventsGetCurrentEventId ( ) ;
+
+FUNCTION: CFUUIDRef FSEventsCopyUUIDForDevice ( dev_t dev ) ;
+
+FUNCTION: FSEventStreamEventId FSEventsGetLastEventIdForDeviceBeforeTime (
+ dev_t dev,
+ CFAbsoluteTime time ) ;
+
+FUNCTION: Boolean FSEventsPurgeEventsForDeviceUpToEventId (
+ dev_t dev,
+ FSEventStreamEventId eventId ) ;
+
+FUNCTION: void FSEventStreamRetain ( FSEventStreamRef streamRef ) ;
+
+FUNCTION: void FSEventStreamRelease ( FSEventStreamRef streamRef ) ;
+
+FUNCTION: void FSEventStreamScheduleWithRunLoop (
+ FSEventStreamRef streamRef,
+ CFRunLoopRef runLoop,
+ CFStringRef runLoopMode ) ;
+
+FUNCTION: void FSEventStreamUnscheduleFromRunLoop (
+ FSEventStreamRef streamRef,
+ CFRunLoopRef runLoop,
+ CFStringRef runLoopMode ) ;
+
+FUNCTION: void FSEventStreamInvalidate ( FSEventStreamRef streamRef ) ;
+
+FUNCTION: Boolean FSEventStreamStart ( FSEventStreamRef streamRef ) ;
+
+FUNCTION: FSEventStreamEventId FSEventStreamFlushAsync ( FSEventStreamRef streamRef ) ;
+
+FUNCTION: void FSEventStreamFlushSync ( FSEventStreamRef streamRef ) ;
+
+FUNCTION: void FSEventStreamStop ( FSEventStreamRef streamRef ) ;
+
+FUNCTION: void FSEventStreamShow ( FSEventStreamRef streamRef ) ;
+
+FUNCTION: CFStringRef FSEventStreamCopyDescription ( FSEventStreamRef streamRef ) ;
+
+: make-FSEventStreamContext ( info -- alien )
+ "FSEventStreamContext" <c-object>
+ [ set-FSEventStreamContext-info ] keep ;
+
+: <FSEventStream> ( callback info paths latency flags -- event-stream )
+ >r >r >r >r >r
+ f ! allocator
+ r> ! callback
+ r> make-FSEventStreamContext
+ r> <CFStringArray> ! paths
+ FSEventStreamEventIdSinceNow ! sinceWhen
+ r> ! latency
+ r> ! flags
+ FSEventStreamCreate ;
+
+: kCFRunLoopCommonModes ( -- string )
+ "kCFRunLoopCommonModes" f dlsym *void* ;
+
+: schedule-event-stream ( event-stream -- )
+ CFRunLoopGetMain
+ kCFRunLoopCommonModes
+ FSEventStreamScheduleWithRunLoop ;
+
+: unschedule-event-stream ( event-stream -- )
+ CFRunLoopGetMain
+ kCFRunLoopCommonModes
+ FSEventStreamUnscheduleFromRunLoop ;
+
+: enable-event-stream ( event-stream -- )
+ dup
+ schedule-event-stream
+ dup FSEventStreamStart [
+ drop
+ ] [
+ dup unschedule-event-stream
+ FSEventStreamRelease
+ "Cannot enable FSEventStream" throw
+ ] if ;
+
+: disable-event-stream ( event-stream -- )
+ dup FSEventStreamStop
+ unschedule-event-stream ;
+
+SYMBOL: event-stream-callbacks
+
+: event-stream-counter \ event-stream-counter counter ;
+
+[
+ H{ } clone event-stream-callbacks set-global
+ 1 \ event-stream-counter set-global
+] "core-foundation" add-init-hook
+
+event-stream-callbacks global [ H{ } assoc-like ] change-at
+
+: add-event-source-callback ( quot -- id )
+ event-stream-counter <alien>
+ [ event-stream-callbacks get set-at ] keep ;
+
+: remove-event-source-callback ( id -- )
+ event-stream-callbacks get delete-at ;
+
+: >event-triple ( n eventPaths eventFlags eventIds -- triple )
+ [
+ >r >r >r dup dup
+ r> char*-nth ,
+ r> int-nth ,
+ r> longlong-nth ,
+ ] { } make ;
+
+: master-event-source-callback ( -- alien )
+ "void"
+ {
+ "FSEventStreamRef"
+ "void*" ! info
+ "size_t" ! numEvents
+ "void*" ! eventPaths
+ "FSEventStreamEventFlags*"
+ "FSEventStreamEventId*"
+ }
+ "cdecl" [
+ [ >event-triple ] 3curry map
+ swap event-stream-callbacks get at call
+ drop
+ ] alien-callback ;
+
+TUPLE: event-stream info handle ;
+
+: <event-stream> ( quot paths latency flags -- event-stream )
+ >r >r >r
+ add-event-source-callback dup
+ >r master-event-source-callback r>
+ r> r> r> <FSEventStream>
+ dup enable-event-stream
+ event-stream construct-boa ;
+
+M: event-stream dispose
+ dup event-stream-info remove-event-source-callback
+ event-stream-handle dup disable-event-stream
+ FSEventStreamRelease ;
diff --git a/extra/io/unix/bsd/bsd.factor b/extra/io/unix/bsd/bsd.factor
index a4315ce5d0..0ab9f4ed2a 100755
--- a/extra/io/unix/bsd/bsd.factor
+++ b/extra/io/unix/bsd/bsd.factor
@@ -5,14 +5,14 @@ USING: io.backend io.unix.backend io.unix.kqueue io.unix.select
io.launcher io.unix.launcher namespaces kernel assocs threads
continuations ;
-! On *BSD and Mac OS X, we use select() for the top-level
-! multiplexer, and we hang a kqueue off of it but file change
-! notification and process exit notification.
+! On Mac OS X, we use select() for the top-level
+! multiplexer, and we hang a kqueue off of it for process exit
+! notification.
! kqueue is buggy with files and ptys so we can't use it as the
! main multiplexer.
-TUPLE: bsd-io ;
+MIXIN: bsd-io
INSTANCE: bsd-io unix-io
@@ -25,5 +25,3 @@ M: bsd-io init-io ( -- )
M: bsd-io register-process ( process -- )
process-handle kqueue-mx get-global add-pid-task ;
-
-T{ bsd-io } set-io-backend
diff --git a/extra/io/unix/freebsd/freebsd.factor b/extra/io/unix/freebsd/freebsd.factor
new file mode 100644
index 0000000000..2aad0bdb1a
--- /dev/null
+++ b/extra/io/unix/freebsd/freebsd.factor
@@ -0,0 +1,8 @@
+IN: io.unix.freebsd
+USING: io.unix.bsd io.backend core-foundation.fsevents ;
+
+TUPLE: freebsd-io ;
+
+INSTANCE: freebsd-io bsd-io
+
+T{ freebsd-io } set-io-backend
diff --git a/extra/io/unix/linux/linux.factor b/extra/io/unix/linux/linux.factor
index b3bd2eee4e..dc4c8c8760 100755
--- a/extra/io/unix/linux/linux.factor
+++ b/extra/io/unix/linux/linux.factor
@@ -136,5 +136,3 @@ M: linux-io init-io ( -- )
T{ linux-io } set-io-backend
[ start-wait-thread ] "io.unix.linux" add-init-hook
-
-"vocabs.monitor" require
\ No newline at end of file
diff --git a/extra/io/unix/macosx/macosx.factor b/extra/io/unix/macosx/macosx.factor
new file mode 100644
index 0000000000..22c013d64b
--- /dev/null
+++ b/extra/io/unix/macosx/macosx.factor
@@ -0,0 +1,27 @@
+IN: io.unix.macosx
+USING: io.unix.bsd io.backend io.monitors io.monitors.private
+continuations kernel core-foundation.fsevents ;
+
+TUPLE: macosx-io ;
+
+INSTANCE: macosx-io bsd-io
+
+T{ macosx-io } set-io-backend
+
+TUPLE: macosx-monitor ;
+
+: enqueue-notifications ( triples monitor -- )
+ monitor-queue [
+ [ first { +modify-file+ } swap changed-file ] each
+ ] bind ;
+
+M: macosx-io <monitor>
+ drop
+ f macosx-monitor construct-simple-monitor
+ dup [ enqueue-notifications ] curry
+ rot 1array 0 0 <event-stream>
+ over set-simple-monitor-handle ;
+
+M: macosx-monitor dispose
+ dup simple-monitor-handle dispose delegate dispose ;
+
diff --git a/extra/io/unix/netbsd/netbsd.factor b/extra/io/unix/netbsd/netbsd.factor
new file mode 100644
index 0000000000..3aa8678702
--- /dev/null
+++ b/extra/io/unix/netbsd/netbsd.factor
@@ -0,0 +1,8 @@
+IN: io.unix.netbsd
+USING: io.unix.bsd io.backend ;
+
+TUPLE: netbsd-io ;
+
+INSTANCE: netbsd-io bsd-io
+
+T{ netbsd-io } set-io-backend
diff --git a/extra/io/unix/openbsd/openbsd.factor b/extra/io/unix/openbsd/openbsd.factor
new file mode 100644
index 0000000000..767861ec75
--- /dev/null
+++ b/extra/io/unix/openbsd/openbsd.factor
@@ -0,0 +1,8 @@
+IN: io.unix.openbsd
+USING: io.unix.bsd io.backend core-foundation.fsevents ;
+
+TUPLE: openbsd-io ;
+
+INSTANCE: openbsd-io bsd-io
+
+T{ openbsd-io } set-io-backend
diff --git a/extra/io/unix/unix.factor b/extra/io/unix/unix.factor
index 9013df29aa..14fab00a15 100755
--- a/extra/io/unix/unix.factor
+++ b/extra/io/unix/unix.factor
@@ -2,9 +2,6 @@ USING: io.unix.backend io.unix.files io.unix.sockets io.timeouts
io.unix.launcher io.unix.mmap io.backend combinators namespaces
system vocabs.loader ;
-{
- { [ bsd? ] [ "io.unix.bsd" ] }
- { [ macosx? ] [ "io.unix.bsd" ] }
- { [ linux? ] [ "io.unix.linux" ] }
- { [ solaris? ] [ "io.unix.solaris" ] }
-} cond require
+"io.unix." os append require
+
+"vocabs.monitor" require
diff --git a/extra/io/windows/nt/nt.factor b/extra/io/windows/nt/nt.factor
index be57a398a2..da7e83baca 100755
--- a/extra/io/windows/nt/nt.factor
+++ b/extra/io/windows/nt/nt.factor
@@ -12,5 +12,3 @@ USE: io.windows.mmap
USE: io.backend
T{ windows-nt-io } set-io-backend
-
-"vocabs.monitor" require