Merge branch 'master' of git://factorcode.org/git/factor

basis/alien/c-types/c-types-tests.factor

@@ -8,7 +8,7 @@ sequences system libc alien.strings io.encodings.utf8 ;
 
 [ { "blah" 123 } ] [ { "blah" xyz } expand-constants ] unit-test
 
-: foo ( -- n ) "fdafd" f dlsym [ 123 ] unless* ;
+: foo ( -- n ) &: fdafd [ 123 ] unless* ;
 
 [ 123 ] [ foo ] unit-test
 

basis/alien/syntax/syntax-docs.factor

@@ -77,6 +77,11 @@ HELP: C-ENUM:
     { $code "C-ENUM: red green blue ;" ": red 0 ;  : green 1 ;  : blue 2 ;" }
 } ;
 
+HELP: &:
+{ $syntax "&: symbol" }
+{ $values { "symbol" "A C library symbol name" } }
+{ $description "Pushes the address of a symbol named " { $snippet "symbol" } " from the current library, set with " { $link POSTPONE: LIBRARY: } "." } ;
+
 HELP: typedef
 { $values { "old" "a string" } { "new" "a string" } }
 { $description "Alises the C type " { $snippet "old" } " under the name " { $snippet "new" } "." }

basis/alien/syntax/syntax.factor

@@ -3,7 +3,8 @@
 USING: accessors arrays alien alien.c-types alien.structs
 alien.arrays alien.strings kernel math namespaces parser
 sequences words quotations math.parser splitting grouping
-effects assocs combinators lexer strings.parser alien.parser ;
+effects assocs combinators lexer strings.parser alien.parser 
+fry ;
 IN: alien.syntax
 
 : DLL" lexer get skip-blank parse-string dlopen parsed ; parsing
@@ -33,3 +34,7 @@ IN: alien.syntax
     dup length
     [ [ create-in ] dip 1quotation define ] 2each ;
     parsing
+
+: &:
+    scan "c-library" get
+    '[ _ _ load-library dlsym ] over push-all ; parsing

basis/bootstrap/finish-bootstrap.factor

@@ -12,5 +12,6 @@ namespaces eval kernel vocabs.loader io ;
         ignore-cli-args? not script get and
         [ run-script ] [ "run" get run ] if*
         output-stream get [ stream-flush ] when*
+        0 exit
     ] [ print-error 1 exit ] recover
 ] set-boot-quot

basis/bootstrap/finish-staging.factor

@@ -7,4 +7,5 @@ io ;
     (command-line) parse-command-line
     "run" get run
     output-stream get [ stream-flush ] when*
+    0 exit
 ] set-boot-quot

basis/bootstrap/stage2.factor

@@ -102,6 +102,8 @@ SYMBOL: bootstrap-time
     ] if
 ] [
     drop
-    load-help? off
-    "resource:basis/bootstrap/bootstrap-error.factor" run-file
+    [
+        load-help? off
+        "resource:basis/bootstrap/bootstrap-error.factor" run-file
+    ] with-scope
 ] recover

basis/cocoa/application/application-docs.factor

@@ -1,5 +1,5 @@
 USING: debugger quotations help.markup help.syntax strings alien
-core-foundation ;
+core-foundation core-foundation.strings core-foundation.arrays ;
 IN: cocoa.application
 
 HELP: <NSString>
@@ -30,10 +30,6 @@ HELP: cocoa-app
 { $values { "quot" quotation } }
 { $description "Initializes Cocoa, calls the quotation, and starts the Cocoa event loop." } ;
 
-HELP: do-event
-{ $values { "app" "an " { $snippet "NSApplication" } } { "?" "a boolean" } }
-{ $description "Processes a pending event in the queue, if any, returning a boolean indicating if there was one. Does not block." } ;
-
 HELP: add-observer
 { $values { "observer" "an " { $snippet "NSObject" } } { "selector" string } { "name" "an " { $snippet "NSString" } } { "object" "an " { $snippet "NSObject" } } }
 { $description "Registers an observer with the " { $snippet "NSNotificationCenter" } " singleton." } ;
@@ -52,7 +48,6 @@ HELP: objc-error
 ARTICLE: "cocoa-application-utils" "Cocoa application utilities"
 "Utilities:"
 { $subsection NSApp }
-{ $subsection do-event }
 { $subsection add-observer }
 { $subsection remove-observer }
 { $subsection install-delegate }

basis/cocoa/application/application.factor

@@ -1,7 +1,8 @@
 ! Copyright (C) 2006, 2008 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien alien.syntax io kernel namespaces core-foundation
-core-foundation.run-loop cocoa.messages cocoa cocoa.classes
+core-foundation.arrays core-foundation.data
+core-foundation.strings cocoa.messages cocoa cocoa.classes
 cocoa.runtime sequences threads init summary kernel.private
 assocs ;
 IN: cocoa.application
@@ -34,13 +35,6 @@ FUNCTION: void NSBeep ( ) ;
 : with-cocoa ( quot -- )
     [ NSApp drop call ] with-autorelease-pool ; inline
 
