diff --git a/basis/alien/arrays/arrays-docs.factor b/basis/alien/arrays/arrays-docs.factor index e8ebe1824d..bf012090f8 100644 --- a/basis/alien/arrays/arrays-docs.factor +++ b/basis/alien/arrays/arrays-docs.factor @@ -7,6 +7,6 @@ $nl "C type specifiers for array types are documented in " { $link "c-types-specs" } "." $nl "Specialized sequences are provided for accessing memory as an array of primitive type values. These sequences are implemented in the " { $vocab-link "specialized-arrays" } " and " { $vocab-link "specialized-arrays.direct" } " vocabulary sets. They can also be loaded and constructed through their primitive C types:" -{ $subsection require-c-type-arrays } -{ $subsection } -{ $subsection } ; +{ $subsection require-c-arrays } +{ $subsection } +{ $subsection } ; diff --git a/basis/alien/c-types/c-types-docs.factor b/basis/alien/c-types/c-types-docs.factor index cd0f90f81c..b6b28d0a95 100644 --- a/basis/alien/c-types/c-types-docs.factor +++ b/basis/alien/c-types/c-types-docs.factor @@ -49,10 +49,10 @@ HELP: c-setter { $errors "Throws an error if the type does not exist." } ; HELP: -{ $deprecated "New code should use " { $link } " or the " { $vocab-link "specialized-arrays" } " vocabularies." } { $values { "n" "a non-negative integer" } { "type" "a C type" } { "array" byte-array } } { $description "Creates a byte array large enough to hold " { $snippet "n" } " values of a C type." } -{ $errors "Throws an error if the type does not exist or the requested size is negative." } ; +{ $notes "The appropriate specialized array vocabulary must be loaded; otherwise, a " { $link specialized-array-vocab-not-loaded } " error will be thrown. The vocabulary can be loaded with a " { $link POSTPONE: USING: } " form as usual, or with the " { $link require-c-arrays } " word. See the " { $vocab-link "specialized-arrays" } " vocabulary set 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 { "type" "a C type" } { "array" byte-array } } @@ -72,8 +72,8 @@ HELP: byte-array>memory HELP: malloc-array { $values { "n" "a non-negative integer" } { "type" "a C type" } { "alien" alien } } -{ $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 direct specialized array vocabulary must be loaded; otherwise, a " { $link specialized-array-vocab-not-loaded } " error will be thrown. The vocabulary can be loaded with a " { $link POSTPONE: USING: } " form as usual, or with the " { $link require-c-type-arrays } " word. See the " { $vocab-link "specialized-arrays.direct" } " vocabulary set for details on the underlying sequence type constructed." } +{ $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 direct specialized array vocabulary must be loaded; otherwise, a " { $link specialized-array-vocab-not-loaded } " error will be thrown. The vocabulary can be loaded with a " { $link POSTPONE: USING: } " form as usual, or with the " { $link require-c-arrays } " word. See the " { $vocab-link "specialized-arrays.direct" } " vocabulary set for details on the underlying sequence type constructed." } { $warning "Don't forget to deallocate the memory with a call to " { $link free } "." } { $errors "Throws an error if the type does not exist, if the requested size is negative, if a direct specialized array class appropriate to the type is not loaded, or if memory allocation fails." } ; @@ -89,7 +89,7 @@ HELP: malloc-byte-array { $warning "Don't forget to deallocate the memory with a call to " { $link free } "." } { $errors "Throws an error if memory allocation fails." } ; -{ malloc-array } related-words +{ malloc-array } related-words HELP: box-parameter { $values { "n" integer } { "ctype" string } } @@ -130,20 +130,15 @@ HELP: malloc-string } } ; -HELP: require-c-type-arrays +HELP: require-c-arrays { $values { "c-type" "a C type" } } -{ $description { $link require } "s any unloaded vocabularies needed to construct a specialized array or direct array of " { $snippet "c-type" } " using the " { $link } " or " { $link } " vocabularies." } +{ $description { $link require } "s any unloaded vocabularies needed to construct a specialized array or direct array of " { $snippet "c-type" } " using the " { $link } " or " { $link } " vocabularies." } { $notes "This word must be called inside a compilation unit. See the " { $vocab-link "specialized-arrays" } " and " { $vocab-link "specialized-arrays.direct" } " vocabulary sets for details on the underlying sequence types loaded." } ; -HELP: -{ $values { "len" integer } { "c-type" "a C type" } { "array" "a specialized array" } } -{ $description "Constructs a new specialized array of length " { $snippet "len" } " and element type " { $snippet "c-type" } "." } -{ $notes "The appropriate specialized array vocabulary must be loaded; otherwise, a " { $link specialized-array-vocab-not-loaded } " error will be thrown. The vocabulary can be loaded with a " { $link POSTPONE: USING: } " form as usual, or with the " { $link require-c-type-arrays } " word. See the " { $vocab-link "specialized-arrays" } " vocabulary set for details on the underlying sequence type constructed." } ; - -HELP: +HELP: { $values { "alien" c-ptr } { "len" integer } { "c-type" "a C type" } { "array" "a specialized direct array" } } { $description "Constructs a new specialized array of length " { $snippet "len" } " and element type " { $snippet "c-type" } " over the range of memory referenced by " { $snippet "alien" } "." } -{ $notes "The appropriate direct specialized array vocabulary must be loaded; otherwise, a " { $link specialized-array-vocab-not-loaded } " error will be thrown. The vocabulary can be loaded with a " { $link POSTPONE: USING: } " form as usual, or with the " { $link require-c-type-arrays } " word. See the " { $vocab-link "specialized-arrays.direct" } " vocabulary set for details on the underlying sequence type constructed." } ; +{ $notes "The appropriate direct specialized array vocabulary must be loaded; otherwise, a " { $link specialized-array-vocab-not-loaded } " error will be thrown. The vocabulary can be loaded with a " { $link POSTPONE: USING: } " form as usual, or with the " { $link require-c-arrays } " word. See the " { $vocab-link "specialized-arrays.direct" } " vocabulary set for details on the underlying sequence type constructed." } ; ARTICLE: "c-strings" "C strings" "C string types are arrays with shape " { $snippet "{ \"char*\" encoding }" } ", where " { $snippet "encoding" } " is an encoding descriptor. The type " { $snippet "\"char*\"" } " is an alias for " { $snippet "{ \"char*\" utf8 }" } ". See " { $link "encodings-descriptors" } " for information about encoding descriptors." diff --git a/basis/alien/c-types/c-types.factor b/basis/alien/c-types/c-types.factor index d75a4898c5..e565796ab1 100755 --- a/basis/alien/c-types/c-types.factor +++ b/basis/alien/c-types/c-types.factor @@ -24,6 +24,7 @@ size align array-class array-constructor +(array)-constructor direct-array-class direct-array-constructor sequence-mixin-class ; @@ -79,47 +80,65 @@ M: string c-type ( name -- type ) : ?require-word ( word/pair -- ) dup word? [ drop ] [ first require ] ?if ; -GENERIC: require-c-type-arrays ( c-type -- ) +GENERIC: require-c-arrays ( c-type -- ) -M: object require-c-type-arrays +M: object require-c-arrays drop ; -M: c-type require-c-type-arrays +M: c-type require-c-arrays [ array-class>> ?require-word ] [ sequence-mixin-class>> ?require-word ] [ direct-array-class>> ?require-word ] tri ; -M: string require-c-type-arrays - c-type require-c-type-arrays ; +M: string require-c-arrays + c-type require-c-arrays ; -M: array require-c-type-arrays - first c-type require-c-type-arrays ; +M: array require-c-arrays + first c-type require-c-arrays ; ERROR: specialized-array-vocab-not-loaded vocab word ; -: c-type-array-constructor ( c-type -- word ) +: c-array-constructor ( c-type -- word ) array-constructor>> dup array? [ first2 specialized-array-vocab-not-loaded ] when ; foldable -: c-type-direct-array-constructor ( c-type -- word ) +: c-(array)-constructor ( c-type -- word ) + (array)-constructor>> dup array? + [ first2 specialized-array-vocab-not-loaded ] when ; foldable + +: c-direct-array-constructor ( c-type -- word ) direct-array-constructor>> dup array? [ first2 specialized-array-vocab-not-loaded ] when ; foldable -GENERIC: ( len c-type -- array ) -M: object - c-type-array-constructor execute( len -- array ) ; inline -M: string - c-type ; inline -M: array - first c-type ; inline +GENERIC: ( len c-type -- array ) +M: object + c-array-constructor execute( len -- array ) ; inline +M: string + c-type ; inline +M: array + first c-type ; inline -GENERIC: ( alien len c-type -- array ) -M: object - c-type-direct-array-constructor execute( alien len -- array ) ; inline -M: string - c-type ; inline -M: array - first c-type ; inline +GENERIC: (c-array) ( len c-type -- array ) +M: object (c-array) + c-(array)-constructor execute( len -- array ) ; inline +M: string (c-array) + c-type (c-array) ; inline +M: array (c-array) + first c-type (c-array) ; inline + +GENERIC: ( alien len c-type -- array ) +M: object + c-direct-array-constructor execute( alien len -- array ) ; inline +M: string + c-type ; inline +M: array + first c-type ; inline + +: malloc-array ( n type -- alien ) + [ heap-size calloc ] [ ] 2bi ; inline + +: (malloc-array) ( n type -- alien ) + [ heap-size * malloc ] [ ] 2bi ; inline GENERIC: c-type-class ( name -- class ) @@ -253,21 +272,12 @@ M: f byte-length drop 0 ; inline [ "Cannot write struct fields with this type" throw ] ] unless* ; -: ( n type -- array ) - heap-size * ; inline deprecated - : ( type -- array ) heap-size ; inline : (c-object) ( type -- array ) heap-size (byte-array) ; inline -: malloc-array ( n type -- alien ) - [ heap-size calloc ] [ ] 2bi ; inline - -: (malloc-array) ( n type -- alien ) - [ heap-size * malloc ] [ ] 2bi ; inline - : malloc-object ( type -- alien ) 1 swap heap-size calloc ; inline @@ -354,6 +364,10 @@ M: long-long-type box-return ( type -- ) [ "specialized-arrays." prepend ] [ "<" "-array>" surround ] bi* ?lookup >>array-constructor ] + [ + [ "specialized-arrays." prepend ] + [ "(" "-array)" surround ] bi* ?lookup >>(array)-constructor + ] [ [ "specialized-arrays." prepend ] [ "-sequence" append ] bi* ?lookup >>sequence-mixin-class diff --git a/basis/specialized-arrays/functor/functor.factor b/basis/specialized-arrays/functor/functor.factor index f5aca7fb95..df1c938d03 100644 --- a/basis/specialized-arrays/functor/functor.factor +++ b/basis/specialized-arrays/functor/functor.factor @@ -10,10 +10,10 @@ ERROR: bad-byte-array-length byte-array type ; M: bad-byte-array-length summary drop "Byte array length doesn't divide type width" ; -: (c-array) ( n c-type -- array ) +: (underlying) ( n c-type -- array ) heap-size * (byte-array) ; inline -: ( n type -- array ) +: ( n type -- array ) heap-size * ; inline FUNCTOR: define-array ( T -- ) @@ -37,9 +37,9 @@ TUPLE: A { length array-capacity read-only } { underlying byte-array read-only } ; -: ( n -- specialized-array ) dup T A boa ; inline +: ( n -- specialized-array ) dup T A boa ; inline -: (A) ( n -- specialized-array ) dup T (c-array) A boa ; inline +: (A) ( n -- specialized-array ) dup T (underlying) A boa ; inline : byte-array>A ( byte-array -- specialized-array ) dup length T heap-size /mod 0 = [ drop T bad-byte-array-length ] unless @@ -86,6 +86,7 @@ A T c-type-boxed-class specialize-vector-words T c-type \ A >>array-class \ >>array-constructor + \ (A) >>(array)-constructor \ S >>sequence-mixin-class drop