From 0dc734195c29aec58bce79b1751150ecc9c67f53 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 15 Oct 2009 00:12:11 -0500 Subject: [PATCH 01/12] fix enumerating fully qualified paths by calling normalize-path first --- basis/io/directories/search/search.factor | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/basis/io/directories/search/search.factor b/basis/io/directories/search/search.factor index 3fbf09a3c3..93d4d0146c 100755 --- a/basis/io/directories/search/search.factor +++ b/basis/io/directories/search/search.factor @@ -1,16 +1,16 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors arrays continuations deques dlists fry -io.directories io.files io.files.info io.pathnames kernel -sequences system vocabs.loader locals math namespaces -sorting assocs calendar threads io math.parser unicode.case ; +USING: accessors arrays assocs continuations deques dlists fry +io.backend io.directories io.files.info io.pathnames kernel +locals math sequences sorting system unicode.case vocabs.loader ; IN: io.directories.search : qualified-directory-entries ( path -- seq ) - dup directory-entries - [ [ append-path ] change-name ] with map ; + normalize-path + dup directory-entries [ [ append-path ] change-name ] with map ; : qualified-directory-files ( path -- seq ) + normalize-path dup directory-files [ append-path ] with map ; : with-qualified-directory-files ( path quot -- ) From 1db55cdfbb2aacbb59c363123643bd492706c946 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Thu, 15 Oct 2009 13:35:22 -0500 Subject: [PATCH 02/12] add some tests for math.matrices.simd matrix-vector multiplication --- extra/math/matrices/simd/simd-tests.factor | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/extra/math/matrices/simd/simd-tests.factor b/extra/math/matrices/simd/simd-tests.factor index 965c2bddb5..25482c8e1e 100644 --- a/extra/math/matrices/simd/simd-tests.factor +++ b/extra/math/matrices/simd/simd-tests.factor @@ -229,3 +229,13 @@ IN: math.matrices.simd.tests float-4{ 2.0 2.0 0.0 0.0 } 1.0 5.0 frustum-matrix4 ] unit-test + +[ float-4{ 3.0 4.0 5.0 1.0 } ] +[ float-4{ 1.0 1.0 1.0 1.0 } translation-matrix4 float-4{ 2.0 3.0 4.0 1.0 } m4.v ] unit-test + +[ float-4{ 2.0 2.5 3.0 1.0 } ] +[ + float-4{ 1.0 1.0 1.0 1.0 } translation-matrix4 + float-4{ 0.5 0.5 0.5 1.0 } scale-matrix4 m4. + float-4{ 2.0 3.0 4.0 1.0 } m4.v +] unit-test From a91ab493ba5fb999c9a60a4228352d8f96fa04b2 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Thu, 15 Oct 2009 14:32:39 -0500 Subject: [PATCH 03/12] vectored struct functor --- extra/classes/struct/vectored/authors.txt | 1 + extra/classes/struct/vectored/summary.txt | 1 + .../struct/vectored/vectored-tests.factor | 73 +++++++++++ extra/classes/struct/vectored/vectored.factor | 117 ++++++++++++++++++ 4 files changed, 192 insertions(+) create mode 100644 extra/classes/struct/vectored/authors.txt create mode 100644 extra/classes/struct/vectored/summary.txt create mode 100644 extra/classes/struct/vectored/vectored-tests.factor create mode 100644 extra/classes/struct/vectored/vectored.factor diff --git a/extra/classes/struct/vectored/authors.txt b/extra/classes/struct/vectored/authors.txt new file mode 100644 index 0000000000..f13c9c1e77 --- /dev/null +++ b/extra/classes/struct/vectored/authors.txt @@ -0,0 +1 @@ +Joe Groff diff --git a/extra/classes/struct/vectored/summary.txt b/extra/classes/struct/vectored/summary.txt new file mode 100644 index 0000000000..d4e5fc3ec4 --- /dev/null +++ b/extra/classes/struct/vectored/summary.txt @@ -0,0 +1 @@ +Derive a tuple of specialized arrays from a struct class diff --git a/extra/classes/struct/vectored/vectored-tests.factor b/extra/classes/struct/vectored/vectored-tests.factor new file mode 100644 index 0000000000..1b3aa86eff --- /dev/null +++ b/extra/classes/struct/vectored/vectored-tests.factor @@ -0,0 +1,73 @@ +! (c)2009 Joe Groff bsd license +USING: accessors alien.c-types classes.struct classes.struct.vectored +kernel sequences specialized-arrays tools.test ; +SPECIALIZED-ARRAYS: int ushort float ; +IN: classes.struct.vectored.tests + +STRUCT: foo + { x int } + { y float } + { z ushort } + { w ushort } ; + +SPECIALIZED-ARRAY: foo +VECTORED-STRUCT: foo + +[ + T{ vectored-foo + { x int-array{ 0 1 0 0 } } + { y float-array{ 0.0 2.0 0.0 0.0 } } + { z ushort-array{ 0 3 0 0 } } + { w ushort-array{ 0 4 0 0 } } + } +] [ S{ foo f 1 2.0 3 4 } 4 [ set-second ] keep ] unit-test + +[ + T{ vectored-foo + { x int-array{ 0 1 2 3 } } + { y float-array{ 0.0 0.5 1.0 1.5 } } + { z ushort-array{ 10 20 30 40 } } + { w ushort-array{ 15 25 35 45 } } + } +] [ + foo-array{ + S{ foo { x 0 } { y 0.0 } { z 10 } { w 15 } } + S{ foo { x 1 } { y 0.5 } { z 20 } { w 25 } } + S{ foo { x 2 } { y 1.0 } { z 30 } { w 35 } } + S{ foo { x 3 } { y 1.5 } { z 40 } { w 45 } } + } struct-transpose +] unit-test + +[ + foo-array{ + S{ foo { x 0 } { y 0.0 } { z 10 } { w 15 } } + S{ foo { x 1 } { y 0.5 } { z 20 } { w 25 } } + S{ foo { x 2 } { y 1.0 } { z 30 } { w 35 } } + S{ foo { x 3 } { y 1.5 } { z 40 } { w 45 } } + } +] [ + T{ vectored-foo + { x int-array{ 0 1 2 3 } } + { y float-array{ 0.0 0.5 1.0 1.5 } } + { z ushort-array{ 10 20 30 40 } } + { w ushort-array{ 15 25 35 45 } } + } struct-transpose +] unit-test + +[ 30 ] [ + T{ vectored-foo + { x int-array{ 0 1 2 3 } } + { y float-array{ 0.0 0.5 1.0 1.5 } } + { z ushort-array{ 10 20 30 40 } } + { w ushort-array{ 15 25 35 45 } } + } third z>> +] unit-test + +[ S{ foo { x 2 } { y 1.0 } { z 30 } { w 35 } } ] [ + T{ vectored-foo + { x int-array{ 0 1 2 3 } } + { y float-array{ 0.0 0.5 1.0 1.5 } } + { z ushort-array{ 10 20 30 40 } } + { w ushort-array{ 15 25 35 45 } } + } third vectored-element> +] unit-test diff --git a/extra/classes/struct/vectored/vectored.factor b/extra/classes/struct/vectored/vectored.factor new file mode 100644 index 0000000000..16ff95b1c0 --- /dev/null +++ b/extra/classes/struct/vectored/vectored.factor @@ -0,0 +1,117 @@ +! (c)2009 Joe Groff bsd license +USING: accessors classes.struct classes.tuple combinators fry +functors kernel locals macros math parser quotations sequences +sequences.private slots specialized-arrays words ; +IN: classes.struct.vectored + +> "-array" append swap lookup ] bi ; +: -of ( type -- array-type ) + [ define-array-vocab ] [ name>> "<" "-array>" surround swap lookup ] bi ; +: (array-class)-of ( type -- array-type ) + [ define-array-vocab ] [ name>> "(" "-array)" surround swap lookup ] bi ; + +: >vectored-slot ( struct-slot offset -- tuple-slot ) + { + [ drop name>> ] + [ nip ] + [ drop type>> array-class-of dup initial-value ] + [ 2drop t ] + } 2cleave slot-spec boa ; + +MACRO: first-slot ( struct-class -- quot: ( struct -- value ) ) + struct-slots first name>> reader-word 1quotation ; + +MACRO: set-vectored-nth ( struct-class -- quot: ( value i vector -- ) ) + struct-slots [ + name>> reader-word 1quotation dup + '[ _ [ ] _ tri* set-nth-unsafe ] + ] map '[ _ 3cleave ] ; + +MACRO: ( struct-class -- quot: ( n -- slots... ) ) + struct-slots [ type>> -of 1quotation ] map + '[ _ cleave ] ; + +MACRO: (vectored-slots) ( struct-class -- quot: ( n -- slots... ) ) + struct-slots [ type>> (array-class)-of 1quotation ] map + '[ _ cleave ] ; + +MACRO: (vectored-element>) ( struct-class -- quot: ( elt -- struct ) ) + [ struct-slots [ name>> reader-word 1quotation ] map ] keep + '[ _ cleave _ ] ; + +SLOT: (n) +SLOT: (vectored) + +FUNCTOR: define-vectored-accessors ( S>> (>>S) T -- ) + +WHERE + +M: T S>> + [ (n)>> ] [ (vectored)>> S>> ] bi nth-unsafe ; inline +M: T (>>S) + [ (n)>> ] [ (vectored)>> S>> ] bi set-nth-unsafe ; inline + +;FUNCTOR + +PRIVATE> + +GENERIC: struct-transpose ( structstruct -- ssttrruucctt ) +GENERIC: vectored-element> ( elt -- struct ) + +FUNCTOR: define-vectored-struct ( T -- ) + +T-array [ T array-class-of ] + +vectored-T DEFINES-CLASS vectored-${T} +vectored-T-element DEFINES-CLASS vectored-${T}-element + + DEFINES +(vectored-T) DEFINES (vectored-${T}) + +WHERE + +vectored-T tuple T struct-slots [ >vectored-slot ] map-index define-tuple-class + +TUPLE: vectored-T-element + { (n) fixnum read-only } + { (vectored) vectored-T read-only } ; + +T struct-slots [ + name>> [ reader-word ] [ writer-word ] bi + vectored-T-element define-vectored-accessors +] each + +M: vectored-T-element vectored-element> + T (vectored-element>) ; inline + +M: vectored-T nth-unsafe + vectored-T-element boa ; inline + +M: vectored-T length + T first-slot length ; inline + +M: vectored-T set-nth-unsafe + T set-vectored-nth ; inline + +INSTANCE: vectored-T sequence + +: ( n -- vectored-T ) + T vectored-T boa ; inline + +: (vectored-T) ( n -- vectored-T ) + T (vectored-slots) vectored-T boa ; inline + +M: vectored-T struct-transpose + [ vectored-element> ] T-array new map-as ; inline + +M: T-array struct-transpose + dup length [ nip iota ] [ drop ] [ nip (vectored-T) ] 2tri + [ [ [ nth ] [ set-nth ] bi-curry* bi ] 2curry each ] keep ; inline + +;FUNCTOR + +SYNTAX: VECTORED-STRUCT: + scan-word define-vectored-struct ; From ac54569777f71445403e584ce7c5792a14fddc71 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Thu, 15 Oct 2009 14:57:27 -0500 Subject: [PATCH 04/12] add tests that data-map compiles given a fried quot --- extra/alien/data/map/map-tests.factor | 27 ++++++++++++++++++--------- 1 file changed, 18 insertions(+), 9 deletions(-) diff --git a/extra/alien/data/map/map-tests.factor b/extra/alien/data/map/map-tests.factor index e4e1aa6d18..f8c7cb0914 100644 --- a/extra/alien/data/map/map-tests.factor +++ b/extra/alien/data/map/map-tests.factor @@ -1,6 +1,6 @@ ! (c)Joe Groff bsd license -USING: alien.data.map generalizations kernel math.vectors -math.vectors.conversion math.vectors.simd +USING: alien.data.map fry generalizations kernel math.vectors +math.vectors.conversion math math.vectors.simd specialized-arrays tools.test ; FROM: alien.c-types => uchar short int float ; SIMDS: float int short uchar ; @@ -19,6 +19,16 @@ IN: alien.data.map.tests [ dup ] data-map!( int -- float[2] ) ] unit-test +: float-pixels>byte-pixels* ( floats scale bias -- bytes ) + '[ + [ _ 255.0 * v*n _ 255.0 * v+n float-4 int-4 vconvert ] 4 napply + [ int-4 short-8 vconvert ] 2bi@ + short-8 uchar-16 vconvert + ] data-map( float-4[4] -- uchar-16 ) ; inline + +: float-pixels>byte-pixels ( floats -- bytes ) + 1.0 0.0 float-pixels>byte-pixels* ; + [ B{ 127 191 255 63 @@ -32,11 +42,7 @@ IN: alien.data.map.tests 1.0 0.1 0.2 0.3 0.3 0.2 0.9 0.5 0.1 1.0 1.5 2.0 - } [ - [ 255.0 v*n float-4 int-4 vconvert ] 4 napply - [ int-4 short-8 vconvert ] 2bi@ - short-8 uchar-16 vconvert - ] data-map( float-4[4] -- uchar-16 ) + } float-pixels>byte-pixels ] unit-test [ @@ -63,6 +69,10 @@ IN: alien.data.map.tests : vmerge-transpose ( a b c d -- ac bd ac bd ) [ (vmerge) ] bi-curry@ bi* ; inline +: fold-rgba-planes ( r g b a -- rgba ) + [ vmerge-transpose vmerge-transpose ] + data-map( uchar-16 uchar-16 uchar-16 uchar-16 -- uchar-16[4] ) ; + [ B{ 1 10 11 15 @@ -87,6 +97,5 @@ IN: alien.data.map.tests B{ 10 20 30 40 50 60 70 80 90 100 110 120 130 140 150 160 } B{ 11 22 33 44 55 66 77 88 99 110 121 132 143 154 165 176 } B{ 15 25 35 45 55 65 75 85 95 105 115 125 135 145 155 165 } - [ vmerge-transpose vmerge-transpose ] - data-map( uchar-16 uchar-16 uchar-16 uchar-16 -- uchar-16[4] ) + fold-rgba-planes ] unit-test From d413e14461c7baeddd018e7f16a7fed0cb028add Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Thu, 15 Oct 2009 15:04:30 -0500 Subject: [PATCH 05/12] fix nkeep so it takes a nonliteral quot --- basis/generalizations/generalizations-tests.factor | 2 ++ basis/generalizations/generalizations.factor | 4 ++-- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/basis/generalizations/generalizations-tests.factor b/basis/generalizations/generalizations-tests.factor index 73f8410790..cb2c40ca0a 100644 --- a/basis/generalizations/generalizations-tests.factor +++ b/basis/generalizations/generalizations-tests.factor @@ -30,7 +30,9 @@ IN: generalizations.tests [ 1 5 4 3 2 ] [ 1 2 3 4 5 4 nspin ] unit-test [ 1 2 3 4 5 [ drop drop drop drop drop 2 ] 5 nkeep ] must-infer +[ 1 2 3 4 5 2 '[ drop drop drop drop drop _ ] 5 nkeep ] must-infer { 2 1 2 3 4 5 } [ 1 2 3 4 5 [ drop drop drop drop drop 2 ] 5 nkeep ] unit-test +{ 2 1 2 3 4 5 } [ 1 2 3 4 5 2 '[ drop drop drop drop drop _ ] 5 nkeep ] unit-test [ [ 1 2 3 + ] ] [ 1 2 3 [ + ] 3 ncurry ] unit-test [ "HELLO" ] [ "hello" [ >upper ] 1 napply ] unit-test diff --git a/basis/generalizations/generalizations.factor b/basis/generalizations/generalizations.factor index 9354b89974..2ae076655e 100644 --- a/basis/generalizations/generalizations.factor +++ b/basis/generalizations/generalizations.factor @@ -77,8 +77,8 @@ MACRO: ntuck ( n -- ) MACRO: ndip ( n -- ) [ [ dip ] curry ] n*quot [ call ] compose ; -MACRO: nkeep ( quot n -- ) - tuck '[ _ ndup _ _ ndip ] ; +MACRO: nkeep ( n -- ) + dup '[ [ _ ndup ] dip _ ndip ] ; MACRO: ncurry ( n -- ) [ curry ] n*quot ; From 211dce8cd705951c9e8f6e70cf5b39b799e12799 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 15 Oct 2009 15:28:35 -0500 Subject: [PATCH 06/12] add a move-file-unique word to move a file into a directory without name clashes --- basis/io/files/unique/unique-docs.factor | 11 ++++++++++- basis/io/files/unique/unique.factor | 5 +++++ 2 files changed, 15 insertions(+), 1 deletion(-) diff --git a/basis/io/files/unique/unique-docs.factor b/basis/io/files/unique/unique-docs.factor index 11511732b0..a2051bd10a 100644 --- a/basis/io/files/unique/unique-docs.factor +++ b/basis/io/files/unique/unique-docs.factor @@ -54,6 +54,13 @@ HELP: with-unique-directory } { $description "Creates a directory with " { $link unique-directory } " and calls the quotation with the pathname on the stack using the " { $link with-temporary-directory } " combinator. The quotation can access the " { $link current-temporary-directory } " symbol for the name of the temporary directory. Subsequent unique files will be created in this unique directory until the combinator returns." } ; +HELP: move-file-unique +{ $values + { "path" "a pathname string" } { "directory" "a directory" } + { "path'" "a pathname string" } +} +{ $description "Moves " { $snippet "path" } " to " { $snippet "directory" } " by creating a unique file in this directory. Returns the new path." } ; + HELP: current-temporary-directory { $values { "value" "a path" } @@ -90,6 +97,8 @@ ARTICLE: "io.files.unique" "Unique files" cleanup-unique-directory } "Default temporary directory:" -{ $subsections default-temporary-directory } ; +{ $subsections default-temporary-directory } +"Moving files into a directory safely:" +{ $subsections move-file-unique } ; ABOUT: "io.files.unique" diff --git a/basis/io/files/unique/unique.factor b/basis/io/files/unique/unique.factor index a7ae317668..f167b1e99b 100644 --- a/basis/io/files/unique/unique.factor +++ b/basis/io/files/unique/unique.factor @@ -70,6 +70,11 @@ PRIVATE> : unique-file ( prefix -- path ) "" make-unique-file ; +: move-file-unique ( path directory -- path' ) + [ + "" unique-file [ move-file ] keep + ] with-temporary-directory ; + { { [ os unix? ] [ "io.files.unique.unix" ] } { [ os windows? ] [ "io.files.unique.windows" ] } From 4ca7afa4893ed497ca813e22c5e360bcdea23dd3 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Thu, 15 Oct 2009 15:44:07 -0500 Subject: [PATCH 07/12] update nkeep docs --- basis/generalizations/generalizations-docs.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/generalizations/generalizations-docs.factor b/basis/generalizations/generalizations-docs.factor index 4a4d4be318..f5c0de2ea2 100644 --- a/basis/generalizations/generalizations-docs.factor +++ b/basis/generalizations/generalizations-docs.factor @@ -172,7 +172,7 @@ HELP: ndip } ; HELP: nkeep -{ $values { "quot" quotation } { "n" integer } } +{ $values { "n" integer } } { $description "A generalization of " { $link keep } " that can work " "for any stack depth. The first " { $snippet "n" } " items after the quotation will be " "saved, the quotation called, and the items restored." From 80151dc146998bb1ce68d6a3f1f8f681e884c54b Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Thu, 15 Oct 2009 19:36:19 -0500 Subject: [PATCH 08/12] tweak alien.data.map to work around limitation in using locals in macro expansions --- extra/alien/data/map/map-tests.factor | 25 +++++++++++++++- extra/alien/data/map/map.factor | 41 +++++++++++++-------------- 2 files changed, 44 insertions(+), 22 deletions(-) diff --git a/extra/alien/data/map/map-tests.factor b/extra/alien/data/map/map-tests.factor index f8c7cb0914..e6845d1847 100644 --- a/extra/alien/data/map/map-tests.factor +++ b/extra/alien/data/map/map-tests.factor @@ -1,5 +1,5 @@ ! (c)Joe Groff bsd license -USING: alien.data.map fry generalizations kernel math.vectors +USING: alien.data.map fry generalizations kernel locals math.vectors math.vectors.conversion math math.vectors.simd specialized-arrays tools.test ; FROM: alien.c-types => uchar short int float ; @@ -19,6 +19,13 @@ IN: alien.data.map.tests [ dup ] data-map!( int -- float[2] ) ] unit-test +:: float-pixels>byte-pixels-locals ( floats scale bias -- bytes ) + floats [ + [ scale 255.0 * v*n bias 255.0 * v+n float-4 int-4 vconvert ] 4 napply + [ int-4 short-8 vconvert ] 2bi@ + short-8 uchar-16 vconvert + ] data-map( float-4[4] -- uchar-16 ) ; inline + : float-pixels>byte-pixels* ( floats scale bias -- bytes ) '[ [ _ 255.0 * v*n _ 255.0 * v+n float-4 int-4 vconvert ] 4 napply @@ -29,6 +36,22 @@ IN: alien.data.map.tests : float-pixels>byte-pixels ( floats -- bytes ) 1.0 0.0 float-pixels>byte-pixels* ; +[ + B{ + 127 191 255 63 + 255 25 51 76 + 76 51 229 127 + 25 255 255 255 + } +] [ + float-array{ + 0.5 0.75 1.0 0.25 + 1.0 0.1 0.2 0.3 + 0.3 0.2 0.9 0.5 + 0.1 1.0 1.5 2.0 + } 1.0 0.0 float-pixels>byte-pixels-locals +] unit-test + [ B{ 127 191 255 63 diff --git a/extra/alien/data/map/map.factor b/extra/alien/data/map/map.factor index ea232fb15a..d4c24ef18f 100644 --- a/extra/alien/data/map/map.factor +++ b/extra/alien/data/map/map.factor @@ -1,7 +1,7 @@ ! (c)Joe Groff bsd license USING: accessors alien alien.c-types alien.data alien.parser arrays byte-arrays combinators effects.parser fry generalizations kernel -lexer locals macros math math.ranges parser sequences sequences.private ; +lexer locals macros make math math.ranges parser sequences sequences.private ; IN: alien.data.map ERROR: bad-data-map-input-length byte-length iter-size remainder ; @@ -39,27 +39,23 @@ INSTANCE: data-map-param immutable-sequence dup array? [ unclip swap product >fixnum ] [ 1 ] if 2dup swap heap-size * >fixnum ; inline -MACRO:: >param ( in -- quot: ( array -- param ) ) - in c-type-count :> iter-length :> count :> c-type - - [ - [ c-type count ] dip +MACRO: >param ( in -- quot: ( array -- param ) ) + c-type-count '[ + [ _ _ ] dip [ ] [ >c-ptr ] [ byte-length ] tri - iter-length + _ 2dup /i data-map-param boa ] ; -MACRO:: alloc-param ( out -- quot: ( len -- param ) ) - out c-type-count :> iter-length :> count :> c-type - - [ - [ c-type count ] dip +MACRO: alloc-param ( out -- quot: ( len -- param ) ) + c-type-count dup '[ + [ _ _ ] dip [ - iter-length * >fixnum [ (byte-array) dup ] keep - iter-length + _ * >fixnum [ (byte-array) dup ] keep + _ ] keep data-map-param boa ] ; @@ -76,14 +72,17 @@ MACRO: pack-params ( outs -- ) outs length :> #outs #ins #outs + :> #params - [| quot | - param-quot call + [ + param-quot % [ - [ [ ins unpack-params quot call ] #outs ndip outs pack-params ] - #params neach - ] #outs nkeep - [ orig>> ] #outs napply - ] ; + [ + [ ins , \ unpack-params , \ @ , ] [ ] make , + #outs , \ ndip , outs , \ pack-params , + ] [ ] make , + #params , \ neach , + ] [ ] make , #outs , \ nkeep , + [ orig>> ] , #outs , \ napply , + ] [ ] make fry \ call suffix ; MACRO: data-map ( ins outs -- ) 2dup From 0bb63276882360570267f849fedc85a38a8e835a Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 15 Oct 2009 21:37:34 -0500 Subject: [PATCH 09/12] fix compiler warnings in vm --- vm/debug.cpp | 2 +- vm/vm.hpp | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/vm/debug.cpp b/vm/debug.cpp index 3a8e847f14..1d2edbbf46 100755 --- a/vm/debug.cpp +++ b/vm/debug.cpp @@ -211,7 +211,7 @@ void factor_vm::dump_memory(cell from, cell to) dump_cell(from); } -void factor_vm::dump_zone(char *name, zone *z) +void factor_vm::dump_zone(const char *name, zone *z) { print_string(name); print_string(": "); print_string("Start="); print_cell(z->start); diff --git a/vm/vm.hpp b/vm/vm.hpp index 73a423ccf4..ce2acfab45 100755 --- a/vm/vm.hpp +++ b/vm/vm.hpp @@ -301,7 +301,7 @@ struct factor_vm void print_callstack(); void dump_cell(cell x); void dump_memory(cell from, cell to); - void dump_zone(char *name, zone *z); + void dump_zone(const char *name, zone *z); void dump_generations(); void dump_objects(cell type); void find_data_references_step(cell *scan); From 4c2cdb18b55a44ae41311f926f0b6726f7e9c2ad Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 15 Oct 2009 21:42:01 -0500 Subject: [PATCH 10/12] fix compiler warning --- vm/old_space.cpp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/vm/old_space.cpp b/vm/old_space.cpp index 6bd8d6db0a..06e13a77ba 100644 --- a/vm/old_space.cpp +++ b/vm/old_space.cpp @@ -68,7 +68,7 @@ cell old_space::next_object_after(factor_vm *myvm, cell scan) if(scan + size < here) return scan + size; else - return NULL; + return 0; } } From 58557e41bf1d524e61bcded76b5bcfd33c264b04 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 15 Oct 2009 21:43:19 -0500 Subject: [PATCH 11/12] add psapi stub to windows.nt --- basis/windows/nt/nt.factor | 1 + basis/windows/psapi/authors.txt | 1 + basis/windows/psapi/psapi.factor | 12 ++++++++++++ 3 files changed, 14 insertions(+) create mode 100755 basis/windows/psapi/authors.txt create mode 100755 basis/windows/psapi/psapi.factor diff --git a/basis/windows/nt/nt.factor b/basis/windows/nt/nt.factor index e05a409e67..abc728ed19 100644 --- a/basis/windows/nt/nt.factor +++ b/basis/windows/nt/nt.factor @@ -14,4 +14,5 @@ USING: alien sequences alien.libraries ; { "glu" "glu32.dll" "stdcall" } { "ole32" "ole32.dll" "stdcall" } { "usp10" "usp10.dll" "stdcall" } + { "psapi" "psapi.dll" "stdcall" } } [ first3 add-library ] each diff --git a/basis/windows/psapi/authors.txt b/basis/windows/psapi/authors.txt new file mode 100755 index 0000000000..b4bd0e7b35 --- /dev/null +++ b/basis/windows/psapi/authors.txt @@ -0,0 +1 @@ +Doug Coleman \ No newline at end of file diff --git a/basis/windows/psapi/psapi.factor b/basis/windows/psapi/psapi.factor new file mode 100755 index 0000000000..b45928f615 --- /dev/null +++ b/basis/windows/psapi/psapi.factor @@ -0,0 +1,12 @@ +! Copyright (C) 2009 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: alien.syntax windows.types ; +IN: windows.psapi + +LIBRARY: psapi + +FUNCTION: BOOL EnumDeviceDrivers ( LPVOID* lpImageBase, DWORD cb, LPDWORD lpcbNeeded ) ; + +FUNCTION: DWORD GetDeviceDriverBaseNameW ( LPVOID ImageBase, LPTSTR lpBaseName, DWORD nSize ) ; + +ALIAS: GetDeviceDriverBaseName GetDeviceDriverBaseNameW From 42751cb148bf5a3f0b8969bf1134c4e6a2c14202 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 15 Oct 2009 22:00:46 -0500 Subject: [PATCH 12/12] fix io.directories.search on windows --- basis/io/directories/search/search.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/basis/io/directories/search/search.factor b/basis/io/directories/search/search.factor index 93d4d0146c..0c947e5bc6 100755 --- a/basis/io/directories/search/search.factor +++ b/basis/io/directories/search/search.factor @@ -6,11 +6,11 @@ locals math sequences sorting system unicode.case vocabs.loader ; IN: io.directories.search : qualified-directory-entries ( path -- seq ) - normalize-path + (normalize-path) dup directory-entries [ [ append-path ] change-name ] with map ; : qualified-directory-files ( path -- seq ) - normalize-path + (normalize-path) dup directory-files [ append-path ] with map ; : with-qualified-directory-files ( path quot -- )