diff --git a/basis/alien/c-types/c-types-tests.factor b/basis/alien/c-types/c-types-tests.factor index f57d102452..31542b2699 100644 --- a/basis/alien/c-types/c-types-tests.factor +++ b/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 diff --git a/basis/alien/syntax/syntax-docs.factor b/basis/alien/syntax/syntax-docs.factor index 586bb97402..a3215cd8c6 100644 --- a/basis/alien/syntax/syntax-docs.factor +++ b/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" } "." } diff --git a/basis/alien/syntax/syntax.factor b/basis/alien/syntax/syntax.factor index b0ba10a316..15d82884f9 100644 --- a/basis/alien/syntax/syntax.factor +++ b/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 diff --git a/basis/compiler/tests/alien.factor b/basis/compiler/tests/alien.factor index 230a7bf542..1b21e40bac 100644 --- a/basis/compiler/tests/alien.factor +++ b/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 ) diff --git a/basis/core-foundation/core-foundation.factor b/basis/core-foundation/core-foundation.factor index 48d7b7e483..40dd4710a1 100644 --- a/basis/core-foundation/core-foundation.factor +++ b/basis/core-foundation/core-foundation.factor @@ -1,8 +1,8 @@ ! 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 ; +math math.bitwise sequences io.encodings.utf8 destructors +accessors combinators byte-arrays ; IN: core-foundation TYPEDEF: void* CFAllocatorRef @@ -195,11 +195,22 @@ FUNCTION: CFFileDescriptorRef CFFileDescriptorCreate ( CFFileDescriptorContext* context ) ; +: kCFFileDescriptorReadCallBack 1 ; inline +: kCFFileDescriptorWriteCallBack 2 ; inline + FUNCTION: void CFFileDescriptorEnableCallBacks ( CFFileDescriptorRef f, CFOptionFlags callBackTypes ) ; +: enable-all-callbacks ( fd -- ) + { kCFFileDescriptorReadCallBack kCFFileDescriptorWriteCallBack } flags + CFFileDescriptorEnableCallBacks ; + +: ( fd callback -- handle ) + [ f swap ] [ t swap ] bi* f CFFileDescriptorCreate + [ "CFFileDescriptorCreate failed" throw ] unless* ; + : load-framework ( name -- ) dup [ CFBundleLoadExecutable drop diff --git a/basis/core-foundation/fsevents/fsevents.factor b/basis/core-foundation/fsevents/fsevents.factor index d4d5e88512..67c2dcfa35 100644 --- a/basis/core-foundation/fsevents/fsevents.factor +++ b/basis/core-foundation/fsevents/fsevents.factor @@ -3,10 +3,10 @@ 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 ; +core-foundation.run-loop io.encodings.utf8 destructors locals +arrays specialized-arrays.direct.alien +specialized-arrays.direct.int specialized-arrays.direct.longlong +; 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 diff --git a/basis/core-foundation/run-loop/run-loop.factor b/basis/core-foundation/run-loop/run-loop.factor index 39f4101301..d254bf3adc 100644 --- a/basis/core-foundation/run-loop/run-loop.factor +++ b/basis/core-foundation/run-loop/run-loop.factor @@ -32,6 +32,12 @@ FUNCTION: void CFRunLoopAddSource ( CFStringRef mode ) ; +FUNCTION: void CFRunLoopRemoveSource ( + CFRunLoopRef rl, + CFRunLoopSourceRef source, + CFStringRef mode +) ; + : CFRunLoopDefaultMode ( -- alien ) #! Ugly, but we don't have static NSStrings \ CFRunLoopDefaultMode get-global dup expired? [ diff --git a/basis/core-foundation/run-loop/thread/summary.txt b/basis/core-foundation/run-loop/thread/summary.txt deleted file mode 100644 index e5818b3d78..0000000000 --- a/basis/core-foundation/run-loop/thread/summary.txt +++ /dev/null @@ -1 +0,0 @@ -Vocabulary with init hook for running CoreFoundation event loop diff --git a/basis/core-foundation/run-loop/thread/thread.factor b/basis/core-foundation/run-loop/thread/thread.factor deleted file mode 100644 index aeeff312cb..0000000000 --- a/basis/core-foundation/run-loop/thread/thread.factor +++ /dev/null @@ -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 diff --git a/basis/environment/unix/unix.factor b/basis/environment/unix/unix.factor index c2dddc25ab..7da19ee47b 100644 --- a/basis/environment/unix/unix.factor +++ b/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 ; diff --git a/basis/http/client/client.factor b/basis/http/client/client.factor index 119fa23567..108ae5ecc4 100644 --- a/basis/http/client/client.factor +++ b/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" ; +M: string >post-data utf8 encode "application/octet-stream" ; M: byte-array >post-data "application/octet-stream" ; -M: assoc >post-data assoc>query "application/x-www-form-urlencoded" ; +M: assoc >post-data assoc>query ascii encode "application/x-www-form-urlencoded" ; 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 ; diff --git a/basis/io/launcher/launcher-docs.factor b/basis/io/launcher/launcher-docs.factor index 45bbec20e3..3585214735 100644 --- a/basis/io/launcher/launcher-docs.factor +++ b/basis/io/launcher/launcher-docs.factor @@ -143,8 +143,9 @@ HELP: { $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 } "." diff --git a/basis/io/launcher/launcher.factor b/basis/io/launcher/launcher.factor index 0ed10e63c3..7bafb95376 100644 --- a/basis/io/launcher/launcher.factor +++ b/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 -- ) diff --git a/basis/io/unix/backend/backend.factor b/basis/io/unix/backend/backend.factor index 1666d60c83..41bd03a58b 100644 --- a/basis/io/unix/backend/backend.factor +++ b/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 new @@ -207,10 +175,10 @@ TUPLE: mx-port < port mx ; : ( mx -- port ) dup fd>> mx-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 ) diff --git a/basis/io/unix/bsd/bsd.factor b/basis/io/unix/bsd/bsd.factor index 50b4b610da..83f063d713 100644 --- a/basis/io/unix/bsd/bsd.factor +++ b/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 ( -- ) - mx set-global ; -! kqueue-mx set-global -! kqueue-mx get-global -! dup io-task-fd -! [ mx get-global reads>> set-at ] -! [ mx get-global writes>> set-at ] 2bi ; + mx set-global ; ! M: bsd (monitor) ( path recursive? mailbox -- ) ! swap [ "Recursive kqueue monitors not supported" throw ] when diff --git a/basis/io/unix/epoll/epoll.factor b/basis/io/unix/epoll/epoll.factor index e8d33787f3..93d0b4aa99 100644 --- a/basis/io/unix/epoll/epoll.factor +++ b/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 diff --git a/basis/io/unix/kqueue/kqueue.factor b/basis/io/unix/kqueue/kqueue.factor index b4e2b7af6f..be99d17572 100644 --- a/basis/io/unix/kqueue/kqueue.factor +++ b/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 { diff --git a/basis/io/unix/launcher/launcher-tests.factor b/basis/io/unix/launcher/launcher-tests.factor index 33988c273b..68ca821ed4 100644 --- a/basis/io/unix/launcher/launcher-tests.factor +++ b/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 [ ] + s [ ] | + [ + "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 diff --git a/basis/io/unix/launcher/launcher.factor b/basis/io/unix/launcher/launcher.factor index e80a372aef..729c1545d8 100644 --- a/basis/io/unix/launcher/launcher.factor +++ b/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 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 ; diff --git a/basis/io/unix/linux/linux.factor b/basis/io/unix/linux/linux.factor index be5b83f1b0..fd24e0ac02 100644 --- a/basis/io/unix/linux/linux.factor +++ b/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 ( -- ) diff --git a/basis/io/unix/linux/monitors/monitors.factor b/basis/io/unix/linux/monitors/monitors.factor index f27d48c6b0..3964a25a04 100644 --- a/basis/io/unix/linux/monitors/monitors.factor +++ b/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 diff --git a/basis/io/unix/macosx/macosx.factor b/basis/io/unix/macosx/macosx.factor index ef52b676fb..75f42b7394 100644 --- a/basis/io/unix/macosx/macosx.factor +++ b/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 ( -- ) - mx set-global ; + mx set-global ; macosx set-io-backend diff --git a/basis/core-foundation/run-loop/thread/authors.txt b/basis/io/unix/multiplexers/epoll/authors.txt old mode 100644 new mode 100755 similarity index 100% rename from basis/core-foundation/run-loop/thread/authors.txt rename to basis/io/unix/multiplexers/epoll/authors.txt diff --git a/basis/io/unix/multiplexers/epoll/epoll.factor b/basis/io/unix/multiplexers/epoll/epoll.factor new file mode 100644 index 0000000000..08e20d4b95 --- /dev/null +++ b/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 + +: ( -- mx ) + epoll-mx new-mx + max-events epoll_create dup io-error >>fd + max-events "epoll-event" >>events ; + +M: epoll-mx dispose fd>> close-file ; + +: make-event ( fd events -- event ) + "epoll-event" + [ 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 ; diff --git a/basis/core-foundation/run-loop/thread/tags.txt b/basis/io/unix/multiplexers/epoll/tags.txt similarity index 100% rename from basis/core-foundation/run-loop/thread/tags.txt rename to basis/io/unix/multiplexers/epoll/tags.txt diff --git a/basis/io/unix/multiplexers/kqueue/authors.txt b/basis/io/unix/multiplexers/kqueue/authors.txt new file mode 100755 index 0000000000..1901f27a24 --- /dev/null +++ b/basis/io/unix/multiplexers/kqueue/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/basis/io/unix/multiplexers/kqueue/kqueue.factor b/basis/io/unix/multiplexers/kqueue/kqueue.factor new file mode 100644 index 0000000000..a66e86a6a7 --- /dev/null +++ b/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 + +: ( -- mx ) + kqueue-mx new-mx + kqueue dup io-error >>fd + max-events "kevent" >>events ; + +M: kqueue-mx dispose fd>> close-file ; + +: make-kevent ( fd filter flags -- event ) + "kevent" + [ 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 ; diff --git a/basis/io/unix/multiplexers/kqueue/tags.txt b/basis/io/unix/multiplexers/kqueue/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/basis/io/unix/multiplexers/kqueue/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/basis/io/unix/multiplexers/multiplexers.factor b/basis/io/unix/multiplexers/multiplexers.factor new file mode 100644 index 0000000000..1c9fb134e7 --- /dev/null +++ b/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 ; diff --git a/basis/io/unix/multiplexers/run-loop/run-loop.factor b/basis/io/unix/multiplexers/run-loop/run-loop.factor new file mode 100644 index 0000000000..baaf910f37 --- /dev/null +++ b/basis/io/unix/multiplexers/run-loop/run-loop.factor @@ -0,0 +1,57 @@ +! Copyright (C) 2008 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: kernel namespaces math accessors threads alien locals +destructors combinators core-foundation core-foundation.run-loop +io.unix.multiplexers io.unix.multiplexers.kqueue ; +IN: io.unix.multiplexers.run-loop + +TUPLE: run-loop-mx kqueue-mx fd source ; + +: kqueue-callback ( -- callback ) + "void" { "CFFileDescriptorRef" "CFOptionFlags" "void*" } + "cdecl" [ + 3drop + 0 mx get kqueue-mx>> wait-for-events + mx get fd>> enable-all-callbacks + yield + ] + alien-callback ; + +SYMBOL: kqueue-run-loop-source + +: create-kqueue-source ( fd -- source ) + f swap 0 CFFileDescriptorCreateRunLoopSource ; + +: add-kqueue-to-run-loop ( mx -- ) + CFRunLoopGetMain swap source>> CFRunLoopDefaultMode CFRunLoopAddSource ; + +: remove-kqueue-from-run-loop ( source -- ) + CFRunLoopGetMain swap source>> CFRunLoopDefaultMode CFRunLoopRemoveSource ; + +: ( -- mx ) + [ + |dispose + dup fd>> kqueue-callback |dispose + dup create-kqueue-source run-loop-mx boa + dup add-kqueue-to-run-loop + ] with-destructors ; + +M: run-loop-mx dispose + [ + { + [ fd>> &dispose drop ] + [ source>> &dispose drop ] + [ remove-kqueue-from-run-loop ] + [ kqueue-mx>> &dispose drop ] + } cleave + ] 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 -- ) + mx fd>> enable-all-callbacks + CFRunLoopDefaultMode us [ 1000000 /f ] [ 60 ] if* t CFRunLoopRunInMode + kCFRunLoopRunHandledSource = [ 0 mx wait-for-events ] when ; diff --git a/basis/io/unix/multiplexers/run-loop/tags.txt b/basis/io/unix/multiplexers/run-loop/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/basis/io/unix/multiplexers/run-loop/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/basis/io/unix/multiplexers/select/authors.txt b/basis/io/unix/multiplexers/select/authors.txt new file mode 100755 index 0000000000..1901f27a24 --- /dev/null +++ b/basis/io/unix/multiplexers/select/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/basis/io/unix/multiplexers/select/select.factor b/basis/io/unix/multiplexers/select/select.factor new file mode 100644 index 0000000000..915daac2d3 --- /dev/null +++ b/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 + +: ( -- mx ) + select-mx new-mx + FD_SETSIZE 8 * >>read-fdset + FD_SETSIZE 8 * >>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 ; diff --git a/basis/io/unix/multiplexers/select/tags.txt b/basis/io/unix/multiplexers/select/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/basis/io/unix/multiplexers/select/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/basis/io/unix/select/select.factor b/basis/io/unix/select/select.factor index 27231aee5a..a6b61001a6 100644 --- a/basis/io/unix/select/select.factor +++ b/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 ; diff --git a/basis/tools/disassembler/disassembler-docs.factor b/basis/tools/disassembler/disassembler-docs.factor index f03861a8ed..7d193d0aac 100644 --- a/basis/tools/disassembler/disassembler-docs.factor +++ b/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" diff --git a/basis/tools/disassembler/disassembler.factor b/basis/tools/disassembler/disassembler.factor index 76e1f0f1b8..fac340845b 100644 --- a/basis/tools/disassembler/disassembler.factor +++ b/basis/tools/disassembler/disassembler.factor @@ -1,43 +1,25 @@ -! 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 ; 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 ) - - +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.32 [ "tools.disassembler.udis" ] } + { x86.64 [ "tools.disassembler.udis" ] } + { ppc [ "tools.disassembler.gdb" ] } +} case require diff --git a/basis/tools/disassembler/gdb/gdb.factor b/basis/tools/disassembler/gdb/gdb.factor new file mode 100644 index 0000000000..65d0e2f43a --- /dev/null +++ b/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 ) + + +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 diff --git a/basis/tools/disassembler/gdb/tags.txt b/basis/tools/disassembler/gdb/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/basis/tools/disassembler/gdb/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/basis/tools/disassembler/udis/tags.txt b/basis/tools/disassembler/udis/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/basis/tools/disassembler/udis/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/basis/tools/disassembler/udis/udis.factor b/basis/tools/disassembler/udis/udis.factor new file mode 100644 index 0000000000..c5b5c80d13 --- /dev/null +++ b/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" + 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 ] [ 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 ) + [ ] 2dip { + [ drop ud_set_pc ] + [ buf/len ud_set_input_buffer ] + [ 2drop (disassemble) format-disassembly ] + } 3cleave ; + +udis-disassembler disassembler-backend set-global diff --git a/basis/ui/gadgets/worlds/worlds-docs.factor b/basis/ui/gadgets/worlds/worlds-docs.factor index 35781fa568..60e4e58ed5 100644 --- a/basis/ui/gadgets/worlds/worlds-docs.factor +++ b/basis/ui/gadgets/worlds/worlds-docs.factor @@ -2,6 +2,10 @@ USING: ui.gadgets ui.render ui.gestures ui.backend help.markup help.syntax models opengl strings ; IN: ui.gadgets.worlds +HELP: user-input +{ $values { "string" string } { "world" world } } +{ $description "Calls " { $link user-input* } " on every parent of the world's currently-focused child." } ; + HELP: origin { $var-description "Within the dynamic extent of " { $link draw-world } ", holds the co-ordinate system origin for the gadget currently being drawn." } ; diff --git a/basis/ui/gestures/gestures-docs.factor b/basis/ui/gestures/gestures-docs.factor index 602d3fd425..f6495a14c3 100644 --- a/basis/ui/gestures/gestures-docs.factor +++ b/basis/ui/gestures/gestures-docs.factor @@ -1,5 +1,5 @@ -USING: ui.gadgets help.markup help.syntax hashtables -strings kernel system ; +USING: ui.gadgets ui.gadgets.worlds help.markup help.syntax +hashtables strings kernel system ; IN: ui.gestures HELP: set-gestures @@ -21,10 +21,6 @@ HELP: propagate-gesture { $values { "gesture" "a gesture" } { "gadget" gadget } } { $description "Calls " { $link handle-gesture } " on every parent of " { $snippet "gadget" } "." } ; -HELP: user-input -{ $values { "string" string } { "gadget" gadget } } -{ $description "Calls " { $link user-input* } " on every parent of the gadget." } ; - HELP: motion { $class-description "Mouse motion gesture." } { $examples { $code "T{ motion }" } } ; diff --git a/basis/ui/x11/x11.factor b/basis/ui/x11/x11.factor index b4a0427ccd..563b98aa34 100755 --- a/basis/ui/x11/x11.factor +++ b/basis/ui/x11/x11.factor @@ -137,7 +137,7 @@ M: world focus-out-event M: world selection-notify-event [ handle>> window>> selection-from-event ] keep - world user-input ; + user-input ; : supported-type? ( atom -- ? ) { "UTF8_STRING" "STRING" "TEXT" } diff --git a/basis/unix/process/process.factor b/basis/unix/process/process.factor index 175425f948..7d5f9eb330 100644 --- a/basis/unix/process/process.factor +++ b/basis/unix/process/process.factor @@ -74,7 +74,7 @@ FUNCTION: int setpriority ( int which, int who, int prio ) ; HEX: 7f bitand ; inline : WIFEXITED ( status -- ? ) - WTERMSIG zero? ; inline + WTERMSIG 0 = ; inline : WEXITSTATUS ( status -- value ) HEX: ff00 bitand -8 shift ; inline @@ -86,7 +86,7 @@ FUNCTION: int setpriority ( int which, int who, int prio ) ; HEX: 80 ; inline : WCOREDUMP ( status -- ? ) - WCOREFLAG bitand zero? not ; inline + WCOREFLAG bitand 0 = not ; inline : WIFSTOPPED ( status -- ? ) HEX: ff bitand HEX: 7f = ; inline diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor index e364359928..7bb509cb67 100644 --- a/core/sequences/sequences.factor +++ b/core/sequences/sequences.factor @@ -343,7 +343,7 @@ PRIVATE> [ (each) ] dip collect ; inline : 2nth-unsafe ( n seq1 seq2 -- elt1 elt2 ) - [ over ] dip nth-unsafe [ nth-unsafe ] dip ; inline + [ over ] dip [ nth-unsafe ] 2bi@ ; inline : (2each) ( seq1 seq2 quot -- n quot' ) [ [ min-length ] 2keep ] dip @@ -538,12 +538,12 @@ M: sequence <=> : sequence-hashcode-step ( oldhash newpart -- newhash ) >fixnum swap [ - dup -2 fixnum-shift-fast swap 5 fixnum-shift-fast + [ -2 fixnum-shift-fast ] [ 5 fixnum-shift-fast ] bi fixnum+fast fixnum+fast ] keep fixnum-bitxor ; inline : sequence-hashcode ( n seq -- x ) - 0 -rot [ hashcode* sequence-hashcode-step ] with each ; inline + [ 0 ] 2dip [ hashcode* sequence-hashcode-step ] with each ; inline M: reversed equal? over reversed? [ sequence= ] [ 2drop f ] if ;