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

db4
Joe Groff 2009-08-30 21:14:33 -05:00
commit 5d56e16188
10 changed files with 96 additions and 67 deletions

View File

@ -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

View File

@ -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 -- )
[

View File

@ -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

View File

@ -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

View File

@ -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 ;

View File

@ -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 ) ;

View File

@ -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 ) ;

View File

@ -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 ) ;

View File

@ -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 ) ;

View File

@ -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 ) ;