From 20376674735156104e2d3853c05cd949b0fe209e Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 1 Sep 2009 14:46:08 -0500 Subject: [PATCH 1/4] io.backend.unix.multiplexers.epoll: update for STRUCT: --- .../backend/unix/multiplexers/epoll/epoll.factor | 14 +++++++------- basis/unix/linux/epoll/epoll.factor | 10 +++++----- 2 files changed, 12 insertions(+), 12 deletions(-) diff --git a/basis/io/backend/unix/multiplexers/epoll/epoll.factor b/basis/io/backend/unix/multiplexers/epoll/epoll.factor index 98c48c113d..11fa5620f2 100644 --- a/basis/io/backend/unix/multiplexers/epoll/epoll.factor +++ b/basis/io/backend/unix/multiplexers/epoll/epoll.factor @@ -1,6 +1,6 @@ -! Copyright (C) 2008 Slava Pestov. +! Copyright (C) 2008, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors alien.c-types kernel destructors bit-arrays +USING: accessors classes.struct kernel destructors bit-arrays sequences assocs struct-arrays math namespaces locals fry unix unix.linux.epoll unix.time io.ports io.backend.unix io.backend.unix.multiplexers ; @@ -16,14 +16,14 @@ TUPLE: epoll-mx < mx events ; : ( -- mx ) epoll-mx new-mx max-events epoll_create dup io-error >>fd - max-events "epoll-event" >>events ; + max-events epoll-event >>events ; M: epoll-mx dispose* fd>> close-file ; : make-event ( fd events -- event ) - "epoll-event" - [ set-epoll-event-events ] keep - [ set-epoll-event-fd ] keep ; + epoll-event + swap >>events + swap >>fd ; :: do-epoll-ctl ( fd mx what events -- ) mx fd>> what fd fd events make-event epoll_ctl io-error ; @@ -55,7 +55,7 @@ M: epoll-mx remove-output-callbacks ( fd mx -- seq ) epoll_wait multiplexer-error ; : handle-event ( event mx -- ) - [ epoll-event-fd ] dip + [ fd>> ] dip [ EPOLLIN EPOLLOUT bitor do-epoll-del ] [ input-available ] [ output-available ] 2tri ; diff --git a/basis/unix/linux/epoll/epoll.factor b/basis/unix/linux/epoll/epoll.factor index 7c68dfa45a..966db32f60 100644 --- a/basis/unix/linux/epoll/epoll.factor +++ b/basis/unix/linux/epoll/epoll.factor @@ -1,16 +1,16 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. IN: unix.linux.epoll -USING: alien.syntax math ; +USING: alien.syntax classes.struct math ; FUNCTION: int epoll_create ( int size ) ; FUNCTION: int epoll_ctl ( int epfd, int op, int fd, epoll_event* event ) ; -C-STRUCT: epoll-event - { "uint" "events" } - { "uint" "fd" } - { "uint" "padding" } ; +STRUCT: epoll-event +{ events uint } +{ fd uint } +{ padding uint } ; FUNCTION: int epoll_wait ( int epfd, epoll_event* events, int maxevents, int timeout ) ; From 7bdd819d512ba024008aef9290b941a373baa14b Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 1 Sep 2009 14:46:24 -0500 Subject: [PATCH 2/4] struct-arrays: remove support for arrays of old-style structs --- basis/struct-arrays/struct-arrays-docs.factor | 6 +-- basis/struct-arrays/struct-arrays.factor | 42 +++++++++---------- 2 files changed, 23 insertions(+), 25 deletions(-) diff --git a/basis/struct-arrays/struct-arrays-docs.factor b/basis/struct-arrays/struct-arrays-docs.factor index 7b49d6ef42..175b2e2783 100644 --- a/basis/struct-arrays/struct-arrays-docs.factor +++ b/basis/struct-arrays/struct-arrays-docs.factor @@ -7,11 +7,11 @@ $nl "The " { $slot "underlying" } " slot holds a " { $link c-ptr } " with the raw data. This pointer can be passed to C functions." } ; HELP: -{ $values { "length" integer } { "c-type" string } { "struct-array" struct-array } } -{ $description "Creates a new array for holding values of the specified C type." } ; +{ $values { "length" integer } { "struct-class" struct-class } { "struct-array" struct-array } } +{ $description "Creates a new array for holding values of the specified struct type." } ; HELP: -{ $values { "alien" c-ptr } { "length" integer } { "c-type" string } { "struct-array" struct-array } } +{ $values { "alien" c-ptr } { "length" integer } { "struct-class" struct-class } { "struct-array" struct-array } } { $description "Creates a new array for holding values of the specified C type, backed by the memory at " { $snippet "alien" } "." } ; HELP: struct-array-on diff --git a/basis/struct-arrays/struct-arrays.factor b/basis/struct-arrays/struct-arrays.factor index cc34072d2c..3adc4496ee 100755 --- a/basis/struct-arrays/struct-arrays.factor +++ b/basis/struct-arrays/struct-arrays.factor @@ -5,9 +5,6 @@ classes classes.struct kernel libc math parser sequences sequences.private words fry memoize compiler.units ; IN: struct-arrays -: c-type-struct-class ( c-type -- class ) - c-type boxed-class>> ; foldable - TUPLE: struct-array { underlying c-ptr read-only } { length array-capacity read-only } @@ -15,35 +12,36 @@ TUPLE: struct-array { class read-only } { ctor read-only } ; -M: struct-array length length>> ; inline -M: struct-array byte-length [ length>> ] [ element-size>> ] bi * ; inline +> * >fixnum ] [ underlying>> ] bi ; inline +: (struct-element-constructor) ( struct-class -- word ) + [ + "struct-array-ctor" f + [ swap '[ _ memory>struct ] (( alien -- object )) define-inline ] keep + ] with-compilation-unit ; + +! Foldable memo word. This is an optimization; by precompiling a +! constructor for array elements, we avoid memory>struct's slow path. +MEMO: struct-element-constructor ( struct-class -- word ) + (struct-element-constructor) ; foldable + +PRIVATE> + +M: struct-array length length>> ; inline + +M: struct-array byte-length [ length>> ] [ element-size>> ] bi * ; inline + M: struct-array nth-unsafe [ (nth-ptr) ] [ ctor>> ] bi execute( alien -- object ) ; inline M: struct-array set-nth-unsafe [ (nth-ptr) swap ] [ element-size>> ] bi memcpy ; inline -: (struct-element-constructor) ( c-type -- word ) - [ - "struct-array-ctor" f - [ - swap dup struct-class? - [ '[ _ memory>struct ] [ ] like ] [ drop [ ] ] if - (( alien -- object )) define-inline - ] keep - ] with-compilation-unit ; - -! Foldable memo word. This is an optimization; by precompiling a -! constructor for array elements, we avoid memory>struct's slow path. -MEMO: struct-element-constructor ( c-type -- word ) - (struct-element-constructor) ; foldable - -: ( alien length c-type -- struct-array ) - [ heap-size ] [ c-type-struct-class ] [ struct-element-constructor ] +: ( alien length struct-class -- struct-array ) + [ heap-size ] [ ] [ struct-element-constructor ] tri struct-array boa ; inline M: struct-array new-sequence From 1efcf36083b5737502383a4f925442049c5c4255 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 1 Sep 2009 14:47:04 -0500 Subject: [PATCH 3/4] struct-vectors: update unit test to use new structs --- basis/struct-vectors/struct-vectors-docs.factor | 4 ++-- basis/struct-vectors/struct-vectors-tests.factor | 15 +++++---------- basis/struct-vectors/struct-vectors.factor | 3 ++- 3 files changed, 9 insertions(+), 13 deletions(-) diff --git a/basis/struct-vectors/struct-vectors-docs.factor b/basis/struct-vectors/struct-vectors-docs.factor index 368b054565..fe1b8991cf 100644 --- a/basis/struct-vectors/struct-vectors-docs.factor +++ b/basis/struct-vectors/struct-vectors-docs.factor @@ -1,11 +1,11 @@ IN: struct-vectors -USING: help.markup help.syntax alien strings math ; +USING: help.markup help.syntax classes.struct alien strings math ; HELP: struct-vector { $class-description "The class of growable C struct and union arrays." } ; HELP: -{ $values { "capacity" integer } { "c-type" string } { "struct-vector" struct-vector } } +{ $values { "capacity" integer } { "struct-class" struct-class } { "struct-vector" struct-vector } } { $description "Creates a new vector with the given initial capacity." } ; ARTICLE: "struct-vectors" "C struct and union vectors" diff --git a/basis/struct-vectors/struct-vectors-tests.factor b/basis/struct-vectors/struct-vectors-tests.factor index f57c64152c..dec2e96040 100644 --- a/basis/struct-vectors/struct-vectors-tests.factor +++ b/basis/struct-vectors/struct-vectors-tests.factor @@ -1,21 +1,16 @@ IN: struct-vectors.tests -USING: struct-vectors tools.test alien.c-types alien.syntax +USING: struct-vectors tools.test alien.c-types classes.struct accessors namespaces kernel sequences ; -C-STRUCT: point - { "float" "x" } - { "float" "y" } ; +STRUCT: point { x float } { y float } ; -: make-point ( x y -- point ) - "point" - [ set-point-y ] keep - [ set-point-x ] keep ; +: make-point ( x y -- point ) point ; -[ ] [ 1 "point" "v" set ] unit-test +[ ] [ 1 point "v" set ] unit-test [ 1.5 6.0 ] [ 1.0 2.0 make-point "v" get push 3.0 4.5 make-point "v" get push 1.5 6.0 make-point "v" get push - "v" get pop [ point-x ] [ point-y ] bi + "v" get pop [ x>> ] [ y>> ] bi ] unit-test \ No newline at end of file diff --git a/basis/struct-vectors/struct-vectors.factor b/basis/struct-vectors/struct-vectors.factor index 5a0654ea16..d4aa03c7ed 100644 --- a/basis/struct-vectors/struct-vectors.factor +++ b/basis/struct-vectors/struct-vectors.factor @@ -9,10 +9,11 @@ TUPLE: struct-vector { length array-capacity } { c-type read-only } ; -: ( capacity c-type -- struct-vector ) +: ( capacity struct-class -- struct-vector ) [ 0 ] keep struct-vector boa ; inline M: struct-vector byte-length underlying>> byte-length ; + M: struct-vector new-sequence [ c-type>> ] [ [ >fixnum ] [ c-type>> ] bi* ] 2bi struct-vector boa ; From b8aa894960e8fc8420b1ea432b0b75b8f71c8433 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 1 Sep 2009 14:58:49 -0500 Subject: [PATCH 4/4] struct-arrays: fix help lint, throw error if class parameter is not a struct class --- basis/struct-arrays/struct-arrays-tests.factor | 2 ++ basis/struct-arrays/struct-arrays.factor | 5 ++++- 2 files changed, 6 insertions(+), 1 deletion(-) diff --git a/basis/struct-arrays/struct-arrays-tests.factor b/basis/struct-arrays/struct-arrays-tests.factor index a57bb0259c..0a79f47a34 100755 --- a/basis/struct-arrays/struct-arrays-tests.factor +++ b/basis/struct-arrays/struct-arrays-tests.factor @@ -51,3 +51,5 @@ STRUCT: fixed-string { text char[100] } ; [ { ALIEN: 123 ALIEN: 223 ALIEN: 323 ALIEN: 423 } ] [ ALIEN: 123 4 fixed-string [ (underlying)>> ] { } map-as ] unit-test + +[ 10 "int" ] must-fail \ No newline at end of file diff --git a/basis/struct-arrays/struct-arrays.factor b/basis/struct-arrays/struct-arrays.factor index 3adc4496ee..15f996f3bf 100755 --- a/basis/struct-arrays/struct-arrays.factor +++ b/basis/struct-arrays/struct-arrays.factor @@ -40,7 +40,10 @@ M: struct-array nth-unsafe M: struct-array set-nth-unsafe [ (nth-ptr) swap ] [ element-size>> ] bi memcpy ; inline +ERROR: not-a-struct-class struct-class ; + : ( alien length struct-class -- struct-array ) + dup struct-class? [ not-a-struct-class ] unless [ heap-size ] [ ] [ struct-element-constructor ] tri struct-array boa ; inline @@ -52,7 +55,7 @@ M: struct-array resize ( n seq -- newseq ) [ [ element-size>> * ] [ underlying>> ] bi resize ] [ class>> ] 2bi ; inline -: ( length c-type -- struct-array ) +: ( length struct-class -- struct-array ) [ heap-size * ] 2keep ; inline ERROR: bad-byte-array-length byte-array ;