Merge branch 'master' of git://factorcode.org/git/factor
Doug Coleman
commit
05d6cf873f
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -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" } "." }
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 )
|
||||
|
|
|
|||
|
|
@ -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 ;
|
||||
|
||||
: <CFFileDescriptor> ( fd callback -- handle )
|
||||
[ f swap ] [ t swap ] bi* f CFFileDescriptorCreate
|
||||
[ "CFFileDescriptorCreate failed" throw ] unless* ;
|
||||
|
||||
: load-framework ( name -- )
|
||||
dup <CFBundle> [
|
||||
CFBundleLoadExecutable drop
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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? [
|
||||
|
|
|
|||
|
|
@ -1 +0,0 @@
|
|||
Vocabulary with init hook for running CoreFoundation event loop
|
||||
|
|
@ -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
|
||||
|
|
@ -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 ;
|
||||
|
||||
|
|
|
|||
|
|
@ -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 ;
|
||||
|
||||
|
|
|
|||
|
|
@ -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 } "."
|
||||
|
|
|
|||
|
|
@ -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 -- )
|
||||
|
|
|
|||
|
|
@ -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 )
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 {
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 ;
|
||||
|
|
|
|||
|
|
@ -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 ( -- )
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
0
basis/core-foundation/run-loop/thread/authors.txt → basis/io/unix/multiplexers/epoll/authors.txt
Normal file → Executable file
0
basis/core-foundation/run-loop/thread/authors.txt → basis/io/unix/multiplexers/epoll/authors.txt
Normal file → Executable file
|
|
@ -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 ;
|
||||
|
|
@ -0,0 +1 @@
|
|||
Slava Pestov
|
||||
|
|
@ -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 ;
|
||||
|
|
@ -0,0 +1 @@
|
|||
unportable
|
||||
|
|
@ -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 ;
|
||||
|
|
@ -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 ;
|
||||
|
||||
: <run-loop-mx> ( -- mx )
|
||||
[
|
||||
<kqueue-mx> |dispose
|
||||
dup fd>> kqueue-callback <CFFileDescriptor> |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 ;
|
||||
|
|
@ -0,0 +1 @@
|
|||
unportable
|
||||
|
|
@ -0,0 +1 @@
|
|||
Slava Pestov
|
||||
|
|
@ -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 ;
|
||||
|
|
@ -0,0 +1 @@
|
|||
unportable
|
||||
|
|
@ -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 ;
|
||||
|
|
|
|||
|
|
@ -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"
|
||||
|
|
|
|||
|
|
@ -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 )
|
||||
<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.32 [ "tools.disassembler.udis" ] }
|
||||
{ x86.64 [ "tools.disassembler.udis" ] }
|
||||
{ ppc [ "tools.disassembler.gdb" ] }
|
||||
} case require
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
@ -0,0 +1 @@
|
|||
unportable
|
||||
|
|
@ -0,0 +1 @@
|
|||
unportable
|
||||
|
|
@ -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
|
||||
|
|
@ -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." } ;
|
||||
|
||||
|
|
|
|||
|
|
@ -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 }" } } ;
|
||||
|
|
|
|||
|
|
@ -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" }
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 ;
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue