From 8be06f0e5e1af9f5a8c51ff76d555ec843ec6c0a Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 30 Aug 2009 19:05:49 -0500 Subject: [PATCH 1/8] typo in stat --- basis/unix/stat/freebsd/freebsd.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/unix/stat/freebsd/freebsd.factor b/basis/unix/stat/freebsd/freebsd.factor index 02f31f3682..aeec5ef7a3 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 } From de94e49f069c9f5f362278b6c1a64e6e0c077541 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 30 Aug 2009 20:10:41 -0500 Subject: [PATCH 2/8] escape the class name in io.files.info --- basis/io/files/info/unix/openbsd/openbsd.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) 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 ; From 2dd3f5690dc408dc93d133d92d90afb7d3d4c337 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 30 Aug 2009 20:13:54 -0500 Subject: [PATCH 3/8] classes.struct: make , malloc-struct, and clone work in deployed images where C type info has been stripped out --- basis/classes/struct/struct.factor | 29 +++++++++++++++++++---------- 1 file changed, 19 insertions(+), 10 deletions(-) diff --git a/basis/classes/struct/struct.factor b/basis/classes/struct/struct.factor index 99150e9bb6..6954c0680b 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,23 @@ 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 \ memory>struct [ ] 3sequence ] bi + define-inline-method ; : slot>field ( slot -- field ) field-spec new swap { @@ -207,7 +214,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 -- ) [ From 6867f2a806bb204fba585461201b74d64c84bc7c Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 30 Aug 2009 20:25:57 -0500 Subject: [PATCH 4/8] fix stat struct on freebsd --- basis/unix/stat/freebsd/freebsd.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/unix/stat/freebsd/freebsd.factor b/basis/unix/stat/freebsd/freebsd.factor index aeec5ef7a3..40492faefd 100644 --- a/basis/unix/stat/freebsd/freebsd.factor +++ b/basis/unix/stat/freebsd/freebsd.factor @@ -18,7 +18,7 @@ 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] } From 05cc8babb6496595619642b1e9fa0bf11d30553f Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 30 Aug 2009 20:26:25 -0500 Subject: [PATCH 5/8] update kqueue for structs --- .../unix/multiplexers/kqueue/kqueue.factor | 25 ++++++++++--------- basis/unix/kqueue/freebsd/freebsd.factor | 17 ++++++------- basis/unix/kqueue/macosx/macosx.factor | 17 ++++++------- basis/unix/kqueue/netbsd/netbsd.factor | 17 ++++++------- basis/unix/kqueue/openbsd/openbsd.factor | 17 ++++++------- 5 files changed, 45 insertions(+), 48 deletions(-) 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/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 ) ; From 867d87998c54c70a34f39ba53dc0b94765f956d4 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 30 Aug 2009 20:46:49 -0500 Subject: [PATCH 6/8] fix typo in stat struct --- basis/unix/stat/freebsd/freebsd.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/unix/stat/freebsd/freebsd.factor b/basis/unix/stat/freebsd/freebsd.factor index 40492faefd..0acf2512e8 100644 --- a/basis/unix/stat/freebsd/freebsd.factor +++ b/basis/unix/stat/freebsd/freebsd.factor @@ -21,7 +21,7 @@ STRUCT: stat { 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 ) ; From e918e9cddcfc9af483fa92dfcc160d92e2f8b073 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 30 Aug 2009 21:01:44 -0500 Subject: [PATCH 7/8] classes.struct: add more unit tests for clone method, and fix clone breakage when the struct class word is not a symbol --- basis/classes/struct/struct-tests.factor | 27 ++++++++++++++++++++++-- basis/classes/struct/struct.factor | 3 ++- 2 files changed, 27 insertions(+), 3 deletions(-) diff --git a/basis/classes/struct/struct-tests.factor b/basis/classes/struct/struct-tests.factor index 0cd91da370..f015556bec 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 << @@ -204,4 +204,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 6954c0680b..09c1d23c4e 100644 --- a/basis/classes/struct/struct.factor +++ b/basis/classes/struct/struct.factor @@ -131,7 +131,8 @@ M: struct-class writer-quot [ >c-ptr ] [ byte-length ] bi memory>byte-array ; inline : (define-clone-method) ( class -- ) - [ \ clone ] [ \ clone-underlying swap \ memory>struct [ ] 3sequence ] bi + [ \ clone ] + [ \ clone-underlying swap literalize \ memory>struct [ ] 3sequence ] bi define-inline-method ; : slot>field ( slot -- field ) From 348311ea9007f75eb5b647ed228434348c929c83 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 30 Aug 2009 21:01:49 -0500 Subject: [PATCH 8/8] io.backend.unix: tweak test --- basis/io/backend/unix/unix-tests.factor | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) 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