From: John Benediktsson Date: Sun, 25 Sep 2011 18:49:27 +0000 (-0700) Subject: specialized-arrays: performed some cleanup. X-Git-Tag: 0.97~4059 X-Git-Url: https://gitweb.factorcode.org/gitweb.cgi?p=factor.git;a=commitdiff_plain;h=4f42c72012b53c42f53f7f7f175e2c86eda39511 specialized-arrays: performed some cleanup. Specifically, • Created >c-array to be replacement for >T-array. • Created cast-array to be generic replacement for all T-array-cast words. • Created c-array@ to be generic replacement for T-array@ words. • Replaced usages of with T • Replaced usages of with T • Replaced usages of >T-array with T >c-array • Replaced usages of T-array-cast with T cast-array • Replaced usages of malloc-T-array with T malloc-array. • Removed malloc-T-array. • Removed T-array-cast. • Removed T-array@. • Removed >T-array. I also added (but didn't change any code to use): • T c-array-type, returns T-array • T c-array?, returns T-array? • c-array{ T ... }, returns T-array{ ... } Bootstraps just find on Mac OS X. Also `load-all test-all` works for me. --- diff --git a/basis/alien/data/data-docs.factor b/basis/alien/data/data-docs.factor index 3936c11f11..cd394916c4 100644 --- a/basis/alien/data/data-docs.factor +++ b/basis/alien/data/data-docs.factor @@ -4,18 +4,35 @@ alien.strings sequences io.encodings.string debugger destructors vocabs.loader classes.struct quotations kernel ; IN: alien.data +HELP: >c-array +{ $values { "seq" sequence } { "c-type" "a C type" } { "array" byte-array } } +{ $description "Outputs a freshly allocated byte-array whose elements are C type values from the given sequence." } +{ $notes "The appropriate specialized array vocabulary must be loaded; otherwise, an error will be thrown. See the " { $vocab-link "specialized-arrays" } " vocabulary for details on the underlying sequence type constructed." } +{ $errors "Throws an error if the type does not exist, the necessary specialized array vocabulary is not loaded, or the requested size is negative." } ; + HELP: { $values { "len" "a non-negative integer" } { "c-type" "a C type" } { "array" byte-array } } { $description "Creates a byte array large enough to hold " { $snippet "n" } " values of a C type." } { $notes "The appropriate specialized array vocabulary must be loaded; otherwise, an error will be thrown. See the " { $vocab-link "specialized-arrays" } " vocabulary for details on the underlying sequence type constructed." } { $errors "Throws an error if the type does not exist, the necessary specialized array vocabulary is not loaded, or the requested size is negative." } ; +HELP: c-array{ +{ $description "Literal syntax, consists of a C-type followed by a series of values terminated by " { $snippet "}" } } +{ $notes "The appropriate specialized array vocabulary must be loaded; otherwise, an error will be thrown. See the " { $vocab-link "specialized-arrays" } " vocabulary for details on the underlying sequence type constructed." } +{ $errors "Throws an error if the type does not exist, the necessary specialized array vocabulary is not loaded, or the requested size is negative." } ; + HELP: memory>byte-array { $values { "alien" c-ptr } { "len" "a non-negative integer" } { "byte-array" byte-array } } { $description "Reads " { $snippet "len" } " bytes starting from " { $snippet "base" } " and stores them in a new byte array." } ; +HELP: cast-array +{ $values { "byte-array" byte-array } { "c-type" "a C type" } { "array" "a specialized array" } } +{ $description "Converts a byte array into a specialized array by interpreting the bytes in as machine-specific values. Code which uses this word is unportable" } +{ $notes "The appropriate specialized array vocabulary must be loaded; otherwise, an error will be thrown. See the " { $vocab-link "specialized-arrays" } " vocabulary for details on the underlying sequence type constructed." } +{ $errors "Throws an error if the type does not exist, the necessary specialized array vocabulary is not loaded, or the requested size is negative." } ; + HELP: malloc-array -{ $values { "n" "a non-negative integer" } { "type" "a C type" } { "array" "a specialized array" } } +{ $values { "n" "a non-negative integer" } { "c-type" "a C type" } { "array" "a specialized array" } } { $description "Allocates an unmanaged memory block large enough to hold " { $snippet "n" } " values of a C type, then wraps the memory in a sequence object using " { $link } "." } { $notes "The appropriate specialized array vocabulary must be loaded; otherwise, an error will be thrown. See the " { $vocab-link "specialized-arrays" } " vocabulary for details on the underlying sequence type constructed." } { $warning "Don't forget to deallocate the memory with a call to " { $link free } "." } diff --git a/basis/alien/data/data.factor b/basis/alien/data/data.factor index 4fdb83a3a1..d3ce555eb0 100644 --- a/basis/alien/data/data.factor +++ b/basis/alien/data/data.factor @@ -1,9 +1,9 @@ ! (c)2009, 2010 Slava Pestov, Joe Groff bsd license -USING: accessors alien alien.c-types alien.arrays alien.strings -arrays byte-arrays cpu.architecture fry io io.encodings.binary -io.files io.streams.memory kernel libc math math.functions -sequences words macros combinators generalizations -stack-checker.dependencies combinators.short-circuit ; +USING: accessors alien alien.arrays alien.c-types alien.strings +arrays byte-arrays combinators combinators.short-circuit +cpu.architecture fry generalizations io io.streams.memory kernel +libc macros math math.functions parser sequences +stack-checker.dependencies summary words ; QUALIFIED: math IN: alien.data @@ -22,6 +22,26 @@ GENERIC: c-(array)-constructor ( c-type -- word ) foldable GENERIC: c-direct-array-constructor ( c-type -- word ) foldable +GENERIC: c-array-type ( c-type -- word ) foldable + +GENERIC: c-array-type? ( c-type -- word ) foldable + +GENERIC: c-array? ( obj c-type -- ? ) foldable + +M: word c-array? + c-array-type? execute( seq -- array ) ; inline + +M: pointer c-array? + drop void* c-array? ; + +GENERIC: >c-array ( seq c-type -- array ) + +M: word >c-array + c-array-type new clone-like ; + +M: pointer >c-array + drop void* >c-array ; + GENERIC: ( len c-type -- array ) M: word @@ -46,7 +66,22 @@ M: word M: pointer drop void* ; -: malloc-array ( n type -- array ) +SYNTAX: c-array{ \ } [ unclip >c-array ] parse-literal ; + +SYNTAX: c-array@ + scan-object [ scan-object scan-object ] dip + suffix! ; + +ERROR: bad-byte-array-length byte-array type ; + +M: bad-byte-array-length summary + drop "Byte array length doesn't divide type width" ; + +: cast-array ( byte-array c-type -- array ) + [ binary-object ] dip [ heap-size /mod 0 = ] keep swap + [ ] [ bad-byte-array-length ] if ; inline + +: malloc-array ( n c-type -- array ) [ heap-size calloc ] [ ] 2bi ; inline : malloc-byte-array ( byte-array -- alien ) diff --git a/basis/checksums/md5/md5.factor b/basis/checksums/md5/md5.factor index a1cb548e6a..8a3f5fd48b 100644 --- a/basis/checksums/md5/md5.factor +++ b/basis/checksums/md5/md5.factor @@ -184,7 +184,7 @@ HINTS: (process-md5-block-I) { uint-array md5-state } ; ] unless ; : uint-array-cast-le ( byte-array -- uint-array ) - byte-array>le uint-array-cast ; + byte-array>le uint cast-array ; HINTS: uint-array-cast-le byte-array ; diff --git a/basis/classes/struct/struct-docs.factor b/basis/classes/struct/struct-docs.factor index 13ac16a7bb..02f7aee2ae 100644 --- a/basis/classes/struct/struct-docs.factor +++ b/basis/classes/struct/struct-docs.factor @@ -121,11 +121,11 @@ ARTICLE: "classes.struct.examples" "Struct class examples" { $code "test-struct ." } "Creating a new instance with slots initialized from the stack:" { $code - "USING: libc specialized-arrays ;" + "USING: libc specialized-arrays alien.data ;" "SPECIALIZED-ARRAY: char" "" "42" - "\"Hello, chicken.\" >char-array" + "\"Hello, chicken.\" char >c-array" "1024 malloc" "test-struct ." } ; diff --git a/basis/classes/struct/struct-tests.factor b/basis/classes/struct/struct-tests.factor index 6003924998..79018f577b 100644 --- a/basis/classes/struct/struct-tests.factor +++ b/basis/classes/struct/struct-tests.factor @@ -305,7 +305,7 @@ SPECIALIZED-ARRAY: struct-test-optimization [ t ] [ [ struct-test-optimization memory>struct x>> second ] - { memory>struct x>> } inlined? + { memory>struct x>> int } inlined? ] unit-test [ f ] [ [ memory>struct y>> ] { memory>struct y>> } inlined? ] unit-test @@ -328,7 +328,7 @@ STRUCT: clone-test-struct { x int } { y char[3] } ; clone-test-struct 1 >>x char-array{ 9 1 1 } >>y clone - [ x>> ] [ y>> >char-array ] bi + [ x>> ] [ y>> char >c-array ] bi ] unit-test [ t 1 char-array{ 9 1 1 } ] [ @@ -336,7 +336,7 @@ STRUCT: clone-test-struct { x int } { y char[3] } ; clone-test-struct malloc-struct &free 1 >>x char-array{ 9 1 1 } >>y clone - [ >c-ptr byte-array? ] [ x>> ] [ y>> >char-array ] tri + [ >c-ptr byte-array? ] [ x>> ] [ y>> char >c-array ] tri ] with-destructors ] unit-test diff --git a/basis/classes/struct/struct.factor b/basis/classes/struct/struct.factor index c00746865b..6e75af874f 100644 --- a/basis/classes/struct/struct.factor +++ b/basis/classes/struct/struct.factor @@ -64,7 +64,7 @@ M: struct equal? M: struct hashcode* binary-object over - [ hashcode* ] [ 3drop 0 ] if ; inline + [ uchar hashcode* ] [ 3drop 0 ] if ; inline : struct-prototype ( class -- prototype ) "prototype" word-prop ; foldable @@ -244,7 +244,7 @@ M: struct-bit-slot-spec compute-slot-offset PRIVATE> M: struct byte-length class "struct-size" word-prop ; foldable -M: struct binary-zero? binary-object [ 0 = ] all? ; inline +M: struct binary-zero? binary-object uchar [ 0 = ] all? ; inline ! class definition diff --git a/basis/cocoa/messages/messages.factor b/basis/cocoa/messages/messages.factor index b607682e76..21604c8df1 100644 --- a/basis/cocoa/messages/messages.factor +++ b/basis/cocoa/messages/messages.factor @@ -218,7 +218,7 @@ ERROR: no-objc-type name ; : each-method-in-class ( class quot -- ) [ { uint } [ class_copyMethodList ] with-out-parameters ] dip over 0 = [ 3drop ] [ - [ ] dip + [ void* ] dip [ each ] [ drop (free) ] 2bi ] if ; inline diff --git a/basis/compiler/tests/alien.factor b/basis/compiler/tests/alien.factor index a082888690..6aa9cd8bce 100755 --- a/basis/compiler/tests/alien.factor +++ b/basis/compiler/tests/alien.factor @@ -227,8 +227,8 @@ FUNCTION: int ffi_test_12 int a int b RECT c int d int e int f ; FUNCTION: float ffi_test_23 ( float[3] x, float[3] y ) ; [ 32.0 ] [ - { 1.0 2.0 3.0 } >float-array - { 4.0 5.0 6.0 } >float-array + { 1.0 2.0 3.0 } float >c-array + { 4.0 5.0 6.0 } float >c-array ffi_test_23 ] unit-test diff --git a/basis/core-foundation/dictionaries/dictionaries.factor b/basis/core-foundation/dictionaries/dictionaries.factor index fc0e98a215..f9c27e2147 100644 --- a/basis/core-foundation/dictionaries/dictionaries.factor +++ b/basis/core-foundation/dictionaries/dictionaries.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: alien.c-types alien.syntax core-foundation kernel assocs -specialized-arrays math sequences accessors ; +USING: alien.c-types alien.data alien.syntax core-foundation +kernel assocs specialized-arrays math sequences accessors ; IN: core-foundation.dictionaries SPECIALIZED-ARRAY: void* @@ -27,7 +27,7 @@ FUNCTION: void* CFDictionaryGetValue ( : ( alist -- dictionary ) [ kCFAllocatorDefault ] dip - unzip [ >void*-array ] bi@ + unzip [ void* >c-array ] bi@ [ [ underlying>> ] bi@ ] [ nip length ] 2bi &: kCFTypeDictionaryKeyCallBacks &: kCFTypeDictionaryValueCallBacks diff --git a/basis/core-foundation/fsevents/fsevents.factor b/basis/core-foundation/fsevents/fsevents.factor index 0c91197dee..2c7bf7e9ec 100644 --- a/basis/core-foundation/fsevents/fsevents.factor +++ b/basis/core-foundation/fsevents/fsevents.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008 Slava Pestov ! See http://factorcode.org/license.txt for BSD license. -USING: alien alien.c-types alien.strings alien.syntax kernel -math sequences namespaces make assocs init accessors +USING: alien alien.c-types alien.data alien.strings alien.syntax +kernel math sequences namespaces make assocs init accessors continuations combinators io.encodings.utf8 destructors locals arrays specialized-arrays classes.struct core-foundation core-foundation.arrays core-foundation.run-loop @@ -165,9 +165,9 @@ SYMBOL: event-stream-callbacks event-stream-callbacks get delete-at ; :: (master-event-source-callback) ( eventStream info numEvents eventPaths eventFlags eventIds -- ) - eventPaths numEvents [ utf8 alien>string ] { } map-as - eventFlags numEvents - eventIds numEvents + eventPaths numEvents void* [ utf8 alien>string ] { } map-as + eventFlags numEvents int + eventIds numEvents longlong 3array flip info event-stream-callbacks get at [ drop ] or call( changes -- ) ; diff --git a/basis/db/postgresql/lib/lib.factor b/basis/db/postgresql/lib/lib.factor index 11218d21ff..0818ccfd68 100644 --- a/basis/db/postgresql/lib/lib.factor +++ b/basis/db/postgresql/lib/lib.factor @@ -93,7 +93,7 @@ M: postgresql-result-null summary ( obj -- str ) ] 2map flip [ f f ] [ - first2 [ >void*-array ] [ >uint-array ] bi* + first2 [ void* >c-array ] [ uint >c-array ] bi* ] if-empty ; : param-formats ( statement -- seq ) diff --git a/basis/game/input/dinput/dinput.factor b/basis/game/input/dinput/dinput.factor index f38b60844a..3b7981780b 100755 --- a/basis/game/input/dinput/dinput.factor +++ b/basis/game/input/dinput/dinput.factor @@ -75,7 +75,7 @@ SYMBOLS: +dinput+ +keyboard-device+ +keyboard-state+ GUID_SysMouse device-for-guid [ configure-mouse ] [ +mouse-device+ set-global ] bi 0 0 0 0 8 f mouse-state boa +mouse-state+ set-global - MOUSE-BUFFER-SIZE +mouse-buffer+ set-global ; + MOUSE-BUFFER-SIZE DIDEVICEOBJECTDATA +mouse-buffer+ set-global ; : device-info ( device -- DIDEVICEIMAGEINFOW ) DIDEVICEINSTANCEW diff --git a/basis/images/gtk/gtk.factor b/basis/images/gtk/gtk.factor index 05015c2dfc..95b677b3c2 100644 --- a/basis/images/gtk/gtk.factor +++ b/basis/images/gtk/gtk.factor @@ -38,7 +38,7 @@ os { linux freebsd netbsd openbsd } member? [ bytes-per-row rowstride = [ pixels h rowstride * memory>byte-array ] [ - pixels rowstride h * + pixels rowstride h * uchar rowstride [ bytes-per-row head-slice ] map concat ] if diff --git a/basis/images/normalization/normalization.factor b/basis/images/normalization/normalization.factor index aa85057ee9..f24315d6b2 100644 --- a/basis/images/normalization/normalization.factor +++ b/basis/images/normalization/normalization.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2009 Doug Coleman, Keith Lazuka ! See http://factorcode.org/license.txt for BSD license. -USING: accessors alien.c-types byte-arrays combinators fry -grouping images kernel locals math math.vectors +USING: accessors alien.c-types alien.data byte-arrays +combinators fry grouping images kernel locals math math.vectors sequences specialized-arrays math.floats.half ; FROM: alien.c-types => float ; SPECIALIZED-ARRAY: half @@ -47,13 +47,13 @@ GENERIC: normalize-component-type* ( image component-type -- image ) [ 255.0 * >integer ] B{ } map-as ; M: float-components normalize-component-type* - drop float-array-cast normalize-floats ; + drop float cast-array normalize-floats ; M: half-components normalize-component-type* - drop half-array-cast normalize-floats ; + drop half cast-array normalize-floats ; : ushorts>ubytes ( bitmap -- bitmap' ) - ushort-array-cast [ -8 shift ] B{ } map-as ; inline + ushort cast-array [ -8 shift ] B{ } map-as ; inline M: ushort-components normalize-component-type* drop ushorts>ubytes ; diff --git a/basis/io/backend/unix/multiplexers/kqueue/kqueue.factor b/basis/io/backend/unix/multiplexers/kqueue/kqueue.factor index 41fc7a65bc..cecf67ead5 100644 --- a/basis/io/backend/unix/multiplexers/kqueue/kqueue.factor +++ b/basis/io/backend/unix/multiplexers/kqueue/kqueue.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors alien.c-types combinators destructors -io.backend.unix kernel math.bitwise sequences +USING: accessors alien.c-types alien.data combinators +destructors io.backend.unix kernel math.bitwise sequences specialized-arrays unix unix.kqueue unix.time assocs io.backend.unix.multiplexers classes.struct literals ; SPECIALIZED-ARRAY: kevent @@ -16,7 +16,7 @@ CONSTANT: max-events 256 : ( -- mx ) kqueue-mx new-mx kqueue dup io-error >>fd - max-events >>events ; + max-events \ kevent >>events ; M: kqueue-mx dispose* fd>> close-file ; diff --git a/basis/io/files/info/unix/freebsd/freebsd.factor b/basis/io/files/info/unix/freebsd/freebsd.factor index 7c13d86a3c..37a37f1958 100644 --- a/basis/io/files/info/unix/freebsd/freebsd.factor +++ b/basis/io/files/info/unix/freebsd/freebsd.factor @@ -4,8 +4,8 @@ USING: accessors alien alien.c-types alien.syntax combinators io.backend io.files io.files.info io.files.unix kernel math system unix unix.statfs.freebsd unix.statvfs.freebsd unix.getfsstat.freebsd sequences grouping alien.strings io.encodings.utf8 unix.types -arrays io.files.info.unix classes.struct -specialized-arrays ; +arrays io.files.info.unix classes.struct specialized-arrays +alien.data ; SPECIALIZED-ARRAY: statfs IN: io.files.info.unix.freebsd @@ -52,6 +52,6 @@ M: freebsd statvfs>file-system-info ( file-system-info statvfs -- file-system-in M: freebsd file-systems ( -- array ) f 0 0 getfsstat dup io-error - + \ statfs [ dup byte-length 0 getfsstat io-error ] [ [ f_mntonname>> utf8 alien>string file-system-info ] { } map-as ] bi ; diff --git a/basis/io/files/info/unix/macosx/macosx.factor b/basis/io/files/info/unix/macosx/macosx.factor index d0d4bb7c05..26ed593646 100644 --- a/basis/io/files/info/unix/macosx/macosx.factor +++ b/basis/io/files/info/unix/macosx/macosx.factor @@ -14,7 +14,7 @@ io-size owner type-id filesystem-subtype ; M: macosx file-systems ( -- array ) f void* dup 0 getmntinfo64 dup io-error - [ void* deref ] dip + [ void* deref ] dip \ statfs64 [ f_mntonname>> utf8 alien>string file-system-info ] { } map-as ; M: macosx new-file-system-info macosx-file-system-info new ; diff --git a/basis/io/files/info/unix/netbsd/netbsd.factor b/basis/io/files/info/unix/netbsd/netbsd.factor index 9ea475433b..5be9a945d4 100644 --- a/basis/io/files/info/unix/netbsd/netbsd.factor +++ b/basis/io/files/info/unix/netbsd/netbsd.factor @@ -4,7 +4,7 @@ USING: alien alien.syntax kernel unix.stat math unix combinators system io.backend accessors alien.c-types io.encodings.utf8 alien.strings unix.types io.files.unix io.files io.files.info unix.statvfs.netbsd unix.getfsstat.netbsd arrays -grouping sequences io.encodings.utf8 classes.struct +grouping sequences io.encodings.utf8 classes.struct alien.data specialized-arrays io.files.info.unix ; SPECIALIZED-ARRAY: statvfs IN: io.files.info.unix.netbsd @@ -48,6 +48,6 @@ M: netbsd statvfs>file-system-info ( file-system-info statvfs -- file-system-inf M: netbsd file-systems ( -- array ) f 0 0 getvfsstat dup io-error - + \ statvfs [ dup byte-length 0 getvfsstat io-error ] [ [ f_mntonname>> utf8 alien>string file-system-info ] { } map-as ] bi ; diff --git a/basis/io/files/info/unix/openbsd/openbsd.factor b/basis/io/files/info/unix/openbsd/openbsd.factor index e80a4fdafd..7373012914 100644 --- a/basis/io/files/info/unix/openbsd/openbsd.factor +++ b/basis/io/files/info/unix/openbsd/openbsd.factor @@ -4,7 +4,7 @@ USING: accessors alien alien.c-types alien.strings alien.syntax combinators io.backend io.files io.files.info io.files.unix kernel math sequences system unix unix.getfsstat.openbsd grouping unix.statfs.openbsd unix.statvfs.openbsd unix.types -arrays io.files.info.unix classes.struct +arrays io.files.info.unix classes.struct alien.data specialized-arrays io.encodings.utf8 ; SPECIALIZED-ARRAY: statfs IN: io.files.unix.openbsd @@ -49,6 +49,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 byte-length 0 getfsstat io-error ] [ [ f_mntonname>> utf8 alien>string file-system-info ] { } map-as ] bi ; diff --git a/basis/io/files/info/unix/unix.factor b/basis/io/files/info/unix/unix.factor index 3b85467964..6df4f40739 100644 --- a/basis/io/files/info/unix/unix.factor +++ b/basis/io/files/info/unix/unix.factor @@ -1,11 +1,11 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors alien.c-types arrays calendar calendar.unix -classes.struct combinators combinators.short-circuit io.backend -io.directories io.files.info io.files.types kernel literals -math math.bitwise sequences specialized-arrays strings system -unix unix.ffi unix.groups unix.stat unix.time unix.users -vocabs.loader ; +USING: accessors alien.c-types alien.data arrays calendar +calendar.unix classes.struct combinators +combinators.short-circuit io.backend io.directories +io.files.info io.files.types kernel literals math math.bitwise +sequences specialized-arrays strings system unix unix.ffi +unix.groups unix.stat unix.time unix.users vocabs.loader ; IN: io.files.info.unix SPECIALIZED-ARRAY: timeval @@ -195,7 +195,7 @@ M: unix copy-file-and-info ( from to -- ) : timestamps>byte-array ( timestamps -- byte-array ) [ [ timestamp>timeval ] [ \ timeval ] if* ] map - >timeval-array ; + timeval >c-array ; PRIVATE> diff --git a/basis/io/files/windows/windows.factor b/basis/io/files/windows/windows.factor index 4d184bb309..cda77915cc 100755 --- a/basis/io/files/windows/windows.factor +++ b/basis/io/files/windows/windows.factor @@ -297,7 +297,7 @@ SYMBOLS: +read-only+ +hidden+ +system+ SetFileTime win32-error=0/f ; M: windows cwd - MAX_UNICODE_PATH dup + MAX_UNICODE_PATH dup ushort [ GetCurrentDirectory win32-error=0/f ] keep utf16n alien>string ; diff --git a/basis/io/pipes/unix/unix.factor b/basis/io/pipes/unix/unix.factor index 7dbeb0a589..2ac4964697 100644 --- a/basis/io/pipes/unix/unix.factor +++ b/basis/io/pipes/unix/unix.factor @@ -1,12 +1,12 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: alien.c-types system kernel unix math sequences +USING: alien.c-types alien.data system kernel unix math sequences io.backend.unix io.ports specialized-arrays accessors unix.ffi ; QUALIFIED: io.pipes SPECIALIZED-ARRAY: int IN: io.pipes.unix M: unix io.pipes:(pipe) ( -- pair ) - 2 + 2 int [ pipe io-error ] [ first2 [ init-fd ] bi@ io.pipes:pipe boa ] bi ; diff --git a/basis/io/ports/ports-tests.factor b/basis/io/ports/ports-tests.factor index d2fb5764ff..7f198fdedf 100644 --- a/basis/io/ports/ports-tests.factor +++ b/basis/io/ports/ports-tests.factor @@ -1,6 +1,6 @@ -USING: destructors io io.directories io.encodings.binary -io.files io.files.temp kernel libc math sequences -specialized-arrays.instances.alien.c-types.int tools.test ; +USING: alien.c-types alien.data destructors io io.directories +io.encodings.binary io.files io.files.temp kernel libc math +sequences tools.test ; IN: io.ports.tests ! Make sure that writing malloced storage to a file works, and @@ -11,14 +11,14 @@ IN: io.ports.tests [ 100,000 iota 0 - 100,000 malloc-int-array &free [ copy ] keep write + 100,000 int malloc-array &free [ copy ] keep write ] with-destructors ] with-file-writer ] unit-test [ t ] [ "test.txt" temp-file binary [ - 100,000 4 * read int-array-cast 100,000 iota sequence= + 100,000 4 * read int cast-array 100,000 iota sequence= ] with-file-reader ] unit-test diff --git a/basis/io/ports/ports.factor b/basis/io/ports/ports.factor index 6c2f75ec80..ee09deb511 100644 --- a/basis/io/ports/ports.factor +++ b/basis/io/ports/ports.factor @@ -3,8 +3,8 @@ USING: math kernel io sequences io.buffers io.timeouts generic byte-vectors system io.encodings math.order io.backend continuations classes byte-arrays namespaces splitting grouping -dlists alien alien.c-types assocs io.encodings.binary summary -accessors destructors combinators fry specialized-arrays +dlists alien alien.c-types alien.data assocs io.encodings.binary +summary accessors destructors combinators fry specialized-arrays locals ; SPECIALIZED-ARRAY: uchar IN: io.ports @@ -120,7 +120,7 @@ M: output-port stream-write1 buffer>> byte>buffer ; inline : write-in-groups ( byte-array port -- ) - [ binary-object ] dip + [ binary-object uchar ] dip [ buffer>> size>> ] [ '[ _ stream-write ] ] bi each ; diff --git a/basis/math/bitwise/bitwise-tests.factor b/basis/math/bitwise/bitwise-tests.factor index b05ca1d53f..d0805237fd 100644 --- a/basis/math/bitwise/bitwise-tests.factor +++ b/basis/math/bitwise/bitwise-tests.factor @@ -1,5 +1,5 @@ USING: accessors math math.bitwise tools.test kernel words -specialized-arrays alien.c-types math.vectors.simd +specialized-arrays alien.c-types alien.data math.vectors.simd sequences destructors libc literals classes.struct ; SPECIALIZED-ARRAY: int IN: math.bitwise.tests @@ -44,7 +44,7 @@ SPECIALIZED-ARRAY: uint-4 [ 1 ] [ [ - 2 malloc-int-array &free 1 0 pick set-nth bit-count + 2 int malloc-array &free 1 0 pick set-nth bit-count ] with-destructors ] unit-test diff --git a/basis/math/floats/half/half-tests.factor b/basis/math/floats/half/half-tests.factor index 82db3d195b..26bd304142 100644 --- a/basis/math/floats/half/half-tests.factor +++ b/basis/math/floats/half/half-tests.factor @@ -45,5 +45,5 @@ STRUCT: halves ] unit-test [ half-array{ 1.0 2.0 3.0 1/0. -1/0. } ] -[ { 1.0 2.0 3.0 1/0. -1/0. } >half-array ] unit-test +[ { 1.0 2.0 3.0 1/0. -1/0. } half >c-array ] unit-test diff --git a/basis/math/vectors/simd/intrinsics/intrinsics.factor b/basis/math/vectors/simd/intrinsics/intrinsics.factor index 2fe4cc922b..563e07d840 100644 --- a/basis/math/vectors/simd/intrinsics/intrinsics.factor +++ b/basis/math/vectors/simd/intrinsics/intrinsics.factor @@ -60,44 +60,44 @@ SYNTAX: SIMD-INTRINSIC:: : [byte>rep-array] ( rep -- class ) { - { char-16-rep [ [ 16 ] ] } - { uchar-16-rep [ [ 16 ] ] } - { short-8-rep [ [ 8 ] ] } - { ushort-8-rep [ [ 8 ] ] } - { int-4-rep [ [ 4 ] ] } - { uint-4-rep [ [ 4 ] ] } - { longlong-2-rep [ [ 2 ] ] } - { ulonglong-2-rep [ [ 2 ] ] } - { float-4-rep [ [ 4 ] ] } - { double-2-rep [ [ 2 ] ] } + { char-16-rep [ [ 16 c:char ] ] } + { uchar-16-rep [ [ 16 c:uchar ] ] } + { short-8-rep [ [ 8 c:short ] ] } + { ushort-8-rep [ [ 8 c:ushort ] ] } + { int-4-rep [ [ 4 c:int ] ] } + { uint-4-rep [ [ 4 c:uint ] ] } + { longlong-2-rep [ [ 2 c:longlong ] ] } + { ulonglong-2-rep [ [ 2 c:ulonglong ] ] } + { float-4-rep [ [ 4 c:float ] ] } + { double-2-rep [ [ 2 c:double ] ] } } case ; foldable : [>rep-array] ( rep -- class ) { - { char-16-rep [ [ >char-array ] ] } - { uchar-16-rep [ [ >uchar-array ] ] } - { short-8-rep [ [ >short-array ] ] } - { ushort-8-rep [ [ >ushort-array ] ] } - { int-4-rep [ [ >int-array ] ] } - { uint-4-rep [ [ >uint-array ] ] } - { longlong-2-rep [ [ >longlong-array ] ] } - { ulonglong-2-rep [ [ >ulonglong-array ] ] } - { float-4-rep [ [ >float-array ] ] } - { double-2-rep [ [ >double-array ] ] } + { char-16-rep [ [ c:char >c-array ] ] } + { uchar-16-rep [ [ c:uchar >c-array ] ] } + { short-8-rep [ [ c:short >c-array ] ] } + { ushort-8-rep [ [ c:ushort >c-array ] ] } + { int-4-rep [ [ c:int >c-array ] ] } + { uint-4-rep [ [ c:uint >c-array ] ] } + { longlong-2-rep [ [ c:longlong >c-array ] ] } + { ulonglong-2-rep [ [ c:ulonglong >c-array ] ] } + { float-4-rep [ [ c:float >c-array ] ] } + { double-2-rep [ [ c:double >c-array ] ] } } case ; foldable : [] ( rep -- class ) { - { char-16-rep [ [ 16 (char-array) ] ] } - { uchar-16-rep [ [ 16 (uchar-array) ] ] } - { short-8-rep [ [ 8 (short-array) ] ] } - { ushort-8-rep [ [ 8 (ushort-array) ] ] } - { int-4-rep [ [ 4 (int-array) ] ] } - { uint-4-rep [ [ 4 (uint-array) ] ] } - { longlong-2-rep [ [ 2 (longlong-array) ] ] } - { ulonglong-2-rep [ [ 2 (ulonglong-array) ] ] } - { float-4-rep [ [ 4 (float-array) ] ] } - { double-2-rep [ [ 2 (double-array) ] ] } + { char-16-rep [ [ 16 c:char (c-array) ] ] } + { uchar-16-rep [ [ 16 c:uchar (c-array) ] ] } + { short-8-rep [ [ 8 c:short (c-array) ] ] } + { ushort-8-rep [ [ 8 c:ushort (c-array) ] ] } + { int-4-rep [ [ 4 c:int (c-array) ] ] } + { uint-4-rep [ [ 4 c:uint (c-array) ] ] } + { longlong-2-rep [ [ 2 c:longlong (c-array) ] ] } + { ulonglong-2-rep [ [ 2 c:ulonglong (c-array) ] ] } + { float-4-rep [ [ 4 c:float (c-array) ] ] } + { double-2-rep [ [ 2 c:double (c-array) ] ] } } case ; foldable : rep-tf-values ( rep -- t f ) diff --git a/basis/opengl/opengl.factor b/basis/opengl/opengl.factor index 0589e0eede..dc7fe152c9 100644 --- a/basis/opengl/opengl.factor +++ b/basis/opengl/opengl.factor @@ -183,7 +183,7 @@ MACRO: all-enabled-client-state ( seq quot -- ) glActiveTexture swap glBindTexture gl-error ; : (set-draw-buffers) ( buffers -- ) - [ length ] [ >uint-array ] bi glDrawBuffers ; + [ length ] [ uint >c-array ] bi glDrawBuffers ; MACRO: set-draw-buffers ( buffers -- ) words>values '[ _ (set-draw-buffers) ] ; diff --git a/basis/opengl/shaders/shaders.factor b/basis/opengl/shaders/shaders.factor index 1b7ac94f4d..f2f527994b 100644 --- a/basis/opengl/shaders/shaders.factor +++ b/basis/opengl/shaders/shaders.factor @@ -108,7 +108,7 @@ PREDICATE: fragment-shader < gl-shader (fragment-shader?) ; : gl-program-shaders ( program -- shaders ) dup gl-program-shaders-length 2 * 0 int - over + over uint [ glGetAttachedShaders ] keep [ zero? not ] filter ; : delete-gl-program-only ( program -- ) diff --git a/basis/random/mersenne-twister/mersenne-twister.factor b/basis/random/mersenne-twister/mersenne-twister.factor index 9fd82a3062..3d379bb4ec 100644 --- a/basis/random/mersenne-twister/mersenne-twister.factor +++ b/basis/random/mersenne-twister/mersenne-twister.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. ! mersenne twister based on ! http://www.math.sci.hiroshima-u.ac.jp/~m-mat/MT/MT2002/CODES/mt19937ar.c -USING: alien.c-types kernel math namespaces sequences +USING: alien.c-types alien.data kernel math namespaces sequences sequences.private system init accessors math.ranges random math.bitwise combinators specialized-arrays fry ; SPECIALIZED-ARRAY: uint @@ -44,7 +44,7 @@ CONSTANT: a uint-array{ 0 HEX: 9908b0df } ] each-integer ; inline : init-mt-seq ( seed -- seq ) - 32 bits n + 32 bits n uint [ set-first ] [ init-mt-rest ] [ ] tri ; inline : mt-temper ( y -- yt ) diff --git a/basis/random/sfmt/sfmt.factor b/basis/random/sfmt/sfmt.factor index 730c5b320b..d2c4e2d448 100644 --- a/basis/random/sfmt/sfmt.factor +++ b/basis/random/sfmt/sfmt.factor @@ -112,14 +112,14 @@ M:: sfmt generate ( sfmt -- ) : ( sfmt -- uint-array uint-4-array ) state>> - [ n>> 4 * [1,b] >uint-array ] [ seed>> ] bi + [ n>> 4 * [1,b] uint >c-array ] [ seed>> ] bi [ [ [ -30 shift ] [ ] bi bitxor state-multiplier * 32 bits ] dip + 32 bits ] uint-array{ } accumulate-as nip - dup uint-4-array-cast ; + dup uint-4 cast-array ; : ( seed n m mask parity -- sfmt ) sfmt-state diff --git a/basis/specialized-arrays/prettyprint/prettyprint.factor b/basis/specialized-arrays/prettyprint/prettyprint.factor index 4d6416a1b4..3dcc092e5f 100644 --- a/basis/specialized-arrays/prettyprint/prettyprint.factor +++ b/basis/specialized-arrays/prettyprint/prettyprint.factor @@ -1,13 +1,15 @@ ! Copyright (C) 2009 Joe Groff. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors kernel prettyprint.backend +USING: accessors alien.data kernel prettyprint.backend prettyprint.sections prettyprint.custom specialized-arrays ; IN: specialized-arrays.prettyprint : pprint-direct-array ( direct-array -- ) - dup direct-array-syntax - [ [ underlying>> ] [ length>> ] bi [ pprint* ] bi@ ] pprint-prefix ; + \ c-array@ [ + [ underlying-type ] [ underlying>> ] [ length>> ] tri + [ pprint* ] tri@ + ] pprint-prefix ; M: specialized-array pprint* [ pprint-object ] [ pprint-direct-array ] pprint-c-object ; diff --git a/basis/specialized-arrays/specialized-arrays-docs.factor b/basis/specialized-arrays/specialized-arrays-docs.factor index 99036ac013..9dc02de976 100644 --- a/basis/specialized-arrays/specialized-arrays-docs.factor +++ b/basis/specialized-arrays/specialized-arrays-docs.factor @@ -41,10 +41,7 @@ ARTICLE: "specialized-array-words" "Specialized array words" { { $snippet "T-array" } { "The class of arrays with elements of type " { $snippet "T" } } } { { $snippet "" } { "Constructor for arrays with elements of type " { $snippet "T" } "; stack effect " { $snippet "( len -- array )" } } } { { $snippet "(T-array)" } { "Constructor for arrays with elements of type " { $snippet "T" } ", where the initial contents are uninitialized; stack effect " { $snippet "( len -- array )" } } } - { { $snippet "malloc-T-array" } { "Constructor for arrays with elements of type " { $snippet "T" } " backed by newly-allocated, zeroed out, unmanaged memory; stack effect " { $snippet "( len -- array )" } } } { { $snippet "" } { "Constructor for arrays with elements of type " { $snippet "T" } " backed by raw memory; stack effect " { $snippet "( alien len -- array )" } } } - { { $snippet "T-array-cast" } { "Converts a byte array into a specialized array by interpreting the bytes in as machine-specific values. Code which uses this word is unportable" } } - { { $snippet ">T-array" } { "Converts a sequence into a specialized array of type " { $snippet "T" } "; stack effect " { $snippet "( seq -- array )" } } } { { $snippet "T-array{" } { "Literal syntax, consists of a series of values terminated by " { $snippet "}" } } } } "Behind the scenes, these words are placed in a vocabulary named " { $snippet "specialized-arrays.instances.T" } ", however this vocabulary should not be placed in a " { $link POSTPONE: USING: } " form directly. Instead, always use " { $link POSTPONE: SPECIALIZED-ARRAY: } " or " { $link POSTPONE: SPECIALIZED-ARRAYS: } ". This ensures that the vocabulary can get generated the first time it is needed." @@ -70,7 +67,7 @@ $nl "FUNCTION: void process_data ( int* data, int len ) ;" "int-array{ 10 20 30 } dup length process_data" } -"Literal specialized arrays, as well as specialized arrays created with " { $snippet "" } " and " { $snippet ">T-array" } " are backed by a " { $link byte-array } " in the Factor heap, and can move as a result of garbage collection. If this is unsuitable, the array can be allocated in unmanaged memory instead." +"Literal specialized arrays, as well as specialized arrays created with " { $snippet "" } " and " { $snippet "T >c-array" } " are backed by a " { $link byte-array } " in the Factor heap, and can move as a result of garbage collection. If this is unsuitable, the array can be allocated in unmanaged memory instead." $nl "In the following example, it is presumed that the C library holds on to a pointer to the array's data after the " { $snippet "init_with_data()" } " call returns; this is one situation where unmanaged memory has to be used instead. Note the use of destructors to ensure the memory is deallocated after the block ends:" { $code diff --git a/basis/specialized-arrays/specialized-arrays-tests.factor b/basis/specialized-arrays/specialized-arrays-tests.factor index e3770220e8..f27ae66b8e 100644 --- a/basis/specialized-arrays/specialized-arrays-tests.factor +++ b/basis/specialized-arrays/specialized-arrays-tests.factor @@ -13,28 +13,28 @@ IN: specialized-arrays.tests SPECIALIZED-ARRAY: int SPECIALIZED-ARRAYS: bool ushort char uint float ulonglong ; -[ t ] [ { 1 2 3 } >int-array int-array? ] unit-test +[ t ] [ { 1 2 3 } int >c-array int-array? ] unit-test [ t ] [ int-array{ 1 2 3 } int-array? ] unit-test [ 2 ] [ int-array{ 1 2 3 } second ] unit-test [ t ] [ - { t f t } >bool-array underlying>> + { t f t } bool >c-array underlying>> { 1 0 1 } bool heap-size { - { 1 [ >char-array ] } - { 4 [ >uint-array ] } + { 1 [ char >c-array ] } + { 4 [ uint >c-array ] } } case underlying>> = ] unit-test [ ushort-array{ 1234 } ] [ - little-endian? B{ 210 4 } B{ 4 210 } ? ushort-array-cast + little-endian? B{ 210 4 } B{ 4 210 } ? ushort cast-array ] unit-test -[ B{ 210 4 1 } ushort-array-cast ] must-fail +[ B{ 210 4 1 } ushort cast-array ] must-fail [ { 3 1 3 3 7 } ] [ - int-array{ 3 1 3 3 7 } malloc-byte-array 5 >array + int-array{ 3 1 3 3 7 } malloc-byte-array 5 int >array ] unit-test [ float-array{ HEX: 1.222,222 HEX: 1.111,112 } ] @@ -130,7 +130,7 @@ SPECIALIZED-ARRAY: fixed-string ! Test prettyprinting [ "int-array{ 1 2 3 }" ] [ int-array{ 1 2 3 } unparse ] unit-test -[ "int-array@ f 100" ] [ f 100 unparse ] unit-test +[ "c-array@ int f 100" ] [ f 100 unparse ] unit-test ! If the C type doesn't exist, don't generate a vocab SYMBOL: __does_not_exist__ diff --git a/basis/specialized-arrays/specialized-arrays.factor b/basis/specialized-arrays/specialized-arrays.factor index 9754fd2abc..96aaf6e62f 100644 --- a/basis/specialized-arrays/specialized-arrays.factor +++ b/basis/specialized-arrays/specialized-arrays.factor @@ -12,24 +12,25 @@ MIXIN: specialized-array INSTANCE: specialized-array sequence -GENERIC: direct-array-syntax ( obj -- word ) - -ERROR: bad-byte-array-length byte-array type ; - -M: bad-byte-array-length summary - drop "Byte array length doesn't divide type width" ; - -ERROR: not-a-byte-array alien ; - -M: not-a-byte-array summary - drop "Not a byte array" ; - : (underlying) ( n c-type -- array ) heap-size * (byte-array) ; inline : ( n type -- array ) heap-size * ; inline +GENERIC: underlying-type ( c-type -- c-type' ) + +M: c-type-word underlying-type + dup "c-type" word-prop { + { [ dup not ] [ drop no-c-type ] } + { [ dup pointer? ] [ 2drop void* ] } + { [ dup c-type-word? ] [ nip underlying-type ] } + [ drop ] + } cond ; + +M: pointer underlying-type + drop void* ; + DEFINES malloc-A DEFINES malloc-${A} ->A DEFINES >${A} A-cast DEFINES ${A}-cast A{ DEFINES ${A}{ A@ DEFINES ${A}@ @@ -63,13 +63,6 @@ M: A direct-like drop ; inline : (A) ( n -- specialized-array ) [ \ T (underlying) ] keep ; inline -: malloc-A ( len -- specialized-array ) - [ \ T heap-size calloc ] keep ; inline - -: A-cast ( byte-array -- specialized-array ) - binary-object \ T heap-size /mod 0 = - [ ] [ drop \ T bad-byte-array-length ] if ; inline - M: A clone [ underlying>> clone ] [ length>> ] bi ; inline M: A length length>> ; inline @@ -80,9 +73,7 @@ M: A nth-c-ptr underlying>> \ T array-accessor drop swap ; inl M: A set-nth-unsafe underlying>> \ T set-alien-element ; inline -: >A ( seq -- specialized-array ) A new clone-like ; - -M: A like drop dup A instance? [ >A ] unless ; inline +M: A like drop dup A instance? [ \ T >c-array ] unless ; inline M: A new-sequence drop (A) ; inline @@ -97,14 +88,13 @@ M: A resize M: A element-size drop \ T heap-size ; inline -M: A direct-array-syntax drop \ A@ ; +M: A underlying-type drop \ T ; M: A pprint-delims drop \ A{ \ } ; M: A >pprint-sequence ; -SYNTAX: A{ \ } [ >A ] parse-literal ; -SYNTAX: A@ scan-object scan-object suffix! ; +SYNTAX: A{ \ } [ \ T >c-array ] parse-literal ; INSTANCE: A specialized-array @@ -116,19 +106,6 @@ M: A v*high [ * \ T heap-size neg shift ] 2map ; inline ;FUNCTOR -GENERIC: underlying-type ( c-type -- c-type' ) - -M: c-type-word underlying-type - dup "c-type" word-prop { - { [ dup not ] [ drop no-c-type ] } - { [ dup pointer? ] [ 2drop void* ] } - { [ dup c-type-word? ] [ nip underlying-type ] } - [ drop ] - } cond ; - -M: pointer underlying-type - drop void* ; - : specialized-array-vocab ( c-type -- vocab ) [ "specialized-arrays.instances." % @@ -180,6 +157,20 @@ M: c-type-word c-direct-array-constructor M: pointer c-direct-array-constructor drop void* c-direct-array-constructor ; +M: c-type-word c-array-type + underlying-type + dup [ name>> "-array" append ] [ specialized-array-vocab ] bi lookup + [ ] [ specialized-array-vocab-not-loaded ] ?if ; foldable + +M: pointer c-array-type drop void* c-array-type ; + +M: c-type-word c-array-type? + underlying-type + dup [ name>> "-array?" append ] [ specialized-array-vocab ] bi lookup + [ ] [ specialized-array-vocab-not-loaded ] ?if ; foldable + +M: pointer c-array-type? drop void* c-array-type? ; + SYNTAX: SPECIALIZED-ARRAYS: ";" [ parse-c-type define-array-vocab use-vocab ] each-token ; diff --git a/basis/specialized-vectors/specialized-vectors.factor b/basis/specialized-vectors/specialized-vectors.factor index 2b5b2f3f92..7112442c23 100644 --- a/basis/specialized-vectors/specialized-vectors.factor +++ b/basis/specialized-vectors/specialized-vectors.factor @@ -1,8 +1,8 @@ ! Copyright (C) 2008, 2010 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors alien alien.c-types alien.parser assocs -classes compiler.units functors growable kernel lexer math -namespaces parser prettyprint.custom sequences +USING: accessors alien alien.c-types alien.data alien.parser +assocs classes compiler.units functors growable kernel lexer +math namespaces parser prettyprint.custom sequences specialized-arrays specialized-arrays.private strings vocabs vocabs.loader vocabs.parser vocabs.generated fry make ; FROM: sequences.private => nth-unsafe ; @@ -19,7 +19,6 @@ FUNCTOR: define-vector ( T -- ) V DEFINES-CLASS ${T}-vector A IS ${T}-array ->A IS >${A} IS <${A}> IS @@ -48,7 +47,9 @@ M: V nth-c-ptr underlying>> nth-c-ptr ; inline M: A like drop dup A instance? [ - dup V instance? [ [ >c-ptr ] [ length>> ] bi ] [ >A ] if + dup V instance? [ + [ >c-ptr ] [ length>> ] bi + ] [ \ T >c-array ] if ] unless ; inline SYNTAX: V{ \ } [ >V ] parse-literal ; diff --git a/basis/system-info/windows/windows.factor b/basis/system-info/windows/windows.factor index 273461e74d..9af9910aba 100644 --- a/basis/system-info/windows/windows.factor +++ b/basis/system-info/windows/windows.factor @@ -55,7 +55,7 @@ M: windows os-version ( -- obj ) PF_SSE3_INSTRUCTIONS_AVAILABLE feature-present? ; : get-directory ( word -- str ) - [ MAX_UNICODE_PATH [ ] keep dupd ] dip + [ MAX_UNICODE_PATH [ ushort ] keep dupd ] dip execute win32-error=0/f alien>native-string ; inline : windows-directory ( -- str ) diff --git a/basis/tools/deploy/libraries/windows/windows.factor b/basis/tools/deploy/libraries/windows/windows.factor index 4698754f07..82fd5179fa 100644 --- a/basis/tools/deploy/libraries/windows/windows.factor +++ b/basis/tools/deploy/libraries/windows/windows.factor @@ -1,7 +1,7 @@ ! (c)2010 Joe Groff bsd license -USING: alien.strings byte-arrays io.encodings.utf16n kernel -specialized-arrays system tools.deploy.libraries windows.kernel32 -windows.types ; +USING: alien.data alien.strings byte-arrays io.encodings.utf16n +kernel specialized-arrays system tools.deploy.libraries +windows.kernel32 windows.types ; FROM: alien.c-types => ushort ; SPECIALIZED-ARRAY: ushort IN: tools.deploy.libraries.windows @@ -9,7 +9,7 @@ IN: tools.deploy.libraries.windows M: windows find-library-file f DONT_RESOLVE_DLL_REFERENCES LoadLibraryEx [ [ - 32768 (ushort-array) [ 32768 GetModuleFileName drop ] keep + 32768 ushort (c-array) [ 32768 GetModuleFileName drop ] keep utf16n alien>string ] [ FreeLibrary drop ] bi ] [ f ] if* ; diff --git a/basis/ui/backend/windows/windows.factor b/basis/ui/backend/windows/windows.factor index 559a89217e..215da172d1 100755 --- a/basis/ui/backend/windows/windows.factor +++ b/basis/ui/backend/windows/windows.factor @@ -805,7 +805,7 @@ M: windows-ui-backend system-alert : client-area>RECT ( hwnd -- RECT ) RECT [ GetClientRect win32-error=0/f ] - [ >c-ptr POINT-array-cast [ ClientToScreen drop ] with each ] + [ >c-ptr POINT cast-array [ ClientToScreen drop ] with each ] [ nip ] 2tri ; : hwnd>RECT ( hwnd -- RECT ) diff --git a/basis/ui/backend/x11/x11.factor b/basis/ui/backend/x11/x11.factor index 3984ad9699..49b37abe33 100644 --- a/basis/ui/backend/x11/x11.factor +++ b/basis/ui/backend/x11/x11.factor @@ -41,7 +41,7 @@ SINGLETON: x11-ui-backend ] with-out-parameters [| type format n-atoms bytes-after atoms | - atoms n-atoms >array + atoms n-atoms ulong >array atoms XFree ] call ; diff --git a/basis/ui/pens/gradient/gradient.factor b/basis/ui/pens/gradient/gradient.factor index fbf190a218..728ba226a5 100644 --- a/basis/ui/pens/gradient/gradient.factor +++ b/basis/ui/pens/gradient/gradient.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: kernel accessors math math.vectors locals sequences -specialized-arrays colors arrays combinators +specialized-arrays colors arrays combinators alien.data opengl opengl.gl ui.pens ui.pens.caching ; FROM: alien.c-types => float ; SPECIALIZED-ARRAY: float @@ -18,11 +18,11 @@ TUPLE: gradient < caching-pen colors last-vertices last-colors ; direction dim v* dim over v- swap colors length [ iota ] [ 1 - ] bi v/n [ v*n ] with map swap [ over v+ 2array ] curry map - concat concat >float-array ; + concat concat float >c-array ; : gradient-colors ( colors -- seq ) [ >rgba-components 4array dup 2array ] map concat concat - >float-array ; + float >c-array ; M: gradient recompute-pen ( gadget gradient -- ) [ nip ] [ [ [ orientation>> ] [ dim>> ] bi ] [ colors>> ] bi* ] 2bi diff --git a/basis/ui/pens/polygon/polygon.factor b/basis/ui/pens/polygon/polygon.factor index c1e1ada61b..0907cb6867 100644 --- a/basis/ui/pens/polygon/polygon.factor +++ b/basis/ui/pens/polygon/polygon.factor @@ -1,8 +1,8 @@ ! Copyright (C) 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors alien.c-types colors help.markup help.syntax -kernel opengl opengl.gl sequences math.vectors ui.gadgets -ui.pens specialized-arrays ; +USING: accessors alien.c-types alien.data colors help.markup +help.syntax kernel opengl opengl.gl sequences math.vectors +ui.gadgets ui.pens specialized-arrays ; SPECIALIZED-ARRAY: float IN: ui.pens.polygon @@ -17,7 +17,7 @@ boundary-count ; dup first suffix ; : ( color points -- polygon ) - dup close-path [ [ concat >float-array ] [ length ] bi ] bi@ + dup close-path [ [ concat float >c-array ] [ length ] bi ] bi@ polygon boa ; M: polygon draw-boundary diff --git a/basis/ui/pixel-formats/pixel-formats.factor b/basis/ui/pixel-formats/pixel-formats.factor index abc857c566..c0a645629b 100644 --- a/basis/ui/pixel-formats/pixel-formats.factor +++ b/basis/ui/pixel-formats/pixel-formats.factor @@ -1,6 +1,6 @@ -USING: alien.c-types accessors assocs classes destructors -functors kernel lexer math parser sequences specialized-arrays -ui.backend words ; +USING: alien.c-types alien.data accessors assocs classes +destructors functors kernel lexer math parser sequences +specialized-arrays ui.backend words ; SPECIALIZED-ARRAY: int IN: ui.pixel-formats @@ -82,7 +82,7 @@ M: pixel-format-attribute >PFA [ drop { } ] if* ; : >PFA-int-array ( attribute -- int-array ) - [ >PFA ] map concat PERM prepend 0 suffix >int-array ; + [ >PFA ] map concat PERM prepend 0 suffix int >c-array ; ;FUNCTOR diff --git a/basis/windows/com/wrapper/wrapper.factor b/basis/windows/com/wrapper/wrapper.factor index 20de2a9e4e..e4601a1de2 100644 --- a/basis/windows/com/wrapper/wrapper.factor +++ b/basis/windows/com/wrapper/wrapper.factor @@ -158,5 +158,5 @@ M: com-wrapper dispose* : com-wrap ( object wrapper -- wrapped-object ) [ vtbls>> ] [ (malloc-wrapped-object) ] bi - [ over length 0 swap copy ] keep + [ over length void* 0 swap copy ] keep [ +wrapped-objects+ get-global set-at ] keep ; diff --git a/basis/windows/directx/dinput/constants/constants.factor b/basis/windows/directx/dinput/constants/constants.factor index bd4ac93feb..1c8e0a3087 100755 --- a/basis/windows/directx/dinput/constants/constants.factor +++ b/basis/windows/directx/dinput/constants/constants.factor @@ -62,7 +62,7 @@ M: array array-base-type first ; : make-DIOBJECTDATAFORMAT-array-quot ( struct arr -- quot ) [ nip length ] [ make-DIOBJECTDATAFORMAT-arrays ] 2bi '[ - _ malloc-DIOBJECTDATAFORMAT-array + _ DIOBJECTDATAFORMAT malloc-array [ _ dup byte-length memcpy ] [ _ [ get >>pguid drop ] 2each ] [ ] tri diff --git a/basis/windows/shell32/shell32.factor b/basis/windows/shell32/shell32.factor index 1b1d1b4f09..f3db3bc4af 100644 --- a/basis/windows/shell32/shell32.factor +++ b/basis/windows/shell32/shell32.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2006, 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: alien alien.c-types alien.strings alien.syntax +USING: alien alien.c-types alien.data alien.strings alien.syntax classes.struct combinators io.encodings.utf16n io.files io.pathnames kernel windows.errors windows.com windows.com.syntax windows.types windows.user32 @@ -89,7 +89,7 @@ ALIAS: ShellExecute ShellExecuteW : shell32-directory ( n -- str ) f swap f SHGFP_TYPE_DEFAULT - MAX_UNICODE_PATH + MAX_UNICODE_PATH ushort [ SHGetFolderPath drop ] keep utf16n alien>string ; : desktop ( -- str ) @@ -224,4 +224,4 @@ FUNCTION: HRESULT SHGetDesktopFolder ( IShellFolder** ppshf ) ; FUNCTION: UINT DragQueryFileW ( HDROP hDrop, UINT iFile, LPWSTR lpszFile, UINT cch ) ; ALIAS: DragQueryFile DragQueryFileW -FUNCTION: BOOL IsUserAnAdmin ( ) ; \ No newline at end of file +FUNCTION: BOOL IsUserAnAdmin ( ) ; diff --git a/basis/windows/streams/streams.factor b/basis/windows/streams/streams.factor index 2f3eef6324..1109692168 100644 --- a/basis/windows/streams/streams.factor +++ b/basis/windows/streams/streams.factor @@ -1,6 +1,6 @@ -USING: accessors alien.c-types classes.struct combinators -continuations io kernel libc literals locals sequences -specialized-arrays windows.com memoize +USING: accessors alien.c-types alien.data classes.struct +combinators continuations io kernel libc literals locals +sequences specialized-arrays windows.com memoize windows.com.wrapper windows.kernel32 windows.ole32 windows.types ; IN: windows.streams @@ -24,7 +24,7 @@ SPECIALIZED-ARRAY: uchar :: IStream-write ( stream pv cb out-written -- hresult ) [ - pv cb stream stream-write + pv cb uchar stream stream-write out-written [ cb out-written 0 ULONG set-alien-value ] when S_OK ] with-hresult ; inline diff --git a/basis/x11/xim/xim.factor b/basis/x11/xim/xim.factor index b9248bac05..5fd42fd77e 100644 --- a/basis/x11/xim/xim.factor +++ b/basis/x11/xim/xim.factor @@ -41,7 +41,7 @@ SYMBOL: keybuf SYMBOL: keysym : prepare-lookup ( -- ) - buf-size keybuf set + buf-size uint keybuf set 0 KeySym keysym set ; : finish-lookup ( len -- string keysym ) diff --git a/core/io/files/files-tests.factor b/core/io/files/files-tests.factor index 8b578750bc..d8ba53347b 100644 --- a/core/io/files/files-tests.factor +++ b/core/io/files/files-tests.factor @@ -1,4 +1,4 @@ -USING: alien alien.c-types arrays classes.struct +USING: alien alien.c-types alien.data arrays classes.struct debugger.threads destructors generic.single io io.directories io.encodings.8-bit.latin1 io.encodings.ascii io.encodings.binary io.encodings.string io.files @@ -80,7 +80,7 @@ IN: io.files.tests "test.txt" temp-file binary [ 3 4 * read ] with-file-reader - int-array-cast + int cast-array ] unit-test [ ] [ @@ -117,7 +117,7 @@ CONSTANT: pt-array-1 [ t ] [ "test.txt" temp-file binary file-contents - pt-array-cast + pt cast-array pt-array-1 rest-slice sequence= ] unit-test diff --git a/core/io/streams/byte-array/byte-array-tests.factor b/core/io/streams/byte-array/byte-array-tests.factor index c220121402..2dd86d97cf 100644 --- a/core/io/streams/byte-array/byte-array-tests.factor +++ b/core/io/streams/byte-array/byte-array-tests.factor @@ -1,6 +1,6 @@ USING: tools.test io.streams.byte-array io.encodings.binary io.encodings.utf8 io kernel arrays strings namespaces math -specialized-arrays alien.c-types io.encodings.ascii ; +specialized-arrays alien.c-types alien.data io.encodings.ascii ; SPECIALIZED-ARRAY: int IN: io.streams.byte-array.tests @@ -55,5 +55,5 @@ IN: io.streams.byte-array.tests ! Writing specialized arrays to byte writers [ int-array{ 1 2 3 } ] [ binary [ int-array{ 1 2 3 } write ] with-byte-writer - int-array-cast + int cast-array ] unit-test diff --git a/core/io/streams/c/c-tests.factor b/core/io/streams/c/c-tests.factor index 63a56b4af1..038f44d99d 100644 --- a/core/io/streams/c/c-tests.factor +++ b/core/io/streams/c/c-tests.factor @@ -1,6 +1,6 @@ USING: tools.test io.files io.files.temp io io.streams.c io.encodings.ascii strings destructors kernel specialized-arrays -alien.c-types math ; +alien.c-types math alien.data ; SPECIALIZED-ARRAY: int IN: io.streams.c.tests @@ -31,7 +31,7 @@ IN: io.streams.c.tests "test.txt" temp-file "rb" fopen [ 3 4 * read ] with-input-stream - int-array-cast + int cast-array ] unit-test ! Writing strings to binary streams should fail diff --git a/extra/alien/data/map/map-tests.factor b/extra/alien/data/map/map-tests.factor index 67e7b5f22e..5e8b6d666d 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 locals math.vectors +USING: alien.data alien.data.map fry generalizations kernel locals math.vectors math.vectors.conversion math math.vectors.simd math.ranges sequences specialized-arrays tools.test ; FROM: alien.c-types => uchar short int float ; @@ -9,7 +9,7 @@ IN: alien.data.map.tests [ float-array{ 1.0 1.0 3.0 3.0 5.0 5.0 } ] [ int-array{ 1 3 5 } [ dup ] data-map( int -- float[2] ) - float-array-cast + float cast-array ] unit-test [ @@ -20,7 +20,7 @@ IN: alien.data.map.tests } ] [ 3 iota [ float-4-with ] data-map( object -- float-4 ) - float-4-array-cast + float-4 cast-array ] unit-test [ @@ -31,7 +31,7 @@ IN: alien.data.map.tests } ] [ 12 iota [ float-4-boa ] data-map( object[4] -- float-4 ) - float-4-array-cast + float-4 cast-array ] unit-test [ float-array{ 1.0 1.0 3.0 3.0 5.0 5.0 0.0 0.0 } ] @@ -151,5 +151,5 @@ CONSTANT: plane-count 4 [ ] data-map( object -- float ) ; [ float-array{ 0.0 0.5 1.0 } ] -[ 2 data-map-compiler-bug-test float-array-cast ] +[ 2 data-map-compiler-bug-test float cast-array ] unit-test diff --git a/extra/audio/engine/engine.factor b/extra/audio/engine/engine.factor index 9932953822..3503cb8f96 100644 --- a/extra/audio/engine/engine.factor +++ b/extra/audio/engine/engine.factor @@ -118,7 +118,7 @@ ERROR: audio-context-not-available device-name ; al-context>> alcMakeContextCurrent drop ; inline : allocate-sources ( audio-engine -- sources ) - voice-count>> dup (uint-array) [ alGenSources ] keep ; inline + voice-count>> dup c:uint (c-array) [ alGenSources ] keep ; inline :: flush-source ( al-source -- ) al-source alSourceStop @@ -277,7 +277,7 @@ M: audio-engine dispose* audio-engine get-available-source :> al-source al-source [ - buffer-count dup (uint-array) [ alGenBuffers ] keep :> al-buffers + buffer-count dup c:uint (c-array) [ alGenBuffers ] keep :> al-buffers generator generator-audio-format :> ( channels sample-bits sample-rate ) streaming-audio-clip new-disposable diff --git a/extra/audio/vorbis/vorbis.factor b/extra/audio/vorbis/vorbis.factor index 2ae957812e..d8036b4ee0 100644 --- a/extra/audio/vorbis/vorbis.factor +++ b/extra/audio/vorbis/vorbis.factor @@ -4,9 +4,9 @@ byte-arrays classes.struct combinators destructors fry io io.files io.encodings.binary kernel libc locals make math math.order math.parser ogg ogg.vorbis sequences specialized-arrays specialized-vectors ; -FROM: alien.c-types => float short void* ; -SPECIALIZED-ARRAYS: float void* ; -SPECIALIZED-VECTOR: short +QUALIFIED-WITH: alien.c-types c +SPECIALIZED-ARRAYS: c:float c:void* ; +SPECIALIZED-VECTOR: c:short IN: audio.vorbis TUPLE: vorbis-stream < disposable @@ -166,15 +166,15 @@ ERROR: no-vorbis-in-ogg ; vorbis-stream buffer>> :> buffer buffer length -1 shift :> buffer-length offset -1 shift :> sample-offset - buffer buffer-length sample-offset short-vector boa :> short-buffer + buffer buffer-length c:short sample-offset short-vector boa :> short-buffer vorbis-stream info>> channels>> :> #channels buffer-length sample-offset - #channels /i :> max-len len max-len min :> len' - pcm #channels :> channel*s + pcm #channels void* :> channel*s len' iota [| sample | #channels iota [| channel | - channel channel*s nth len + channel channel*s nth len c:float sample swap nth float>short-sample short-buffer push ] each diff --git a/extra/benchmark/fasta/fasta.factor b/extra/benchmark/fasta/fasta.factor index f1ebc2aa9f..a30e427e45 100644 --- a/extra/benchmark/fasta/fasta.factor +++ b/extra/benchmark/fasta/fasta.factor @@ -1,7 +1,7 @@ ! Based on http://shootout.alioth.debian.org/gp4/benchmark.php?test=fasta&lang=java&id=2 USING: assocs benchmark.reverse-complement byte-arrays fry io io.encodings.ascii io.files locals kernel math sequences -sequences.private specialized-arrays strings typed ; +sequences.private specialized-arrays strings typed alien.data ; QUALIFIED-WITH: alien.c-types c SPECIALIZED-ARRAY: c:double IN: benchmark.fasta @@ -47,7 +47,7 @@ CONSTANT: homo-sapiens TYPED: make-cumulative ( freq -- chars: byte-array floats: double-array ) [ keys >byte-array ] - [ values >double-array unclip [ + ] accumulate swap suffix ] bi ; + [ values c:double >c-array unclip [ + ] accumulate swap suffix ] bi ; :: select-random ( seed chars floats -- seed elt ) seed random floats [ <= ] with find drop chars nth-unsafe ; inline diff --git a/extra/benchmark/spectral-norm-simd/spectral-norm-simd.factor b/extra/benchmark/spectral-norm-simd/spectral-norm-simd.factor index ce91813f9d..7a762f3935 100644 --- a/extra/benchmark/spectral-norm-simd/spectral-norm-simd.factor +++ b/extra/benchmark/spectral-norm-simd/spectral-norm-simd.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2010 Marc Fauconneau. ! See http://factorcode.org/license.txt for BSD license. -USING: alien.c-types specialized-arrays kernel math +USING: alien.c-types alien.data specialized-arrays kernel math math.functions math.vectors sequences sequences.private prettyprint words typed locals math.vectors.simd math.vectors.simd.cords ; @@ -43,10 +43,10 @@ IN: benchmark.spectral-norm-simd [ swap nth-unsafe ] [ eval4-A' ] bi-curry bi* n*v ; inline : eval-At-times-u ( u n -- seq ) - [ double-array-cast ] dip [ (eval-At-times-u) ] inner-loop ; inline + [ double cast-array ] dip [ (eval-At-times-u) ] inner-loop ; inline : eval-AtA-times-u ( u n -- seq ) - [ double-array-cast ] dip [ eval-A-times-u ] [ eval-At-times-u ] bi ; inline + [ double cast-array ] dip [ eval-A-times-u ] [ eval-At-times-u ] bi ; inline : ones ( n -- seq ) 4 /i [ double-4{ 1.0 1.0 1.0 1.0 } ] double-4-array{ } replicate-as ; inline @@ -60,7 +60,7 @@ IN: benchmark.spectral-norm-simd ] times ; inline TYPED: spectral-norm ( n: fixnum -- norm ) - u/v [ double-array-cast ] bi@ [ v. ] [ norm-sq ] bi /f sqrt ; + u/v [ double cast-array ] bi@ [ v. ] [ norm-sq ] bi /f sqrt ; : spectral-norm-main ( -- ) 2000 spectral-norm . ; diff --git a/extra/benchmark/struct-arrays/struct-arrays.factor b/extra/benchmark/struct-arrays/struct-arrays.factor index 942f78a483..36c113b5ff 100644 --- a/extra/benchmark/struct-arrays/struct-arrays.factor +++ b/extra/benchmark/struct-arrays/struct-arrays.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors classes.struct combinators.smart fry kernel -math math.functions math.order math.parser sequences +USING: accessors alien.data classes.struct combinators.smart +fry kernel math math.functions math.order math.parser sequences specialized-arrays io ; FROM: alien.c-types => float ; IN: benchmark.struct-arrays @@ -22,7 +22,7 @@ SPECIALIZED-ARRAY: point 1 + ; inline : make-points ( len -- points ) - dup 0 [ init-point ] reduce drop ; inline + point dup 0 [ init-point ] reduce drop ; inline : point-norm ( point -- norm ) [ xyz [ absq ] tri@ ] sum-outputs sqrt ; inline diff --git a/extra/bunny/model/model.factor b/extra/bunny/model/model.factor index a82de2044d..00009981ec 100644 --- a/extra/bunny/model/model.factor +++ b/extra/bunny/model/model.factor @@ -2,7 +2,7 @@ USING: accessors alien.c-types arrays combinators destructors http.client io io.encodings.ascii io.files io.files.temp kernel locals math math.matrices math.parser math.vectors opengl opengl.capabilities opengl.gl opengl.demo-support sequences -splitting vectors words specialized-arrays ; +splitting vectors words specialized-arrays alien.data ; FROM: sequences => change-nth ; QUALIFIED-WITH: alien.c-types c SPECIALIZED-ARRAY: c:float @@ -72,11 +72,11 @@ TUPLE: bunny-buffers array element-array nv ni ; { [ [ first concat ] [ second concat ] bi - append >float-array underlying>> + append c:float >c-array underlying>> GL_ARRAY_BUFFER swap GL_STATIC_DRAW ] [ - third concat >uint-array underlying>> + third concat c:uint >c-array underlying>> GL_ELEMENT_ARRAY_BUFFER swap GL_STATIC_DRAW ] [ first length 3 * ] diff --git a/extra/chipmunk/demo/demo.factor b/extra/chipmunk/demo/demo.factor index f27d40cc53..1f30d93bdc 100644 --- a/extra/chipmunk/demo/demo.factor +++ b/extra/chipmunk/demo/demo.factor @@ -1,9 +1,9 @@ ! Copyright (C) 2010 Erik Charlebois ! See http:// factorcode.org/license.txt for BSD license. -USING: accessors alien alien.c-types chipmunk.ffi classes.struct -game.loop game.worlds kernel literals locals math method-chains -opengl.gl random sequences specialized-arrays ui -ui.gadgets.worlds ui.pixel-formats ; +USING: accessors alien alien.c-types alien.data chipmunk.ffi +classes.struct game.loop game.worlds kernel literals locals +math method-chains opengl.gl random sequences specialized-arrays +ui ui.gadgets.worlds ui.pixel-formats ; SPECIALIZED-ARRAY: void* IN: chipmunk.demo @@ -81,7 +81,7 @@ M:: chipmunk-world draw-world* ( world -- ) 0 0 0 glColor3f GL_POINTS glBegin space bodies>> - [ num>> ] [ arr>> swap ] bi [ + [ num>> ] [ arr>> swap void* ] bi [ cpBody memory>struct p>> [ x>> ] [ y>> ] bi glVertex2f ] each glEnd @@ -90,9 +90,9 @@ M:: chipmunk-world draw-world* ( world -- ) 1 0 0 glColor3f GL_POINTS glBegin space arbiters>> - [ num>> ] [ arr>> swap ] bi [ + [ num>> ] [ arr>> swap void* ] bi [ cpArbiter memory>struct - [ numContacts>> ] [ contacts>> >c-ptr swap ] bi [ + [ numContacts>> ] [ contacts>> >c-ptr swap cpContact ] bi [ p>> [ x>> ] [ y>> ] bi glVertex2f ] each ] each diff --git a/extra/chipmunk/ffi/ffi.factor b/extra/chipmunk/ffi/ffi.factor index ea7c6fbd1a..f28b0467b6 100644 --- a/extra/chipmunk/ffi/ffi.factor +++ b/extra/chipmunk/ffi/ffi.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2010 Erik Charlebois ! See http:// factorcode.org/license.txt for BSD license. -USING: accessors alien alien.c-types alien.libraries +USING: accessors alien alien.c-types alien.data alien.libraries alien.syntax classes.struct combinators combinators.short-circuit kernel math math.order sequences typed specialized-arrays locals system ; @@ -442,17 +442,17 @@ FUNCTION: int cpPolyShapeGetNumVerts ( cpShape* shape ) ; FUNCTION: cpVect cpPolyShapeGetVert ( cpShape* shape, int idx ) ; TYPED: cpPolyShapeValueOnAxis ( poly: cpPolyShape n: cpVect d -- min-dist ) - swap rot [ numVerts>> ] [ tVerts>> swap ] bi swap + swap rot [ numVerts>> ] [ tVerts>> swap cpVect ] bi swap [ cpvdot ] curry [ min ] reduce swap - ; inline TYPED: cpPolyShapeContainsVert ( poly: cpPolyShape v: cpVect -- ? ) - swap [ numVerts>> ] [ tAxes>> swap ] bi swap + swap [ numVerts>> ] [ tAxes>> swap cpPolyShapeAxis ] bi swap [ [ [ n>> ] dip cpvdot ] [ drop d>> ] 2bi - ] curry [ max ] reduce 0.0 <= ; inline TYPED: cpPolyShapeContainsVertPartial ( poly: cpPolyShape v: cpVect n: cpVect -- ? ) - rot [ numVerts>> ] [ tAxes>> swap ] bi -rot + rot [ numVerts>> ] [ tAxes>> swap cpPolyShapeAxis ] bi -rot [| axis v n | axis n>> n cpvdot 0.0 < 0 [ 0.0 ] @@ -527,7 +527,7 @@ TYPED: cpArbiterGetNormal ( arb: cpArbiter i -- n: cpVect ) [ swap [ numContacts>> ] - [ contacts>> swap ] bi nth cpContact memory>struct n>> + [ contacts>> swap void* ] bi nth cpContact memory>struct n>> ] [ drop swappedColl>> 0 = [ ] [ cpvneg ] if @@ -536,7 +536,7 @@ TYPED: cpArbiterGetNormal ( arb: cpArbiter i -- n: cpVect ) TYPED: cpArbiterGetPoint ( arb: cpArbiter i -- p: cpVect ) swap [ numContacts>> ] - [ contacts>> swap ] bi + [ contacts>> swap void* ] bi nth cpContact memory>struct p>> ; inline ! cpCollision.h diff --git a/extra/elf/elf.factor b/extra/elf/elf.factor index b1cbb17289..96c86b474f 100644 --- a/extra/elf/elf.factor +++ b/extra/elf/elf.factor @@ -1,8 +1,9 @@ ! Copyright (C) 2010 Erik Charlebois. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors alien alien.c-types alien.strings alien.syntax arrays -classes.struct fry io.encodings.ascii io.mmap kernel locals math -math.intervals sequences specialized-arrays strings typed assocs ; +USING: accessors alien alien.c-types alien.data alien.strings +alien.syntax arrays classes.struct fry io.encodings.ascii +io.mmap kernel locals math math.intervals sequences +specialized-arrays strings typed assocs ; IN: elf ! FFI data @@ -482,15 +483,15 @@ TYPED:: elf-section-headers ( elf: Elf32/64_Ehdr -- headers: Elf32/64_Shdr-array elf [ e_shoff>> ] [ e_shnum>> ] bi :> ( off num ) off elf >c-ptr num elf 64-bit? - [ ] - [ ] if ; + [ Elf64_Shdr ] + [ Elf32_Shdr ] if ; TYPED:: elf-program-headers ( elf: Elf32/64_Ehdr -- headers: Elf32/64_Phdr-array ) elf [ e_phoff>> ] [ e_phnum>> ] bi :> ( off num ) off elf >c-ptr num elf 64-bit? - [ ] - [ ] if ; + [ Elf64_Phdr ] + [ Elf32_Phdr ] if ; TYPED: elf-loadable-segments ( headers: Elf32/64_Phdr-array -- headers: Elf32/64_Phdr-array ) [ p_type>> PT_LOAD = ] filter ; @@ -517,10 +518,10 @@ TYPED:: virtual-address-section ( elf: Elf32/64_Ehdr address -- section-header/f ] filter [ f ] [ first ] if-empty ; TYPED:: elf-segment-data ( elf: Elf32/64_Ehdr header: Elf32/64_Phdr -- uchar-array/f ) - header [ p_offset>> elf >c-ptr ] [ p_filesz>> ] bi ; + header [ p_offset>> elf >c-ptr ] [ p_filesz>> ] bi uchar ; TYPED:: elf-section-data ( elf: Elf32/64_Ehdr header: Elf32/64_Shdr -- uchar-array/f ) - header [ sh_offset>> elf >c-ptr ] [ sh_size>> ] bi ; + header [ sh_offset>> elf >c-ptr ] [ sh_size>> ] bi uchar ; TYPED:: elf-section-data-by-index ( elf: Elf32/64_Ehdr index -- header/f uchar-array/f ) elf elf-section-headers :> sections @@ -554,8 +555,8 @@ TYPED:: elf-symbols ( elf: Elf32/64_Ehdr section-data: uchar-array -- symbols ) elf ".strtab" elf-section-data-by-name nip >c-ptr :> strings section-data [ >c-ptr ] [ length ] bi elf 64-bit? - [ Elf64_Sym heap-size / ] - [ Elf32_Sym heap-size / ] if + [ Elf64_Sym heap-size / Elf64_Sym ] + [ Elf32_Sym heap-size / Elf32_Sym ] if [ [ st_name>> strings ascii alien>string ] keep 2array ] { } map-as ; ! High level interface @@ -608,7 +609,7 @@ M:: segment sections ( segment -- sections ) symbol [ elf-header>> ] [ sym>> st_value>> ] bi virtual-address-segment :> segment symbol sym>> st_value>> segment p_vaddr>> - segment p_offset>> + :> faddress faddress symbol elf-header>> >c-ptr - symbol sym>> st_size>> ; + symbol sym>> st_size>> uchar ; : find-section ( sections name -- section/f ) '[ name>> _ = ] find nip ; inline diff --git a/extra/fluids/fluids.factor b/extra/fluids/fluids.factor index f76ee063cd..87fa4b93e7 100644 --- a/extra/fluids/fluids.factor +++ b/extra/fluids/fluids.factor @@ -6,7 +6,7 @@ gpu.render gpu.shaders gpu.state gpu.textures gpu.util images images.loader kernel literals locals make math math.rectangles math.vectors namespaces opengl.gl sequences specialized-arrays ui.gadgets.worlds ui.gestures ui.pixel-formats gpu.effects.step -images.pgm images.ppm ; +images.pgm images.ppm alien.data ; FROM: alien.c-types => float ; SPECIALIZED-ARRAY: float IN: fluids @@ -113,8 +113,8 @@ GAME: fluids { fluids-world H{ { T{ button-down } [ [ - hand-loc get >float-array - world get dim>> >float-array v/ 2 v*n 1 v-n { 1 -1 } v* + hand-loc get float >c-array + world get dim>> float >c-array v/ 2 v*n 1 v-n { 1 -1 } v* float-array{ 0 0.2 } 2.0 particle_t suffix ] change-particles drop ] } } set-gestures diff --git a/extra/game/debug/debug.factor b/extra/game/debug/debug.factor index a4f4895812..1bdc3fc295 100644 --- a/extra/game/debug/debug.factor +++ b/extra/game/debug/debug.factor @@ -1,9 +1,10 @@ ! Copyright (C) 2010 Erik Charlebois ! See http://factorcode.org/license.txt for BSD license. -USING: accessors alien.c-types arrays circular colors colors.constants -columns destructors fonts gpu.buffers gpu.render gpu.shaders gpu.state -gpu.textures images kernel literals locals make math math.constants -math.functions math.vectors sequences specialized-arrays typed ui.text fry ; +USING: accessors alien.c-types alien.data arrays circular colors +colors.constants columns destructors fonts gpu.buffers +gpu.render gpu.shaders gpu.state gpu.textures images kernel +literals locals make math math.constants math.functions +math.vectors sequences specialized-arrays typed ui.text fry ; FROM: alien.c-types => float ; SPECIALIZED-ARRAYS: float uint ; IN: game.debug @@ -108,7 +109,7 @@ CONSTANT: debug-text-texture-parameters image upside-down?>> [ { x0 y0 0 0 x1 y0 1 0 x1 y1 1 1 x0 y1 0 1 } ] [ { x0 y0 0 1 x1 y0 1 1 x1 y1 1 0 x0 y1 0 0 } ] - if >float-array ; + if float >c-array ; : debug-text-uniform-variables ( string color -- image uniforms ) text>image dup image>texture diff --git a/extra/game/models/collada/collada.factor b/extra/game/models/collada/collada.factor index bb7c73c2c7..45a47d814c 100644 --- a/extra/game/models/collada/collada.factor +++ b/extra/game/models/collada/collada.factor @@ -1,12 +1,12 @@ ! Copyright (C) 2010 Erik Charlebois ! See http://factorcode.org/license.txt for BSD license. -USING: accessors arrays assocs grouping hashtables kernel locals -math math.parser sequences sequences.deep -specialized-arrays.instances.alien.c-types.float -specialized-arrays.instances.alien.c-types.uint splitting xml -xml.data xml.traversal math.order namespaces combinators images -gpu.shaders io make game.models game.models.util -io.encodings.ascii game.models.loader ; +USING: accessors alien.c-types alien.data arrays assocs grouping +hashtables kernel locals math math.parser sequences sequences.deep +splitting xml xml.data xml.traversal math.order namespaces +combinators images gpu.shaders io make game.models game.models.util +io.encodings.ascii game.models.loader specialized-arrays ; +QUALIFIED-WITH: alien.c-types c +SPECIALIZED-ARRAYS: c:float c:uint ; IN: game.models.collada SINGLETON: collada-models @@ -150,8 +150,8 @@ VERTEX-FORMAT: collada-vertex-format ] [ soa>aos - [ flatten >float-array ] - [ flatten >uint-array ] + [ flatten c:float >c-array ] + [ flatten c:uint >c-array ] bi* collada-vertex-format f model boa ] bi ; diff --git a/extra/game/models/obj/obj.factor b/extra/game/models/obj/obj.factor index 9b91b8fcf7..1f1877ef4f 100644 --- a/extra/game/models/obj/obj.factor +++ b/extra/game/models/obj/obj.factor @@ -2,11 +2,11 @@ ! See http://factorcode.org/license.txt for BSD license. USING: io io.encodings.ascii math.parser sequences splitting kernel assocs io.files combinators math.order math namespaces -arrays sequences.deep accessors -specialized-arrays.instances.alien.c-types.float -specialized-arrays.instances.alien.c-types.uint game.models -game.models.util gpu.shaders images game.models.loader -prettyprint ; +arrays sequences.deep accessors alien.c-types alien.data +game.models game.models.util gpu.shaders images game.models.loader +prettyprint specialized-arrays ; +QUALIFIED-WITH: alien.c-types c +SPECIALIZED-ARRAYS: c:float c:uint ; IN: game.models.obj SINGLETON: obj-models @@ -125,8 +125,8 @@ VERTEX-FORMAT: obj-vertex-format : push-current-model ( -- ) current-model get [ - [ dseq>> flatten >float-array ] - [ iseq>> flatten >uint-array ] + [ dseq>> flatten c:float >c-array ] + [ iseq>> flatten c:uint >c-array ] bi obj-vertex-format current-material get model boa models get push V{ } V{ } H{ } current-model set ] unless-empty ; diff --git a/extra/gpu/framebuffers/framebuffers.factor b/extra/gpu/framebuffers/framebuffers.factor index 9a594c1cd0..76f46e4fa7 100644 --- a/extra/gpu/framebuffers/framebuffers.factor +++ b/extra/gpu/framebuffers/framebuffers.factor @@ -281,8 +281,8 @@ M: opengl-2 (clear-integer-color-attachment) M: opengl-3 (clear-integer-color-attachment) [ GL_COLOR 0 ] dip 4 0 pad-tail swap { - { int-type [ >int-array glClearBufferiv ] } - { uint-type [ >uint-array glClearBufferuiv ] } + { int-type [ int >c-array glClearBufferiv ] } + { uint-type [ uint >c-array glClearBufferuiv ] } } case ; :: (clear-color-attachment) ( type attachment value -- ) diff --git a/extra/gpu/render/render.factor b/extra/gpu/render/render.factor index 10bddc3752..ed75f218de 100755 --- a/extra/gpu/render/render.factor +++ b/extra/gpu/render/render.factor @@ -293,13 +293,13 @@ GENERIC: bind-uniform-vec4 ( index sequence -- ) M: object >uniform-bool-array [ >c-bool ] int-array{ } map-as ; inline M: binary-data >uniform-bool-array ; inline -M: object >uniform-int-array >int-array ; inline +M: object >uniform-int-array c:int >c-array ; inline M: binary-data >uniform-int-array ; inline -M: object >uniform-uint-array >uint-array ; inline +M: object >uniform-uint-array c:uint >c-array ; inline M: binary-data >uniform-uint-array ; inline -M: object >uniform-float-array >float-array ; inline +M: object >uniform-float-array c:float >c-array ; inline M: binary-data >uniform-float-array ; inline M: object >uniform-bvec-array '[ _ head-slice [ >c-bool ] int-array{ } map-as ] map concat ; inline @@ -316,7 +316,7 @@ M: binary-data >uniform-vec-array drop ; inline M:: object >uniform-matrix ( sequence cols rows -- c-array ) sequence flip cols head-slice - [ rows head-slice >float-array ] { } map-as concat ; inline + [ rows head-slice c:float >c-array ] { } map-as concat ; inline M: binary-data >uniform-matrix 2drop ; inline M: object >uniform-matrix-array @@ -549,7 +549,7 @@ SYNTAX: UNIFORM-TUPLE: [ gl-attachment ] with map dup length 1 = [ first glDrawBuffer ] - [ [ length ] [ >int-array ] bi glDrawBuffers ] if ; + [ [ length ] [ c:int >c-array ] bi glDrawBuffers ] if ; : bind-named-output-attachments ( program-instance framebuffer attachments -- ) rot '[ first _ swap output-index ] sort-with values diff --git a/extra/gpu/state/state.factor b/extra/gpu/state/state.factor index 31a8678060..5cc4b72125 100755 --- a/extra/gpu/state/state.factor +++ b/extra/gpu/state/state.factor @@ -425,9 +425,9 @@ M: mask-state set-gpu-state* : get-gl-bools ( enum count -- value ) [ glGetBooleanv ] keep [ c-bool> ] { } map-as ; : get-gl-ints ( enum count -- value ) - [ glGetIntegerv ] keep ; + int [ glGetIntegerv ] keep ; : get-gl-floats ( enum count -- value ) - [ glGetFloatv ] keep ; + c:float [ glGetFloatv ] keep ; : get-gl-rect ( enum -- value ) 4 get-gl-ints first4 [ 2array ] 2bi@ ; diff --git a/extra/graphviz/ffi/ffi.factor b/extra/graphviz/ffi/ffi.factor index d0ca4ca8ae..c1dcff4f03 100644 --- a/extra/graphviz/ffi/ffi.factor +++ b/extra/graphviz/ffi/ffi.factor @@ -147,7 +147,7 @@ FUNCTION: char** f gvPluginList &(free) :> ret size* int deref :> size - ret size [ + ret size void* [ &(free) ascii alien>string ] { } map-as ] with-destructors ; diff --git a/extra/grid-meshes/grid-meshes-tests.factor b/extra/grid-meshes/grid-meshes-tests.factor index 0b6275dba0..e39d9d7f5a 100644 --- a/extra/grid-meshes/grid-meshes-tests.factor +++ b/extra/grid-meshes/grid-meshes-tests.factor @@ -1,5 +1,5 @@ IN: grid-meshes.tests -USING: alien.c-types grid-meshes grid-meshes.private +USING: alien.c-types alien.data grid-meshes grid-meshes.private specialized-arrays tools.test ; SPECIALIZED-ARRAY: float @@ -18,4 +18,4 @@ SPECIALIZED-ARRAY: float 1.0 0.0 0.5 1.0 1.0 0.0 1.0 1.0 } -] [ { 2 2 } vertex-array float-array-cast ] unit-test +] [ { 2 2 } vertex-array float cast-array ] unit-test diff --git a/extra/images/bitmap/bitmap.factor b/extra/images/bitmap/bitmap.factor index 71aaf7b4ec..b2fa51745d 100644 --- a/extra/images/bitmap/bitmap.factor +++ b/extra/images/bitmap/bitmap.factor @@ -1,10 +1,11 @@ ! Copyright (C) 2007, 2009 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors alien.c-types arrays byte-arrays combinators -compression.run-length fry grouping images images.loader -images.normalization io io.binary io.encodings.8-bit.latin1 -io.encodings.string kernel math math.bitwise sequences -specialized-arrays summary io.streams.throwing ; +USING: accessors alien.c-types alien.data arrays byte-arrays +combinators compression.run-length fry grouping images +images.loader images.normalization io io.binary +io.encodings.8-bit.latin1 io.encodings.string kernel math +math.bitwise sequences specialized-arrays summary +io.streams.throwing ; QUALIFIED-WITH: bitstreams b SPECIALIZED-ARRAYS: uint ushort ; IN: images.bitmap @@ -279,7 +280,7 @@ ERROR: bmp-not-supported n ; { 24 [ color-index>> ] } { 16 [ [ - ! ushort-array-cast + ! ushort cast-array 2 group [ le> ] map ! 5 6 5 ! { HEX: f800 HEX: 7e0 HEX: 1f } uncompress-bitfield @@ -310,7 +311,7 @@ M: unsupported-bitfield-widths summary dup header>> bit-count>> { { 16 [ dup bitfields>> '[ - ushort-array-cast _ uncompress-bitfield + ushort cast-array _ uncompress-bitfield ] change-color-index ] } { 32 [ ] } diff --git a/extra/libusb/libusb.factor b/extra/libusb/libusb.factor index a5abc72790..4d6202cad0 100644 --- a/extra/libusb/libusb.factor +++ b/extra/libusb/libusb.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2010 Erik Charlebois. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors alien alien.c-types alien.libraries +USING: accessors alien alien.c-types alien.data alien.libraries alien.syntax classes.struct combinators endian io.binary kernel locals math sequences specialized-arrays system unix.time unix.types ; @@ -341,7 +341,7 @@ FUNCTION: void libusb_free_transfer ( libusb_transfer* transfer ) ; : libusb_set_iso_packet_lengths ( transfer length -- ) [ [ iso_packet_desc>> >c-ptr ] [ num_iso_packets>> ] bi - + libusb_iso_packet_descriptor ] dip [ >>length drop ] curry each ; inline :: libusb_get_iso_packet_buffer ( transfer packet -- data ) @@ -351,7 +351,7 @@ FUNCTION: void libusb_free_transfer ( libusb_transfer* transfer ) ; transfer [ iso_packet_desc>> >c-ptr ] [ num_iso_packets>> ] bi - 0 + libusb_iso_packet_descriptor 0 [ length>> + ] reduce transfer buffer>> ] if ; @@ -363,7 +363,7 @@ FUNCTION: void libusb_free_transfer ( libusb_transfer* transfer ) ; 0 transfer [ iso_packet_desc>> >c-ptr ] [ num_iso_packets>> ] bi - nth + libusb_iso_packet_descriptor nth length>> packet * transfer buffer>> ] if ; diff --git a/extra/llvm/invoker/invoker.factor b/extra/llvm/invoker/invoker.factor index 9d6bfc8a5a..20fb7e8f62 100644 --- a/extra/llvm/invoker/invoker.factor +++ b/extra/llvm/invoker/invoker.factor @@ -1,10 +1,11 @@ ! Copyright (C) 2009 Matthew Willis. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors alien arrays assocs compiler.units effects -io.backend io.pathnames kernel llvm.core llvm.jit llvm.reader -llvm.types make namespaces sequences specialized-arrays -vocabs words ; -SPECIALIZED-ARRAY: void* +USING: accessors alien alien.data arrays assocs compiler.units +effects io.backend io.pathnames kernel llvm.core llvm.jit +llvm.reader llvm.types make namespaces sequences +specialized-arrays vocabs words ; +QUALIFIED-WITH: alien.c-types c +SPECIALIZED-ARRAY: c:void* IN: llvm.invoker ! get function name, ret type, param types and names @@ -15,7 +16,7 @@ IN: llvm.invoker TUPLE: function name alien return params ; : params ( llvm-function -- param-list ) - dup LLVMCountParams + dup LLVMCountParams c:void* [ LLVMGetParams ] keep >array [ [ LLVMGetValueName ] [ LLVMTypeOf tref> ] bi 2array ] map ; @@ -52,5 +53,5 @@ TUPLE: function name alien return params ; : install-bc ( path -- ) [ normalize-path ] [ file-name ] bi [ load-into-jit ] keep install-module ; - + << "alien.llvm" create-vocab drop >> diff --git a/extra/llvm/types/types.factor b/extra/llvm/types/types.factor index 25995c389b..be23db36b3 100644 --- a/extra/llvm/types/types.factor +++ b/extra/llvm/types/types.factor @@ -1,9 +1,9 @@ ! Copyright (C) 2009 Matthew Willis. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors alien.c-types arrays combinators kernel -llvm.core locals math.parser math multiline namespaces parser -peg.ebnf sequences sequences.deep specialized-arrays strings -vocabs words ; +USING: accessors alien.c-types alien.data arrays combinators +kernel llvm.core locals math.parser math multiline namespaces +parser peg.ebnf sequences sequences.deep specialized-arrays +strings vocabs words ; SPECIALIZED-ARRAY: void* IN: llvm.types @@ -119,13 +119,13 @@ TUPLE: struct < enclosing types packed? ; swap >>packed? swap >>types ; M: struct (>tref)* - [ types>> [ (>tref) ] map >void*-array ] + [ types>> [ (>tref) ] map void* >c-array ] [ types>> length ] [ packed?>> 1 0 ? ] tri LLVMStructType ; M: struct clean* types>> [ clean ] each ; M: struct (tref>)* over LLVMIsPackedStruct 0 = not >>packed? - swap dup LLVMCountStructElementTypes + swap dup LLVMCountStructElementTypes void* [ LLVMGetStructElementTypes ] keep >array [ (tref>) ] map >>types ; @@ -148,7 +148,7 @@ TUPLE: function < enclosing return params vararg? ; M: function (>tref)* { [ return>> (>tref) ] - [ params>> [ (>tref) ] map >void*-array ] + [ params>> [ (>tref) ] map void* >c-array ] [ params>> length ] [ vararg?>> 1 0 ? ] } cleave LLVMFunctionType ; @@ -156,7 +156,7 @@ M: function clean* [ return>> clean ] [ params>> [ clean ] each ] bi ; M: function (tref>)* over LLVMIsFunctionVarArg 0 = not >>vararg? over LLVMGetReturnType (tref>) >>return - swap dup LLVMCountParamTypes + swap dup LLVMCountParamTypes void* [ LLVMGetParamTypes ] keep >array [ (tref>) ] map >>params ; diff --git a/extra/macho/macho.factor b/extra/macho/macho.factor index 3c0536dd9c..2b96829bbe 100644 --- a/extra/macho/macho.factor +++ b/extra/macho/macho.factor @@ -1,10 +1,10 @@ ! Copyright (C) 2010 Erik Charlebois. ! See http:// factorcode.org/license.txt for BSD license. -USING: accessors alien alien.c-types alien.strings alien.syntax -classes classes.struct combinators combinators.short-circuit -io.encodings.ascii io.encodings.string kernel literals make -math sequences specialized-arrays typed fry io.mmap formatting -locals splitting io.binary arrays ; +USING: accessors alien alien.c-types alien.data alien.strings +alien.syntax classes classes.struct combinators +combinators.short-circuit io.encodings.ascii io.encodings.string +kernel literals make math sequences specialized-arrays typed +fry io.mmap formatting locals splitting io.binary arrays ; FROM: alien.c-types => short ; IN: macho @@ -837,12 +837,12 @@ TYPED: fat-binary-members ( >c-ptr -- fat-binary-members ) } case dup [ >c-ptr fat_header heap-size swap ] [ nfat_arch>> 4 >be le> ] bi - [ + fat_arch [ { [ nip cputype>> 4 >be le> ] [ nip cpusubtype>> 4 >be le> ] [ offset>> 4 >be le> swap >c-ptr ] - [ nip size>> 4 >be le> ] + [ nip size>> 4 >be le> uchar ] } 2cleave fat-binary-member boa ] with { } map-as ; @@ -913,8 +913,8 @@ TYPED: load-commands ( macho: mach_header_32/64 -- load-commands ) [ nsects>> ] [ segment_command_64? ] } cleave - [ ] - [ ] if ; + [ section_64 ] + [ section ] if ; : sections-array ( segment-commands -- sections-array ) [ @@ -926,8 +926,8 @@ TYPED: load-commands ( macho: mach_header_32/64 -- load-commands ) : symbols ( mach-header symtab-command -- symbols string-table ) [ symoff>> swap >c-ptr ] [ nsyms>> swap 64-bit? - [ ] - [ ] if ] + [ nlist_64 ] + [ nlist ] if ] [ stroff>> swap >c-ptr ] 2tri ; : symbol-name ( symbol string-table -- name ) diff --git a/extra/noise/noise.factor b/extra/noise/noise.factor index 9417a868a0..adbedd974d 100644 --- a/extra/noise/noise.factor +++ b/extra/noise/noise.factor @@ -1,4 +1,4 @@ -USING: accessors alien.data.map byte-arrays combinators combinators.short-circuit +USING: accessors alien.data alien.data.map byte-arrays combinators combinators.short-circuit fry generalizations images kernel locals math math.constants math.functions math.libm math.matrices.simd math.vectors math.vectors.conversion math.vectors.simd memoize random random.mersenne-twister sequences sequences.private specialized-arrays @@ -124,7 +124,7 @@ MEMO: perlin-noise-map-coords ( dim -- coords ) TYPED:: perlin-noise-map ( table: byte-array transform: matrix4 coords: float-4-array -- map: float-array ) coords [| coord | table transform coord m4.v perlin-noise ] data-map( float-4 -- c:float ) - float-array-cast ; + c:float cast-array ; : perlin-noise-image ( table transform dim -- image ) [ perlin-noise-map-coords perlin-noise-map ] [ 5/7. 0.5 float-map>image ] bi ; diff --git a/extra/openal/openal.factor b/extra/openal/openal.factor index 5ce7a5b990..32351fde78 100755 --- a/extra/openal/openal.factor +++ b/extra/openal/openal.factor @@ -248,15 +248,15 @@ DESTRUCTOR: alcCloseDevice* DESTRUCTOR: alcDestroyContext : gen-sources ( size -- seq ) - dup [ alGenSources ] keep ; + dup uint [ alGenSources ] keep ; : gen-buffers ( size -- seq ) - dup [ alGenBuffers ] keep ; + dup uint [ alGenBuffers ] keep ; : gen-buffer ( -- buffer ) 1 gen-buffers first ; : queue-buffers ( source buffers -- ) - [ length ] [ >uint-array ] bi alSourceQueueBuffers ; + [ length ] [ uint >c-array ] bi alSourceQueueBuffers ; : queue-buffer ( source buffer -- ) 1array queue-buffers ; diff --git a/extra/opencl/ffi/ffi-tests.factor b/extra/opencl/ffi/ffi-tests.factor index 60083a0b0a..08d13062e1 100644 --- a/extra/opencl/ffi/ffi-tests.factor +++ b/extra/opencl/ffi/ffi-tests.factor @@ -30,7 +30,7 @@ ERROR: cl-error err ; :: opencl-square ( in -- out ) 0 f 0 uint [ clGetPlatformIDs cl-success ] keep uint deref - dup [ f clGetPlatformIDs cl-success ] keep first + dup void* [ f clGetPlatformIDs cl-success ] keep first CL_DEVICE_TYPE_DEFAULT 1 f void* [ f clGetDeviceIDs cl-success ] keep void* deref :> device-id f 1 device-id void* f f 0 int [ clCreateContext ] keep int deref cl-success :> context context device-id 0 0 int [ clCreateCommandQueue ] keep int deref cl-success :> queue @@ -60,7 +60,7 @@ ERROR: cl-error err ; queue clFinish cl-success - queue output CL_TRUE 0 in byte-length in length + queue output CL_TRUE 0 in byte-length in length float [ 0 f f clEnqueueReadBuffer cl-success ] keep input clReleaseMemObject cl-success diff --git a/extra/opencl/ffi/ffi.factor b/extra/opencl/ffi/ffi.factor index c3a053d6ae..30d00c0ae2 100644 --- a/extra/opencl/ffi/ffi.factor +++ b/extra/opencl/ffi/ffi.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2010 Erik Charlebois. ! See http://factorcode.org/license.txt for BSD license. -USING: alien alien.c-types alien.libraries alien.syntax +USING: alien alien.c-types alien.data alien.libraries alien.syntax classes.struct combinators system alien.accessors byte-arrays kernel ; IN: opencl.ffi diff --git a/extra/opencl/opencl-tests.factor b/extra/opencl/opencl-tests.factor index 628a9b0d63..316d496ac8 100644 --- a/extra/opencl/opencl-tests.factor +++ b/extra/opencl/opencl-tests.factor @@ -36,7 +36,8 @@ __kernel void square( { num-floats } [ ] cl-queue-kernel &dispose drop cl-finish - out-buffer 0 num-bytes cl-read-buffer num-floats + out-buffer 0 num-bytes + cl-read-buffer num-floats flloat ] with-cl-state ] with-destructors ; diff --git a/extra/opencl/opencl.factor b/extra/opencl/opencl.factor index 01ceb4e88f..4550222352 100644 --- a/extra/opencl/opencl.factor +++ b/extra/opencl/opencl.factor @@ -60,7 +60,7 @@ ERROR: cl-error err ; [ ascii decode 1 head* ] 2info ; inline : info-size_t-array ( handle name quot -- size_t-array ) - [ [ length size_t heap-size / ] keep swap ] info ; inline + [ [ length size_t heap-size / ] keep swap size_t ] info ; inline TUPLE: cl-handle < disposable handle ; PRIVATE> @@ -314,7 +314,7 @@ M: cl-filter-linear filter-mode-constant drop CL_FILTER_LINEAR ; CL_DEVICE_TYPE_ALL [ 0 f 0 uint [ clGetDeviceIDs cl-success ] keep uint deref ] [ - rot dup [ f clGetDeviceIDs cl-success ] keep + rot dup void* [ f clGetDeviceIDs cl-success ] keep ] 2bi ; inline : command-queue-info-ulong ( handle name -- ulong ) @@ -427,7 +427,7 @@ PRIVATE> : cl-platforms ( -- platforms ) 0 f 0 uint [ clGetPlatformIDs cl-success ] keep uint deref - dup [ f clGetPlatformIDs cl-success ] keep + dup void* [ f clGetPlatformIDs cl-success ] keep [ dup [ platform-info ] diff --git a/extra/random/cmwc/cmwc-tests.factor b/extra/random/cmwc/cmwc-tests.factor index d5e1fe6858..6ad8b57fb8 100644 --- a/extra/random/cmwc/cmwc-tests.factor +++ b/extra/random/cmwc/cmwc-tests.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2009 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: alien.c-types arrays kernel random random.cmwc sequences -specialized-arrays tools.test ; +USING: alien.c-types alien.data arrays kernel random random.cmwc +sequences specialized-arrays tools.test ; SPECIALIZED-ARRAY: uint IN: random.cmwc.tests @@ -26,18 +26,18 @@ IN: random.cmwc.tests } ] [ cmwc-4096 - 4096 iota >uint-array 362436 seed-random [ + 4096 iota uint >c-array 362436 seed-random [ 10 [ random-32 ] replicate ] with-random ] unit-test [ t ] [ cmwc-4096 [ - 4096 iota >uint-array 362436 seed-random [ + 4096 iota uint >c-array 362436 seed-random [ 10 [ random-32 ] replicate ] with-random ] [ - 4096 iota >uint-array 362436 seed-random [ + 4096 iota uint >c-array 362436 seed-random [ 10 [ random-32 ] replicate ] with-random ] bi = diff --git a/extra/random/cmwc/cmwc.factor b/extra/random/cmwc/cmwc.factor index 44bb016267..9741889d1f 100644 --- a/extra/random/cmwc/cmwc.factor +++ b/extra/random/cmwc/cmwc.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2009 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors alien.c-types arrays fry kernel locals math -math.bitwise random sequences sequences.private +USING: accessors alien.c-types alien.data arrays fry kernel +locals math math.bitwise random sequences sequences.private specialized-arrays ; SPECIALIZED-ARRAY: uint IN: random.cmwc @@ -24,7 +24,7 @@ TUPLE: cmwc-seed { Q uint-array read-only } { c read-only } ; swap >>c swap >>b swap >>a - swap [ 1 - >>i ] [ >>Q ] bi + swap [ 1 - >>i ] [ uint >>Q ] bi dup b>> 1 - >>r dup Q>> length 1 - >>mod ; inline diff --git a/extra/random/lagged-fibonacci/lagged-fibonacci.factor b/extra/random/lagged-fibonacci/lagged-fibonacci.factor index 7905c575bd..6109a727b5 100644 --- a/extra/random/lagged-fibonacci/lagged-fibonacci.factor +++ b/extra/random/lagged-fibonacci/lagged-fibonacci.factor @@ -1,7 +1,8 @@ ! Copyright (C) 2009 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors alien.c-types fry kernel literals locals math -random sequences specialized-arrays namespaces sequences.private ; +USING: accessors alien.c-types alien.data fry kernel literals +locals math random sequences specialized-arrays namespaces +sequences.private ; SPECIALIZED-ARRAY: double IN: random.lagged-fibonacci @@ -54,7 +55,7 @@ M:: lagged-fibonacci seed-random ( lagged-fibonacci seed! -- lagged-fibonacci ) : ( seed -- lagged-fibonacci ) lagged-fibonacci new - p-r 1 + >>u + p-r 1 + double >>u swap seed-random ; inline GENERIC: random-float* ( tuple -- r ) diff --git a/unmaintained/math/blas/matrices/matrices.factor b/unmaintained/math/blas/matrices/matrices.factor index a551190dbd..812bd10a5b 100644 --- a/unmaintained/math/blas/matrices/matrices.factor +++ b/unmaintained/math/blas/matrices/matrices.factor @@ -251,7 +251,6 @@ FUNCTOR: (define-blas-matrix) ( TYPE T U C -- ) VECTOR IS ${TYPE}-blas-vector IS <${TYPE}-blas-vector> ->ARRAY IS >${TYPE}-array XGEMV IS ${T}GEMV XGEMM IS ${T}GEMM XGERU IS ${T}GER${U} @@ -281,7 +280,7 @@ M: MATRIX (blas-vector-like) drop ; : >MATRIX ( arrays -- matrix ) - [ >ARRAY underlying>> ] (>matrix) ; + [ TYPE >c-array underlying>> ] (>matrix) ; M: VECTOR n*M.V+n*V! (prepare-gemv) [ XGEMV ] dip ; diff --git a/unmaintained/math/blas/vectors/vectors.factor b/unmaintained/math/blas/vectors/vectors.factor index caf0984aa4..bd07cfb932 100644 --- a/unmaintained/math/blas/vectors/vectors.factor +++ b/unmaintained/math/blas/vectors/vectors.factor @@ -1,8 +1,8 @@ -USING: accessors alien alien.c-types alien.complex arrays ascii -byte-arrays combinators combinators.short-circuit fry kernel -math math.blas.ffi math.complex math.functions math.order -sequences sequences.private functors words locals parser -prettyprint.backend prettyprint.custom specialized-arrays ; +USING: accessors alien alien.c-types alien.complex alien.data +arrays ascii byte-arrays combinators combinators.short-circuit +fry kernel math math.blas.ffi math.complex math.functions +math.order sequences sequences.private functors words locals +parser prettyprint.backend prettyprint.custom specialized-arrays ; FROM: alien.c-types => float ; SPECIALIZED-ARRAY: float SPECIALIZED-ARRAY: double @@ -132,7 +132,6 @@ M: blas-vector-base virtual@ FUNCTOR: (define-blas-vector) ( TYPE T -- ) IS ->ARRAY IS >${TYPE}-array XCOPY IS ${T}COPY XSWAP IS ${T}SWAP IXAMAX IS I${T}AMAX @@ -154,7 +153,7 @@ TUPLE: VECTOR < blas-vector-base ; : ( underlying length inc -- vector ) VECTOR boa ; inline : >VECTOR ( seq -- v ) - [ >ARRAY underlying>> ] [ length ] bi 1 ; + [ TYPE >c-array underlying>> ] [ length ] bi 1 ; M: VECTOR clone TYPE heap-size (prepare-copy)