diff --git a/basis/classes/struct/struct-tests.factor b/basis/classes/struct/struct-tests.factor index cf9c17da8b..271138df4a 100644 --- a/basis/classes/struct/struct-tests.factor +++ b/basis/classes/struct/struct-tests.factor @@ -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 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 + 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 diff --git a/basis/classes/struct/struct.factor b/basis/classes/struct/struct.factor index 6ea4a6c5b5..f96c6f5f8b 100644 --- a/basis/classes/struct/struct.factor +++ b/basis/classes/struct/struct.factor @@ -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 ; - 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 : ( class -- struct ) - [ >c-ptr clone ] [ heap-size ] (init-struct) ; + [ >c-ptr clone ] [ heap-size ] (init-struct) ; inline MACRO: ( 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 -- ) [ diff --git a/basis/io/backend/unix/multiplexers/kqueue/kqueue.factor b/basis/io/backend/unix/multiplexers/kqueue/kqueue.factor index f7b15beb54..e01f33bbd8 100644 --- a/basis/io/backend/unix/multiplexers/kqueue/kqueue.factor +++ b/basis/io/backend/unix/multiplexers/kqueue/kqueue.factor @@ -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 : ( -- mx ) kqueue-mx new-mx kqueue dup io-error >>fd - max-events "kevent" >>events ; + 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 ; + \ kevent + 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 diff --git a/basis/io/backend/unix/unix-tests.factor b/basis/io/backend/unix/unix-tests.factor index ed054d7958..6eb4227855 100644 --- a/basis/io/backend/unix/unix-tests.factor +++ b/basis/io/backend/unix/unix-tests.factor @@ -74,8 +74,7 @@ yield [ datagram-client delete-file ] ignore-errors -datagram-client -"d" set +[ ] [ datagram-client "d" set ] unit-test [ ] [ "hello" >byte-array diff --git a/basis/io/files/info/unix/openbsd/openbsd.factor b/basis/io/files/info/unix/openbsd/openbsd.factor index 7f23324fec..6c334b8d62 100644 --- a/basis/io/files/info/unix/openbsd/openbsd.factor +++ b/basis/io/files/info/unix/openbsd/openbsd.factor @@ -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 dup dup length 0 getfsstat io-error - statfs heap-size group + \ statfs dup dup length 0 getfsstat io-error + \ statfs heap-size group [ f_mntonname>> alien>native-string file-system-info ] map ; diff --git a/basis/unix/kqueue/freebsd/freebsd.factor b/basis/unix/kqueue/freebsd/freebsd.factor index 1153b997c2..4bf5af8482 100644 --- a/basis/unix/kqueue/freebsd/freebsd.factor +++ b/basis/unix/kqueue/freebsd/freebsd.factor @@ -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 ) ; diff --git a/basis/unix/kqueue/macosx/macosx.factor b/basis/unix/kqueue/macosx/macosx.factor index 843a0afad9..c30584efab 100644 --- a/basis/unix/kqueue/macosx/macosx.factor +++ b/basis/unix/kqueue/macosx/macosx.factor @@ -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 ) ; diff --git a/basis/unix/kqueue/netbsd/netbsd.factor b/basis/unix/kqueue/netbsd/netbsd.factor index 7ba942d712..d9a9116930 100644 --- a/basis/unix/kqueue/netbsd/netbsd.factor +++ b/basis/unix/kqueue/netbsd/netbsd.factor @@ -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 ) ; diff --git a/basis/unix/kqueue/openbsd/openbsd.factor b/basis/unix/kqueue/openbsd/openbsd.factor index c62ba05a4c..1d851c8d68 100644 --- a/basis/unix/kqueue/openbsd/openbsd.factor +++ b/basis/unix/kqueue/openbsd/openbsd.factor @@ -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 ) ; diff --git a/basis/unix/stat/freebsd/freebsd.factor b/basis/unix/stat/freebsd/freebsd.factor index 02f31f3682..0acf2512e8 100644 --- a/basis/unix/stat/freebsd/freebsd.factor +++ b/basis/unix/stat/freebsd/freebsd.factor @@ -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 ) ;