Merge branch 'master' of git://factorcode.org/git/factor
commit
5d56e16188
|
@ -6,7 +6,7 @@ kernel libc literals math multiline namespaces prettyprint
|
|||
prettyprint.config see sequences specialized-arrays.ushort
|
||||
system tools.test compiler.tree.debugger struct-arrays
|
||||
classes.tuple.private specialized-arrays.direct.int
|
||||
compiler.units ;
|
||||
compiler.units byte-arrays specialized-arrays.char ;
|
||||
IN: classes.struct.tests
|
||||
|
||||
<<
|
||||
|
@ -224,4 +224,27 @@ STRUCT: struct-test-optimization
|
|||
|
||||
[ f ] [ [ memory>struct y>> ] { memory>struct y>> } inlined? ] unit-test
|
||||
|
||||
[ f ] [ struct-test-foo <struct> dup clone [ >c-ptr ] bi@ eq? ] unit-test
|
||||
! Test cloning structs
|
||||
STRUCT: clone-test-struct { x int } { y char[3] } ;
|
||||
|
||||
[ 1 char-array{ 9 1 1 } ] [
|
||||
clone-test-struct <struct>
|
||||
1 >>x char-array{ 9 1 1 } >>y
|
||||
clone
|
||||
[ x>> ] [ y>> >char-array ] bi
|
||||
] unit-test
|
||||
|
||||
[ t 1 char-array{ 9 1 1 } ] [
|
||||
[
|
||||
clone-test-struct malloc-struct &free
|
||||
1 >>x char-array{ 9 1 1 } >>y
|
||||
clone
|
||||
[ >c-ptr byte-array? ] [ x>> ] [ y>> >char-array ] tri
|
||||
] with-destructors
|
||||
] unit-test
|
||||
|
||||
STRUCT: struct-that's-a-word { x int } ;
|
||||
|
||||
: struct-that's-a-word ( -- ) "OOPS" throw ;
|
||||
|
||||
[ -77 ] [ S{ struct-that's-a-word { x -77 } } clone x>> ] unit-test
|
||||
|
|
|
@ -46,9 +46,6 @@ M: struct equal?
|
|||
dup struct-class? [ '[ _ boa ] ] [ drop f ] if
|
||||
] 1 define-partial-eval
|
||||
|
||||
M: struct clone
|
||||
[ >c-ptr ] [ byte-length memory>byte-array ] [ class memory>struct ] tri ;
|
||||
|
||||
<PRIVATE
|
||||
: (init-struct) ( class with-prototype: ( prototype -- alien ) sans-prototype: ( class -- alien ) -- alien )
|
||||
'[ dup struct-prototype _ _ ?if ] keep memory>struct ; inline
|
||||
|
@ -58,13 +55,13 @@ PRIVATE>
|
|||
[ heap-size malloc ] keep memory>struct ; inline
|
||||
|
||||
: malloc-struct ( class -- struct )
|
||||
[ >c-ptr malloc-byte-array ] [ 1 swap heap-size calloc ] (init-struct) ;
|
||||
[ >c-ptr malloc-byte-array ] [ 1 swap heap-size calloc ] (init-struct) ; inline
|
||||
|
||||
: (struct) ( class -- struct )
|
||||
[ heap-size (byte-array) ] keep memory>struct ; inline
|
||||
|
||||
: <struct> ( class -- struct )
|
||||
[ >c-ptr clone ] [ heap-size <byte-array> ] (init-struct) ;
|
||||
[ >c-ptr clone ] [ heap-size <byte-array> ] (init-struct) ; inline
|
||||
|
||||
MACRO: <struct-boa> ( class -- quot: ( ... -- struct ) )
|
||||
[
|
||||
|
@ -119,13 +116,24 @@ M: struct-class writer-quot
|
|||
\ cleave [ ] 2sequence
|
||||
\ output>array [ ] 2sequence ;
|
||||
|
||||
: define-inline-method ( class generic quot -- )
|
||||
[ create-method-in ] dip [ define ] [ drop make-inline ] 2bi ;
|
||||
|
||||
: (define-struct-slot-values-method) ( class -- )
|
||||
[ \ struct-slot-values create-method-in ]
|
||||
[ struct-slot-values-quot ] bi define ;
|
||||
[ \ struct-slot-values ] [ struct-slot-values-quot ] bi
|
||||
define-inline-method ;
|
||||
|
||||
: (define-byte-length-method) ( class -- )
|
||||
[ \ byte-length create-method-in ]
|
||||
[ heap-size \ drop swap [ ] 2sequence ] bi define ;
|
||||
[ \ byte-length ] [ heap-size \ drop swap [ ] 2sequence ] bi
|
||||
define-inline-method ;
|
||||
|
||||
: clone-underlying ( struct -- byte-array )
|
||||
[ >c-ptr ] [ byte-length ] bi memory>byte-array ; inline
|
||||
|
||||
: (define-clone-method) ( class -- )
|
||||
[ \ clone ]
|
||||
[ \ clone-underlying swap literalize \ memory>struct [ ] 3sequence ] bi
|
||||
define-inline-method ;
|
||||
|
||||
: slot>field ( slot -- field )
|
||||
field-spec new swap {
|
||||
|
@ -207,7 +215,9 @@ M: struct-class heap-size
|
|||
|
||||
: (struct-methods) ( class -- )
|
||||
[ (define-struct-slot-values-method) ]
|
||||
[ (define-byte-length-method) ] bi ;
|
||||
[ (define-byte-length-method) ]
|
||||
[ (define-clone-method) ]
|
||||
tri ;
|
||||
|
||||
: (struct-word-props) ( class slots size align -- )
|
||||
[
|
||||
|
|
|
@ -2,28 +2,28 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors alien.c-types combinators destructors
|
||||
io.backend.unix kernel math.bitwise sequences struct-arrays unix
|
||||
unix.kqueue unix.time assocs io.backend.unix.multiplexers ;
|
||||
unix.kqueue unix.time assocs io.backend.unix.multiplexers
|
||||
classes.struct ;
|
||||
IN: io.backend.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
|
||||
! We read up to 256 events at a time. This is an arbitrary
|
||||
! constant...
|
||||
CONSTANT: max-events 256
|
||||
|
||||
: <kqueue-mx> ( -- mx )
|
||||
kqueue-mx new-mx
|
||||
kqueue dup io-error >>fd
|
||||
max-events "kevent" <struct-array> >>events ;
|
||||
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 ;
|
||||
\ kevent <struct>
|
||||
swap >>flags
|
||||
swap >>filter
|
||||
swap >>ident ;
|
||||
|
||||
: register-kevent ( kevent mx -- )
|
||||
fd>> swap 1 f 0 f kevent io-error ;
|
||||
|
@ -63,13 +63,14 @@ M: kqueue-mx remove-output-callbacks ( fd mx -- seq )
|
|||
] dip kevent multiplexer-error ;
|
||||
|
||||
: handle-kevent ( mx kevent -- )
|
||||
[ kevent-ident swap ] [ kevent-filter ] bi {
|
||||
[ ident>> swap ] [ filter>> ] bi {
|
||||
{ EVFILT_READ [ input-available ] }
|
||||
{ EVFILT_WRITE [ output-available ] }
|
||||
} case ;
|
||||
|
||||
: handle-kevents ( mx n -- )
|
||||
[ dup events>> ] dip head-slice [ handle-kevent ] with each ;
|
||||
[ dup events>> ] dip head-slice
|
||||
[ \ kevent memory>struct handle-kevent ] with each ;
|
||||
|
||||
M: kqueue-mx wait-for-events ( us mx -- )
|
||||
swap dup [ make-timespec ] when
|
||||
|
|
|
@ -74,8 +74,7 @@ yield
|
|||
|
||||
[ datagram-client delete-file ] ignore-errors
|
||||
|
||||
datagram-client <local> <datagram>
|
||||
"d" set
|
||||
[ ] [ datagram-client <local> <datagram> "d" set ] unit-test
|
||||
|
||||
[ ] [
|
||||
"hello" >byte-array
|
||||
|
|
|
@ -47,6 +47,6 @@ M: openbsd statvfs>file-system-info ( file-system-info statvfs -- file-system-in
|
|||
|
||||
M: openbsd file-systems ( -- seq )
|
||||
f 0 0 getfsstat dup io-error
|
||||
statfs <c-type-array> dup dup length 0 getfsstat io-error
|
||||
statfs heap-size group
|
||||
\ statfs <c-type-array> dup dup length 0 getfsstat io-error
|
||||
\ statfs heap-size group
|
||||
[ f_mntonname>> alien>native-string file-system-info ] map ;
|
||||
|
|
|
@ -1,14 +1,13 @@
|
|||
USING: alien.syntax ;
|
||||
USING: alien.syntax classes.struct ;
|
||||
IN: unix.kqueue
|
||||
|
||||
C-STRUCT: kevent
|
||||
{ "ulong" "ident" } ! identifier for this event
|
||||
{ "short" "filter" } ! filter for event
|
||||
{ "ushort" "flags" } ! action flags for kqueue
|
||||
{ "uint" "fflags" } ! filter flag value
|
||||
{ "long" "data" } ! filter data value
|
||||
{ "void*" "udata" } ! opaque user data identifier
|
||||
;
|
||||
STRUCT: kevent
|
||||
{ ident ulong }
|
||||
{ filter short }
|
||||
{ flags ushort }
|
||||
{ fflags uint }
|
||||
{ data long }
|
||||
{ udata void* } ;
|
||||
|
||||
FUNCTION: int kevent ( int kq, kevent* changelist, int nchanges, kevent* eventlist, int nevents, timespec* timeout ) ;
|
||||
|
||||
|
|
|
@ -1,14 +1,13 @@
|
|||
USING: alien.syntax ;
|
||||
USING: alien.syntax classes.struct ;
|
||||
IN: unix.kqueue
|
||||
|
||||
C-STRUCT: kevent
|
||||
{ "ulong" "ident" } ! identifier for this event
|
||||
{ "short" "filter" } ! filter for event
|
||||
{ "ushort" "flags" } ! action flags for kqueue
|
||||
{ "uint" "fflags" } ! filter flag value
|
||||
{ "long" "data" } ! filter data value
|
||||
{ "void*" "udata" } ! opaque user data identifier
|
||||
;
|
||||
STRUCT: kevent
|
||||
{ ident ulong }
|
||||
{ filter short }
|
||||
{ flags ushort }
|
||||
{ fflags uint }
|
||||
{ data long }
|
||||
{ udata void* } ;
|
||||
|
||||
FUNCTION: int kevent ( int kq, kevent* changelist, int nchanges, kevent* eventlist, int nevents, timespec* timeout ) ;
|
||||
|
||||
|
|
|
@ -1,14 +1,13 @@
|
|||
USING: alien.syntax ;
|
||||
USING: alien.syntax classes.struct ;
|
||||
IN: unix.kqueue
|
||||
|
||||
C-STRUCT: kevent
|
||||
{ "ulong" "ident" } ! identifier for this event
|
||||
{ "uint" "filter" } ! filter for event
|
||||
{ "uint" "flags" } ! action flags for kqueue
|
||||
{ "uint" "fflags" } ! filter flag value
|
||||
{ "longlong" "data" } ! filter data value
|
||||
{ "void*" "udata" } ! opaque user data identifier
|
||||
;
|
||||
STRUCT: kevent
|
||||
{ ident ulong }
|
||||
{ filter uint }
|
||||
{ flags uint }
|
||||
{ fflags uint }
|
||||
{ data longlong }
|
||||
{ udata void* } ;
|
||||
|
||||
FUNCTION: int kevent ( int kq, kevent* changelist, size_t nchanges, kevent* eventlist, size_t nevents, timespec* timeout ) ;
|
||||
|
||||
|
|
|
@ -1,14 +1,13 @@
|
|||
USING: alien.syntax ;
|
||||
USING: alien.syntax classes.struct ;
|
||||
IN: unix.kqueue
|
||||
|
||||
C-STRUCT: kevent
|
||||
{ "uint" "ident" } ! identifier for this event
|
||||
{ "short" "filter" } ! filter for event
|
||||
{ "ushort" "flags" } ! action flags for kqueue
|
||||
{ "uint" "fflags" } ! filter flag value
|
||||
{ "int" "data" } ! filter data value
|
||||
{ "void*" "udata" } ! opaque user data identifier
|
||||
;
|
||||
STRUCT: kevent
|
||||
{ ident uint }
|
||||
{ filter short }
|
||||
{ flags ushort }
|
||||
{ fflags uint }
|
||||
{ data int }
|
||||
{ udata void* } ;
|
||||
|
||||
FUNCTION: int kevent ( int kq, kevent* changelist, int nchanges, kevent* eventlist, int nevents, timespec* timeout ) ;
|
||||
|
||||
|
|
|
@ -9,7 +9,7 @@ STRUCT: stat
|
|||
{ st_mode mode_t }
|
||||
{ st_nlink nlink_t }
|
||||
{ st_uid uid_t }
|
||||
{ st_gid git_t }
|
||||
{ st_gid gid_t }
|
||||
{ st_rdev __dev_t }
|
||||
{ st_atimespec timespec }
|
||||
{ st_mtimespec timespec }
|
||||
|
@ -18,10 +18,10 @@ STRUCT: stat
|
|||
{ st_blocks blkcnt_t }
|
||||
{ st_blksize blksize_t }
|
||||
{ st_flags fflags_t }
|
||||
{ st_gen _uint32_t }
|
||||
{ st_gen __uint32_t }
|
||||
{ st_lspare __int32_t }
|
||||
{ st_birthtimespec timespec }
|
||||
{ pad0 __int32_t[2] }
|
||||
{ pad0 __int32_t[2] } ;
|
||||
|
||||
FUNCTION: int stat ( char* pathname, stat* buf ) ;
|
||||
FUNCTION: int lstat ( char* pathname, stat* buf ) ;
|
||||
|
|
Loading…
Reference in New Issue