-: next-event ( app -- event )
-    NSAnyEventMask f CFRunLoopDefaultMode 1
-    -> nextEventMatchingMask:untilDate:inMode:dequeue: ;
-
-: do-event ( app -- ? )
-    dup next-event [ dupd -> sendEvent: -> updateWindows t ] [ drop f ] if* ;
-
 : add-observer ( observer selector name object -- )
     [
         [ NSNotificationCenter -> defaultCenter ] 2dip

basis/cocoa/cocoa.factor

@@ -2,8 +2,8 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: compiler io kernel cocoa.runtime cocoa.subclassing
 cocoa.messages cocoa.types sequences words vocabs parser
-core-foundation namespaces assocs hashtables compiler.units
-lexer init ;
+core-foundation.bundles namespaces assocs hashtables
+compiler.units lexer init ;
 IN: cocoa
 
 : (remember-send) ( selector variable -- )

basis/cocoa/dialogs/dialogs.factor

@@ -1,7 +1,8 @@
 ! Copyright (C) 2006, 2008 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel cocoa cocoa.messages cocoa.classes
-cocoa.application sequences splitting core-foundation ;
+cocoa.application sequences splitting core-foundation
+core-foundation.strings ;
 IN: cocoa.dialogs
 
 : <NSOpenPanel> ( -- panel )

basis/cocoa/nibs/nibs.factor

@@ -1,5 +1,8 @@
-USING: cocoa.application cocoa.messages cocoa.classes cocoa.runtime 
-kernel cocoa core-foundation alien.c-types ;
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: cocoa.application cocoa.messages cocoa.classes
+cocoa.runtime kernel cocoa alien.c-types core-foundation
+core-foundation.arrays ;
 IN: cocoa.nibs
 
 : load-nib ( name -- )

basis/cocoa/pasteboard/pasteboard.factor

@@ -1,8 +1,8 @@
 ! Copyright (C) 2006, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien.accessors arrays kernel cocoa.messages
-cocoa.classes cocoa.application cocoa core-foundation sequences
-;
+cocoa.classes cocoa.application sequences cocoa core-foundation
+core-foundation.strings core-foundation.arrays ;
 IN: cocoa.pasteboard
 
 : NSStringPboardType "NSStringPboardType" ;

basis/cocoa/plists/plists.factor

@@ -3,7 +3,7 @@
 USING: strings arrays hashtables assocs sequences
 cocoa.messages cocoa.classes cocoa.application cocoa kernel
 namespaces io.backend math cocoa.enumeration byte-arrays
-combinators alien.c-types core-foundation ;
+combinators alien.c-types core-foundation core-foundation.data ;
 IN: cocoa.plists
 
 GENERIC: >plist ( value -- plist )

basis/cocoa/views/views.factor

@@ -55,10 +55,9 @@ PRIVATE>
 : with-multisample ( quot -- )
     t +multisample+ pick with-variable ; inline
 
-: <PixelFormat> ( -- pixelfmt )
-    NSOpenGLPixelFormat -> alloc [
-        NSOpenGLPFAWindow ,
-        NSOpenGLPFADoubleBuffer ,
+: <PixelFormat> ( attributes -- pixelfmt )
+    NSOpenGLPixelFormat -> alloc swap [
+        %
         NSOpenGLPFADepthSize , 16 ,
         +software-renderer+ get [
             NSOpenGLPFARendererID , kCGLRendererGenericFloatID ,
@@ -74,7 +73,8 @@ PRIVATE>
     -> autorelease ;
 
 : <GLView> ( class dim -- view )
-    [ -> alloc 0 0 ] dip first2 <NSRect> <PixelFormat>
+    [ -> alloc 0 0 ] dip first2 <NSRect>
+    NSOpenGLPFAWindow NSOpenGLPFADoubleBuffer 2array <PixelFormat>
     -> initWithFrame:pixelFormat:
     dup 1 -> setPostsBoundsChangedNotifications:
     dup 1 -> setPostsFrameChangedNotifications: ;

basis/compiler/tests/alien.factor

@@ -83,14 +83,14 @@ FUNCTION: tiny ffi_test_17 int x ;
 
 { 1 1 } [ indirect-test-1 ] must-infer-as
 
-[ 3 ] [ "ffi_test_1" f dlsym indirect-test-1 ] unit-test
+[ 3 ] [ &: ffi_test_1 indirect-test-1 ] unit-test
 
 : indirect-test-1' ( ptr -- )
     "int" { } "cdecl" alien-indirect drop ;
 
 { 1 0 } [ indirect-test-1' ] must-infer-as
 
-[ ] [ "ffi_test_1" f dlsym indirect-test-1' ] unit-test
+[ ] [ &: ffi_test_1 indirect-test-1' ] unit-test
 
 [ -1 indirect-test-1 ] must-fail
 
@@ -100,7 +100,7 @@ FUNCTION: tiny ffi_test_17 int x ;
 { 3 1 } [ indirect-test-2 ] must-infer-as
 
 [ 5 ]
-[ 2 3 "ffi_test_2" f dlsym indirect-test-2 ]
+[ 2 3 &: ffi_test_2 indirect-test-2 ]
 unit-test
 
 : indirect-test-3 ( a b c d ptr -- result )

basis/core-foundation/arrays/arrays-docs.factor

@@ -0,0 +1,11 @@
+USING: help.syntax help.markup arrays alien ;
+IN: core-foundation.arrays
+
+HELP: CF>array
+{ $values { "alien" "a " { $snippet "CFArray" } } { "array" "an array of " { $link alien } " instances" } }
+{ $description "Creates a Factor array from a Core Foundation array." } ;
+
+HELP: <CFArray>
+{ $values { "seq" "a sequence of " { $link alien } " instances" } { "alien" "a " { $snippet "CFArray" } } }
+{ $description "Creates a Core Foundation array from a Factor array." } ;
+

basis/core-foundation/arrays/arrays.factor

@@ -0,0 +1,22 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: alien.syntax kernel sequences ;
+IN: core-foundation.arrays
+
+TYPEDEF: void* CFArrayRef
+
+FUNCTION: CFArrayRef CFArrayCreateMutable ( CFAllocatorRef allocator, CFIndex capacity, void* callbacks ) ;
+
+FUNCTION: void* CFArrayGetValueAtIndex ( CFArrayRef array, CFIndex idx ) ;
+
+FUNCTION: void CFArraySetValueAtIndex ( CFArrayRef array, CFIndex index, void* value ) ;
+
+FUNCTION: CFIndex CFArrayGetCount ( CFArrayRef array ) ;
+
+: CF>array ( alien -- array )
+    dup CFArrayGetCount [ CFArrayGetValueAtIndex ] with map ;
+
+: <CFArray> ( seq -- alien )
+    [ f swap length f CFArrayCreateMutable ] keep
+    [ length ] keep
+    [ [ dupd ] dip CFArraySetValueAtIndex ] 2each ;

basis/core-foundation/arrays/tags.txt

@@ -0,0 +1,2 @@
+unportable
+bindings

basis/core-foundation/bundles/bundles-docs.factor

@@ -0,0 +1,11 @@
+USING: help.syntax help.markup ;
+IN: core-foundation.bundles
+
+HELP: <CFBundle>
+{ $values { "string" "a pathname string" } { "bundle" "a " { $snippet "CFBundle" } } }
+{ $description "Creates a new " { $snippet "CFBundle" } "." } ;
+
+HELP: load-framework
+{ $values { "name" "a pathname string" } }
+{ $description "Loads a Core Foundation framework." } ;
+

basis/core-foundation/bundles/bundles.factor

@@ -0,0 +1,23 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: alien.syntax kernel sequences core-foundation
+core-foundation.urls ;
+IN: core-foundation.bundles
+
+TYPEDEF: void* CFBundleRef
+
+FUNCTION: CFBundleRef CFBundleCreate ( CFAllocatorRef allocator, CFURLRef bundleURL ) ;
+
+FUNCTION: Boolean CFBundleLoadExecutable ( CFBundleRef bundle ) ;
+
+: <CFBundle> ( string -- bundle )
+    t <CFFileSystemURL> [
+        f swap CFBundleCreate
+    ] keep CFRelease ;
+
+: load-framework ( name -- )
+    dup <CFBundle> [
+        CFBundleLoadExecutable drop
+    ] [
+        "Cannot load bundle named " prepend throw
+    ] ?if ;

basis/core-foundation/bundles/tags.txt

@@ -0,0 +1,2 @@
+unportable
+bindings

basis/core-foundation/core-foundation-docs.factor

@@ -1,42 +1,6 @@
 USING: alien strings arrays help.markup help.syntax destructors ;
 IN: core-foundation
 
-HELP: CF>array
-{ $values { "alien" "a " { $snippet "CFArray" } } { "array" "an array of " { $link alien } " instances" } }
-{ $description "Creates a Factor array from a Core Foundation array." } ;
-
-HELP: <CFArray>
-{ $values { "seq" "a sequence of " { $link alien } " instances" } { "alien" "a " { $snippet "CFArray" } } }
-{ $description "Creates a Core Foundation array from a Factor array." } ;
-
-HELP: <CFString>
-{ $values { "string" string } { "alien" "a " { $snippet "CFString" } } }
-{ $description "Creates a Core Foundation string from a Factor string." } ;
-
-HELP: CF>string
-{ $values { "alien" "a " { $snippet "CFString" } } { "string" string } }
-{ $description "Creates a Factor string from a Core Foundation string." } ;
-
-HELP: CF>string-array
-{ $values { "alien" "a " { $snippet "CFArray" } " of " { $snippet "CFString" } " instances" } { "seq" string } }
-{ $description "Creates an array of Factor strings from a " { $snippet "CFArray" } " of " { $snippet "CFString" } "s." } ;
-
-HELP: <CFFileSystemURL>
-{ $values { "string" "a pathname string" } { "dir?" "a boolean indicating if the pathname is a directory" } { "url" "a " { $snippet "CFURL" } } }
-{ $description "Creates a new " { $snippet "CFURL" } " pointing to the given local pathname." } ;
-
-HELP: <CFURL>
-{ $values { "string" "a URL string" } { "url" "a " { $snippet "CFURL" } } }
-{ $description "Creates a new " { $snippet "CFURL" } "." } ;
-
-HELP: <CFBundle>
-{ $values { "string" "a pathname string" } { "bundle" "a " { $snippet "CFBundle" } } }
-{ $description "Creates a new " { $snippet "CFBundle" } "." } ;
-
-HELP: load-framework
-{ $values { "name" "a pathname string" } }
-{ $description "Loads a Core Foundation framework." } ;
-
 HELP: &CFRelease
 { $values { "alien" "Pointer to a Core Foundation object" } }
 { $description "Marks the given Core Foundation object for unconditional release via " { $link CFRelease } " at the end of the enclosing " { $link with-destructors } " scope." } ;
@@ -46,24 +10,3 @@ HELP: |CFRelease
 { $description "Marks the given Core Foundation object for release via " { $link CFRelease } " in the event of an error at the end of the enclosing " { $link with-destructors } " scope." } ;
 
 { CFRelease |CFRelease &CFRelease } related-words
-
-ARTICLE: "core-foundation" "Core foundation utilities"
-"The " { $vocab-link "core-foundation" } " vocabulary defines bindings for some frequently-used Core Foundation functions. It also provides some utility words."
-$nl
-"Strings:"
-{ $subsection <CFString> }
-{ $subsection CF>string }
-"Arrays:"
-{ $subsection <CFArray> }
-{ $subsection CF>array }
-{ $subsection CF>string-array }
-"URLs:"
-{ $subsection <CFFileSystemURL> }
-{ $subsection <CFURL> }
-"Frameworks:"
-{ $subsection load-framework }
-"Memory management:"
-{ $subsection &CFRelease }
-{ $subsection |CFRelease } ;
-
-ABOUT: "core-foundation"

basis/core-foundation/core-foundation.factor

@@ -1,212 +1,24 @@
 ! Copyright (C) 2006, 2008 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.c-types alien.strings alien.syntax kernel
-math sequences io.encodings.utf8 destructors accessors
-combinators byte-arrays ;
+USING: alien.syntax destructors accessors kernel ;
 IN: core-foundation
 
-TYPEDEF: void* CFAllocatorRef
-TYPEDEF: void* CFArrayRef
-TYPEDEF: void* CFDataRef
-TYPEDEF: void* CFDictionaryRef
-TYPEDEF: void* CFMutableDictionaryRef
-TYPEDEF: void* CFNumberRef
-TYPEDEF: void* CFBundleRef
-TYPEDEF: void* CFSetRef
-TYPEDEF: void* CFStringRef
-TYPEDEF: void* CFURLRef
-TYPEDEF: void* CFUUIDRef
 TYPEDEF: void* CFTypeRef
-TYPEDEF: void* CFFileDescriptorRef
+
+TYPEDEF: void* CFAllocatorRef
+: kCFAllocatorDefault f ; inline
+
 TYPEDEF: bool Boolean
 TYPEDEF: long CFIndex
 TYPEDEF: int SInt32
 TYPEDEF: uint UInt32
 TYPEDEF: ulong CFTypeID
 TYPEDEF: UInt32 CFOptionFlags
-TYPEDEF: double CFTimeInterval
-TYPEDEF: double CFAbsoluteTime
-TYPEDEF: int CFFileDescriptorNativeDescriptor
-TYPEDEF: void* CFFileDescriptorCallBack
-
-TYPEDEF: int CFNumberType
-: kCFNumberSInt8Type 1 ; inline
-: kCFNumberSInt16Type 2 ; inline
-: kCFNumberSInt32Type 3 ; inline
-: kCFNumberSInt64Type 4 ; inline
-: kCFNumberFloat32Type 5 ; inline
-: kCFNumberFloat64Type 6 ; inline
-: kCFNumberCharType 7 ; inline
-: kCFNumberShortType 8 ; inline
-: kCFNumberIntType 9 ; inline
-: kCFNumberLongType 10 ; inline
-: kCFNumberLongLongType 11 ; inline
-: kCFNumberFloatType 12 ; inline
-: kCFNumberDoubleType 13 ; inline
-: kCFNumberCFIndexType 14 ; inline
-: kCFNumberNSIntegerType 15 ; inline
-: kCFNumberCGFloatType 16 ; inline
-: kCFNumberMaxType 16 ; inline
-
-TYPEDEF: int CFPropertyListMutabilityOptions
-: kCFPropertyListImmutable                  0 ; inline
-: kCFPropertyListMutableContainers          1 ; inline
-: kCFPropertyListMutableContainersAndLeaves 2 ; inline
-
-FUNCTION: CFArrayRef CFArrayCreateMutable ( CFAllocatorRef allocator, CFIndex capacity, void* callbacks ) ;
-
-FUNCTION: void* CFArrayGetValueAtIndex ( CFArrayRef array, CFIndex idx ) ;
-
-FUNCTION: void CFArraySetValueAtIndex ( CFArrayRef array, CFIndex index, void* value ) ;
-
-FUNCTION: CFIndex CFArrayGetCount ( CFArrayRef array ) ;
-
-: kCFURLPOSIXPathStyle 0 ; inline
-: kCFAllocatorDefault f ; inline
-
-FUNCTION: CFURLRef CFURLCreateWithFileSystemPath ( CFAllocatorRef allocator, CFStringRef filePath, int pathStyle, Boolean isDirectory ) ;
-
-FUNCTION: CFURLRef CFURLCreateWithString ( CFAllocatorRef allocator, CFStringRef string, CFURLRef base ) ;
-
-FUNCTION: CFURLRef CFURLCopyFileSystemPath ( CFURLRef url, int pathStyle ) ;
-
-TYPEDEF: int CFStringEncoding
-: kCFStringEncodingMacRoman HEX: 0 ;
-: kCFStringEncodingWindowsLatin1 HEX: 0500 ;
-: kCFStringEncodingISOLatin1 HEX: 0201 ;
-: kCFStringEncodingNextStepLatin HEX: 0B01 ;
-: kCFStringEncodingASCII HEX: 0600 ;
-: kCFStringEncodingUnicode HEX: 0100 ;
-: kCFStringEncodingUTF8 HEX: 08000100 ;
-: kCFStringEncodingNonLossyASCII HEX: 0BFF ;
-: kCFStringEncodingUTF16 HEX: 0100 ;
-: kCFStringEncodingUTF16BE HEX: 10000100 ;
-: kCFStringEncodingUTF16LE HEX: 14000100 ;
-: kCFStringEncodingUTF32 HEX: 0c000100 ;
-: kCFStringEncodingUTF32BE HEX: 18000100 ;
-: kCFStringEncodingUTF32LE HEX: 1c000100 ;
-
-FUNCTION: CFStringRef CFStringCreateFromExternalRepresentation (
-   CFAllocatorRef alloc,
-   CFDataRef data,
-   CFStringEncoding encoding
-) ;
-
-FUNCTION: CFStringRef CFStringCreateWithBytes (
-   CFAllocatorRef alloc,
-   UInt8* bytes,
-   CFIndex numBytes,
-   CFStringEncoding encoding,
-   Boolean isExternalRepresentation
-) ;
-
-FUNCTION: CFIndex CFStringGetLength ( CFStringRef theString ) ;
-
-FUNCTION: void CFStringGetCharacters ( void* theString, CFIndex start, CFIndex length, void* buffer ) ;
-
-FUNCTION: Boolean CFStringGetCString (
-   CFStringRef theString,
-   char* buffer,
-   CFIndex bufferSize,
-   CFStringEncoding encoding
-) ;
-
-FUNCTION: CFStringRef CFStringCreateWithCString (
-   CFAllocatorRef alloc,
-   char* cStr,
-   CFStringEncoding encoding
-) ;
-
-FUNCTION: CFNumberRef CFNumberCreate ( CFAllocatorRef allocator, CFNumberType theType, void* valuePtr ) ;
-
-FUNCTION: CFDataRef CFDataCreate ( CFAllocatorRef allocator, uchar* bytes, CFIndex length ) ;
-
-FUNCTION: CFBundleRef CFBundleCreate ( CFAllocatorRef allocator, CFURLRef bundleURL ) ;
-
-FUNCTION: Boolean CFBundleLoadExecutable ( CFBundleRef bundle ) ;
 
 FUNCTION: CFTypeRef CFRetain ( CFTypeRef cf ) ;
+
 FUNCTION: void CFRelease ( CFTypeRef cf ) ;
 
-FUNCTION: CFTypeID CFGetTypeID ( CFTypeRef cf ) ;
-
-: CF>array ( alien -- array )
-    dup CFArrayGetCount [ CFArrayGetValueAtIndex ] with map ;
-
-: <CFArray> ( seq -- alien )
-    [ f swap length f CFArrayCreateMutable ] keep
-    [ length ] keep
-    [ [ dupd ] dip CFArraySetValueAtIndex ] 2each ;
-
-: <CFString> ( string -- alien )
-    f swap utf8 string>alien kCFStringEncodingUTF8 CFStringCreateWithCString
-    [ "CFStringCreateWithCString failed" throw ] unless* ;
-
-: CF>string ( alien -- string )
-    dup CFStringGetLength 4 * 1 + <byte-array> [
-        dup length
-        kCFStringEncodingUTF8
-        CFStringGetCString
-        [ "CFStringGetCString failed" throw ] unless
-    ] keep utf8 alien>string ;
-
-: CF>string-array ( alien -- seq )
-    CF>array [ CF>string ] map ;
-
-: <CFStringArray> ( seq -- alien )
-    [ <CFString> ] map [ <CFArray> ] [ [ CFRelease ] each ] bi ;
-
-: <CFFileSystemURL> ( string dir? -- url )
-    [ <CFString> f over kCFURLPOSIXPathStyle ] dip
-    CFURLCreateWithFileSystemPath swap CFRelease ;
-
-: <CFURL> ( string -- url )
-    <CFString>
-    [ f swap f CFURLCreateWithString ] keep
-    CFRelease ;
-
-: <CFBundle> ( string -- bundle )
-    t <CFFileSystemURL> [
-        f swap CFBundleCreate
-    ] keep CFRelease ;
-
-GENERIC: <CFNumber> ( number -- alien )
-
-M: integer <CFNumber>
-    [ f kCFNumberLongLongType ] dip <longlong> CFNumberCreate ;
-
-M: float <CFNumber>
-    [ f kCFNumberDoubleType ] dip <double> CFNumberCreate ;
-
-M: t <CFNumber>
-    drop f kCFNumberIntType 1 <int> CFNumberCreate ;
-
-M: f <CFNumber>
-    drop f kCFNumberIntType 0 <int> CFNumberCreate ;
-
-: <CFData> ( byte-array -- alien )
-    [ f ] dip dup length CFDataCreate ;
-
-FUNCTION: CFFileDescriptorRef CFFileDescriptorCreate (
-    CFAllocatorRef allocator,
-    CFFileDescriptorNativeDescriptor fd,
-    Boolean closeOnInvalidate,
-    CFFileDescriptorCallBack callout, 
-    CFFileDescriptorContext* context
-) ;
-
-FUNCTION: void CFFileDescriptorEnableCallBacks (
-    CFFileDescriptorRef f,
-    CFOptionFlags callBackTypes
-) ;
-
-: load-framework ( name -- )
-    dup <CFBundle> [
-        CFBundleLoadExecutable drop
-    ] [
-        "Cannot load bundle named " prepend throw
-    ] ?if ;
-
 TUPLE: CFRelease-destructor alien disposed ;
 
 M: CFRelease-destructor dispose* alien>> CFRelease ;

basis/core-foundation/data/data.factor

@@ -0,0 +1,58 @@
+! Copyright (C) 2008 Joe Groff.
+! See http://factorcode.org/license.txt for BSD license.
+USING: alien.syntax alien.c-types sequences kernel math ;
+IN: core-foundation.data
+
+TYPEDEF: void* CFDataRef
+TYPEDEF: void* CFDictionaryRef
+TYPEDEF: void* CFMutableDictionaryRef
+TYPEDEF: void* CFNumberRef
+TYPEDEF: void* CFSetRef
+TYPEDEF: void* CFUUIDRef
+
+TYPEDEF: int CFNumberType
+: kCFNumberSInt8Type 1 ; inline
+: kCFNumberSInt16Type 2 ; inline
+: kCFNumberSInt32Type 3 ; inline
+: kCFNumberSInt64Type 4 ; inline
+: kCFNumberFloat32Type 5 ; inline
+: kCFNumberFloat64Type 6 ; inline
+: kCFNumberCharType 7 ; inline
+: kCFNumberShortType 8 ; inline
+: kCFNumberIntType 9 ; inline
+: kCFNumberLongType 10 ; inline
+: kCFNumberLongLongType 11 ; inline
+: kCFNumberFloatType 12 ; inline
+: kCFNumberDoubleType 13 ; inline
+: kCFNumberCFIndexType 14 ; inline
+: kCFNumberNSIntegerType 15 ; inline
+: kCFNumberCGFloatType 16 ; inline
+: kCFNumberMaxType 16 ; inline
+
+TYPEDEF: int CFPropertyListMutabilityOptions
+: kCFPropertyListImmutable                  0 ; inline
+: kCFPropertyListMutableContainers          1 ; inline
+: kCFPropertyListMutableContainersAndLeaves 2 ; inline
+
+FUNCTION: CFNumberRef CFNumberCreate ( CFAllocatorRef allocator, CFNumberType theType, void* valuePtr ) ;
+
+FUNCTION: CFDataRef CFDataCreate ( CFAllocatorRef allocator, uchar* bytes, CFIndex length ) ;
+
+FUNCTION: CFTypeID CFGetTypeID ( CFTypeRef cf ) ;
+
+GENERIC: <CFNumber> ( number -- alien )
+
+M: integer <CFNumber>
+    [ f kCFNumberLongLongType ] dip <longlong> CFNumberCreate ;
+
+M: float <CFNumber>
+    [ f kCFNumberDoubleType ] dip <double> CFNumberCreate ;
+
+M: t <CFNumber>
+    drop f kCFNumberIntType 1 <int> CFNumberCreate ;
+
+M: f <CFNumber>
+    drop f kCFNumberIntType 0 <int> CFNumberCreate ;
+
+: <CFData> ( byte-array -- alien )
+    [ f ] dip dup length CFDataCreate ;

basis/core-foundation/data/tags.txt

@@ -0,0 +1,2 @@
+unportable
+bindings

basis/core-foundation/file-descriptors/file-descriptors.factor

@@ -0,0 +1,32 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: alien.syntax kernel math.bitwise core-foundation ;
+IN: core-foundation.file-descriptors
+
+TYPEDEF: void* CFFileDescriptorRef
+TYPEDEF: int CFFileDescriptorNativeDescriptor
+TYPEDEF: void* CFFileDescriptorCallBack
+
+FUNCTION: CFFileDescriptorRef CFFileDescriptorCreate (
+    CFAllocatorRef allocator,
+    CFFileDescriptorNativeDescriptor fd,
+    Boolean closeOnInvalidate,
+    CFFileDescriptorCallBack callout, 
+    CFFileDescriptorContext* context
+) ;
+
+: kCFFileDescriptorReadCallBack 1 ; inline
+: kCFFileDescriptorWriteCallBack 2 ; inline
+   
+FUNCTION: void CFFileDescriptorEnableCallBacks (
+    CFFileDescriptorRef f,
+    CFOptionFlags callBackTypes
+) ;
+
+: enable-all-callbacks ( fd -- )
+    { kCFFileDescriptorReadCallBack kCFFileDescriptorWriteCallBack } flags
+    CFFileDescriptorEnableCallBacks ;
+
+: <CFFileDescriptor> ( fd callback -- handle )
+    [ f swap ] [ t swap ] bi* f CFFileDescriptorCreate
+    [ "CFFileDescriptorCreate failed" throw ] unless* ;

basis/core-foundation/file-descriptors/tags.txt

@@ -0,0 +1,2 @@
+unportable
+bindings

basis/core-foundation/fsevents/fsevents.factor

@@ -2,11 +2,11 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien alien.c-types alien.strings alien.syntax kernel
 math sequences namespaces make assocs init accessors
-continuations combinators core-foundation
-core-foundation.run-loop core-foundation.run-loop.thread
-io.encodings.utf8 destructors locals arrays
-specialized-arrays.direct.alien specialized-arrays.direct.int
-specialized-arrays.direct.longlong ;
+continuations combinators io.encodings.utf8 destructors locals
+arrays specialized-arrays.direct.alien
+specialized-arrays.direct.int specialized-arrays.direct.longlong
+core-foundation core-foundation.run-loop core-foundation.strings
+core-foundation.time ;
 IN: core-foundation.fsevents
 
 : kFSEventStreamCreateFlagUseCFTypes 2 ; inline
@@ -118,7 +118,7 @@ FUNCTION: CFStringRef FSEventStreamCopyDescription ( FSEventStreamRef streamRef
     FSEventStreamCreate ;
 
 : kCFRunLoopCommonModes ( -- string )
-    "kCFRunLoopCommonModes" f dlsym *void* ;
+    &: kCFRunLoopCommonModes *void* ;
 
 : schedule-event-stream ( event-stream -- )
     CFRunLoopGetMain

basis/core-foundation/run-loop/run-loop.factor

@@ -1,6 +1,10 @@
 ! Copyright (C) 2008 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.syntax core-foundation kernel namespaces ;
+USING: accessors alien alien.syntax kernel math namespaces
+sequences destructors combinators threads heaps deques calendar
+core-foundation core-foundation.strings
+core-foundation.file-descriptors core-foundation.timers
+core-foundation.time ;
 IN: core-foundation.run-loop
 
 : kCFRunLoopRunFinished 1 ; inline
@@ -32,6 +36,24 @@ FUNCTION: void CFRunLoopAddSource (
    CFStringRef mode
 ) ;
 
+FUNCTION: void CFRunLoopRemoveSource (
+   CFRunLoopRef rl,
+   CFRunLoopSourceRef source,
+   CFStringRef mode
+) ;
+
+FUNCTION: void CFRunLoopAddTimer (
+   CFRunLoopRef rl,
+   CFRunLoopTimerRef timer,
+   CFStringRef mode
+) ;
+
+FUNCTION: void CFRunLoopRemoveTimer (
+   CFRunLoopRef rl,
+   CFRunLoopTimerRef timer,
+   CFStringRef mode
+) ;
+
 : CFRunLoopDefaultMode ( -- alien )
     #! Ugly, but we don't have static NSStrings
     \ CFRunLoopDefaultMode get-global dup expired? [
@@ -39,3 +61,80 @@ FUNCTION: void CFRunLoopAddSource (
         "kCFRunLoopDefaultMode" <CFString>
         dup \ CFRunLoopDefaultMode set-global
     ] when ;
+
+TUPLE: run-loop fds sources timers ;
+
+: <run-loop> ( -- run-loop )
+    V{ } clone V{ } clone V{ } clone \ run-loop boa ;
+
+SYMBOL: expiry-check
+
+: run-loop ( -- run-loop )
+    \ run-loop get-global not expiry-check get expired? or
+    [
+        31337 <alien> expiry-check set-global
+        <run-loop> dup \ run-loop set-global
+    ] [ \ run-loop get-global ] if ;
+
+: add-source-to-run-loop ( source -- )
+    [ run-loop sources>> push ]
+    [
+        CFRunLoopGetMain
+        swap CFRunLoopDefaultMode
+        CFRunLoopAddSource
+    ] bi ;
+
+: create-fd-source ( CFFileDescriptor -- source )
+    f swap 0 CFFileDescriptorCreateRunLoopSource ;
+
+: add-fd-to-run-loop ( fd callback -- )
+    [
+        <CFFileDescriptor> |CFRelease
+        [ run-loop fds>> push ]
+        [ create-fd-source |CFRelease add-source-to-run-loop ]
+        bi
+    ] with-destructors ;
+
+: add-timer-to-run-loop ( timer -- )
+    [ run-loop timers>> push ]
+    [
+        CFRunLoopGetMain
+        swap CFRunLoopDefaultMode
+        CFRunLoopAddTimer
+    ] bi ;
+
+<PRIVATE
+
+: ((reset-timer)) ( timer counter timestamp -- )
+    nip >CFAbsoluteTime CFRunLoopTimerSetNextFireDate ;
+
+: (reset-timer) ( timer counter -- )
+    yield {
+        { [ dup 0 = ] [ now ((reset-timer)) ] }
+        { [ run-queue deque-empty? not ] [ 1- (reset-timer) ] }
+        { [ sleep-queue heap-empty? ] [ 5 minutes hence ((reset-timer)) ] }
+        [ sleep-queue heap-peek nip micros>timestamp ((reset-timer)) ]
+    } cond ;
+
+: reset-timer ( timer -- )
+    10 (reset-timer) ;
+
+PRIVATE>
+
+: reset-run-loop ( -- )
+    run-loop
+    [ timers>> [ reset-timer ] each ]
+    [ fds>> [ enable-all-callbacks ] each ] bi ;
+
+: timer-callback ( -- callback )
+    "void" { "CFRunLoopTimerRef" "void*" } "cdecl"
+    [ 2drop reset-run-loop yield ] alien-callback ;
+
+: init-thread-timer ( -- )
+    timer-callback <CFTimer> add-timer-to-run-loop ;
+
+: run-one-iteration ( us -- handled? )
+    reset-run-loop
+    CFRunLoopDefaultMode
+    swap [ microseconds ] [ 5 minutes ] if* >CFTimeInterval
+    t CFRunLoopRunInMode kCFRunLoopRunHandledSource = ;

basis/core-foundation/run-loop/thread/summary.txt

@@ -1 +0,0 @@
-Vocabulary with init hook for running CoreFoundation event loop

basis/core-foundation/run-loop/thread/thread.factor

@@ -1,16 +0,0 @@
-! Copyright (C) 2008 Slava Pestov
-! See http://factorcode.org/license.txt for BSD license.
-USING: calendar core-foundation.run-loop init kernel threads ;
-IN: core-foundation.run-loop.thread
-
-! Load this vocabulary if you need a run loop running.
-
-: run-loop-thread ( -- )
-    CFRunLoopDefaultMode 0 f CFRunLoopRunInMode
-    kCFRunLoopRunHandledSource = [ 1 seconds sleep ] unless
-    run-loop-thread ;
-
-: start-run-loop-thread ( -- )
-    [ run-loop-thread t ] "CFRunLoop dispatcher" spawn-server drop ;
-
-[ start-run-loop-thread ] "core-foundation.run-loop.thread" add-init-hook

basis/core-foundation/strings/strings-docs.factor

@@ -0,0 +1,14 @@
+USING: help.syntax help.markup strings ;
+IN: core-foundation.strings
+
+HELP: <CFString>
+{ $values { "string" string } { "alien" "a " { $snippet "CFString" } } }
+{ $description "Creates a Core Foundation string from a Factor string." } ;
+
+HELP: CF>string
+{ $values { "alien" "a " { $snippet "CFString" } } { "string" string } }
+{ $description "Creates a Factor string from a Core Foundation string." } ;
+
+HELP: CF>string-array
+{ $values { "alien" "a " { $snippet "CFArray" } " of " { $snippet "CFString" } " instances" } { "seq" string } }
+{ $description "Creates an array of Factor strings from a " { $snippet "CFArray" } " of " { $snippet "CFString" } "s." } ;

basis/core-foundation/strings/strings-tests.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: core-foundation tools.test kernel ;
+USING: core-foundation.strings core-foundation tools.test kernel ;
 IN: core-foundation
 
 [ ] [ "Hello" <CFString> CFRelease ] unit-test

basis/core-foundation/strings/strings.factor

@@ -0,0 +1,66 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: alien.syntax alien.strings kernel sequences byte-arrays
+io.encodings.utf8 math core-foundation core-foundation.arrays ;
+IN: core-foundation.strings
+
+TYPEDEF: void* CFStringRef
+
+TYPEDEF: int CFStringEncoding
+: kCFStringEncodingMacRoman HEX: 0 ;
+: kCFStringEncodingWindowsLatin1 HEX: 0500 ;
+: kCFStringEncodingISOLatin1 HEX: 0201 ;
+: kCFStringEncodingNextStepLatin HEX: 0B01 ;
+: kCFStringEncodingASCII HEX: 0600 ;
+: kCFStringEncodingUnicode HEX: 0100 ;
+: kCFStringEncodingUTF8 HEX: 08000100 ;
+: kCFStringEncodingNonLossyASCII HEX: 0BFF ;
+: kCFStringEncodingUTF16 HEX: 0100 ;
+: kCFStringEncodingUTF16BE HEX: 10000100 ;
+: kCFStringEncodingUTF16LE HEX: 14000100 ;
+: kCFStringEncodingUTF32 HEX: 0c000100 ;
+: kCFStringEncodingUTF32BE HEX: 18000100 ;
+: kCFStringEncodingUTF32LE HEX: 1c000100 ;
+
+FUNCTION: CFStringRef CFStringCreateWithBytes (
+   CFAllocatorRef alloc,
+   UInt8* bytes,
+   CFIndex numBytes,
+   CFStringEncoding encoding,
+   Boolean isExternalRepresentation
+) ;
+
+FUNCTION: CFIndex CFStringGetLength ( CFStringRef theString ) ;
+
+FUNCTION: void CFStringGetCharacters ( void* theString, CFIndex start, CFIndex length, void* buffer ) ;
+
+FUNCTION: Boolean CFStringGetCString (
+   CFStringRef theString,
+   char* buffer,
+   CFIndex bufferSize,
+   CFStringEncoding encoding
+) ;
+
+FUNCTION: CFStringRef CFStringCreateWithCString (
+   CFAllocatorRef alloc,
+   char* cStr,
+   CFStringEncoding encoding
+) ;
+
+: <CFString> ( string -- alien )
+    f swap utf8 string>alien kCFStringEncodingUTF8 CFStringCreateWithCString
+    [ "CFStringCreateWithCString failed" throw ] unless* ;
+
+: CF>string ( alien -- string )
+    dup CFStringGetLength 4 * 1 + <byte-array> [
+        dup length
+        kCFStringEncodingUTF8
+        CFStringGetCString
+        [ "CFStringGetCString failed" throw ] unless
+    ] keep utf8 alien>string ;
+
+: CF>string-array ( alien -- seq )
+    CF>array [ CF>string ] map ;
+
+: <CFStringArray> ( seq -- alien )
+    [ <CFString> ] map [ <CFArray> ] [ [ CFRelease ] each ] bi ;

basis/core-foundation/strings/tags.txt

@@ -0,0 +1,2 @@
+unportable
+bindings

basis/core-foundation/time/time.factor

@@ -0,0 +1,14 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: calendar alien.syntax ;
+IN: core-foundation.time
+
+TYPEDEF: double CFTimeInterval
+TYPEDEF: double CFAbsoluteTime
+
+: >CFTimeInterval ( duration -- interval )
+    duration>seconds ; inline
+
+: >CFAbsoluteTime ( timestamp -- time )
+    T{ timestamp { year 2001 } { month 1 } { day 1 } } time-
+    duration>seconds ; inline

basis/core-foundation/timers/tags.txt

@@ -0,0 +1,2 @@
+unportable
+bindings

basis/core-foundation/timers/timers.factor

@@ -0,0 +1,35 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: alien.syntax system math kernel calendar core-foundation
+core-foundation.time ;
+IN: core-foundation.timers
+
+TYPEDEF: void* CFRunLoopTimerRef
+TYPEDEF: void* CFRunLoopTimerCallBack
+TYPEDEF: void* CFRunLoopTimerContext
+
+FUNCTION: CFRunLoopTimerRef CFRunLoopTimerCreate (
+   CFAllocatorRef allocator,
+   CFAbsoluteTime fireDate,
+   CFTimeInterval interval,
+   CFOptionFlags flags,
+   CFIndex order,
+   CFRunLoopTimerCallBack callout,
+   CFRunLoopTimerContext* context
+) ;
+
+: <CFTimer> ( callback -- timer )
+    [ f now >CFAbsoluteTime 60 0 0 ] dip f CFRunLoopTimerCreate ;
+
+FUNCTION: void CFRunLoopTimerInvalidate (
+   CFRunLoopTimerRef timer
+) ;
+
+FUNCTION: Boolean CFRunLoopTimerIsValid (
+   CFRunLoopTimerRef timer
+) ;
+
+FUNCTION: void CFRunLoopTimerSetNextFireDate (
+   CFRunLoopTimerRef timer,
+   CFAbsoluteTime fireDate
+) ;

basis/core-foundation/urls/tags.txt

@@ -0,0 +1,2 @@
+unportable
+bindings

basis/core-foundation/urls/urls-docs.factor

@@ -0,0 +1,10 @@
+USING: help.syntax help.markup ;
+IN: core-foundation.urls
+
+HELP: <CFFileSystemURL>
+{ $values { "string" "a pathname string" } { "dir?" "a boolean indicating if the pathname is a directory" } { "url" "a " { $snippet "CFURL" } } }
+{ $description "Creates a new " { $snippet "CFURL" } " pointing to the given local pathname." } ;
+
+HELP: <CFURL>
+{ $values { "string" "a URL string" } { "url" "a " { $snippet "CFURL" } } }
+{ $description "Creates a new " { $snippet "CFURL" } "." } ;

basis/core-foundation/urls/urls.factor

@@ -0,0 +1,24 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: alien.syntax kernel core-foundation.strings
+core-foundation ;
+IN: core-foundation.urls
+
+: kCFURLPOSIXPathStyle 0 ; inline
+
+TYPEDEF: void* CFURLRef
+
+FUNCTION: CFURLRef CFURLCreateWithFileSystemPath ( CFAllocatorRef allocator, CFStringRef filePath, int pathStyle, Boolean isDirectory ) ;
+
+FUNCTION: CFURLRef CFURLCreateWithString ( CFAllocatorRef allocator, CFStringRef string, CFURLRef base ) ;
+
+FUNCTION: CFURLRef CFURLCopyFileSystemPath ( CFURLRef url, int pathStyle ) ;
+
+: <CFFileSystemURL> ( string dir? -- url )
+    [ <CFString> f over kCFURLPOSIXPathStyle ] dip
+    CFURLCreateWithFileSystemPath swap CFRelease ;
+
+: <CFURL> ( string -- url )
+    <CFString>
+    [ f swap f CFURLCreateWithString ] keep
+    CFRelease ;

basis/environment/unix/unix.factor

@@ -2,12 +2,13 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien alien.c-types alien.strings alien.syntax kernel
 layouts sequences system unix environment io.encodings.utf8
-unix.utilities vocabs.loader combinators alien.accessors ;
+unix.utilities vocabs.loader combinators alien.accessors
+alien.syntax ;
 IN: environment.unix
 
 HOOK: environ os ( -- void* )
 
-M: unix environ ( -- void* ) "environ" f dlsym ;
+M: unix environ ( -- void* ) &: environ ;
 
 M: unix os-env ( key -- value ) getenv ;
 

basis/http/client/client.factor

@@ -7,6 +7,7 @@ math.order hashtables byte-arrays destructors
 io.encodings
 io.encodings.string
 io.encodings.ascii
+io.encodings.utf8
 io.encodings.8-bit
 io.encodings.binary
 io.streams.duplex
@@ -40,11 +41,11 @@ GENERIC: >post-data ( object -- post-data )
 
 M: post-data >post-data ;
 
-M: string >post-data "application/octet-stream" <post-data> ;
+M: string >post-data utf8 encode "application/octet-stream" <post-data> ;
 
 M: byte-array >post-data "application/octet-stream" <post-data> ;
 
-M: assoc >post-data assoc>query "application/x-www-form-urlencoded" <post-data> ;
+M: assoc >post-data assoc>query ascii encode "application/x-www-form-urlencoded" <post-data> ;
 
 M: f >post-data ;
 
@@ -52,12 +53,13 @@ M: f >post-data ;
     [ >post-data ] change-post-data ;
 
 : write-post-data ( request -- request )
-    dup method>> "POST" = [ dup post-data>> raw>> write ] when ; 
+    dup method>> [ "POST" = ] [ "PUT" = ] bi or [ dup post-data>> raw>> write ] when ; 
 
 : write-request ( request -- )
     unparse-post-data
     write-request-line
     write-request-header
+    binary encode-output
     write-post-data
     flush
     drop ;
@@ -153,7 +155,7 @@ SYMBOL: redirects
 
 PRIVATE>
 
-: success? ( code -- ? ) 200 = ;
+: success? ( code -- ? ) 200 299 between? ;
 
 ERROR: download-failed response ;
 

basis/io/launcher/launcher-docs.factor

@@ -143,8 +143,9 @@ HELP: <process-stream>
 { $description "Launches a process and redirects its input and output via a pair of pipes which may be read and written as a stream of the given encoding." } ;
 
 HELP: wait-for-process
-{ $values { "process" process } { "status" integer } }
-{ $description "If the process is still running, waits for it to exit, otherwise outputs the exit code immediately. Can be called multiple times on the same process." } ;
+{ $values { "process" process } { "status" object } }
+{ $description "If the process is still running, waits for it to exit, otherwise outputs the status code immediately. Can be called multiple times on the same process." }
+{ $notes "The status code is operating system specific; it may be an integer, or another object (the latter is the case on Unix if the process was killed by a signal). However, one cross-platform behavior code can rely on is that a status code of 0 indicates success." } ;
 
 ARTICLE: "io.launcher.descriptors" "Launch descriptors"
 "Words which launch processes can take either a command line string, a sequence of command line arguments, or a " { $link process } "."

basis/io/launcher/launcher.factor

@@ -157,7 +157,7 @@ M: process-failed error.
     process>> . ;
 
 : wait-for-success ( process -- )
-    dup wait-for-process dup zero?
+    dup wait-for-process dup 0 =
     [ 2drop ] [ process-failed ] if ;
 
 : try-process ( desc -- )

basis/io/thread/thread.factor

@@ -1,14 +1,20 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
+USING: threads io.backend namespaces init math kernel ;
 IN: io.thread
-USING: threads io.backend namespaces init math ;
+
+! The Cocoa UI backend stops the I/O thread and takes over
+! completely.
+SYMBOL: io-thread-running?
 
 : io-thread ( -- )
     sleep-time io-multiplex yield ;
 
 : start-io-thread ( -- )
-    [ io-thread t ]
-    "I/O wait" spawn-server
-    \ io-thread set-global ;
+    [ [ io-thread-running? get-global ] [ io-thread ] [ ] while ]
+    "I/O wait" spawn drop ;
 
-[ start-io-thread ] "io.thread" add-init-hook
+[
+    t io-thread-running? set-global
+    start-io-thread
+] "io.thread" add-init-hook

basis/io/unix/backend/backend.factor

@@ -1,11 +1,11 @@
 ! Copyright (C) 2004, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.c-types generic assocs kernel kernel.private
-math io.ports sequences strings sbufs threads unix
-vectors io.buffers io.backend io.encodings math.parser
+USING: alien alien.c-types alien.syntax generic assocs kernel
+kernel.private math io.ports sequences strings sbufs threads
+unix vectors io.buffers io.backend io.encodings math.parser
 continuations system libc qualified namespaces make io.timeouts
 io.encodings.utf8 destructors accessors summary combinators
-locals unix.time fry ;
+locals unix.time fry io.unix.multiplexers ;
 QUALIFIED: io
 IN: io.unix.backend
 
@@ -37,38 +37,6 @@ M: fd dispose
 
 M: fd handle-fd dup check-disposed fd>> ;
 
-! I/O multiplexers
-TUPLE: mx fd reads writes ;
-
-: new-mx ( class -- obj )
-    new
-        H{ } clone >>reads
-        H{ } clone >>writes ; inline
-
-GENERIC: add-input-callback ( thread fd mx -- )
-
-M: mx add-input-callback reads>> push-at ;
-
-GENERIC: add-output-callback ( thread fd mx -- )
-
-M: mx add-output-callback writes>> push-at ;
-
-GENERIC: remove-input-callbacks ( fd mx -- callbacks )
-
-M: mx remove-input-callbacks reads>> delete-at* drop ;
-
-GENERIC: remove-output-callbacks ( fd mx -- callbacks )
-
-M: mx remove-output-callbacks writes>> delete-at* drop ;
-
-GENERIC: wait-for-events ( ms mx -- )
-
-: input-available ( fd mx -- )
-    reads>> delete-at* drop [ resume ] each ;
-
-: output-available ( fd mx -- )
-    writes>> delete-at* drop [ resume ] each ;
-
 M: fd cancel-operation ( fd -- )
     dup disposed>> [ drop ] [
         fd>>
@@ -184,11 +152,11 @@ M: stdin dispose*
 M: stdin refill
     [ buffer>> ] [ dup wait-for-stdin ] bi* refill-stdin f ;
 
-: control-write-fd ( -- fd ) "control_write" f dlsym *uint ;
+: control-write-fd ( -- fd ) &: control_write *uint ;
 
-: size-read-fd ( -- fd ) "size_read" f dlsym *uint ;
+: size-read-fd ( -- fd ) &: size_read *uint ;
 
-: data-read-fd ( -- fd ) "stdin_read" f dlsym *uint ;
+: data-read-fd ( -- fd ) &: stdin_read *uint ;
 
 : <stdin> ( -- stdin )
     stdin new
@@ -207,10 +175,10 @@ TUPLE: mx-port < port mx ;
 : <mx-port> ( mx -- port )
     dup fd>> mx-port <port> swap >>mx ;
 
-: multiplexer-error ( n -- )
-    0 < [
+: multiplexer-error ( n -- n )
+    dup 0 < [
         err_no [ EAGAIN = ] [ EINTR = ] bi or
-        [ (io-error) ] unless
+        [ drop 0 ] [ (io-error) ] if
     ] when ;
 
 : ?flag ( n mask symbol -- n )

basis/io/unix/bsd/bsd.factor

@@ -1,16 +1,12 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-IN: io.unix.bsd
 USING: namespaces system kernel accessors assocs continuations
-unix io.backend io.unix.backend io.unix.select ;
+unix io.backend io.unix.backend io.unix.multiplexers
+io.unix.multiplexers.kqueue ;
+IN: io.unix.bsd
 
 M: bsd init-io ( -- )
-    <select-mx> mx set-global ;
-!     <kqueue-mx> kqueue-mx set-global
-!     kqueue-mx get-global <mx-port> <mx-task>
-!     dup io-task-fd
-!     [ mx get-global reads>> set-at ]
-!     [ mx get-global writes>> set-at ] 2bi ;
+    <kqueue-mx> mx set-global ;
 
 ! M: bsd (monitor) ( path recursive? mailbox -- )
 !     swap [ "Recursive kqueue monitors not supported" throw ] when

basis/io/unix/epoll/epoll.factor

@@ -49,7 +49,7 @@ M: epoll-mx remove-output-callbacks ( fd mx -- seq )
 
 : wait-event ( mx us -- n )
     [ [ fd>> ] [ events>> ] bi [ underlying>> ] [ length ] bi ] [ 1000 /i ] bi*
-    epoll_wait dup multiplexer-error ;
+    epoll_wait multiplexer-error ;
 
 : handle-event ( event mx -- )
     [ epoll-event-fd ] dip

basis/io/unix/kqueue/kqueue.factor

@@ -58,8 +58,7 @@ M: kqueue-mx remove-output-callbacks ( fd mx -- seq )
     [
         [ fd>> f 0 ]
         [ events>> [ underlying>> ] [ length ] bi ] bi
-    ] dip kevent
-    dup multiplexer-error ;
+    ] dip kevent multiplexer-error ;
 
 : handle-kevent ( mx kevent -- )
     [ kevent-ident swap ] [ kevent-filter ] bi {

basis/io/unix/launcher/launcher-tests.factor

@@ -2,7 +2,8 @@ IN: io.unix.launcher.tests
 USING: io.files tools.test io.launcher arrays io namespaces
 continuations math io.encodings.binary io.encodings.ascii
 accessors kernel sequences io.encodings.utf8 destructors
-io.streams.duplex ;
+io.streams.duplex locals concurrency.promises threads
+unix.process ;
 
 [ ] [
     [ "launcher-test-1" temp-file delete-file ] ignore-errors
@@ -121,3 +122,17 @@ io.streams.duplex ;
         input-stream get contents
     ] with-stream
 ] unit-test
+
+! Killed processes were exiting with code 0 on FreeBSD
+[ f ] [
+    [let | p [ <promise> ]
+           s [ <promise> ] |
+       [
+           "sleep 1000" run-detached
+           [ p fulfill ] [ wait-for-process s fulfill ] bi
+       ] in-thread
+
+       p ?promise handle>> 9 kill drop
+       s ?promise 0 =
+    ]
+] unit-test

basis/io/unix/launcher/launcher.factor

@@ -92,14 +92,16 @@ M: unix kill-process* ( pid -- )
     processes get swap [ nip swap handle>> = ] curry
     assoc-find 2drop ;
 
+TUPLE: signal n ;
+
+: code>status ( code -- obj )
+    dup WIFEXITED [ WEXITSTATUS ] [ WTERMSIG signal boa ] if ;
+
 M: unix wait-for-processes ( -- ? )
     -1 0 <int> tuck WNOHANG waitpid
     dup 0 <= [
         2drop t
     ] [
-        find-process dup [
-            swap *int WEXITSTATUS notify-exit f
-        ] [
-            2drop f
-        ] if
+        find-process dup
+        [ swap *int code>status notify-exit f ] [ 2drop f ] if
     ] if ;

basis/io/unix/linux/linux.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel io.backend io.monitors io.unix.backend
-io.unix.epoll io.unix.linux.monitors system namespaces ;
+USING: kernel system namespaces io.backend io.unix.backend
+io.unix.multiplexers io.unix.multiplexers.epoll ;
 IN: io.unix.linux
 
 M: linux init-io ( -- )

basis/io/unix/linux/monitors/monitors.factor

@@ -2,10 +2,10 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel io.backend io.monitors io.monitors.recursive
 io.files io.buffers io.monitors io.ports io.timeouts
-io.unix.backend io.unix.select io.encodings.utf8
-unix.linux.inotify assocs namespaces make threads continuations
-init math math.bitwise sets alien alien.strings alien.c-types
-vocabs.loader accessors system hashtables destructors unix ;
+io.unix.backend io.encodings.utf8 unix.linux.inotify assocs
+namespaces make threads continuations init math math.bitwise
+sets alien alien.strings alien.c-types vocabs.loader accessors
+system hashtables destructors unix ;
 IN: io.unix.linux.monitors
 
 SYMBOL: watches

basis/io/unix/macosx/macosx.factor

@@ -1,10 +1,10 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
+USING: io.backend system namespaces io.unix.multiplexers
+io.unix.multiplexers.run-loop ;
 IN: io.unix.macosx
-USING: io.unix.backend io.unix.bsd io.unix.kqueue io.backend
-namespaces system ;
 
 M: macosx init-io ( -- )
-    <kqueue-mx> mx set-global ;
+    <run-loop-mx> mx set-global ;
 
 macosx set-io-backend

basis/io/unix/multiplexers/epoll/epoll.factor

@@ -0,0 +1,66 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors alien.c-types kernel destructors bit-arrays
+sequences assocs struct-arrays math namespaces locals fry unix
+unix.linux.epoll unix.time io.ports io.unix.backend
+io.unix.multiplexers ;
+IN: io.unix.multiplexers.epoll
+
+TUPLE: epoll-mx < mx events ;
+
+: max-events ( -- n )
+    #! We read up to 256 events at a time. This is an arbitrary
+    #! constant...
+    256 ; inline
+
+: <epoll-mx> ( -- mx )
+    epoll-mx new-mx
+        max-events epoll_create dup io-error >>fd
+        max-events "epoll-event" <struct-array> >>events ;
+
+M: epoll-mx dispose fd>> close-file ;
+
+: make-event ( fd events -- event )
+    "epoll-event" <c-object>
+    [ set-epoll-event-events ] keep
+    [ set-epoll-event-fd ] keep ;
+
+:: do-epoll-ctl ( fd mx what events -- )
+    mx fd>> what fd fd events make-event epoll_ctl io-error ;
+
+: do-epoll-add ( fd mx events -- )
+    EPOLL_CTL_ADD swap EPOLLONESHOT bitor do-epoll-ctl ;
+
+: do-epoll-del ( fd mx events -- )
+    EPOLL_CTL_DEL swap do-epoll-ctl ;
+
+M: epoll-mx add-input-callback ( thread fd mx -- )
+    [ EPOLLIN do-epoll-add ] [ call-next-method ] 2bi ;
+
+M: epoll-mx add-output-callback ( thread fd mx -- )
+    [ EPOLLOUT do-epoll-add ] [ call-next-method ] 2bi ;
+
+M: epoll-mx remove-input-callbacks ( fd mx -- seq )
+    2dup reads>> key? [
+        [ call-next-method ] [ EPOLLIN do-epoll-del ] 2bi
+    ] [ 2drop f ] if ;
+
+M: epoll-mx remove-output-callbacks ( fd mx -- seq )
+    2dup writes>> key? [
+        [ EPOLLOUT do-epoll-del ] [ call-next-method ] 2bi
+    ] [ 2drop f ] if ;
+
+: wait-event ( mx us -- n )
+    [ [ fd>> ] [ events>> ] bi [ underlying>> ] [ length ] bi ] [ 1000 /i ] bi*
+    epoll_wait multiplexer-error ;
+
+: handle-event ( event mx -- )
+    [ epoll-event-fd ] dip
+    [ EPOLLIN EPOLLOUT bitor do-epoll-del ]
+    [ input-available ] [ output-available ] 2tri ;
+
+: handle-events ( mx n -- )
+    [ dup events>> ] dip head-slice swap '[ _ handle-event ] each ;
+
+M: epoll-mx wait-for-events ( us mx -- )
+    swap 60000000 or dupd wait-event handle-events ;

basis/io/unix/multiplexers/kqueue/authors.txt

@@ -0,0 +1 @@
+Slava Pestov

basis/io/unix/multiplexers/kqueue/kqueue.factor

@@ -0,0 +1,76 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors alien.c-types combinators destructors
+io.unix.backend kernel math.bitwise sequences struct-arrays unix
+unix.kqueue unix.time assocs io.unix.multiplexers ;
+IN: io.unix.multiplexers.kqueue
+
+TUPLE: kqueue-mx < mx events ;
+
+: max-events ( -- n )
+    #! We read up to 256 events at a time. This is an arbitrary
+    #! constant...
+    256 ; inline
+
+: <kqueue-mx> ( -- mx )
+    kqueue-mx new-mx
+        kqueue dup io-error >>fd
+        max-events "kevent" <struct-array> >>events ;
+
+M: kqueue-mx dispose fd>> close-file ;
+
+: make-kevent ( fd filter flags -- event )
+    "kevent" <c-object>
+    [ set-kevent-flags ] keep
+    [ set-kevent-filter ] keep
+    [ set-kevent-ident ] keep ;
+
+: register-kevent ( kevent mx -- )
+    fd>> swap 1 f 0 f kevent io-error ;
+
+M: kqueue-mx add-input-callback ( thread fd mx -- )
+    [ call-next-method ] [
+        [ EVFILT_READ { EV_ADD EV_ONESHOT } flags make-kevent ] dip
+        register-kevent
+    ] 2bi ;
+
+M: kqueue-mx add-output-callback ( thread fd mx -- )
+    [ call-next-method ] [
+        [ EVFILT_WRITE { EV_ADD EV_ONESHOT } flags make-kevent ] dip
+        register-kevent
+    ] 2bi ;
+
+M: kqueue-mx remove-input-callbacks ( fd mx -- seq )
+    2dup reads>> key? [
+        [ call-next-method ] [
+            [ EVFILT_READ EV_DELETE make-kevent ] dip
+            register-kevent
+        ] 2bi
+    ] [ 2drop f ] if ;
+
+M: kqueue-mx remove-output-callbacks ( fd mx -- seq )
+    2dup writes>> key? [
+        [
+            [ EVFILT_WRITE EV_DELETE make-kevent ] dip
+            register-kevent
+        ] [ call-next-method ] 2bi
+    ] [ 2drop f ] if ;
+
+: wait-kevent ( mx timespec -- n )
+    [
+        [ fd>> f 0 ]
+        [ events>> [ underlying>> ] [ length ] bi ] bi
+    ] dip kevent multiplexer-error ;
+
+: handle-kevent ( mx kevent -- )
+    [ kevent-ident swap ] [ kevent-filter ] bi {
+        { EVFILT_READ [ input-available ] }
+        { EVFILT_WRITE [ output-available ] }
+    } case ;
+
+: handle-kevents ( mx n -- )
+    [ dup events>> ] dip head-slice [ handle-kevent ] with each ;
+
+M: kqueue-mx wait-for-events ( us mx -- )
+    swap dup [ make-timespec ] when
+    dupd wait-kevent handle-kevents ;

basis/io/unix/multiplexers/kqueue/tags.txt

@@ -0,0 +1 @@
+unportable

basis/io/unix/multiplexers/multiplexers.factor

@@ -0,0 +1,35 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel accessors assocs sequences threads ;
+IN: io.unix.multiplexers
+
+TUPLE: mx fd reads writes ;
+
+: new-mx ( class -- obj )
+    new
+        H{ } clone >>reads
+        H{ } clone >>writes ; inline
+
+GENERIC: add-input-callback ( thread fd mx -- )
+
+M: mx add-input-callback reads>> push-at ;
+
+GENERIC: add-output-callback ( thread fd mx -- )
+
+M: mx add-output-callback writes>> push-at ;
+
+GENERIC: remove-input-callbacks ( fd mx -- callbacks )
+
+M: mx remove-input-callbacks reads>> delete-at* drop ;
+
+GENERIC: remove-output-callbacks ( fd mx -- callbacks )
+
+M: mx remove-output-callbacks writes>> delete-at* drop ;
+
+GENERIC: wait-for-events ( ms mx -- )
+
+: input-available ( fd mx -- )
+    reads>> delete-at* drop [ resume ] each ;
+
+: output-available ( fd mx -- )
+    writes>> delete-at* drop [ resume ] each ;

basis/io/unix/multiplexers/run-loop/run-loop.factor

@@ -0,0 +1,33 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel arrays namespaces math accessors alien locals
+destructors system threads io.unix.multiplexers
+io.unix.multiplexers.kqueue core-foundation
+core-foundation.run-loop ;
+IN: io.unix.multiplexers.run-loop
+
+TUPLE: run-loop-mx kqueue-mx ;
+
+: file-descriptor-callback ( -- callback )
+    "void" { "CFFileDescriptorRef" "CFOptionFlags" "void*" }
+    "cdecl" [
+        3drop
+        0 mx get kqueue-mx>> wait-for-events
+        reset-run-loop
+        yield
+    ] alien-callback ;
+
+: <run-loop-mx> ( -- mx )
+    [
+        <kqueue-mx> |dispose
+        dup fd>> file-descriptor-callback add-fd-to-run-loop
+        run-loop-mx boa
+    ] with-destructors ;
+
+M: run-loop-mx add-input-callback kqueue-mx>> add-input-callback ;
+M: run-loop-mx add-output-callback kqueue-mx>> add-output-callback ;
+M: run-loop-mx remove-input-callbacks kqueue-mx>> remove-input-callbacks ;
+M: run-loop-mx remove-output-callbacks kqueue-mx>> remove-output-callbacks ;
+
+M: run-loop-mx wait-for-events ( us mx -- )
+    swap run-one-iteration [ 0 swap wait-for-events ] [ drop ] if ;

basis/io/unix/multiplexers/run-loop/tags.txt

@@ -0,0 +1 @@
+unportable

basis/io/unix/multiplexers/select/authors.txt

@@ -0,0 +1 @@
+Slava Pestov

basis/io/unix/multiplexers/select/select.factor

@@ -0,0 +1,56 @@
+! Copyright (C) 2004, 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: alien.c-types kernel bit-arrays sequences assocs unix
+math namespaces accessors math.order locals unix.time fry
+io.ports io.unix.backend io.unix.multiplexers ;
+IN: io.unix.multiplexers.select
+
+TUPLE: select-mx < mx read-fdset write-fdset ;
+
+! Factor's bit-arrays are an array of bytes, OS X expects
+! FD_SET to be an array of cells, so we have to account for
+! byte order differences on big endian platforms
+: munge ( i -- i' )
+    little-endian? [ BIN: 11000 bitxor ] unless ; inline
+
+: <select-mx> ( -- mx )
+    select-mx new-mx
+        FD_SETSIZE 8 * <bit-array> >>read-fdset
+        FD_SETSIZE 8 * <bit-array> >>write-fdset ;
+
+: clear-nth ( n seq -- ? )
+    [ nth ] [ [ f ] 2dip set-nth ] 2bi ;
+
+:: check-fd ( fd fdset mx quot -- )
+    fd munge fdset clear-nth [ fd mx quot call ] when ; inline
+
+: check-fdset ( fds fdset mx quot -- )
+    [ check-fd ] 3curry each ; inline
+
+: init-fdset ( fds fdset -- )
+    '[ t swap munge _ set-nth ] each ;
+
+: read-fdset/tasks ( mx -- seq fdset )
+    [ reads>> keys ] [ read-fdset>> ] bi ;
+
+: write-fdset/tasks ( mx -- seq fdset )
+    [ writes>> keys ] [ write-fdset>> ] bi ;
+
+: max-fd ( assoc -- n )
+    dup assoc-empty? [ drop 0 ] [ keys supremum ] if ;
+
+: num-fds ( mx -- n )
+    [ reads>> max-fd ] [ writes>> max-fd ] bi max 1+ ;
+
+: init-fdsets ( mx -- nfds read write except )
+    [ num-fds ]
+    [ read-fdset/tasks [ init-fdset ] [ underlying>> ] bi ]
+    [ write-fdset/tasks [ init-fdset ] [ underlying>> ] bi ] tri
+    f ;
+
+M:: select-mx wait-for-events ( us mx -- )
+    mx
+    [ init-fdsets us dup [ make-timeval ] when select multiplexer-error drop ]
+    [ [ read-fdset/tasks ] keep [ input-available ] check-fdset ]
+    [ [ write-fdset/tasks ] keep [ output-available ] check-fdset ]
+    tri ;

basis/io/unix/multiplexers/select/tags.txt

@@ -0,0 +1 @@
+unportable

basis/io/unix/select/select.factor

@@ -50,7 +50,7 @@ TUPLE: select-mx < mx read-fdset write-fdset ;
 
 M:: select-mx wait-for-events ( us mx -- )
     mx
-    [ init-fdsets us dup [ make-timeval ] when select multiplexer-error ]
+    [ init-fdsets us dup [ make-timeval ] when select multiplexer-error drop ]
     [ [ read-fdset/tasks ] keep [ input-available ] check-fdset ]
     [ [ write-fdset/tasks ] keep [ output-available ] check-fdset ]
     tri ;

basis/opengl/shaders/shaders.factor

@@ -2,8 +2,8 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel opengl.gl alien.c-types continuations namespaces
 assocs alien alien.strings libc opengl math sequences combinators
-combinators.lib macros arrays io.encodings.ascii fry
-specialized-arrays.uint destructors accessors ;
+macros arrays io.encodings.ascii fry specialized-arrays.uint
+destructors accessors ;
 IN: opengl.shaders
 
 : with-gl-shader-source-ptr ( string quot -- )

basis/stack-checker/alien/alien.factor

@@ -61,12 +61,6 @@ TUPLE: alien-callback-params < alien-node-params quot xt ;
     ! Quotation which coerces return value to required type
     return-prep-quot infer-quot-here ;
 
-! Callbacks are registered in a global hashtable. If you clear
-! this hashtable, they will all be blown away by code GC, beware
-SYMBOL: callbacks
-
-[ H{ } clone callbacks set-global ] "alien.compiler" add-init-hook
-
 : register-callback ( word -- ) callbacks get conjoin ;
 
 : callback-bottom ( params -- )

basis/tools/deploy/deploy-tests.factor

@@ -107,3 +107,8 @@ M: quit-responder call-responder*
     "tools.deploy.test.8" shake-and-bake
     run-temp-image
 ] unit-test
+
+[ ] [
+    "tools.deploy.test.9" shake-and-bake
+    run-temp-image
+] unit-test

basis/tools/deploy/shaker/shaker.factor

@@ -365,6 +365,7 @@ SYMBOL: deploy-vocab
         init-hooks get values concat %
         ,
         strip-io? [ \ flush , ] unless
+        [ 0 exit ] %
     ] [ ] make
     set-boot-quot ;
 

basis/tools/deploy/shaker/strip-cocoa.factor

@@ -19,12 +19,8 @@ IN: cocoa.application
 
 [ [ die ] 19 setenv ] "cocoa.application" add-init-hook
 
-"stop-after-last-window?" get
-
 H{ } clone \ pool [
     global [
-        "stop-after-last-window?" "ui" lookup set
-
         ! Only keeps those methods that we actually call
         sent-messages get super-sent-messages get assoc-union
         objc-methods [ assoc-intersect pool-values ] change

basis/tools/deploy/test/3/deploy.factor

@@ -1,14 +1,15 @@
 USING: tools.deploy.config ;
 H{
-    { deploy-threads? t }
-    { deploy-c-types? f }
-    { deploy-ui? f }
-    { deploy-word-props? f }
-    { deploy-word-defs? f }
-    { deploy-math? t }
-    { deploy-io 3 }
+    { deploy-unicode? f }
     { deploy-name "tools.deploy.test.3" }
-    { deploy-compiler? t }
-    { deploy-reflection 1 }
+    { deploy-ui? f }
     { "stop-after-last-window?" t }
+    { deploy-word-defs? f }
+    { deploy-reflection 1 }
+    { deploy-compiler? t }
+    { deploy-threads? t }
+    { deploy-io 3 }
+    { deploy-math? t }
+    { deploy-word-props? f }
+    { deploy-c-types? f }
 }

basis/tools/deploy/test/9/9.factor

@@ -0,0 +1,10 @@
+USING: alien kernel math ;
+IN: tools.deploy.test.9
+
+: callback-test ( -- callback )
+    "int" { "int" } "cdecl" [ 1 + ] alien-callback ;
+
+: indirect-test ( -- )
+    10 callback-test "int" { "int" } "cdecl" alien-indirect 11 assert= ;
+
+MAIN: indirect-test

basis/tools/deploy/test/9/deploy.factor

@@ -0,0 +1,15 @@
+USING: tools.deploy.config ;
+H{
+    { deploy-unicode? f }
+    { deploy-name "tools.deploy.test.9" }
+    { deploy-ui? f }
+    { "stop-after-last-window?" t }
+    { deploy-word-defs? f }
+    { deploy-reflection 1 }
+    { deploy-compiler? t }
+    { deploy-threads? f }
+    { deploy-io 1 }
+    { deploy-math? t }
+    { deploy-word-props? f }
+    { deploy-c-types? f }
+}

basis/tools/disassembler/disassembler-docs.factor

@@ -3,11 +3,11 @@ USING: help.markup help.syntax sequences.private ;
 
 HELP: disassemble
 { $values { "obj" "a word or a pair of addresses" } }
-{ $description "Disassembles either a compiled word definition or an arbitrary memory range (in the case " { $snippet "obj" } " is a pair of integers) by attaching " { $snippet "gdb" } " to the Factor VM and capturing the output." }
-{ $notes "In some cases the Factor compiler emits data inline with code, which can confuse " { $snippet "gdb" } ". This occurs in words which call " { $link dispatch } ", where the jump table addresses are compiled inline. Also on the ARM architecture, various pointers are often compiled inline, and the preceeding instruction jumps over the inline pinter." } ;
+{ $description "Disassembles either a compiled word definition or an arbitrary memory range (in the case " { $snippet "obj" } " is a pair of integers)." }
+{ $notes "In some cases the Factor compiler emits data inline with code, which can confuse the disassembler. This occurs in words which call " { $link dispatch } ", where the jump table addresses are compiled inline." } ;
 
 ARTICLE: "tools.disassembler" "Disassembling words"
-"The " { $vocab-link "tools.disassembler" } " vocabulary integrates Factor with the GNU debugger (" { $snippet "gdb" } ") for viewing the assembly code generated by the compiler. It can be used on both Unix and Windows as long as a working copy of " { $snippet "gdb" } " is installed and available in the " { $snippet "PATH" } "."
+"The " { $vocab-link "tools.disassembler" } " vocabulary provides support for disassembling compiled word definitions. It uses the " { $snippet "libudis86" } " library on x86-32 and x86-64, and " { $snippet "gdb" } " on PowerPC."
 { $subsection disassemble } ;
 
 ABOUT: "tools.disassembler"

basis/tools/disassembler/disassembler.factor

@@ -1,43 +1,24 @@
-! Copyright (C) 2008 Slava Pestov, Jorge Acereda Macia.
+! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: io.files io words alien kernel math.parser alien.syntax
-io.launcher system assocs arrays sequences namespaces make
-qualified system math compiler.codegen.fixup
-io.encodings.ascii accessors generic tr ;
+USING: tr arrays sequences io words generic system combinators
+vocabs.loader kernel ;
 IN: tools.disassembler
 
-: in-file ( -- path ) "gdb-in.txt" temp-file ;
+GENERIC: disassemble ( obj -- )
 
-: out-file ( -- path ) "gdb-out.txt" temp-file ;
+SYMBOL: disassembler-backend
 
-GENERIC: make-disassemble-cmd ( obj -- )
-
-M: word make-disassemble-cmd
-    word-xt code-format - 2array make-disassemble-cmd ;
-
-M: pair make-disassemble-cmd
-    in-file ascii [
-        "attach " write
-        current-process-handle number>string print
-        "disassemble " write
-        [ number>string write bl ] each
-    ] with-file-writer ;
-
-M: method-spec make-disassemble-cmd
-    first2 method make-disassemble-cmd ;
-
-: gdb-binary ( -- string ) "gdb" ;
-
-: run-gdb ( -- lines )
-    <process>
-        +closed+ >>stdin
-        out-file >>stdout
-        [ gdb-binary , "-x" , in-file , "-batch" , ] { } make >>command
-    try-process
-    out-file ascii file-lines ;
+HOOK: disassemble* disassembler-backend ( from to -- lines )
 
 TR: tabs>spaces "\t" "\s" ;
 
-: disassemble ( obj -- )
-    make-disassemble-cmd run-gdb
-    [ tabs>spaces ] map [ print ] each ;
+M: pair disassemble first2 disassemble* [ tabs>spaces print ] each ;
+
+M: word disassemble word-xt 2array disassemble ;
+
+M: method-spec disassemble first2 method disassemble ;
+
+cpu x86? os unix? and
+"tools.disassembler.udis"
+"tools.disassembler.gdb" ?
+require

basis/tools/disassembler/gdb/gdb.factor

@@ -0,0 +1,36 @@
+! Copyright (C) 2008 Slava Pestov, Jorge Acereda Macia.
+! See http://factorcode.org/license.txt for BSD license.
+USING: io.files io words alien kernel math.parser alien.syntax
+io.launcher system assocs arrays sequences namespaces make
+qualified system math io.encodings.ascii accessors
+tools.disassembler ;
+IN: tools.disassembler.gdb
+
+SINGLETON: gdb-disassembler
+
+: in-file ( -- path ) "gdb-in.txt" temp-file ;
+
+: out-file ( -- path ) "gdb-out.txt" temp-file ;
+
+: make-disassemble-cmd ( from to -- )
+    in-file ascii [
+        "attach " write
+        current-process-handle number>string print
+        "disassemble " write
+        [ number>string write bl ] bi@
+    ] with-file-writer ;
+
+: gdb-binary ( -- string ) "gdb" ;
+
+: run-gdb ( -- lines )
+    <process>
+        +closed+ >>stdin
+        out-file >>stdout
+        [ gdb-binary , "-x" , in-file , "-batch" , ] { } make >>command
+    try-process
+    out-file ascii file-lines ;
+
+M: gdb-disassembler disassemble*
+    make-disassemble-cmd run-gdb ;
+
+gdb-disassembler disassembler-backend set-global

basis/tools/disassembler/gdb/tags.txt

@@ -0,0 +1 @@
+unportable

basis/tools/disassembler/udis/tags.txt

@@ -0,0 +1 @@
+unportable

basis/tools/disassembler/udis/udis.factor

@@ -0,0 +1,89 @@
+! Copyright (C) 2008 Slava Pestov, Jorge Acereda Macia.
+! See http://factorcode.org/license.txt for BSD license.
+USING: tools.disassembler namespaces combinators
+alien alien.syntax alien.c-types lexer parser kernel
+sequences layouts math math.parser system make fry arrays ;
+IN: tools.disassembler.udis
+
+<<
+"libudis86" {
+    { [ os macosx? ] [ "libudis86.0.dylib" ] }
+    { [ os unix? ] [ "libudis86.so.0" ] }
+    { [ os winnt? ] [ "libudis86.dll" ] }
+} cond "cdecl" add-library
+>>
+
+LIBRARY: libudis86
+
+TYPEDEF: char[592] ud
+
+FUNCTION: void ud_translate_intel ( ud* u ) ;
+FUNCTION: void ud_translate_att ( ud* u ) ;
+
+: UD_SYN_INTEL    &: ud_translate_intel ; inline
+: UD_SYN_ATT      &: ud_translate_att ; inline
+: UD_EOI          -1 ; inline
+: UD_INP_CACHE_SZ 32 ; inline
+: UD_VENDOR_AMD   0 ; inline
+: UD_VENDOR_INTEL 1 ; inline
+
+FUNCTION: void ud_init ( ud* u ) ;
+FUNCTION: void ud_set_mode ( ud* u, uint8_t mode ) ;
+FUNCTION: void ud_set_pc ( ud* u, ulonglong pc ) ;
+FUNCTION: void ud_set_input_buffer ( ud* u, uint8_t* offset, size_t size ) ;
+FUNCTION: void ud_set_vendor ( ud* u, uint vendor ) ;
+FUNCTION: void ud_set_syntax ( ud* u, void* syntax ) ;
+FUNCTION: void ud_input_skip ( ud* u, size_t size ) ;
+FUNCTION: int ud_input_end ( ud* u ) ;
+FUNCTION: uint ud_decode ( ud* u ) ;
+FUNCTION: uint ud_disassemble ( ud* u ) ;
+FUNCTION: char* ud_insn_asm ( ud* u ) ;
+FUNCTION: void* ud_insn_ptr ( ud* u ) ;
+FUNCTION: ulonglong ud_insn_off ( ud* u ) ;
+FUNCTION: char* ud_insn_hex ( ud* u ) ;
+FUNCTION: uint ud_insn_len ( ud* u ) ;
+FUNCTION: char* ud_lookup_mnemonic ( int c ) ;
+
+: <ud> ( -- ud )
+    "ud" <c-object>
+    dup ud_init
+    dup cell-bits ud_set_mode
+    dup UD_SYN_INTEL ud_set_syntax ;
+
+SINGLETON: udis-disassembler
+
+: buf/len ( from to -- buf len ) [ drop <alien> ] [ swap - ] 2bi ;
+
+: format-disassembly ( lines -- lines' )
+    dup [ second length ] map supremum
+    '[
+        [
+            [ first >hex cell 2 * CHAR: 0 pad-left % ": " % ]
+            [ second _ CHAR: \s pad-right % "  " % ]
+            [ third % ]
+            tri
+        ] "" make
+    ] map ;
+
+: (disassemble) ( ud -- lines )
+    [
+        dup '[
+            _ ud_disassemble 0 =
+            [ f ] [
+                _
+                [ ud_insn_off ]
+                [ ud_insn_hex ]
+                [ ud_insn_asm ]
+                tri 3array , t
+            ] if
+        ] loop
+    ] { } make ;
+
+M: udis-disassembler disassemble* ( from to -- buffer )
+    [ <ud> ] 2dip {
+        [ drop ud_set_pc ]
+        [ buf/len ud_set_input_buffer ]
+        [ 2drop (disassemble) format-disassembly ]
+    } 3cleave ;
+
+udis-disassembler disassembler-backend set-global

basis/ui/backend/backend.factor

@@ -5,8 +5,6 @@ IN: ui.backend
 
 SYMBOL: ui-backend
 
-HOOK: do-events ui-backend ( -- )
-
 HOOK: set-title ui-backend ( string world -- )
 
 HOOK: set-fullscreen* ui-backend ( ? world -- )
@@ -17,11 +15,17 @@ HOOK: (open-window) ui-backend ( world -- )
 
 HOOK: (close-window) ui-backend ( handle -- )
 
+HOOK: (open-offscreen-buffer) ui-backend ( world -- )
+
+HOOK: (close-offscreen-buffer) ui-backend ( handle -- )
+
 HOOK: raise-window* ui-backend ( world -- )
 
-HOOK: select-gl-context ui-backend ( handle -- )
+GENERIC: select-gl-context ( handle -- )
 
-HOOK: flush-gl-context ui-backend ( handle -- )
+GENERIC: flush-gl-context ( handle -- )
+
+HOOK: offscreen-pixels ui-backend ( world -- alien w h )
 
 HOOK: beep ui-backend ( -- )
 

basis/ui/cocoa/cocoa.factor

@@ -3,21 +3,22 @@
 USING: accessors math arrays assocs cocoa cocoa.application
 command-line kernel memory namespaces cocoa.messages
 cocoa.runtime cocoa.subclassing cocoa.pasteboard cocoa.types
-cocoa.windows cocoa.classes cocoa.application cocoa.nibs
-sequences system ui ui.backend ui.clipboards ui.gadgets
-ui.gadgets.worlds ui.cocoa.views core-foundation threads
-math.geometry.rect fry ;
+cocoa.windows cocoa.classes cocoa.nibs sequences system ui
+ui.backend ui.clipboards ui.gadgets ui.gadgets.worlds
+ui.cocoa.views core-foundation core-foundation.run-loop threads
+math.geometry.rect fry libc generalizations alien.c-types
+cocoa.views combinators io.thread ;
 IN: ui.cocoa
 
-TUPLE: handle view window ;
+TUPLE: handle ;
+TUPLE: window-handle < handle view window ;
+TUPLE: offscreen-handle < handle context buffer ;
 
-C: <handle> handle
+C: <window-handle> window-handle
+C: <offscreen-handle> offscreen-handle
 
 SINGLETON: cocoa-ui-backend
 
-M: cocoa-ui-backend do-events ( -- )
-    [ NSApp '[ _ do-event ] loop ui-wait ] with-autorelease-pool ;
-
 TUPLE: pasteboard handle ;
 
 C: <pasteboard> pasteboard
@@ -39,7 +40,8 @@ M: pasteboard set-clipboard-contents
 : gadget-window ( world -- )
     dup <FactorView>
     2dup swap world>NSRect <ViewWindow>
-    [ [ -> release ] [ install-window-delegate ] bi* ] [ <handle> ] 2bi
+    [ [ -> release ] [ install-window-delegate ] bi* ]
+    [ <window-handle> ] 2bi
     >>handle drop ;
 
 M: cocoa-ui-backend set-title ( string world -- )
@@ -88,11 +90,39 @@ M: cocoa-ui-backend raise-window* ( world -- )
         NSApp 1 -> activateIgnoringOtherApps:
     ] when* ;
 
-M: cocoa-ui-backend select-gl-context ( handle -- )
-    view>> -> openGLContext -> makeCurrentContext ;
+: pixel-size ( pixel-format -- size )
+    0 <int> [ NSOpenGLPFAColorSize 0 -> getValues:forAttribute:forVirtualScreen: ]
+    keep *int -3 shift ;
 
-M: cocoa-ui-backend flush-gl-context ( handle -- )
-    view>> -> openGLContext -> flushBuffer ;
+: offscreen-buffer ( world pixel-format -- alien w h pitch )
+    [ dim>> first2 ] [ pixel-size ] bi*
+    { [ * * malloc ] [ 2drop ] [ drop nip ] [ nip * ] } 3cleave ;
+
+: gadget-offscreen-context ( world -- context buffer )
+    NSOpenGLPFAOffScreen 1array <PixelFormat>
+    [ nip NSOpenGLContext -> alloc swap f -> initWithFormat:shareContext: dup ]
+    [ offscreen-buffer ] 2bi
+    4 npick [ -> setOffScreen:width:height:rowbytes: ] dip ;
+
+M: cocoa-ui-backend (open-offscreen-buffer) ( world -- )
+    dup gadget-offscreen-context <offscreen-handle> >>handle drop ;
+
+M: cocoa-ui-backend (close-offscreen-buffer) ( handle -- )
+    [ context>> -> release ]
+    [ buffer>> free ] bi ;
+
+GENERIC: (gl-context) ( handle -- context )
+M: window-handle (gl-context) view>> -> openGLContext ;
+M: offscreen-handle (gl-context) context>> ;
+
+M: handle select-gl-context ( handle -- )
+    (gl-context) -> makeCurrentContext ;
+
+M: handle flush-gl-context ( handle -- )
+    (gl-context) -> flushBuffer ;
+
+M: cocoa-ui-backend offscreen-pixels ( world -- alien w h )
+    [ handle>> buffer>> ] [ dim>> first2 neg ] bi ;
 
 M: cocoa-ui-backend beep ( -- )
     NSBeep ;
@@ -102,8 +132,8 @@ CLASS: {
     { +name+ "FactorApplicationDelegate" }
 }
 
-{ "applicationDidFinishLaunching:" "void" { "id" "SEL" "id" }
-    [ 3drop event-loop ]
+{  "applicationDidUpdate:" "void" { "id" "SEL" "id" }
+    [ 3drop reset-run-loop ]
 } ;
 
 : install-app-delegate ( -- )
@@ -121,6 +151,9 @@ M: cocoa-ui-backend ui
             init-clipboard
             cocoa-init-hook get call
             start-ui
+            f io-thread-running? set-global
+            init-thread-timer
+            reset-run-loop
             NSApp -> run
         ] ui-running
     ] with-cocoa ;

basis/ui/cocoa/tools/tools.factor

@@ -1,10 +1,10 @@
-! Copyright (C) 2006, 2007 Slava Pestov.
+! Copyright (C) 2006, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien.syntax cocoa cocoa.nibs cocoa.application
 cocoa.classes cocoa.dialogs cocoa.pasteboard cocoa.subclassing
-core-foundation help.topics kernel memory namespaces parser
-system ui ui.tools.browser ui.tools.listener ui.tools.workspace
-ui.cocoa eval locals ;
+core-foundation core-foundation.strings help.topics kernel
+memory namespaces parser system ui ui.tools.browser
+ui.tools.listener ui.tools.workspace ui.cocoa eval locals ;
 IN: ui.cocoa.tools
 
 : finder-run-files ( alien -- )

basis/ui/cocoa/views/views.factor

@@ -4,7 +4,7 @@ USING: accessors alien alien.c-types arrays assocs cocoa kernel
 math cocoa.messages cocoa.subclassing cocoa.classes cocoa.views
 cocoa.application cocoa.pasteboard cocoa.types cocoa.windows
 sequences ui ui.gadgets ui.gadgets.worlds ui.gestures
-core-foundation threads combinators math.geometry.rect ;
+core-foundation.strings threads combinators math.geometry.rect ;
 IN: ui.cocoa.views
 
 : send-mouse-moved ( view event -- )