diff --git a/basis/alien/arrays/arrays-docs.factor b/basis/alien/arrays/arrays-docs.factor index db4a7bf595..74174485fe 100755 --- a/basis/alien/arrays/arrays-docs.factor +++ b/basis/alien/arrays/arrays-docs.factor @@ -1,5 +1,5 @@ +USING: help.syntax help.markup byte-arrays alien.c-types alien.data ; IN: alien.arrays -USING: help.syntax help.markup byte-arrays alien.c-types ; ARTICLE: "c-arrays" "C arrays" "C arrays are allocated in the same manner as other C data; see " { $link "c-byte-arrays" } " and " { $link "malloc" } "." diff --git a/basis/alien/arrays/arrays.factor b/basis/alien/arrays/arrays.factor index a69f7609b1..ee75d22c2c 100755 --- a/basis/alien/arrays/arrays.factor +++ b/basis/alien/arrays/arrays.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: alien alien.strings alien.c-types alien.accessors -arrays words sequences math kernel namespaces fry libc cpu.architecture +USING: alien alien.strings alien.c-types alien.data alien.accessors +arrays words sequences math kernel namespaces fry cpu.architecture io.encodings.utf8 accessors ; IN: alien.arrays @@ -22,15 +22,15 @@ M: array c-type-align first c-type-align ; M: array c-type-stack-align? drop f ; -M: array unbox-parameter drop "void*" unbox-parameter ; +M: array unbox-parameter drop void* unbox-parameter ; -M: array unbox-return drop "void*" unbox-return ; +M: array unbox-return drop void* unbox-return ; -M: array box-parameter drop "void*" box-parameter ; +M: array box-parameter drop void* box-parameter ; -M: array box-return drop "void*" box-return ; +M: array box-return drop void* box-return ; -M: array stack-size drop "void*" stack-size ; +M: array stack-size drop void* stack-size ; M: array c-type-boxer-quot unclip @@ -41,7 +41,7 @@ M: array c-type-boxer-quot M: array c-type-unboxer-quot drop [ >c-ptr ] ; PREDICATE: string-type < pair - first2 [ "char*" = ] [ word? ] bi* and ; + first2 [ char* = ] [ word? ] bi* and ; M: string-type c-type ; @@ -50,37 +50,37 @@ M: string-type c-type-class drop object ; M: string-type c-type-boxed-class drop object ; M: string-type heap-size - drop "void*" heap-size ; + drop void* heap-size ; M: string-type c-type-align - drop "void*" c-type-align ; + drop void* c-type-align ; M: string-type c-type-stack-align? - drop "void*" c-type-stack-align? ; + drop void* c-type-stack-align? ; M: string-type unbox-parameter - drop "void*" unbox-parameter ; + drop void* unbox-parameter ; M: string-type unbox-return - drop "void*" unbox-return ; + drop void* unbox-return ; M: string-type box-parameter - drop "void*" box-parameter ; + drop void* box-parameter ; M: string-type box-return - drop "void*" box-return ; + drop void* box-return ; M: string-type stack-size - drop "void*" stack-size ; + drop void* stack-size ; M: string-type c-type-rep drop int-rep ; M: string-type c-type-boxer - drop "void*" c-type-boxer ; + drop void* c-type-boxer ; M: string-type c-type-unboxer - drop "void*" c-type-unboxer ; + drop void* c-type-unboxer ; M: string-type c-type-boxer-quot second '[ _ alien>string ] ; @@ -94,6 +94,8 @@ M: string-type c-type-getter M: string-type c-type-setter drop [ set-alien-cell ] ; -{ "char*" utf8 } "char*" typedef -"char*" "uchar*" typedef +{ char* utf8 } char* typedef +char* uchar* typedef +char char* "pointer-c-type" set-word-prop +uchar uchar* "pointer-c-type" set-word-prop diff --git a/basis/alien/c-types/c-types-docs.factor b/basis/alien/c-types/c-types-docs.factor index d9e1f7124a..a9613d2c9f 100755 --- a/basis/alien/c-types/c-types-docs.factor +++ b/basis/alien/c-types/c-types-docs.factor @@ -1,7 +1,25 @@ -IN: alien.c-types USING: alien help.syntax help.markup libc kernel.private byte-arrays math strings hashtables alien.syntax alien.strings sequences io.encodings.string debugger destructors vocabs.loader ; +IN: alien.c-types + +HELP: byte-length +{ $values { "seq" "A byte array or float array" } { "n" "a non-negative integer" } } +{ $contract "Outputs the size of the byte array, struct, or specialized array data in bytes." } ; + +HELP: heap-size +{ $values { "type" string } { "size" integer } } +{ $description "Outputs the number of bytes needed for a heap-allocated value of this C type." } +{ $examples + "On a 32-bit system, you will get the following output:" + { $unchecked-example "USE: alien\n\"void*\" heap-size ." "4" } +} +{ $errors "Throws a " { $link no-c-type } " error if the type does not exist." } ; + +HELP: stack-size +{ $values { "type" string } { "size" integer } } +{ $description "Outputs the number of bytes to reserve on the C stack by a value of this C type. In most cases this is equal to " { $link heap-size } ", except on some platforms where C structs are passed by invisible reference, in which case a C struct type only uses as much space as a pointer on the C stack." } +{ $errors "Throws a " { $link no-c-type } " error if the type does not exist." } ; HELP: { $values { "type" hashtable } } @@ -20,24 +38,6 @@ HELP: c-type { $description "Looks up a C type by name." } { $errors "Throws a " { $link no-c-type } " error if the type does not exist." } ; -HELP: heap-size -{ $values { "type" string } { "size" integer } } -{ $description "Outputs the number of bytes needed for a heap-allocated value of this C type." } -{ $examples - "On a 32-bit system, you will get the following output:" - { $unchecked-example "USE: alien\n\"void*\" heap-size ." "4" } -} -{ $errors "Throws a " { $link no-c-type } " error if the type does not exist." } ; - -HELP: stack-size -{ $values { "type" string } { "size" integer } } -{ $description "Outputs the number of bytes to reserve on the C stack by a value of this C type. In most cases this is equal to " { $link heap-size } ", except on some platforms where C structs are passed by invisible reference, in which case a C struct type only uses as much space as a pointer on the C stack." } -{ $errors "Throws a " { $link no-c-type } " error if the type does not exist." } ; - -HELP: byte-length -{ $values { "seq" "A byte array or float array" } { "n" "a non-negative integer" } } -{ $contract "Outputs the size of the byte array or float array data in bytes as presented to the C library interface." } ; - HELP: c-getter { $values { "name" string } { "quot" { $quotation "( c-ptr n -- obj )" } } } { $description "Outputs a quotation which reads values of this C type from a C structure." } @@ -48,49 +48,6 @@ HELP: c-setter { $description "Outputs a quotation which writes values of this C type to a C structure." } { $errors "Throws an error if the type does not exist." } ; -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. The vocabulary can be loaded with the " { $link require-c-array } " word. 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 { "type" "a C type" } { "array" byte-array } } -{ $description "Creates a byte array suitable for holding a value with the given C type." } -{ $errors "Throws an " { $link no-c-type } " error if the type does not exist." } ; - -{ malloc-object } related-words - -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: byte-array>memory -{ $values { "byte-array" byte-array } { "base" c-ptr } } -{ $description "Writes a byte array to memory starting from the " { $snippet "base" } " address." } -{ $warning "This word is unsafe. Improper use can corrupt 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 specialized array vocabulary must be loaded; otherwise, an error will be thrown. The vocabulary can be loaded with the " { $link require-c-array } " word. 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 } "." } -{ $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." } ; - -HELP: malloc-object -{ $values { "type" "a C type" } { "alien" alien } } -{ $description "Allocates an unmanaged memory block large enough to hold a value of a C type." } -{ $warning "Don't forget to deallocate the memory with a call to " { $link free } "." } -{ $errors "Throws an error if the type does not exist or if memory allocation fails." } ; - -HELP: malloc-byte-array -{ $values { "byte-array" byte-array } { "alien" alien } } -{ $description "Allocates an unmanaged memory block of the same size as the byte array, and copies the contents of the byte array there." } -{ $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 - HELP: box-parameter { $values { "n" integer } { "ctype" string } } { $description "Generates code for converting a C value stored at offset " { $snippet "n" } " from the top of the stack into a Factor object to be pushed on the data stack." } @@ -116,48 +73,6 @@ HELP: define-out { $description "Defines a word " { $snippet "<" { $emphasis "name" } ">" } " with stack effect " { $snippet "( value -- array )" } ". This word allocates a byte array large enough to hold a value with C type " { $snippet "name" } ", and writes the value at the top of the stack to the array." } { $notes "This is an internal word called when defining C types, there is no need to call it on your own." } ; -{ string>alien alien>string malloc-string } related-words - -HELP: malloc-string -{ $values { "string" string } { "encoding" "an encoding descriptor" } { "alien" c-ptr } } -{ $description "Encodes a string together with a trailing null code point using the given encoding, and stores the resulting bytes in a freshly-allocated unmanaged memory block." } -{ $warning "Don't forget to deallocate the memory with a call to " { $link free } "." } -{ $errors "Throws an error if one of the following conditions occurs:" - { $list - "the string contains null code points" - "the string contains characters not representable using the encoding specified" - "memory allocation fails" - } -} ; - -HELP: require-c-array -{ $values { "c-type" "a C type" } } -{ $description "Generates a specialized 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" } " vocabulary for details on the underlying sequence types loaded." } ; - -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 specialized array vocabulary must be loaded; otherwise, an error will be thrown. The vocabulary can be loaded with the " { $link require-c-array } " word. See the " { $vocab-link "specialized-arrays" } " vocabulary 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." -$nl -"Passing a Factor string to a C function expecting a C string allocates a " { $link byte-array } " in the Factor heap; the string is then converted to the requested format and a raw pointer is passed to the function." -$nl -"If the conversion fails, for example if the string contains null bytes or characters with values higher than 255, a " { $link c-string-error. } " is thrown." -$nl -"Care must be taken if the C function expects a " { $snippet "char*" } " with a length in bytes, rather than a null-terminated " { $snippet "char*" } "; passing the result of calling " { $link length } " on the string object will not suffice. This is because a Factor string of " { $emphasis "n" } " characters will not necessarily encode to " { $emphasis "n" } " bytes. The correct idiom for C functions which take a string with a length is to first encode the string using " { $link encode } ", and then pass the resulting byte array together with the length of this byte array." -$nl -"Sometimes a C function has a parameter type of " { $snippet "void*" } ", and various data types, among them strings, can be passed in. In this case, strings are not automatically converted to aliens, and instead you must call one of these words:" -{ $subsection string>alien } -{ $subsection malloc-string } -"The first allocates " { $link byte-array } "s, and the latter allocates manually-managed memory which is not moved by the garbage collector and has to be explicitly freed by calling " { $link free } ". See " { $link "byte-arrays-gc" } " for a discussion of the two approaches." -$nl -"A word to read strings from arbitrary addresses:" -{ $subsection alien>string } -"For example, if a C function returns a " { $snippet "char*" } " but stipulates that the caller must deallocate the memory afterward, you must define the function as returning " { $snippet "void*" } ", and call one of the above words before passing the pointer to " { $link free } "." ; - ARTICLE: "byte-arrays-gc" "Byte arrays and the garbage collector" "The Factor garbage collector can move byte arrays around, and it is only safe to pass byte arrays to C functions if the garbage collector will not run while C code still has a reference to the data." $nl @@ -234,61 +149,3 @@ $nl "Fixed-size arrays differ from pointers in that they are allocated inside structures and unions; however when used as function parameters they behave exactly like pointers and thus the dimensions only serve as documentation." $nl "Structure and union types are specified by the name of the structure or union." ; - -ARTICLE: "c-byte-arrays" "Passing data in byte arrays" -"Instances of the " { $link byte-array } " class can be passed to C functions; the C function receives a pointer to the first element of the array." -$nl -"Byte arrays can be allocated directly with a byte count using the " { $link } " word. However in most cases, instead of computing a size in bytes directly, it is easier to use a higher-level word which expects C type and outputs a byte array large enough to hold that type:" -{ $subsection } -{ $subsection } -{ $warning -"The Factor garbage collector can move byte arrays around, and code passing byte arrays to C must obey important guidelines. See " { $link "byte-arrays-gc" } "." } -{ $see-also "c-arrays" } ; - -ARTICLE: "malloc" "Manual memory management" -"Sometimes data passed to C functions must be allocated at a fixed address. See " { $link "byte-arrays-gc" } " for an explanation of when this is the case." -$nl -"Allocating a C datum with a fixed address:" -{ $subsection malloc-object } -{ $subsection malloc-array } -{ $subsection malloc-byte-array } -"There is a set of words in the " { $vocab-link "libc" } " vocabulary which directly call C standard library memory management functions:" -{ $subsection malloc } -{ $subsection calloc } -{ $subsection realloc } -"You must always free pointers returned by any of the above words when the block of memory is no longer in use:" -{ $subsection free } -"Utilities for automatically freeing memory in conjunction with " { $link with-destructors } ":" -{ $subsection &free } -{ $subsection |free } -"The " { $link &free } " and " { $link |free } " words are generated using " { $link "alien.destructors" } "." -$nl -"You can unsafely copy a range of bytes from one memory location to another:" -{ $subsection memcpy } -"You can copy a range of bytes from memory into a byte array:" -{ $subsection memory>byte-array } -"You can copy a byte array to memory unsafely:" -{ $subsection byte-array>memory } ; - -ARTICLE: "c-data" "Passing data between Factor and C" -"Two defining characteristics of Factor are dynamic typing and automatic memory management, which are somewhat incompatible with the machine-level data model exposed by C. Factor's C library interface defines its own set of C data types, distinct from Factor language types, together with automatic conversion between Factor values and C types. For example, C integer types must be declared and are fixed-width, whereas Factor supports arbitrary-precision integers." -$nl -"Furthermore, Factor's garbage collector can move objects in memory; for a discussion of the consequences, see " { $link "byte-arrays-gc" } "." -{ $subsection "c-types-specs" } -{ $subsection "c-byte-arrays" } -{ $subsection "malloc" } -{ $subsection "c-strings" } -{ $subsection "c-arrays" } -{ $subsection "c-out-params" } -"Important guidelines for passing data in byte arrays:" -{ $subsection "byte-arrays-gc" } -"C-style enumerated types are supported:" -{ $subsection POSTPONE: C-ENUM: } -"C types can be aliased for convenience and consitency with native library documentation:" -{ $subsection POSTPONE: TYPEDEF: } -"New C types can be defined:" -{ $subsection "c-structs" } -{ $subsection "c-unions" } -"A utility for defining " { $link "destructors" } " for deallocating memory:" -{ $subsection "alien.destructors" } -{ $see-also "aliens" } ; diff --git a/basis/alien/c-types/c-types-tests.factor b/basis/alien/c-types/c-types-tests.factor index bfeff5f1de..792e7d416a 100644 --- a/basis/alien/c-types/c-types-tests.factor +++ b/basis/alien/c-types/c-types-tests.factor @@ -43,7 +43,7 @@ TYPEDEF: int* MyIntArray TYPEDEF: uchar* MyLPBYTE -[ t ] [ { "char*" utf8 } c-type "MyLPBYTE" c-type = ] unit-test +[ t ] [ { char* utf8 } c-type "MyLPBYTE" c-type = ] unit-test [ 0 B{ 1 2 3 4 } diff --git a/basis/alien/c-types/c-types.factor b/basis/alien/c-types/c-types.factor index 35a9627d50..fa27e29c04 100755 --- a/basis/alien/c-types/c-types.factor +++ b/basis/alien/c-types/c-types.factor @@ -1,18 +1,27 @@ ! Copyright (C) 2004, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: byte-arrays arrays assocs kernel kernel.private libc math +USING: byte-arrays arrays assocs kernel kernel.private math namespaces make parser sequences strings words splitting math.parser cpu.architecture alien alien.accessors alien.strings quotations layouts system compiler.units io io.files io.encodings.binary io.streams.memory accessors combinators effects continuations fry -classes vocabs vocabs.loader ; +classes vocabs vocabs.loader words.symbol ; +QUALIFIED: math IN: alien.c-types +SYMBOLS: + char uchar + short ushort + int uint + long ulong + longlong ulonglong + float double + void* bool + void ; + DEFER: DEFER: *char -: little-endian? ( -- ? ) 1 *char 1 = ; foldable - TUPLE: abstract-c-type { class class initial: object } { boxed-class class initial: object } @@ -40,149 +49,124 @@ global [ ERROR: no-c-type name ; -: (c-type) ( name -- type/f ) - c-types get-global at dup [ - dup string? [ (c-type) ] when - ] when ; +PREDICATE: c-type-word < word + "c-type" word-prop ; + +UNION: c-type-name string c-type-word ; ! C type protocol GENERIC: c-type ( name -- type ) foldable -: resolve-pointer-type ( name -- name ) - c-types get at dup string? - [ "*" append ] [ drop "void*" ] if - c-type ; +GENERIC: resolve-pointer-type ( name -- c-type ) + +M: word resolve-pointer-type + dup "pointer-c-type" word-prop + [ ] [ drop void* ] ?if ; +M: string resolve-pointer-type + dup "*" append dup c-types get at + [ nip ] [ + drop + c-types get at dup c-type-name? + [ resolve-pointer-type ] [ drop void* ] if + ] if ; : resolve-typedef ( name -- type ) - dup string? [ c-type ] when ; + dup c-type-name? [ c-type ] when ; -: parse-array-type ( name -- array ) +: parse-array-type ( name -- dims type ) "[" split unclip - [ [ "]" ?tail drop string>number ] map ] dip prefix ; + [ [ "]" ?tail drop string>number ] map ] dip ; M: string c-type ( name -- type ) CHAR: ] over member? [ - parse-array-type + parse-array-type prefix ] [ - dup c-types get at [ - resolve-typedef - ] [ + dup c-types get at [ ] [ "*" ?tail [ resolve-pointer-type ] [ no-c-type ] if - ] ?if + ] ?if resolve-typedef ] if ; +M: word c-type + "c-type" word-prop resolve-typedef ; + +: void? ( c-type -- ? ) + { void "void" } member? ; + GENERIC: c-struct? ( type -- ? ) M: object c-struct? drop f ; -M: string c-struct? - dup "void" = [ drop f ] [ c-type c-struct? ] if ; +M: c-type-name c-struct? + dup void? [ drop f ] [ c-type c-struct? ] if ; ! These words being foldable means that words need to be ! recompiled if a C type is redefined. Even so, folding the ! size facilitates some optimizations. -GENERIC: heap-size ( type -- size ) foldable - -M: string heap-size c-type heap-size ; - -M: abstract-c-type heap-size size>> ; - -GENERIC: require-c-array ( c-type -- ) - -M: array require-c-array first require-c-array ; - -GENERIC: c-array-constructor ( c-type -- word ) - -GENERIC: c-(array)-constructor ( c-type -- word ) - -GENERIC: c-direct-array-constructor ( c-type -- word ) - -GENERIC: ( len c-type -- array ) - -M: string - c-array-constructor execute( len -- array ) ; inline - -GENERIC: (c-array) ( len c-type -- array ) - -M: string (c-array) - c-(array)-constructor execute( len -- array ) ; inline - -GENERIC: ( alien len c-type -- array ) - -M: string - c-direct-array-constructor execute( alien len -- array ) ; 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 ) M: abstract-c-type c-type-class class>> ; -M: string c-type-class c-type c-type-class ; +M: c-type-name c-type-class c-type c-type-class ; GENERIC: c-type-boxed-class ( name -- class ) M: abstract-c-type c-type-boxed-class boxed-class>> ; -M: string c-type-boxed-class c-type c-type-boxed-class ; +M: c-type-name c-type-boxed-class c-type c-type-boxed-class ; GENERIC: c-type-boxer ( name -- boxer ) M: c-type c-type-boxer boxer>> ; -M: string c-type-boxer c-type c-type-boxer ; +M: c-type-name c-type-boxer c-type c-type-boxer ; GENERIC: c-type-boxer-quot ( name -- quot ) M: abstract-c-type c-type-boxer-quot boxer-quot>> ; -M: string c-type-boxer-quot c-type c-type-boxer-quot ; +M: c-type-name c-type-boxer-quot c-type c-type-boxer-quot ; GENERIC: c-type-unboxer ( name -- boxer ) M: c-type c-type-unboxer unboxer>> ; -M: string c-type-unboxer c-type c-type-unboxer ; +M: c-type-name c-type-unboxer c-type c-type-unboxer ; GENERIC: c-type-unboxer-quot ( name -- quot ) M: abstract-c-type c-type-unboxer-quot unboxer-quot>> ; -M: string c-type-unboxer-quot c-type c-type-unboxer-quot ; +M: c-type-name c-type-unboxer-quot c-type c-type-unboxer-quot ; GENERIC: c-type-rep ( name -- rep ) M: c-type c-type-rep rep>> ; -M: string c-type-rep c-type c-type-rep ; +M: c-type-name c-type-rep c-type c-type-rep ; GENERIC: c-type-getter ( name -- quot ) M: c-type c-type-getter getter>> ; -M: string c-type-getter c-type c-type-getter ; +M: c-type-name c-type-getter c-type c-type-getter ; GENERIC: c-type-setter ( name -- quot ) M: c-type c-type-setter setter>> ; -M: string c-type-setter c-type c-type-setter ; +M: c-type-name c-type-setter c-type c-type-setter ; GENERIC: c-type-align ( name -- n ) M: abstract-c-type c-type-align align>> ; -M: string c-type-align c-type c-type-align ; +M: c-type-name c-type-align c-type c-type-align ; GENERIC: c-type-stack-align? ( name -- ? ) M: c-type c-type-stack-align? stack-align?>> ; -M: string c-type-stack-align? c-type c-type-stack-align? ; +M: c-type-name c-type-stack-align? c-type c-type-stack-align? ; : c-type-box ( n type -- ) [ c-type-rep ] [ c-type-boxer [ "No boxer" throw ] unless* ] bi @@ -196,49 +180,48 @@ GENERIC: box-parameter ( n ctype -- ) M: c-type box-parameter c-type-box ; -M: string box-parameter c-type box-parameter ; +M: c-type-name box-parameter c-type box-parameter ; GENERIC: box-return ( ctype -- ) M: c-type box-return f swap c-type-box ; -M: string box-return c-type box-return ; +M: c-type-name box-return c-type box-return ; GENERIC: unbox-parameter ( n ctype -- ) M: c-type unbox-parameter c-type-unbox ; -M: string unbox-parameter c-type unbox-parameter ; +M: c-type-name unbox-parameter c-type unbox-parameter ; GENERIC: unbox-return ( ctype -- ) M: c-type unbox-return f swap c-type-unbox ; -M: string unbox-return c-type unbox-return ; +M: c-type-name unbox-return c-type unbox-return ; + +: little-endian? ( -- ? ) 1 *char 1 = ; foldable + +GENERIC: heap-size ( type -- size ) foldable + +M: c-type-name heap-size c-type heap-size ; + +M: abstract-c-type heap-size size>> ; GENERIC: stack-size ( type -- size ) foldable -M: string stack-size c-type stack-size ; +M: c-type-name stack-size c-type stack-size ; M: c-type stack-size size>> cell align ; -MIXIN: value-type - -M: value-type c-type-rep drop int-rep ; - -M: value-type c-type-getter - drop [ swap ] ; - -M: value-type c-type-setter ( type -- quot ) - [ c-type-getter ] [ c-type-unboxer-quot ] [ heap-size ] tri - '[ @ swap @ _ memcpy ] ; - GENERIC: byte-length ( seq -- n ) flushable M: byte-array byte-length length ; inline M: f byte-length drop 0 ; inline +MIXIN: value-type + : c-getter ( name -- quot ) c-type-getter [ [ "Cannot read struct fields with this type" throw ] @@ -252,42 +235,29 @@ M: f byte-length drop 0 ; inline [ "Cannot write struct fields with this type" throw ] ] unless* ; -: ( type -- array ) - heap-size ; inline - -: (c-object) ( type -- array ) - heap-size (byte-array) ; inline - -: malloc-object ( type -- alien ) - 1 swap heap-size calloc ; inline - -: (malloc-object) ( type -- alien ) - heap-size malloc ; inline - -: malloc-byte-array ( byte-array -- alien ) - dup byte-length [ nip malloc dup ] 2keep memcpy ; - -: memory>byte-array ( alien len -- byte-array ) - [ nip (byte-array) dup ] 2keep memcpy ; - -: malloc-string ( string encoding -- alien ) - string>alien malloc-byte-array ; - -M: memory-stream stream-read - [ - [ index>> ] [ alien>> ] bi - swap memory>byte-array - ] [ [ + ] change-index drop ] 2bi ; - -: byte-array>memory ( byte-array base -- ) - swap dup byte-length memcpy ; inline - : array-accessor ( type quot -- def ) [ \ swap , [ heap-size , [ * >fixnum ] % ] [ % ] bi* ] [ ] make ; -: typedef ( old new -- ) c-types get set-at ; +GENERIC: typedef ( old new -- ) + +PREDICATE: typedef-word < c-type-word + "c-type" word-prop c-type-name? ; + +M: string typedef ( old new -- ) c-types get set-at ; +M: word typedef ( old new -- ) + { + [ nip define-symbol ] + [ name>> typedef ] + [ swap "c-type" set-word-prop ] + [ + swap dup c-type-name? [ + resolve-pointer-type + "pointer-c-type" set-word-prop + ] [ 2drop ] if + ] + } 2cleave ; TUPLE: long-long-type < c-type ; @@ -312,36 +282,33 @@ M: long-long-type box-return ( type -- ) : define-out ( name -- ) [ "alien.c-types" constructor-word ] - [ dup c-setter '[ _ [ 0 @ ] keep ] ] bi + [ dup c-setter '[ _ heap-size [ 0 @ ] keep ] ] bi (( value -- c-ptr )) define-inline ; -: >c-bool ( ? -- int ) 1 0 ? ; inline - -: c-bool> ( int -- ? ) 0 = not ; inline - : define-primitive-type ( type name -- ) [ typedef ] - [ define-deref ] - [ define-out ] + [ name>> define-deref ] + [ name>> define-out ] tri ; -: malloc-file-contents ( path -- alien len ) - binary file-contents [ malloc-byte-array ] [ length ] bi ; - : if-void ( type true false -- ) - pick "void" = [ drop nip call ] [ nip call ] if ; inline + pick void? [ drop nip call ] [ nip call ] if ; inline CONSTANT: primitive-types { - "char" "uchar" - "short" "ushort" - "int" "uint" - "long" "ulong" - "longlong" "ulonglong" - "float" "double" - "void*" "bool" + char uchar + short ushort + int uint + long ulong + longlong ulonglong + float double + void* bool } +SYMBOLS: + ptrdiff_t intptr_t size_t + char* uchar* ; + [ c-ptr >>class @@ -353,7 +320,7 @@ CONSTANT: primitive-types [ >c-ptr ] >>unboxer-quot "box_alien" >>boxer "alien_offset" >>unboxer - "void*" define-primitive-type + \ void* define-primitive-type integer >>class @@ -364,7 +331,7 @@ CONSTANT: primitive-types 8 >>align "box_signed_8" >>boxer "to_signed_8" >>unboxer - "longlong" define-primitive-type + \ longlong define-primitive-type integer >>class @@ -375,7 +342,7 @@ CONSTANT: primitive-types 8 >>align "box_unsigned_8" >>boxer "to_unsigned_8" >>unboxer - "ulonglong" define-primitive-type + \ ulonglong define-primitive-type integer >>class @@ -386,7 +353,7 @@ CONSTANT: primitive-types bootstrap-cell >>align "box_signed_cell" >>boxer "to_fixnum" >>unboxer - "long" define-primitive-type + \ long define-primitive-type integer >>class @@ -397,7 +364,7 @@ CONSTANT: primitive-types bootstrap-cell >>align "box_unsigned_cell" >>boxer "to_cell" >>unboxer - "ulong" define-primitive-type + \ ulong define-primitive-type integer >>class @@ -408,7 +375,7 @@ CONSTANT: primitive-types 4 >>align "box_signed_4" >>boxer "to_fixnum" >>unboxer - "int" define-primitive-type + \ int define-primitive-type integer >>class @@ -419,7 +386,7 @@ CONSTANT: primitive-types 4 >>align "box_unsigned_4" >>boxer "to_cell" >>unboxer - "uint" define-primitive-type + \ uint define-primitive-type fixnum >>class @@ -430,7 +397,7 @@ CONSTANT: primitive-types 2 >>align "box_signed_2" >>boxer "to_fixnum" >>unboxer - "short" define-primitive-type + \ short define-primitive-type fixnum >>class @@ -441,7 +408,7 @@ CONSTANT: primitive-types 2 >>align "box_unsigned_2" >>boxer "to_cell" >>unboxer - "ushort" define-primitive-type + \ ushort define-primitive-type fixnum >>class @@ -452,7 +419,7 @@ CONSTANT: primitive-types 1 >>align "box_signed_1" >>boxer "to_fixnum" >>unboxer - "char" define-primitive-type + \ char define-primitive-type fixnum >>class @@ -463,20 +430,20 @@ CONSTANT: primitive-types 1 >>align "box_unsigned_1" >>boxer "to_cell" >>unboxer - "uchar" define-primitive-type + \ uchar define-primitive-type - [ alien-unsigned-1 c-bool> ] >>getter - [ [ >c-bool ] 2dip set-alien-unsigned-1 ] >>setter + [ alien-unsigned-1 0 = not ] >>getter + [ [ 1 0 ? ] 2dip set-alien-unsigned-1 ] >>setter 1 >>size 1 >>align "box_boolean" >>boxer "to_boolean" >>unboxer - "bool" define-primitive-type + \ bool define-primitive-type - float >>class - float >>boxed-class + math:float >>class + math:float >>boxed-class [ alien-float ] >>getter [ [ >float ] 2dip set-alien-float ] >>setter 4 >>size @@ -485,11 +452,11 @@ CONSTANT: primitive-types "to_float" >>unboxer float-rep >>rep [ >float ] >>unboxer-quot - "float" define-primitive-type + \ float define-primitive-type - float >>class - float >>boxed-class + math:float >>class + math:float >>boxed-class [ alien-double ] >>getter [ [ >float ] 2dip set-alien-double ] >>setter 8 >>size @@ -498,10 +465,10 @@ CONSTANT: primitive-types "to_double" >>unboxer double-rep >>rep [ >float ] >>unboxer-quot - "double" define-primitive-type + \ double define-primitive-type - "long" "ptrdiff_t" typedef - "long" "intptr_t" typedef - "ulong" "size_t" typedef + \ long \ ptrdiff_t typedef + \ long \ intptr_t typedef + \ ulong \ size_t typedef ] with-compilation-unit diff --git a/basis/alien/data/authors.txt b/basis/alien/data/authors.txt new file mode 100644 index 0000000000..1901f27a24 --- /dev/null +++ b/basis/alien/data/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/basis/alien/data/data-docs.factor b/basis/alien/data/data-docs.factor new file mode 100644 index 0000000000..19bfaaa8ce --- /dev/null +++ b/basis/alien/data/data-docs.factor @@ -0,0 +1,148 @@ +USING: alien alien.c-types help.syntax help.markup libc kernel.private +byte-arrays math strings hashtables alien.syntax alien.strings sequences +io.encodings.string debugger destructors vocabs.loader ; +IN: alien.data + +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. The vocabulary can be loaded with the " { $link require-c-array } " word. 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 { "type" "a C type" } { "array" byte-array } } +{ $description "Creates a byte array suitable for holding a value with the given C type." } +{ $errors "Throws an " { $link no-c-type } " error if the type does not exist." } ; + +{ malloc-object } related-words + +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: byte-array>memory +{ $values { "byte-array" byte-array } { "base" c-ptr } } +{ $description "Writes a byte array to memory starting from the " { $snippet "base" } " address." } +{ $warning "This word is unsafe. Improper use can corrupt 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 specialized array vocabulary must be loaded; otherwise, an error will be thrown. The vocabulary can be loaded with the " { $link require-c-array } " word. 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 } "." } +{ $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." } ; + +HELP: malloc-object +{ $values { "type" "a C type" } { "alien" alien } } +{ $description "Allocates an unmanaged memory block large enough to hold a value of a C type." } +{ $warning "Don't forget to deallocate the memory with a call to " { $link free } "." } +{ $errors "Throws an error if the type does not exist or if memory allocation fails." } ; + +HELP: malloc-byte-array +{ $values { "byte-array" byte-array } { "alien" alien } } +{ $description "Allocates an unmanaged memory block of the same size as the byte array, and copies the contents of the byte array there." } +{ $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 + +{ string>alien alien>string malloc-string } related-words + +ARTICLE: "malloc" "Manual memory management" +"Sometimes data passed to C functions must be allocated at a fixed address. See " { $link "byte-arrays-gc" } " for an explanation of when this is the case." +$nl +"Allocating a C datum with a fixed address:" +{ $subsection malloc-object } +{ $subsection malloc-array } +{ $subsection malloc-byte-array } +"There is a set of words in the " { $vocab-link "libc" } " vocabulary which directly call C standard library memory management functions:" +{ $subsection malloc } +{ $subsection calloc } +{ $subsection realloc } +"You must always free pointers returned by any of the above words when the block of memory is no longer in use:" +{ $subsection free } +"Utilities for automatically freeing memory in conjunction with " { $link with-destructors } ":" +{ $subsection &free } +{ $subsection |free } +"The " { $link &free } " and " { $link |free } " words are generated using " { $link "alien.destructors" } "." +$nl +"You can unsafely copy a range of bytes from one memory location to another:" +{ $subsection memcpy } +"You can copy a range of bytes from memory into a byte array:" +{ $subsection memory>byte-array } +"You can copy a byte array to memory unsafely:" +{ $subsection byte-array>memory } ; + + +ARTICLE: "c-byte-arrays" "Passing data in byte arrays" +"Instances of the " { $link byte-array } " class can be passed to C functions; the C function receives a pointer to the first element of the array." +$nl +"Byte arrays can be allocated directly with a byte count using the " { $link } " word. However in most cases, instead of computing a size in bytes directly, it is easier to use a higher-level word which expects C type and outputs a byte array large enough to hold that type:" +{ $subsection } +{ $subsection } +{ $warning +"The Factor garbage collector can move byte arrays around, and code passing byte arrays to C must obey important guidelines. See " { $link "byte-arrays-gc" } "." } +{ $see-also "c-arrays" } ; + +ARTICLE: "c-data" "Passing data between Factor and C" +"Two defining characteristics of Factor are dynamic typing and automatic memory management, which are somewhat incompatible with the machine-level data model exposed by C. Factor's C library interface defines its own set of C data types, distinct from Factor language types, together with automatic conversion between Factor values and C types. For example, C integer types must be declared and are fixed-width, whereas Factor supports arbitrary-precision integers." +$nl +"Furthermore, Factor's garbage collector can move objects in memory; for a discussion of the consequences, see " { $link "byte-arrays-gc" } "." +{ $subsection "c-types-specs" } +{ $subsection "c-byte-arrays" } +{ $subsection "malloc" } +{ $subsection "c-strings" } +{ $subsection "c-arrays" } +{ $subsection "c-out-params" } +"Important guidelines for passing data in byte arrays:" +{ $subsection "byte-arrays-gc" } +"C-style enumerated types are supported:" +{ $subsection POSTPONE: C-ENUM: } +"C types can be aliased for convenience and consitency with native library documentation:" +{ $subsection POSTPONE: TYPEDEF: } +"New C types can be defined:" +{ $subsection "c-structs" } +{ $subsection "c-unions" } +"A utility for defining " { $link "destructors" } " for deallocating memory:" +{ $subsection "alien.destructors" } +{ $see-also "aliens" } ; +HELP: malloc-string +{ $values { "string" string } { "encoding" "an encoding descriptor" } { "alien" c-ptr } } +{ $description "Encodes a string together with a trailing null code point using the given encoding, and stores the resulting bytes in a freshly-allocated unmanaged memory block." } +{ $warning "Don't forget to deallocate the memory with a call to " { $link free } "." } +{ $errors "Throws an error if one of the following conditions occurs:" + { $list + "the string contains null code points" + "the string contains characters not representable using the encoding specified" + "memory allocation fails" + } +} ; + +HELP: require-c-array +{ $values { "c-type" "a C type" } } +{ $description "Generates a specialized 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" } " vocabulary for details on the underlying sequence types loaded." } ; + +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 specialized array vocabulary must be loaded; otherwise, an error will be thrown. The vocabulary can be loaded with the " { $link require-c-array } " word. See the " { $vocab-link "specialized-arrays" } " vocabulary 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." +$nl +"Passing a Factor string to a C function expecting a C string allocates a " { $link byte-array } " in the Factor heap; the string is then converted to the requested format and a raw pointer is passed to the function." +$nl +"If the conversion fails, for example if the string contains null bytes or characters with values higher than 255, a " { $link c-string-error. } " is thrown." +$nl +"Care must be taken if the C function expects a " { $snippet "char*" } " with a length in bytes, rather than a null-terminated " { $snippet "char*" } "; passing the result of calling " { $link length } " on the string object will not suffice. This is because a Factor string of " { $emphasis "n" } " characters will not necessarily encode to " { $emphasis "n" } " bytes. The correct idiom for C functions which take a string with a length is to first encode the string using " { $link encode } ", and then pass the resulting byte array together with the length of this byte array." +$nl +"Sometimes a C function has a parameter type of " { $snippet "void*" } ", and various data types, among them strings, can be passed in. In this case, strings are not automatically converted to aliens, and instead you must call one of these words:" +{ $subsection string>alien } +{ $subsection malloc-string } +"The first allocates " { $link byte-array } "s, and the latter allocates manually-managed memory which is not moved by the garbage collector and has to be explicitly freed by calling " { $link free } ". See " { $link "byte-arrays-gc" } " for a discussion of the two approaches." +$nl +"A word to read strings from arbitrary addresses:" +{ $subsection alien>string } +"For example, if a C function returns a " { $snippet "char*" } " but stipulates that the caller must deallocate the memory afterward, you must define the function as returning " { $snippet "void*" } ", and call one of the above words before passing the pointer to " { $link free } "." ; + diff --git a/basis/alien/data/data.factor b/basis/alien/data/data.factor new file mode 100644 index 0000000000..1f2c5160e1 --- /dev/null +++ b/basis/alien/data/data.factor @@ -0,0 +1,83 @@ +! (c)2009 Slava Pestov, Joe Groff bsd license +USING: accessors alien alien.c-types alien.strings arrays +byte-arrays cpu.architecture fry io io.encodings.binary +io.files io.streams.memory kernel libc math sequences ; +IN: alien.data + +GENERIC: require-c-array ( c-type -- ) + +M: array require-c-array first require-c-array ; + +GENERIC: c-array-constructor ( c-type -- word ) + +GENERIC: c-(array)-constructor ( c-type -- word ) + +GENERIC: c-direct-array-constructor ( c-type -- word ) + +GENERIC: ( len c-type -- array ) + +M: c-type-name + c-array-constructor execute( len -- array ) ; inline + +GENERIC: (c-array) ( len c-type -- array ) + +M: c-type-name (c-array) + c-(array)-constructor execute( len -- array ) ; inline + +GENERIC: ( alien len c-type -- array ) + +M: c-type-name + c-direct-array-constructor execute( alien len -- array ) ; inline + +: malloc-array ( n type -- alien ) + [ heap-size calloc ] [ ] 2bi ; inline + +: (malloc-array) ( n type -- alien ) + [ heap-size * malloc ] [ ] 2bi ; inline + +: ( type -- array ) + heap-size ; inline + +: (c-object) ( type -- array ) + heap-size (byte-array) ; inline + +: malloc-object ( type -- alien ) + 1 swap heap-size calloc ; inline + +: (malloc-object) ( type -- alien ) + heap-size malloc ; inline + +: malloc-byte-array ( byte-array -- alien ) + dup byte-length [ nip malloc dup ] 2keep memcpy ; + +: memory>byte-array ( alien len -- byte-array ) + [ nip (byte-array) dup ] 2keep memcpy ; + +: malloc-string ( string encoding -- alien ) + string>alien malloc-byte-array ; + +: malloc-file-contents ( path -- alien len ) + binary file-contents [ malloc-byte-array ] [ length ] bi ; + +M: memory-stream stream-read + [ + [ index>> ] [ alien>> ] bi + swap memory>byte-array + ] [ [ + ] change-index drop ] 2bi ; + +: byte-array>memory ( byte-array base -- ) + swap dup byte-length memcpy ; inline + +: >c-bool ( ? -- int ) 1 0 ? ; inline + +: c-bool> ( int -- ? ) 0 = not ; inline + +M: value-type c-type-rep drop int-rep ; + +M: value-type c-type-getter + drop [ swap ] ; + +M: value-type c-type-setter ( type -- quot ) + [ c-type-getter ] [ c-type-unboxer-quot ] [ heap-size ] tri + '[ @ swap @ _ memcpy ] ; + diff --git a/basis/alien/data/summary.txt b/basis/alien/data/summary.txt new file mode 100644 index 0000000000..addddb2da4 --- /dev/null +++ b/basis/alien/data/summary.txt @@ -0,0 +1 @@ +Words for allocating objects and arrays of C types diff --git a/basis/alien/fortran/fortran-tests.factor b/basis/alien/fortran/fortran-tests.factor index 9d893b95c4..238207f192 100644 --- a/basis/alien/fortran/fortran-tests.factor +++ b/basis/alien/fortran/fortran-tests.factor @@ -1,7 +1,7 @@ ! (c) 2009 Joe Groff, see BSD license USING: accessors alien alien.c-types alien.complex -alien.fortran alien.fortran.private alien.strings classes.struct -arrays assocs byte-arrays combinators fry +alien.data alien.fortran alien.fortran.private alien.strings +classes.struct arrays assocs byte-arrays combinators fry generalizations io.encodings.ascii kernel macros macros.expander namespaces sequences shuffle tools.test ; IN: alien.fortran.tests diff --git a/basis/alien/fortran/fortran.factor b/basis/alien/fortran/fortran.factor index 52d69fd193..bf8721b549 100644 --- a/basis/alien/fortran/fortran.factor +++ b/basis/alien/fortran/fortran.factor @@ -1,5 +1,5 @@ ! (c) 2009 Joe Groff, see BSD license -USING: accessors alien alien.c-types alien.complex alien.parser +USING: accessors alien alien.c-types alien.complex alien.data grouping alien.strings alien.syntax arrays ascii assocs byte-arrays combinators combinators.short-circuit fry generalizations kernel lexer macros math math.parser namespaces parser sequences @@ -429,6 +429,11 @@ PRIVATE> MACRO: fortran-invoke ( return library function parameters -- ) { [ 2drop nip set-fortran-abi ] [ (fortran-invoke) ] } 4 ncleave ; +: parse-arglist ( parameters return -- types effect ) + [ 2 group unzip [ "," ?tail drop ] map ] + [ [ { } ] [ 1array ] if-void ] + bi* ; + :: define-fortran-function ( return library function parameters -- ) function create-in dup reset-generic return library function parameters return [ "void" ] unless* parse-arglist diff --git a/basis/alien/parser/parser.factor b/basis/alien/parser/parser.factor index 19ab08c03c..9a24f7cd4d 100644 --- a/basis/alien/parser/parser.factor +++ b/basis/alien/parser/parser.factor @@ -1,16 +1,42 @@ ! Copyright (C) 2008, 2009 Slava Pestov, Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: alien alien.c-types arrays assocs effects grouping kernel -parser sequences splitting words fry locals lexer namespaces -summary math ; +USING: accessors alien alien.c-types arrays assocs +combinators combinators.short-circuit effects grouping +kernel parser sequences splitting words fry locals lexer +namespaces summary math vocabs.parser ; IN: alien.parser +: parse-c-type-name ( name -- word/string ) + [ search ] keep or ; + +: parse-c-type ( string -- array ) + { + { [ dup "void" = ] [ drop void ] } + { [ CHAR: ] over member? ] [ parse-array-type parse-c-type-name prefix ] } + { [ dup search c-type-word? ] [ parse-c-type-name ] } + { [ dup c-types get at ] [ ] } + { [ "*" ?tail ] [ parse-c-type-name resolve-pointer-type ] } + [ no-c-type ] + } cond ; + +: scan-c-type ( -- c-type ) + scan dup "{" = + [ drop \ } parse-until >array ] + [ parse-c-type ] if ; + +: reset-c-type ( word -- ) + { "c-type" "pointer-c-type" } reset-props ; + +: CREATE-C-TYPE ( -- word ) + scan current-vocab create dup reset-c-type ; + : normalize-c-arg ( type name -- type' name' ) [ length ] [ [ CHAR: * = ] trim-head [ length - CHAR: * append ] keep - ] bi ; + ] bi + [ parse-c-type ] dip ; : parse-arglist ( parameters return -- types effect ) [ @@ -36,3 +62,9 @@ IN: alien.parser : define-function ( return library function parameters -- ) make-function define-declared ; + +PREDICATE: alien-function-word < word + def>> { + [ length 5 = ] + [ last \ alien-invoke eq? ] + } 1&& ; diff --git a/basis/alien/prettyprint/prettyprint.factor b/basis/alien/prettyprint/prettyprint.factor index 0ffd5023a7..4586c08542 100644 --- a/basis/alien/prettyprint/prettyprint.factor +++ b/basis/alien/prettyprint/prettyprint.factor @@ -1,8 +1,9 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel combinators alien alien.strings alien.syntax -math.parser prettyprint.backend prettyprint.custom -prettyprint.sections ; +USING: accessors kernel combinators alien alien.strings alien.c-types +alien.parser alien.syntax arrays assocs effects math.parser +prettyprint.backend prettyprint.custom prettyprint.sections +definitions see see.private sequences strings words ; IN: alien.prettyprint M: alien pprint* @@ -13,3 +14,39 @@ M: alien pprint* } cond ; M: dll pprint* dll-path dup "DLL\" " "\"" pprint-string ; + +M: c-type-word definer drop \ C-TYPE: f ; +M: c-type-word definition drop f ; +M: typedef-word declarations. drop ; + +GENERIC: pprint-c-type ( c-type -- ) +M: word pprint-c-type pprint-word ; +M: wrapper pprint-c-type wrapped>> pprint-word ; +M: string pprint-c-type text ; +M: array pprint-c-type pprint* ; + +M: typedef-word definer drop \ TYPEDEF: f ; + +M: typedef-word synopsis* + \ TYPEDEF: pprint-word + dup "c-type" word-prop pprint-c-type + pprint-word ; + +: pprint-function-arg ( type name -- ) + [ pprint-c-type ] [ text ] bi* ; + +: pprint-function-args ( word -- ) + [ def>> fourth ] [ stack-effect in>> ] bi zip [ ] [ + unclip-last + [ [ first2 "," append pprint-function-arg ] each ] dip + first2 pprint-function-arg + ] if-empty ; + +M: alien-function-word definer + drop \ FUNCTION: \ ; ; +M: alien-function-word definition drop f ; +M: alien-function-word synopsis* + \ FUNCTION: pprint-word + [ def>> first pprint-c-type ] + [ pprint-word ] + [ ] tri ; diff --git a/basis/alien/remote-control/remote-control.factor b/basis/alien/remote-control/remote-control.factor index b72c79e478..4ccd0e7488 100644 --- a/basis/alien/remote-control/remote-control.factor +++ b/basis/alien/remote-control/remote-control.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2007, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors alien alien.c-types alien.strings parser +USING: accessors alien alien.data alien.strings parser threads words kernel.private kernel io.encodings.utf8 eval ; IN: alien.remote-control diff --git a/basis/alien/structs/structs-docs.factor b/basis/alien/structs/structs-docs.factor index 62a3817fec..d0485ae4ba 100644 --- a/basis/alien/structs/structs-docs.factor +++ b/basis/alien/structs/structs-docs.factor @@ -1,4 +1,4 @@ -USING: alien.c-types strings help.markup help.syntax alien.syntax +USING: alien.c-types alien.data strings help.markup help.syntax alien.syntax sequences io arrays kernel words assocs namespaces ; IN: alien.structs diff --git a/basis/alien/structs/structs-tests.factor b/basis/alien/structs/structs-tests.factor index 3f84377d5c..d22aa5ee45 100755 --- a/basis/alien/structs/structs-tests.factor +++ b/basis/alien/structs/structs-tests.factor @@ -1,4 +1,4 @@ -USING: alien alien.syntax alien.c-types kernel tools.test +USING: alien alien.syntax alien.c-types alien.data kernel tools.test sequences system libc words vocabs namespaces layouts ; IN: alien.structs.tests diff --git a/basis/alien/structs/structs.factor b/basis/alien/structs/structs.factor index 80837e9a01..9478f98c63 100755 --- a/basis/alien/structs/structs.factor +++ b/basis/alien/structs/structs.factor @@ -15,7 +15,7 @@ M: struct-type c-type ; M: struct-type c-type-stack-align? drop f ; : if-value-struct ( ctype true false -- ) - [ dup value-struct? ] 2dip '[ drop "void*" @ ] if ; inline + [ dup value-struct? ] 2dip '[ drop void* @ ] if ; inline M: struct-type unbox-parameter [ %unbox-large-struct ] [ unbox-parameter ] if-value-struct ; diff --git a/basis/alien/syntax/syntax.factor b/basis/alien/syntax/syntax.factor index e8206c6968..0e3b569fff 100644 --- a/basis/alien/syntax/syntax.factor +++ b/basis/alien/syntax/syntax.factor @@ -19,7 +19,7 @@ SYNTAX: FUNCTION: (FUNCTION:) define-declared ; SYNTAX: TYPEDEF: - scan scan typedef ; + scan-c-type CREATE-C-TYPE typedef ; SYNTAX: C-STRUCT: scan current-vocab parse-definition define-struct ; deprecated @@ -31,6 +31,9 @@ SYNTAX: C-ENUM: ";" parse-tokens [ [ create-in ] dip define-constant ] each-index ; +SYNTAX: C-TYPE: + "Primitive C type definition not supported" throw ; + ERROR: no-such-symbol name library ; : address-of ( name library -- value ) diff --git a/basis/bit-arrays/bit-arrays.factor b/basis/bit-arrays/bit-arrays.factor index 0f87cf4cb6..f5613da6b5 100644 --- a/basis/bit-arrays/bit-arrays.factor +++ b/basis/bit-arrays/bit-arrays.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2007, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: alien.c-types accessors math alien.accessors kernel +USING: alien.c-types alien.data accessors math alien.accessors kernel kernel.private sequences sequences.private byte-arrays parser prettyprint.custom fry ; IN: bit-arrays diff --git a/basis/checksums/openssl/openssl.factor b/basis/checksums/openssl/openssl.factor index 6f21d96e86..673500b62a 100644 --- a/basis/checksums/openssl/openssl.factor +++ b/basis/checksums/openssl/openssl.factor @@ -1,8 +1,8 @@ ! Copyright (C) 2008 Slava Pestov ! See http://factorcode.org/license.txt for BSD license. -USING: accessors byte-arrays alien.c-types kernel continuations -destructors sequences io openssl openssl.libcrypto checksums -checksums.stream ; +USING: accessors byte-arrays alien.c-types alien.data kernel +continuations destructors sequences io openssl openssl.libcrypto +checksums checksums.stream ; IN: checksums.openssl ERROR: unknown-digest name ; diff --git a/basis/classes/struct/prettyprint/prettyprint.factor b/basis/classes/struct/prettyprint/prettyprint.factor index 2c969531e8..43d24e5716 100644 --- a/basis/classes/struct/prettyprint/prettyprint.factor +++ b/basis/classes/struct/prettyprint/prettyprint.factor @@ -1,9 +1,9 @@ ! (c)Joe Groff bsd license -USING: accessors alien alien.c-types arrays assocs classes -classes.struct combinators combinators.short-circuit continuations -fry kernel libc make math math.parser mirrors prettyprint.backend -prettyprint.custom prettyprint.sections see.private sequences -slots strings summary words ; +USING: accessors alien alien.c-types alien.data alien.prettyprint arrays +assocs classes classes.struct combinators combinators.short-circuit +continuations fry kernel libc make math math.parser mirrors +prettyprint.backend prettyprint.custom prettyprint.sections +see.private sequences slots strings summary words ; IN: classes.struct.prettyprint > text ] - [ type>> dup string? [ text ] [ pprint* ] if ] + [ type>> pprint-c-type ] [ read-only>> [ \ read-only pprint-word ] when ] [ initial>> [ \ initial: pprint-word pprint* ] when* ] } cleave block> diff --git a/basis/classes/struct/struct-tests.factor b/basis/classes/struct/struct-tests.factor index bbbaf4f1d5..b60bfa375b 100755 --- a/basis/classes/struct/struct-tests.factor +++ b/basis/classes/struct/struct-tests.factor @@ -1,11 +1,13 @@ ! (c)Joe Groff bsd license -USING: accessors alien alien.c-types ascii +USING: accessors alien alien.c-types alien.data ascii assocs byte-arrays classes.struct classes.tuple.private combinators compiler.tree.debugger compiler.units destructors io.encodings.utf8 io.pathnames io.streams.string kernel libc literals math mirrors multiline namespaces prettyprint prettyprint.config see sequences specialized-arrays system tools.test parser lexer eval layouts ; +FROM: math => float ; +QUALIFIED-WITH: alien.c-types c SPECIALIZED-ARRAY: char SPECIALIZED-ARRAY: int SPECIALIZED-ARRAY: ushort @@ -46,9 +48,9 @@ STRUCT: struct-test-bar [ { { "underlying" B{ 98 0 0 98 127 0 0 127 0 0 0 0 } } - { { "x" "char" } 98 } - { { "y" "int" } HEX: 7F00007F } - { { "z" "bool" } f } + { { "x" char } 98 } + { { "y" int } HEX: 7F00007F } + { { "z" bool } f } } ] [ B{ 98 0 0 98 127 0 0 127 0 0 0 0 } struct-test-foo memory>struct make-mirror >alist @@ -128,7 +130,7 @@ STRUCT: struct-test-bar ] unit-test UNION-STRUCT: struct-test-float-and-bits - { f float } + { f c:float } { bits uint } ; [ 1.0 ] [ struct-test-float-and-bits 1.0 float>bits >>bits f>> ] unit-test @@ -181,14 +183,14 @@ STRUCT: struct-test-string-ptr ] with-scope ] unit-test -[ <" USING: classes.struct ; +[ <" USING: alien.c-types classes.struct ; IN: classes.struct.tests STRUCT: struct-test-foo { x char initial: 0 } { y int initial: 123 } { z bool } ; "> ] [ [ struct-test-foo see ] with-string-writer ] unit-test -[ <" USING: classes.struct ; +[ <" USING: alien.c-types classes.struct ; IN: classes.struct.tests UNION-STRUCT: struct-test-float-and-bits { f float initial: 0.0 } { bits uint initial: 0 } ; @@ -201,20 +203,20 @@ UNION-STRUCT: struct-test-float-and-bits { offset 0 } { initial 0 } { class fixnum } - { type "char" } + { type char } } T{ struct-slot-spec { name "y" } { offset 4 } { initial 123 } { class integer } - { type "int" } + { type int } } T{ struct-slot-spec { name "z" } { offset 8 } { initial f } - { type "bool" } + { type bool } { class object } } } ] [ "struct-test-foo" c-type fields>> ] unit-test @@ -223,14 +225,14 @@ UNION-STRUCT: struct-test-float-and-bits T{ struct-slot-spec { name "f" } { offset 0 } - { type "float" } + { type c:float } { class float } { initial 0.0 } } T{ struct-slot-spec { name "bits" } { offset 0 } - { type "uint" } + { type uint } { class integer } { initial 0 } } @@ -277,7 +279,7 @@ STRUCT: struct-test-array-slots ] unit-test STRUCT: struct-test-optimization - { x { "int" 3 } } { y int } ; + { x { int 3 } } { y int } ; SPECIALIZED-ARRAY: struct-test-optimization diff --git a/basis/classes/struct/struct.factor b/basis/classes/struct/struct.factor index 1de221d2aa..7e99328652 100755 --- a/basis/classes/struct/struct.factor +++ b/basis/classes/struct/struct.factor @@ -1,12 +1,12 @@ ! (c)Joe Groff bsd license -USING: accessors alien alien.c-types arrays byte-arrays classes -classes.parser classes.tuple classes.tuple.parser +USING: accessors alien alien.c-types alien.data alien.parser arrays +byte-arrays classes classes.parser classes.tuple classes.tuple.parser classes.tuple.private combinators combinators.short-circuit combinators.smart cpu.architecture definitions functors.backend fry generalizations generic.parser kernel kernel.private lexer libc locals macros make math math.order parser quotations sequences slots slots.private specialized-arrays vectors words -summary namespaces assocs ; +summary namespaces assocs vocabs.parser ; IN: classes.struct SPECIALIZED-ARRAY: uchar @@ -126,7 +126,7 @@ M: struct-c-type c-type ; M: struct-c-type c-type-stack-align? drop f ; : if-value-struct ( ctype true false -- ) - [ dup value-struct? ] 2dip '[ drop "void*" @ ] if ; inline + [ dup value-struct? ] 2dip '[ drop void* @ ] if ; inline M: struct-c-type unbox-parameter [ %unbox-large-struct ] [ unbox-parameter ] if-value-struct ; @@ -197,20 +197,6 @@ M: struct-c-type c-struct? drop t ; [ type>> c-type-align ] [ max ] map-reduce ; PRIVATE> -M: struct-class c-type name>> c-type ; - -M: struct-class c-type-align c-type c-type-align ; - -M: struct-class c-type-getter c-type c-type-getter ; - -M: struct-class c-type-setter c-type c-type-setter ; - -M: struct-class c-type-boxer-quot c-type c-type-boxer-quot ; - -M: struct-class c-type-unboxer-quot c-type c-type-boxer-quot ; - -M: struct-class heap-size c-type heap-size ; - M: struct byte-length class "struct-size" word-prop ; foldable ! class definition @@ -259,7 +245,7 @@ M: struct byte-length class "struct-size" word-prop ; foldable [ check-struct-slots ] _ [ struct-align [ align ] keep ] tri (struct-word-props) ] - [ drop [ c-type-for-class ] [ name>> ] bi typedef ] 2tri ; inline + [ drop [ c-type-for-class ] keep typedef ] 2tri ; inline PRIVATE> : define-struct-class ( class slots -- ) @@ -284,9 +270,6 @@ ERROR: invalid-struct-slot token ; [ [ dup empty? ] [ peel-off-attributes ] until drop ] tri* ; array ] when ; - : parse-struct-slot ( -- slot ) scan scan-c-type \ } parse-until ; @@ -317,7 +300,7 @@ SYNTAX: S@ array ] [ >string-param ] if ; + scan dup "{" = [ drop \ } parse-until >array ] [ search ] if ; : parse-struct-slot` ( accum -- accum ) scan-string-param scan-c-type` \ } parse-until diff --git a/basis/cocoa/enumeration/enumeration.factor b/basis/cocoa/enumeration/enumeration.factor index caa83331ab..c7bdf625d9 100755 --- a/basis/cocoa/enumeration/enumeration.factor +++ b/basis/cocoa/enumeration/enumeration.factor @@ -1,17 +1,16 @@ ! Copyright (C) 2008 Joe Groff. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors kernel classes.struct cocoa cocoa.types alien.c-types -locals math sequences vectors fry libc destructors ; +USING: accessors kernel classes.struct cocoa cocoa.runtime cocoa.types alien.data +locals math sequences vectors fry libc destructors specialized-arrays ; +SPECIALIZED-ARRAY: id IN: cocoa.enumeration -<< "id" require-c-array >> - CONSTANT: NS-EACH-BUFFER-SIZE 16 : with-enumeration-buffers ( quot -- ) '[ NSFastEnumerationState malloc-struct &free - NS-EACH-BUFFER-SIZE "id" malloc-array &free + NS-EACH-BUFFER-SIZE id malloc-array &free NS-EACH-BUFFER-SIZE @ ] with-destructors ; inline @@ -19,7 +18,7 @@ CONSTANT: NS-EACH-BUFFER-SIZE 16 :: (NSFastEnumeration-each) ( object quot: ( elt -- ) state stackbuf count -- ) object state stackbuf count -> countByEnumeratingWithState:objects:count: :> items-count items-count 0 = [ - state itemsPtr>> [ items-count "id" ] [ stackbuf ] if* :> items + state itemsPtr>> [ items-count id ] [ stackbuf ] if* :> items items-count iota [ items nth quot call ] each object quot state stackbuf count (NSFastEnumeration-each) ] unless ; inline recursive diff --git a/basis/cocoa/plists/plists.factor b/basis/cocoa/plists/plists.factor index ceb097bb3a..86b13b2ddc 100644 --- a/basis/cocoa/plists/plists.factor +++ b/basis/cocoa/plists/plists.factor @@ -4,8 +4,8 @@ USING: strings arrays hashtables assocs sequences fry macros cocoa.messages cocoa.classes cocoa.application cocoa kernel namespaces io.backend math cocoa.enumeration byte-arrays -combinators alien.c-types words core-foundation quotations -core-foundation.data core-foundation.utilities ; +combinators alien.c-types alien.data words core-foundation +quotations core-foundation.data core-foundation.utilities ; IN: cocoa.plists : >plist ( value -- plist ) >cf -> autorelease ; diff --git a/basis/compiler/codegen/codegen.factor b/basis/compiler/codegen/codegen.factor index 0456ff485f..ddf5aa0e02 100755 --- a/basis/compiler/codegen/codegen.factor +++ b/basis/compiler/codegen/codegen.factor @@ -456,7 +456,7 @@ TUPLE: callback-context ; : callback-return-quot ( ctype -- quot ) return>> { - { [ dup "void" = ] [ drop [ ] ] } + { [ dup void? ] [ drop [ ] ] } { [ dup large-struct? ] [ heap-size '[ _ memcpy ] ] } [ c-type c-type-unboxer-quot ] } cond ; diff --git a/basis/compiler/tests/alien.factor b/basis/compiler/tests/alien.factor index 484b1f4f2f..e21e13dc13 100755 --- a/basis/compiler/tests/alien.factor +++ b/basis/compiler/tests/alien.factor @@ -5,6 +5,7 @@ io.streams.string kernel math memory namespaces namespaces.private parser quotations sequences specialized-arrays stack-checker stack-checker.errors system threads tools.test words ; +FROM: alien.c-types => float short ; SPECIALIZED-ARRAY: float SPECIALIZED-ARRAY: char IN: compiler.tests.alien diff --git a/basis/compiler/tests/codegen.factor b/basis/compiler/tests/codegen.factor index fcbac30444..56e368e320 100644 --- a/basis/compiler/tests/codegen.factor +++ b/basis/compiler/tests/codegen.factor @@ -4,6 +4,7 @@ namespaces.private slots.private sequences.private byte-arrays alien alien.accessors layouts words definitions compiler.units io combinators vectors grouping make alien.c-types combinators.short-circuit math.order math.libm math.parser ; +FROM: math => float ; QUALIFIED: namespaces.private IN: compiler.tests.codegen @@ -414,4 +415,4 @@ cell 4 = [ [ "0.169967142900241" "0.9854497299884601" ] [ 1.4 [ [ fcos ] [ fsin ] bi ] compile-call [ number>string ] bi@ ] unit-test [ 1 "0.169967142900241" "0.9854497299884601" ] [ 1.4 1 [ swap >float [ fcos ] [ fsin ] bi ] compile-call [ number>string ] bi@ ] unit-test -[ 6.0 ] [ 1.0 [ >float 3.0 + [ B{ 0 0 0 0 } 0 set-alien-float ] [ 2.0 + ] bi ] compile-call ] unit-test \ No newline at end of file +[ 6.0 ] [ 1.0 [ >float 3.0 + [ B{ 0 0 0 0 } 0 set-alien-float ] [ 2.0 + ] bi ] compile-call ] unit-test diff --git a/basis/compiler/tests/intrinsics.factor b/basis/compiler/tests/intrinsics.factor index ad2d2c8be5..24114e0ccb 100644 --- a/basis/compiler/tests/intrinsics.factor +++ b/basis/compiler/tests/intrinsics.factor @@ -3,8 +3,9 @@ math math.constants math.private math.integers.private sequences strings tools.test words continuations sequences.private hashtables.private byte-arrays system random layouts vectors sbufs strings.private slots.private alien math.order -alien.accessors alien.c-types alien.syntax alien.strings +alien.accessors alien.c-types alien.data alien.syntax alien.strings namespaces libc io.encodings.ascii classes compiler ; +FROM: math => float ; IN: compiler.tests.intrinsics ! Make sure that intrinsic ops compile to correct code. diff --git a/basis/compiler/tree/cleanup/cleanup-tests.factor b/basis/compiler/tree/cleanup/cleanup-tests.factor index faf6968670..02e7409c24 100755 --- a/basis/compiler/tree/cleanup/cleanup-tests.factor +++ b/basis/compiler/tree/cleanup/cleanup-tests.factor @@ -16,6 +16,7 @@ compiler.tree.propagation compiler.tree.propagation.info compiler.tree.checker compiler.tree.debugger ; +FROM: math => float ; IN: compiler.tree.cleanup.tests [ t ] [ [ [ 1 ] [ 2 ] if ] cleaned-up-tree [ #if? ] contains-node? ] unit-test diff --git a/basis/compiler/tree/propagation/propagation-tests.factor b/basis/compiler/tree/propagation/propagation-tests.factor index 0c220542ca..0da234791b 100644 --- a/basis/compiler/tree/propagation/propagation-tests.factor +++ b/basis/compiler/tree/propagation/propagation-tests.factor @@ -10,6 +10,7 @@ compiler.tree.debugger compiler.tree.checker slots.private words hashtables classes assocs locals specialized-arrays system sorting math.libm math.intervals quotations effects alien ; +FROM: math => float ; SPECIALIZED-ARRAY: double IN: compiler.tree.propagation.tests diff --git a/basis/core-foundation/numbers/numbers.factor b/basis/core-foundation/numbers/numbers.factor index f01f522d61..ae061cb4eb 100644 --- a/basis/core-foundation/numbers/numbers.factor +++ b/basis/core-foundation/numbers/numbers.factor @@ -1,6 +1,7 @@ ! Copyright (C) 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: alien.c-types alien.syntax kernel math core-foundation ; +FROM: math => float ; IN: core-foundation.numbers TYPEDEF: void* CFNumberRef diff --git a/basis/cpu/ppc/ppc.factor b/basis/cpu/ppc/ppc.factor index 9c829bc390..72ad543307 100644 --- a/basis/cpu/ppc/ppc.factor +++ b/basis/cpu/ppc/ppc.factor @@ -2,13 +2,14 @@ ! See http://factorcode.org/license.txt for BSD license. USING: accessors assocs sequences kernel combinators make math math.order math.ranges system namespaces locals layouts words -alien alien.accessors alien.c-types literals cpu.architecture +alien alien.accessors alien.c-types alien.data literals cpu.architecture cpu.ppc.assembler cpu.ppc.assembler.backend compiler.cfg.registers compiler.cfg.instructions compiler.cfg.comparisons compiler.codegen.fixup compiler.cfg.intrinsics compiler.cfg.stack-frame compiler.cfg.build-stack-frame compiler.units compiler.constants compiler.codegen ; FROM: cpu.ppc.assembler => B ; +FROM: math => float ; IN: cpu.ppc ! PowerPC register assignments: @@ -770,5 +771,5 @@ USE: vocabs.loader 4 >>align "box_boolean" >>boxer "to_boolean" >>unboxer - "bool" define-primitive-type + bool define-primitive-type ] with-compilation-unit diff --git a/basis/cpu/x86/64/unix/unix.factor b/basis/cpu/x86/64/unix/unix.factor index 17cc0e3f80..13e91a87a4 100644 --- a/basis/cpu/x86/64/unix/unix.factor +++ b/basis/cpu/x86/64/unix/unix.factor @@ -16,9 +16,10 @@ M: float-regs param-regs M: x86.64 reserved-area-size 0 ; -! The ABI for passing structs by value is pretty messed up -<< "void*" c-type clone "__stack_value" define-primitive-type -stack-params "__stack_value" c-type (>>rep) >> +SYMBOL: (stack-value) +! The ABI for passing structs by value is pretty great +<< void* c-type clone \ (stack-value) define-primitive-type +stack-params \ (stack-value) c-type (>>rep) >> : struct-types&offset ( struct-type -- pairs ) fields>> [ @@ -33,12 +34,12 @@ stack-params "__stack_value" c-type (>>rep) >> : flatten-small-struct ( c-type -- seq ) struct-types&offset split-struct [ [ c-type c-type-rep reg-class-of ] map - int-regs swap member? "void*" "double" ? c-type + int-regs swap member? void* double ? c-type ] map ; : flatten-large-struct ( c-type -- seq ) heap-size cell align - cell /i "__stack_value" c-type ; + cell /i \ (stack-value) c-type ; : flatten-struct ( c-type -- seq ) dup heap-size 16 > [ diff --git a/basis/cpu/x86/64/winnt/winnt.factor b/basis/cpu/x86/64/winnt/winnt.factor index d9f83612e6..bbe943e06b 100644 --- a/basis/cpu/x86/64/winnt/winnt.factor +++ b/basis/cpu/x86/64/winnt/winnt.factor @@ -25,8 +25,8 @@ M: x86.64 dummy-fp-params? t ; M: x86.64 temp-reg RAX ; << -"longlong" "ptrdiff_t" typedef -"longlong" "intptr_t" typedef -"int" c-type "long" define-primitive-type -"uint" c-type "ulong" define-primitive-type +longlong ptrdiff_t typedef +longlong intptr_t typedef +int c-type long define-primitive-type +uint c-type ulong define-primitive-type >> diff --git a/basis/cpu/x86/features/features.factor b/basis/cpu/x86/features/features.factor index 02235bb62e..c5cf2d470a 100644 --- a/basis/cpu/x86/features/features.factor +++ b/basis/cpu/x86/features/features.factor @@ -1,8 +1,8 @@ ! Copyright (C) 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: system kernel math math.order math.parser namespaces -alien.syntax combinators locals init io cpu.x86 compiler -compiler.units accessors ; +alien.c-types alien.syntax combinators locals init io cpu.x86 +compiler compiler.units accessors ; IN: cpu.x86.features float ; IN: cpu.x86 << enable-fixnum-log2 >> diff --git a/basis/db/postgresql/lib/lib.factor b/basis/db/postgresql/lib/lib.factor index 2278afe4ed..5398e669ed 100644 --- a/basis/db/postgresql/lib/lib.factor +++ b/basis/db/postgresql/lib/lib.factor @@ -2,11 +2,11 @@ ! See http://factorcode.org/license.txt for BSD license. USING: arrays continuations db io kernel math namespaces quotations sequences db.postgresql.ffi alien alien.c-types -db.types tools.walker ascii splitting math.parser combinators -libc calendar.format byte-arrays destructors prettyprint -accessors strings serialize io.encodings.binary io.encodings.utf8 -alien.strings io.streams.byte-array summary present urls -specialized-arrays db.private ; +alien.data db.types tools.walker ascii splitting math.parser +combinators libc calendar.format byte-arrays destructors +prettyprint accessors strings serialize io.encodings.binary +io.encodings.utf8 alien.strings io.streams.byte-array summary +present urls specialized-arrays db.private ; SPECIALIZED-ARRAY: uint SPECIALIZED-ARRAY: void* IN: db.postgresql.lib diff --git a/basis/db/sqlite/lib/lib.factor b/basis/db/sqlite/lib/lib.factor index 3565b09856..163026f5ff 100644 --- a/basis/db/sqlite/lib/lib.factor +++ b/basis/db/sqlite/lib/lib.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2008 Chris Double, Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: alien.c-types arrays assocs kernel math math.parser +USING: alien.c-types alien.data arrays assocs kernel math math.parser namespaces sequences db.sqlite.ffi db combinators continuations db.types calendar.format serialize io.streams.byte-array byte-arrays io.encodings.binary diff --git a/basis/environment/unix/unix.factor b/basis/environment/unix/unix.factor index 84dfbbd43e..3fc8c2f79b 100644 --- a/basis/environment/unix/unix.factor +++ b/basis/environment/unix/unix.factor @@ -1,8 +1,9 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: alien alien.c-types alien.strings alien.syntax kernel -layouts sequences system unix environment io.encodings.utf8 -unix.utilities vocabs.loader combinators alien.accessors ; +USING: alien alien.c-types alien.data alien.strings +alien.syntax kernel layouts sequences system unix +environment io.encodings.utf8 unix.utilities vocabs.loader +combinators alien.accessors ; IN: environment.unix HOOK: environ os ( -- void* ) diff --git a/basis/environment/winnt/winnt.factor b/basis/environment/winnt/winnt.factor index 518a7d5d7a..894415ace8 100755 --- a/basis/environment/winnt/winnt.factor +++ b/basis/environment/winnt/winnt.factor @@ -1,15 +1,14 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: alien.strings fry io.encodings.utf16n kernel -splitting windows windows.kernel32 system environment -alien.c-types sequences windows.errors io.streams.memory -io.encodings io ; +splitting windows windows.kernel32 windows.types system +environment alien.data sequences windows.errors +io.streams.memory io.encodings io specialized-arrays ; +SPECIALIZED-ARRAY: TCHAR IN: environment.winnt -<< "TCHAR" require-c-array >> - M: winnt os-env ( key -- value ) - MAX_UNICODE_PATH "TCHAR" + MAX_UNICODE_PATH TCHAR [ dup length GetEnvironmentVariable ] keep over 0 = [ 2drop f ] [ diff --git a/basis/functors/functors-tests.factor b/basis/functors/functors-tests.factor index 32d578d05d..58da96aa17 100644 --- a/basis/functors/functors-tests.factor +++ b/basis/functors/functors-tests.factor @@ -1,5 +1,6 @@ USING: classes.struct functors tools.test math words kernel multiline parser io.streams.string generic ; +QUALIFIED-WITH: alien.c-types c IN: functors.tests << @@ -160,15 +161,15 @@ T-class DEFINES-CLASS ${T} WHERE STRUCT: T-class - { NAME int } + { NAME c:int } { x { TYPE 4 } } - { y { "short" N } } + { y { c:short N } } { z TYPE initial: 5 } - { float { "float" 2 } } ; + { float { c:float 2 } } ; ;FUNCTOR -"a-struct" "nemo" "char" 2 define-a-struct +"a-struct" "nemo" c:char 2 define-a-struct >> @@ -179,35 +180,35 @@ STRUCT: T-class { offset 0 } { class integer } { initial 0 } - { type "int" } + { type c:int } } T{ struct-slot-spec { name "x" } { offset 4 } { class object } { initial f } - { type { "char" 4 } } + { type { c:char 4 } } } T{ struct-slot-spec { name "y" } { offset 8 } { class object } { initial f } - { type { "short" 2 } } + { type { c:short 2 } } } T{ struct-slot-spec { name "z" } { offset 12 } { class fixnum } { initial 5 } - { type "char" } + { type c:char } } T{ struct-slot-spec { name "float" } { offset 16 } { class object } { initial f } - { type { "float" 2 } } + { type { c:float 2 } } } } ] [ a-struct struct-slots ] unit-test diff --git a/basis/game-input/dinput/dinput.factor b/basis/game-input/dinput/dinput.factor index ea3100f95f..16bea60ea5 100755 --- a/basis/game-input/dinput/dinput.factor +++ b/basis/game-input/dinput/dinput.factor @@ -6,7 +6,7 @@ math.rectangles namespaces parser sequences shuffle specialized-arrays ui.backend.windows vectors windows.com windows.dinput windows.dinput.constants windows.errors windows.kernel32 windows.messages windows.ole32 -windows.user32 classes.struct ; +windows.user32 classes.struct alien.data ; SPECIALIZED-ARRAY: DIDEVICEOBJECTDATA IN: game-input.dinput @@ -160,19 +160,24 @@ SYMBOLS: +dinput+ +keyboard-device+ +keyboard-state+ [ device-attached? not ] filter [ remove-controller ] each ; -: device-interface? ( dbt-broadcast-hdr -- ? ) - dbch_devicetype>> DBT_DEVTYP_DEVICEINTERFACE = ; +: ?device-interface ( dbt-broadcast-hdr -- ? ) + dup dbch_devicetype>> DBT_DEVTYP_DEVICEINTERFACE = + [ >c-ptr DEV_BROADCAST_DEVICEW memory>struct ] + [ drop f ] if ; inline : device-arrived ( dbt-broadcast-hdr -- ) - device-interface? [ find-controllers ] when ; + ?device-interface [ find-controllers ] when ; inline : device-removed ( dbt-broadcast-hdr -- ) - device-interface? [ find-and-remove-detached-devices ] when ; + ?device-interface [ find-and-remove-detached-devices ] when ; inline + +: ( wParam -- struct ) + DEV_BROADCAST_HDR memory>struct ; : handle-wm-devicechange ( hWnd uMsg wParam lParam -- ) [ 2drop ] 2dip swap { - { [ dup DBT_DEVICEARRIVAL = ] [ drop device-arrived ] } - { [ dup DBT_DEVICEREMOVECOMPLETE = ] [ drop device-removed ] } + { [ dup DBT_DEVICEARRIVAL = ] [ drop device-arrived ] } + { [ dup DBT_DEVICEREMOVECOMPLETE = ] [ drop device-removed ] } [ 2drop ] } cond ; diff --git a/basis/game-input/dinput/keys-array/keys-array.factor b/basis/game-input/dinput/keys-array/keys-array.factor index 9a84747dd8..a8813b0397 100755 --- a/basis/game-input/dinput/keys-array/keys-array.factor +++ b/basis/game-input/dinput/keys-array/keys-array.factor @@ -1,5 +1,5 @@ -USING: sequences sequences.private math alien.c-types -accessors ; +USING: sequences sequences.private math +accessors alien.data ; IN: game-input.dinput.keys-array TUPLE: keys-array diff --git a/basis/game-input/iokit/iokit.factor b/basis/game-input/iokit/iokit.factor index 71d547ad29..85f058f283 100755 --- a/basis/game-input/iokit/iokit.factor +++ b/basis/game-input/iokit/iokit.factor @@ -3,7 +3,8 @@ kernel cocoa.enumeration destructors math.parser cocoa.application sequences locals combinators.short-circuit threads namespaces assocs arrays combinators hints alien core-foundation.run-loop accessors sequences.private -alien.c-types math parser game-input vectors bit-arrays ; +alien.c-types alien.data math parser game-input vectors +bit-arrays ; IN: game-input.iokit SINGLETON: iokit-game-input-backend diff --git a/basis/images/memory/memory.factor b/basis/images/memory/memory.factor index 1a977b604e..ccf891d770 100644 --- a/basis/images/memory/memory.factor +++ b/basis/images/memory/memory.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors alien.c-types destructors fry images kernel -libc math sequences ; +USING: accessors alien.c-types alien.data destructors fry images +kernel libc math sequences ; IN: images.memory ! Some code shared by core-graphics and cairo for constructing @@ -27,4 +27,4 @@ PRIVATE> : make-memory-bitmap ( dim quot -- image ) '[ [ malloc-bitmap-data ] keep _ [ ] 2bi - ] with-destructors ; inline \ No newline at end of file + ] with-destructors ; inline diff --git a/basis/io/backend/windows/nt/privileges/privileges.factor b/basis/io/backend/windows/nt/privileges/privileges.factor index 57878ba75b..bb9e0edc33 100755 --- a/basis/io/backend/windows/nt/privileges/privileges.factor +++ b/basis/io/backend/windows/nt/privileges/privileges.factor @@ -1,4 +1,4 @@ -USING: alien alien.c-types alien.syntax arrays continuations +USING: alien alien.c-types alien.data alien.syntax arrays continuations destructors generic io.mmap io.ports io.backend.windows io.files.windows kernel libc math math.bitwise namespaces quotations sequences windows windows.advapi32 windows.kernel32 io.backend system accessors diff --git a/basis/io/buffers/buffers-tests.factor b/basis/io/buffers/buffers-tests.factor index 4425e08106..d366df7c54 100644 --- a/basis/io/buffers/buffers-tests.factor +++ b/basis/io/buffers/buffers-tests.factor @@ -1,7 +1,7 @@ IN: io.buffers.tests -USING: alien alien.c-types io.buffers kernel kernel.private libc -sequences tools.test namespaces byte-arrays strings accessors -destructors ; +USING: alien alien.c-types alien.data io.buffers kernel +kernel.private libc sequences tools.test namespaces byte-arrays +strings accessors destructors ; : buffer-set ( string buffer -- ) over >byte-array over ptr>> byte-array>memory diff --git a/basis/io/buffers/buffers.factor b/basis/io/buffers/buffers.factor index 82c5326b1d..aa9cedf340 100644 --- a/basis/io/buffers/buffers.factor +++ b/basis/io/buffers/buffers.factor @@ -2,8 +2,8 @@ ! Copyright (C) 2006, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors alien alien.accessors alien.c-types -alien.syntax kernel libc math sequences byte-arrays strings -hints math.order destructors combinators ; +alien.data alien.syntax kernel libc math sequences byte-arrays +strings hints math.order destructors combinators ; IN: io.buffers TUPLE: buffer diff --git a/basis/io/files/info/windows/windows.factor b/basis/io/files/info/windows/windows.factor index bb3a412669..5ae21fcfee 100755 --- a/basis/io/files/info/windows/windows.factor +++ b/basis/io/files/info/windows/windows.factor @@ -6,7 +6,7 @@ windows.time windows accessors alien.c-types combinators generalizations system alien.strings io.encodings.utf16n sequences splitting windows.errors fry continuations destructors calendar ascii combinators.short-circuit locals classes.struct -specialized-arrays ; +specialized-arrays alien.data ; SPECIALIZED-ARRAY: ushort IN: io.files.info.windows diff --git a/basis/io/files/windows/windows.factor b/basis/io/files/windows/windows.factor index 43463bd3f1..ca5c9b3c4a 100755 --- a/basis/io/files/windows/windows.factor +++ b/basis/io/files/windows/windows.factor @@ -6,7 +6,7 @@ io.backend.windows kernel math splitting fry alien.strings windows windows.kernel32 windows.time calendar combinators math.functions sequences namespaces make words system destructors accessors math.bitwise continuations windows.errors -arrays byte-arrays generalizations ; +arrays byte-arrays generalizations alien.data ; IN: io.files.windows : open-file ( path access-mode create-mode flags -- handle ) diff --git a/basis/io/mmap/mmap.factor b/basis/io/mmap/mmap.factor index 704a585dd4..a866232760 100644 --- a/basis/io/mmap/mmap.factor +++ b/basis/io/mmap/mmap.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: continuations destructors io.files io.files.info io.backend kernel quotations system alien alien.accessors -accessors vocabs.loader combinators alien.c-types +accessors vocabs.loader combinators alien.c-types alien.data math ; IN: io.mmap diff --git a/basis/io/monitors/windows/nt/nt.factor b/basis/io/monitors/windows/nt/nt.factor index 3d837d79d8..9cd8bc4df8 100755 --- a/basis/io/monitors/windows/nt/nt.factor +++ b/basis/io/monitors/windows/nt/nt.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008 Doug Coleman, Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: alien alien.c-types alien.strings libc destructors locals -kernel math assocs namespaces make continuations sequences +USING: alien alien.c-types alien.data alien.strings libc destructors +locals kernel math assocs namespaces make continuations sequences hashtables sorting arrays combinators math.bitwise strings system accessors threads splitting io.backend io.backend.windows io.backend.windows.nt io.files.windows.nt io.monitors io.ports diff --git a/basis/io/sockets/secure/openssl/openssl.factor b/basis/io/sockets/secure/openssl/openssl.factor index 8f596da0bd..6d01a66cf0 100644 --- a/basis/io/sockets/secure/openssl/openssl.factor +++ b/basis/io/sockets/secure/openssl/openssl.factor @@ -1,10 +1,10 @@ ! Copyright (C) 2007, 2008, Slava Pestov, Elie CHAFTARI. ! See http://factorcode.org/license.txt for BSD license. USING: accessors byte-arrays kernel sequences namespaces math -math.order combinators init alien alien.c-types alien.strings -libc continuations destructors summary splitting assocs random -math.parser locals unicode.case openssl openssl.libcrypto -openssl.libssl io.backend io.ports io.pathnames +math.order combinators init alien alien.c-types alien.data +alien.strings libc continuations destructors summary splitting +assocs random math.parser locals unicode.case openssl +openssl.libcrypto openssl.libssl io.backend io.ports io.pathnames io.encodings.8-bit io.timeouts io.sockets.secure ; IN: io.sockets.secure.openssl diff --git a/basis/io/sockets/sockets.factor b/basis/io/sockets/sockets.factor index 601d269d5c..a542575446 100755 --- a/basis/io/sockets/sockets.factor +++ b/basis/io/sockets/sockets.factor @@ -6,7 +6,7 @@ arrays io.encodings io.ports io.streams.duplex io.encodings.ascii alien.strings io.binary accessors destructors classes byte-arrays parser alien.c-types math.parser splitting grouping math assocs summary system vocabs.loader combinators present fry vocabs.parser -classes.struct ; +classes.struct alien.data ; IN: io.sockets << { diff --git a/basis/io/sockets/unix/unix.factor b/basis/io/sockets/unix/unix.factor index e892c6a7ef..fa46a71ca0 100755 --- a/basis/io/sockets/unix/unix.factor +++ b/basis/io/sockets/unix/unix.factor @@ -5,7 +5,7 @@ threads sequences byte-arrays io.binary io.backend.unix io.streams.duplex io.backend io.pathnames io.sockets.private io.files.private io.encodings.utf8 math.parser continuations libc combinators system accessors destructors unix locals init -classes.struct ; +classes.struct alien.data ; EXCLUDE: namespaces => bind ; EXCLUDE: io => read write ; diff --git a/basis/io/sockets/windows/nt/nt.factor b/basis/io/sockets/windows/nt/nt.factor index f423a42b65..7cc21c9611 100755 --- a/basis/io/sockets/windows/nt/nt.factor +++ b/basis/io/sockets/windows/nt/nt.factor @@ -1,4 +1,4 @@ -USING: alien alien.accessors alien.c-types byte-arrays +USING: alien alien.accessors alien.c-types alien.data byte-arrays continuations destructors io.ports io.timeouts io.sockets io.sockets.private io namespaces io.streams.duplex io.backend.windows io.sockets.windows io.backend.windows.nt diff --git a/basis/libc/libc.factor b/basis/libc/libc.factor index 4142e40c68..fe56c83516 100644 --- a/basis/libc/libc.factor +++ b/basis/libc/libc.factor @@ -2,29 +2,29 @@ ! Copyright (C) 2007, 2009 Slava Pestov ! Copyright (C) 2007, 2008 Doug Coleman ! See http://factorcode.org/license.txt for BSD license. -USING: alien assocs continuations alien.destructors kernel +USING: alien alien.c-types assocs continuations alien.destructors kernel namespaces accessors sets summary destructors destructors.private ; IN: libc : errno ( -- int ) - "int" "factor" "err_no" { } alien-invoke ; + int "factor" "err_no" { } alien-invoke ; : clear-errno ( -- ) - "void" "factor" "clear_err_no" { } alien-invoke ; + void "factor" "clear_err_no" { } alien-invoke ; >c-ptr [ delete-malloc ] [ (free) ] bi ; : memcpy ( dst src size -- ) - "void" "libc" "memcpy" { "void*" "void*" "ulong" } alien-invoke ; + void "libc" "memcpy" { void* void* ulong } alien-invoke ; : memcmp ( a b size -- cmp ) - "int" "libc" "memcmp" { "void*" "void*" "ulong" } alien-invoke ; + int "libc" "memcmp" { void* void* ulong } alien-invoke ; : memory= ( a b size -- ? ) memcmp 0 = ; : strlen ( alien -- len ) - "size_t" "libc" "strlen" { "char*" } alien-invoke ; + size_t "libc" "strlen" { char* } alien-invoke ; DESTRUCTOR: free diff --git a/basis/math/blas/matrices/matrices.factor b/basis/math/blas/matrices/matrices.factor index a051fb250d..aa9681bb2e 100755 --- a/basis/math/blas/matrices/matrices.factor +++ b/basis/math/blas/matrices/matrices.factor @@ -1,10 +1,11 @@ -USING: accessors alien alien.c-types arrays byte-arrays combinators -combinators.short-circuit fry kernel locals macros -math math.blas.ffi math.blas.vectors math.blas.vectors.private -math.complex math.functions math.order functors words -sequences sequences.merged sequences.private shuffle -parser prettyprint.backend prettyprint.custom ascii -specialized-arrays ; +USING: accessors alien alien.c-types alien.data arrays +byte-arrays combinators combinators.short-circuit fry +kernel locals macros math math.blas.ffi math.blas.vectors +math.blas.vectors.private math.complex math.functions +math.order functors words sequences sequences.merged +sequences.private shuffle parser prettyprint.backend +prettyprint.custom ascii specialized-arrays ; +FROM: alien.c-types => float ; SPECIALIZED-ARRAY: float SPECIALIZED-ARRAY: double SPECIALIZED-ARRAY: complex-float diff --git a/basis/math/blas/vectors/vectors.factor b/basis/math/blas/vectors/vectors.factor index c08fdb6120..20ee7925b0 100755 --- a/basis/math/blas/vectors/vectors.factor +++ b/basis/math/blas/vectors/vectors.factor @@ -3,6 +3,7 @@ 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 SPECIALIZED-ARRAY: complex-float diff --git a/basis/math/libm/libm.factor b/basis/math/libm/libm.factor index df8b36fd28..0288894081 100644 --- a/basis/math/libm/libm.factor +++ b/basis/math/libm/libm.factor @@ -1,62 +1,62 @@ ! Copyright (C) 2006 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: alien ; +USING: alien alien.c-types ; IN: math.libm : facos ( x -- y ) - "double" "libm" "acos" { "double" } alien-invoke ; + double "libm" "acos" { double } alien-invoke ; : fasin ( x -- y ) - "double" "libm" "asin" { "double" } alien-invoke ; + double "libm" "asin" { double } alien-invoke ; : fatan ( x -- y ) - "double" "libm" "atan" { "double" } alien-invoke ; + double "libm" "atan" { double } alien-invoke ; : fatan2 ( x y -- z ) - "double" "libm" "atan2" { "double" "double" } alien-invoke ; + double "libm" "atan2" { double double } alien-invoke ; : fcos ( x -- y ) - "double" "libm" "cos" { "double" } alien-invoke ; + double "libm" "cos" { double } alien-invoke ; : fsin ( x -- y ) - "double" "libm" "sin" { "double" } alien-invoke ; + double "libm" "sin" { double } alien-invoke ; : ftan ( x -- y ) - "double" "libm" "tan" { "double" } alien-invoke ; + double "libm" "tan" { double } alien-invoke ; : fcosh ( x -- y ) - "double" "libm" "cosh" { "double" } alien-invoke ; + double "libm" "cosh" { double } alien-invoke ; : fsinh ( x -- y ) - "double" "libm" "sinh" { "double" } alien-invoke ; + double "libm" "sinh" { double } alien-invoke ; : ftanh ( x -- y ) - "double" "libm" "tanh" { "double" } alien-invoke ; + double "libm" "tanh" { double } alien-invoke ; : fexp ( x -- y ) - "double" "libm" "exp" { "double" } alien-invoke ; + double "libm" "exp" { double } alien-invoke ; : flog ( x -- y ) - "double" "libm" "log" { "double" } alien-invoke ; + double "libm" "log" { double } alien-invoke ; : flog10 ( x -- y ) - "double" "libm" "log10" { "double" } alien-invoke ; + double "libm" "log10" { double } alien-invoke ; : fpow ( x y -- z ) - "double" "libm" "pow" { "double" "double" } alien-invoke ; + double "libm" "pow" { double double } alien-invoke ; : fsqrt ( x -- y ) - "double" "libm" "sqrt" { "double" } alien-invoke ; + double "libm" "sqrt" { double } alien-invoke ; ! Windows doesn't have these... : flog1+ ( x -- y ) - "double" "libm" "log1p" { "double" } alien-invoke ; + double "libm" "log1p" { double } alien-invoke ; : facosh ( x -- y ) - "double" "libm" "acosh" { "double" } alien-invoke ; + double "libm" "acosh" { double } alien-invoke ; : fasinh ( x -- y ) - "double" "libm" "asinh" { "double" } alien-invoke ; + double "libm" "asinh" { double } alien-invoke ; : fatanh ( x -- y ) - "double" "libm" "atanh" { "double" } alien-invoke ; + double "libm" "atanh" { double } alien-invoke ; diff --git a/basis/math/vectors/simd/functor/functor.factor b/basis/math/vectors/simd/functor/functor.factor index cabb731fef..641585a5d7 100644 --- a/basis/math/vectors/simd/functor/functor.factor +++ b/basis/math/vectors/simd/functor/functor.factor @@ -9,14 +9,16 @@ ERROR: bad-length got expected ; FUNCTOR: define-simd-128 ( T -- ) -N [ 16 T heap-size /i ] +T-TYPE IS ${T} + +N [ 16 T-TYPE heap-size /i ] A DEFINES-CLASS ${T}-${N} >A DEFINES >${A} A{ DEFINES ${A}{ -NTH [ T dup c-type-getter-boxer array-accessor ] -SET-NTH [ T dup c-setter array-accessor ] +NTH [ T-TYPE dup c-type-getter-boxer array-accessor ] +SET-NTH [ T-TYPE dup c-setter array-accessor ] A-rep IS ${A}-rep A-vv->v-op DEFINES-PRIVATE ${A}-vv->v-op @@ -74,7 +76,9 @@ PRIVATE> ! Synthesize 256-bit vectors from a pair of 128-bit vectors FUNCTOR: define-simd-256 ( T -- ) -N [ 32 T heap-size /i ] +T-TYPE IS ${T} + +N [ 32 T-TYPE heap-size /i ] N/2 [ N 2 / ] A/2 IS ${T}-${N/2} diff --git a/basis/math/vectors/simd/intrinsics/intrinsics.factor b/basis/math/vectors/simd/intrinsics/intrinsics.factor index 28547f8cf9..914d1ef169 100644 --- a/basis/math/vectors/simd/intrinsics/intrinsics.factor +++ b/basis/math/vectors/simd/intrinsics/intrinsics.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel alien alien.c-types cpu.architecture libc ; +USING: kernel alien alien.data cpu.architecture libc ; IN: math.vectors.simd.intrinsics ERROR: bad-simd-call ; diff --git a/basis/math/vectors/simd/simd.factor b/basis/math/vectors/simd/simd.factor index 7df9b2d8d2..a3c99ae217 100644 --- a/basis/math/vectors/simd/simd.factor +++ b/basis/math/vectors/simd/simd.factor @@ -5,6 +5,8 @@ kernel math math.functions math.vectors math.vectors.simd.functor math.vectors.simd.intrinsics math.vectors.specialization parser prettyprint.custom sequences sequences.private locals assocs words fry ; +FROM: alien.c-types => float ; +QUALIFIED-WITH: math m IN: math.vectors.simd << @@ -15,9 +17,9 @@ DEFER: float-8 DEFER: double-4 "double" define-simd-128 -"float" define-simd-128 +"float" define-simd-128 "double" define-simd-256 -"float" define-simd-256 +"float" define-simd-256 >> @@ -136,7 +138,7 @@ DEFER: double-4 PRIVATE> -\ float-4 \ float-4-with float H{ +\ float-4 \ float-4-with m:float H{ { v+ [ [ (simd-v+) ] float-4-vv->v-op ] } { v- [ [ (simd-v-) ] float-4-vv->v-op ] } { v* [ [ (simd-v*) ] float-4-vv->v-op ] } @@ -146,7 +148,7 @@ PRIVATE> { sum [ [ (simd-sum) ] float-4-v->n-op ] } } simd-vector-words -\ double-2 \ double-2-with float H{ +\ double-2 \ double-2-with m:float H{ { v+ [ [ (simd-v+) ] double-2-vv->v-op ] } { v- [ [ (simd-v-) ] double-2-vv->v-op ] } { v* [ [ (simd-v*) ] double-2-vv->v-op ] } @@ -156,7 +158,7 @@ PRIVATE> { sum [ [ (simd-sum) ] double-2-v->n-op ] } } simd-vector-words -\ float-8 \ float-8-with float H{ +\ float-8 \ float-8-with m:float H{ { v+ [ [ (simd-v+) ] float-8-vv->v-op ] } { v- [ [ (simd-v-) ] float-8-vv->v-op ] } { v* [ [ (simd-v*) ] float-8-vv->v-op ] } @@ -166,7 +168,7 @@ PRIVATE> { sum [ [ (simd-sum) ] [ + ] float-8-v->n-op ] } } simd-vector-words -\ double-4 \ double-4-with float H{ +\ double-4 \ double-4-with m:float H{ { v+ [ [ (simd-v+) ] double-4-vv->v-op ] } { v- [ [ (simd-v-) ] double-4-vv->v-op ] } { v* [ [ (simd-v*) ] double-4-vv->v-op ] } diff --git a/basis/opengl/opengl.factor b/basis/opengl/opengl.factor index 75f327664d..cdf68cebd3 100755 --- a/basis/opengl/opengl.factor +++ b/basis/opengl/opengl.factor @@ -8,6 +8,7 @@ math.parser opengl.gl combinators combinators.smart arrays sequences splitting words byte-arrays assocs vocabs colors colors.constants accessors generalizations locals fry specialized-arrays ; +FROM: alien.c-types => float ; SPECIALIZED-ARRAY: float SPECIALIZED-ARRAY: uint IN: opengl diff --git a/basis/opengl/shaders/shaders.factor b/basis/opengl/shaders/shaders.factor index 26ffd0cf88..562cbc91ce 100755 --- a/basis/opengl/shaders/shaders.factor +++ b/basis/opengl/shaders/shaders.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008 Joe Groff. ! See http://factorcode.org/license.txt for BSD license. USING: kernel opengl.gl alien.c-types continuations namespaces -assocs alien alien.strings libc opengl math sequences combinators +assocs alien alien.data alien.strings libc opengl math sequences combinators macros arrays io.encodings.ascii fry specialized-arrays destructors accessors ; SPECIALIZED-ARRAY: uint diff --git a/basis/prettyprint/config/config-docs.factor b/basis/prettyprint/config/config-docs.factor index 1dcb1b5617..ccc63c61cb 100644 --- a/basis/prettyprint/config/config-docs.factor +++ b/basis/prettyprint/config/config-docs.factor @@ -19,6 +19,9 @@ HELP: length-limit HELP: line-limit { $var-description "The maximum number of lines output by the prettyprinter before output is truncated with \"...\". The default is " { $link f } ", denoting unlimited line count." } ; +HELP: number-base +{ $var-description "The number base in which the prettyprinter will output numeric literals. A value of " { $snippet "2" } " will print integers and ratios in binary with " { $link POSTPONE: BIN: } ", and " { $snippet "8" } " will print them in octal with " { $link POSTPONE: OCT: } ". A value of " { $snippet "16" } " will print all integers, ratios, and floating-point values in hexadecimal with " { $link POSTPONE: HEX: } ". Other values of " { $snippet "number-base" } " will print numbers in decimal, which is the default." } ; + HELP: string-limit? { $var-description "Toggles whether printed strings are truncated to the margin." } ; diff --git a/basis/prettyprint/prettyprint-docs.factor b/basis/prettyprint/prettyprint-docs.factor index 7c114f2e22..1560b208ab 100644 --- a/basis/prettyprint/prettyprint-docs.factor +++ b/basis/prettyprint/prettyprint-docs.factor @@ -28,6 +28,7 @@ ARTICLE: "prettyprint-variables" "Prettyprint control variables" { $subsection nesting-limit } { $subsection length-limit } { $subsection line-limit } +{ $subsection number-base } { $subsection string-limit? } { $subsection boa-tuples? } { $subsection c-object-pointers? } @@ -202,8 +203,8 @@ HELP: .o { $description "Outputs an integer in octal." } ; HELP: .h -{ $values { "n" "an integer" } } -{ $description "Outputs an integer in hexadecimal." } ; +{ $values { "n" "an integer or floating-point value" } } +{ $description "Outputs an integer or floating-point value in hexadecimal." } ; HELP: stack. { $values { "seq" "a sequence" } } diff --git a/basis/random/windows/windows.factor b/basis/random/windows/windows.factor index 83b1fab0d0..d959b191c9 100644 --- a/basis/random/windows/windows.factor +++ b/basis/random/windows/windows.factor @@ -1,4 +1,4 @@ -USING: accessors alien.c-types byte-arrays +USING: accessors alien.c-types alien.data byte-arrays combinators.short-circuit continuations destructors init kernel locals namespaces random windows.advapi32 windows.errors windows.kernel32 math.bitwise ; diff --git a/basis/specialized-arrays/specialized-arrays-tests.factor b/basis/specialized-arrays/specialized-arrays-tests.factor index 2698149bac..5d88f42d50 100755 --- a/basis/specialized-arrays/specialized-arrays-tests.factor +++ b/basis/specialized-arrays/specialized-arrays-tests.factor @@ -4,7 +4,8 @@ specialized-arrays.private sequences alien.c-types accessors kernel arrays combinators compiler compiler.units classes.struct combinators.smart compiler.tree.debugger math libc destructors sequences.private multiline eval words vocabs namespaces -assocs prettyprint ; +assocs prettyprint alien.data ; +FROM: alien.c-types => float ; SPECIALIZED-ARRAY: int SPECIALIZED-ARRAY: bool diff --git a/basis/specialized-arrays/specialized-arrays.factor b/basis/specialized-arrays/specialized-arrays.factor index 15245cc710..6931c83677 100755 --- a/basis/specialized-arrays/specialized-arrays.factor +++ b/basis/specialized-arrays/specialized-arrays.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors alien alien.c-types assocs byte-arrays classes -compiler.units functors kernel lexer libc math +USING: accessors alien alien.c-types alien.data alien.parser assocs +byte-arrays classes compiler.units functors kernel lexer libc math math.vectors.specialization namespaces parser prettyprint.custom sequences sequences.private strings summary vocabs vocabs.loader vocabs.parser words fry combinators ; @@ -103,13 +103,21 @@ A T c-type-boxed-class f specialize-vector-words ;FUNCTOR +GENERIC: (underlying-type) ( c-type -- c-type' ) + +M: string (underlying-type) c-types get at ; +M: word (underlying-type) "c-type" word-prop ; + : underlying-type ( c-type -- c-type' ) - dup c-types get at { + dup (underlying-type) { { [ dup not ] [ drop no-c-type ] } - { [ dup string? ] [ nip underlying-type ] } + { [ dup c-type-name? ] [ nip underlying-type ] } [ drop ] } cond ; +: underlying-type-name ( c-type -- name ) + underlying-type dup word? [ name>> ] when ; + : specialized-array-vocab ( c-type -- vocab ) "specialized-arrays.instances." prepend ; @@ -125,31 +133,31 @@ PRIVATE> ] ?if ; inline : define-array-vocab ( type -- vocab ) - underlying-type + underlying-type-name [ specialized-array-vocab ] [ '[ _ define-array ] ] bi generate-vocab ; -M: string require-c-array define-array-vocab drop ; +M: c-type-name require-c-array define-array-vocab drop ; ERROR: specialized-array-vocab-not-loaded c-type ; -M: string c-array-constructor - underlying-type +M: c-type-name c-array-constructor + underlying-type-name dup [ "<" "-array>" surround ] [ specialized-array-vocab ] bi lookup [ ] [ specialized-array-vocab-not-loaded ] ?if ; foldable -M: string c-(array)-constructor - underlying-type +M: c-type-name c-(array)-constructor + underlying-type-name dup [ "(" "-array)" surround ] [ specialized-array-vocab ] bi lookup [ ] [ specialized-array-vocab-not-loaded ] ?if ; foldable -M: string c-direct-array-constructor - underlying-type +M: c-type-name c-direct-array-constructor + underlying-type-name dup [ "" surround ] [ specialized-array-vocab ] bi lookup [ ] [ specialized-array-vocab-not-loaded ] ?if ; foldable SYNTAX: SPECIALIZED-ARRAY: - scan define-array-vocab use-vocab ; + scan-c-type define-array-vocab use-vocab ; "prettyprint" vocab [ "specialized-arrays.prettyprint" require diff --git a/basis/stack-checker/alien/alien.factor b/basis/stack-checker/alien/alien.factor index da559abd78..3d150adf91 100644 --- a/basis/stack-checker/alien/alien.factor +++ b/basis/stack-checker/alien/alien.factor @@ -19,7 +19,7 @@ TUPLE: alien-callback-params < alien-node-params quot xt ; : alien-stack ( params extra -- ) over parameters>> length + consume-d >>in-d - dup return>> "void" = 0 1 ? produce-d >>out-d + dup return>> void? 0 1 ? produce-d >>out-d drop ; : return-prep-quot ( node -- quot ) diff --git a/basis/tools/deploy/config/config-docs.factor b/basis/tools/deploy/config/config-docs.factor index bd612c644a..12016168fb 100644 --- a/basis/tools/deploy/config/config-docs.factor +++ b/basis/tools/deploy/config/config-docs.factor @@ -1,4 +1,4 @@ -USING: help.markup help.syntax words alien.c-types assocs +USING: help.markup help.syntax words alien.c-types alien.data assocs kernel math ; IN: tools.deploy.config diff --git a/basis/tools/disassembler/disassembler.factor b/basis/tools/disassembler/disassembler.factor index 0a8ab0b116..16408c0eb8 100755 --- a/basis/tools/disassembler/disassembler.factor +++ b/basis/tools/disassembler/disassembler.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: alien alien.c-types arrays byte-arrays combinators destructors generic io kernel libc math sequences system tr -vocabs.loader words ; +vocabs.loader words alien.data ; IN: tools.disassembler GENERIC: disassemble ( obj -- ) diff --git a/basis/tools/disassembler/udis/udis.factor b/basis/tools/disassembler/udis/udis.factor index 2f0456ab62..aaa54ae527 100755 --- a/basis/tools/disassembler/udis/udis.factor +++ b/basis/tools/disassembler/udis/udis.factor @@ -4,7 +4,7 @@ USING: tools.disassembler namespaces combinators alien alien.syntax alien.c-types lexer parser kernel sequences layouts math math.order alien.libraries math.parser system make fry arrays libc destructors -tools.disassembler.utils splitting ; +tools.disassembler.utils splitting alien.data ; IN: tools.disassembler.udis << diff --git a/basis/ui/backend/cocoa/views/views.factor b/basis/ui/backend/cocoa/views/views.factor index 6ae56af030..a49d22735d 100644 --- a/basis/ui/backend/cocoa/views/views.factor +++ b/basis/ui/backend/cocoa/views/views.factor @@ -1,10 +1,10 @@ ! Copyright (C) 2006, 2008 Slava Pestov ! See http://factorcode.org/license.txt for BSD license. -USING: accessors alien alien.c-types alien.strings arrays assocs -cocoa kernel math cocoa.messages cocoa.subclassing cocoa.classes -cocoa.views cocoa.application cocoa.pasteboard cocoa.types -cocoa.windows sequences io.encodings.utf8 ui ui.private ui.gadgets -ui.gadgets.private ui.gadgets.worlds ui.gestures +USING: accessors alien alien.c-types alien.data alien.strings +arrays assocs cocoa kernel math cocoa.messages cocoa.subclassing +cocoa.classes cocoa.views cocoa.application cocoa.pasteboard +cocoa.types cocoa.windows sequences io.encodings.utf8 ui ui.private +ui.gadgets ui.gadgets.private ui.gadgets.worlds ui.gestures core-foundation.strings core-graphics core-graphics.types threads combinators math.rectangles ; IN: ui.backend.cocoa.views diff --git a/basis/ui/backend/windows/windows.factor b/basis/ui/backend/windows/windows.factor index 2be6e70df8..5e2c25ea30 100755 --- a/basis/ui/backend/windows/windows.factor +++ b/basis/ui/backend/windows/windows.factor @@ -13,7 +13,7 @@ opengl ui.render math.bitwise locals accessors math.rectangles math.order calendar ascii sets io.encodings.utf16n windows.errors literals ui.pixel-formats ui.pixel-formats.private memoize classes -specialized-arrays classes.struct ; +specialized-arrays classes.struct alien.data ; SPECIALIZED-ARRAY: POINT IN: ui.backend.windows diff --git a/basis/unix/process/process.factor b/basis/unix/process/process.factor index 131d8dda5d..2912f8b744 100644 --- a/basis/unix/process/process.factor +++ b/basis/unix/process/process.factor @@ -1,6 +1,6 @@ -USING: kernel alien.c-types alien.strings sequences math alien.syntax -unix namespaces continuations threads assocs io.backend.unix -io.encodings.utf8 unix.utilities fry ; +USING: kernel alien.c-types alien.data alien.strings sequences +math alien.syntax unix namespaces continuations threads assocs +io.backend.unix io.encodings.utf8 unix.utilities fry ; IN: unix.process ! Low-level Unix process launching utilities. These are used diff --git a/basis/unix/utilities/utilities.factor b/basis/unix/utilities/utilities.factor index 8d141ccb24..919b2ae8a2 100644 --- a/basis/unix/utilities/utilities.factor +++ b/basis/unix/utilities/utilities.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: alien alien.c-types alien.strings +USING: alien alien.c-types alien.data alien.strings combinators.short-circuit fry kernel layouts sequences accessors specialized-arrays ; IN: unix.utilities diff --git a/basis/unix/utmpx/utmpx.factor b/basis/unix/utmpx/utmpx.factor index 6e72f7d114..f6ccf6858b 100644 --- a/basis/unix/utmpx/utmpx.factor +++ b/basis/unix/utmpx/utmpx.factor @@ -1,9 +1,9 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: alien.c-types alien.syntax combinators continuations -io.encodings.string io.encodings.utf8 kernel sequences strings -unix calendar system accessors unix.time calendar.unix -vocabs.loader ; +USING: alien.c-types alien.data alien.syntax combinators +continuations io.encodings.string io.encodings.utf8 kernel +sequences strings unix calendar system accessors unix.time +calendar.unix vocabs.loader ; IN: unix.utmpx CONSTANT: EMPTY 0 diff --git a/basis/windows/com/com.factor b/basis/windows/com/com.factor index d485692a91..e06f5b6071 100644 --- a/basis/windows/com/com.factor +++ b/basis/windows/com/com.factor @@ -1,6 +1,6 @@ USING: alien alien.c-types alien.destructors windows.com.syntax windows.ole32 windows.types continuations kernel alien.syntax -libc destructors accessors ; +libc destructors accessors alien.data ; IN: windows.com LIBRARY: ole32 diff --git a/basis/windows/com/syntax/syntax.factor b/basis/windows/com/syntax/syntax.factor index 2100d6a215..3cf8b55e39 100755 --- a/basis/windows/com/syntax/syntax.factor +++ b/basis/windows/com/syntax/syntax.factor @@ -67,7 +67,7 @@ unless : (stack-effect-from-return-and-parameters) ( return parameters -- stack-effect ) swap [ [ second ] map ] - [ dup "void" = [ drop { } ] [ 1array ] if ] bi* + [ dup void? [ drop { } ] [ 1array ] if ] bi* ; : (define-word-for-function) ( function interface n -- ) diff --git a/basis/windows/com/wrapper/wrapper.factor b/basis/windows/com/wrapper/wrapper.factor index e69fc5b820..e4f0ef0654 100755 --- a/basis/windows/com/wrapper/wrapper.factor +++ b/basis/windows/com/wrapper/wrapper.factor @@ -1,9 +1,9 @@ -USING: alien alien.c-types alien.accessors windows.com.syntax -init windows.com.syntax.private windows.com continuations kernel -namespaces windows.ole32 libc vocabs assocs accessors arrays -sequences quotations combinators math words compiler.units -destructors fry math.parser generalizations sets -specialized-arrays windows.kernel32 classes.struct ; +USING: alien alien.c-types alien.data alien.accessors +windows.com.syntax init windows.com.syntax.private windows.com +continuations kernel namespaces windows.ole32 libc vocabs +assocs accessors arrays sequences quotations combinators math +words compiler.units destructors fry math.parser generalizations +sets specialized-arrays windows.kernel32 classes.struct ; SPECIALIZED-ARRAY: void* IN: windows.com.wrapper diff --git a/basis/windows/dinput/constants/constants.factor b/basis/windows/dinput/constants/constants.factor index b67b5fa08f..3c0509c49d 100755 --- a/basis/windows/dinput/constants/constants.factor +++ b/basis/windows/dinput/constants/constants.factor @@ -1,8 +1,9 @@ USING: windows.dinput windows.kernel32 windows.ole32 windows.com -windows.com.syntax alien alien.c-types alien.syntax kernel system namespaces -combinators sequences fry math accessors macros words quotations -libc continuations generalizations splitting locals assocs init -specialized-arrays memoize classes.struct ; +windows.com.syntax alien alien.c-types alien.data alien.syntax +kernel system namespaces combinators sequences fry math accessors +macros words quotations libc continuations generalizations +splitting locals assocs init specialized-arrays memoize +classes.struct strings arrays ; SPECIALIZED-ARRAY: DIOBJECTDATAFORMAT IN: windows.dinput.constants @@ -22,12 +23,17 @@ SYMBOLS: MEMO: c-type* ( name -- c-type ) c-type ; MEMO: heap-size* ( c-type -- n ) heap-size ; +GENERIC: array-base-type ( c-type -- c-type' ) +M: object array-base-type ; +M: string array-base-type "[" split1 drop ; +M: array array-base-type first ; + : (field-spec-of) ( field struct -- field-spec ) c-type* fields>> [ name>> = ] with find nip ; : (offsetof) ( field struct -- offset ) [ (field-spec-of) offset>> ] [ drop 0 ] if* ; : (sizeof) ( field struct -- size ) - [ (field-spec-of) type>> "[" split1 drop heap-size* ] [ drop 1 ] if* ; + [ (field-spec-of) type>> array-base-type heap-size* ] [ drop 1 ] if* ; : (flag) ( thing -- integer ) { diff --git a/basis/windows/dragdrop-listener/dragdrop-listener.factor b/basis/windows/dragdrop-listener/dragdrop-listener.factor index bd6512341f..bb8e60cdf5 100755 --- a/basis/windows/dragdrop-listener/dragdrop-listener.factor +++ b/basis/windows/dragdrop-listener/dragdrop-listener.factor @@ -1,17 +1,16 @@ USING: alien.strings io.encodings.utf16n windows.com windows.com.wrapper combinators windows.kernel32 windows.ole32 -windows.shell32 kernel accessors +windows.shell32 kernel accessors windows.types prettyprint namespaces ui.tools.listener ui.tools.workspace -alien.c-types alien sequences math ; +alien.data alien sequences math ; +SPECIALIZED-ARRAY: WCHAR IN: windows.dragdrop-listener -<< "WCHAR" require-c-array >> - : filenames-from-hdrop ( hdrop -- filenames ) dup HEX: FFFFFFFF f 0 DragQueryFile ! get count of files [ 2dup f 0 DragQueryFile 1 + ! get size of filename buffer - dup "WCHAR" + dup WCHAR [ swap DragQueryFile drop ] keep utf16n alien>string ] with map ; diff --git a/basis/windows/errors/errors.factor b/basis/windows/errors/errors.factor index d2ee337726..a7a41433f7 100755 --- a/basis/windows/errors/errors.factor +++ b/basis/windows/errors/errors.factor @@ -1,11 +1,10 @@ -USING: alien.c-types kernel locals math math.bitwise +USING: alien.data kernel locals math math.bitwise windows.kernel32 sequences byte-arrays unicode.categories io.encodings.string io.encodings.utf16n alien.strings -arrays literals ; +arrays literals windows.types specialized-arrays ; +SPECIALIZED-ARRAY: TCHAR IN: windows.errors -<< "TCHAR" require-c-array >> - CONSTANT: ERROR_SUCCESS 0 CONSTANT: ERROR_INVALID_FUNCTION 1 CONSTANT: ERROR_FILE_NOT_FOUND 2 @@ -698,8 +697,6 @@ CONSTANT: FORMAT_MESSAGE_MAX_WIDTH_MASK HEX: 000000FF : make-lang-id ( lang1 lang2 -- n ) 10 shift bitor ; inline -<< "TCHAR" require-c-array >> - ERROR: error-message-failed id ; :: n>win32-error-string ( id -- string ) { @@ -709,7 +706,7 @@ ERROR: error-message-failed id ; f id LANG_NEUTRAL SUBLANG_DEFAULT make-lang-id - 32768 [ "TCHAR" ] [ ] bi + 32768 [ TCHAR ] [ ] bi f pick [ FormatMessage 0 = [ id error-message-failed ] when ] dip utf16n alien>string [ blank? ] trim ; diff --git a/basis/windows/offscreen/offscreen.factor b/basis/windows/offscreen/offscreen.factor index 63cfd92ba1..e38477c98c 100755 --- a/basis/windows/offscreen/offscreen.factor +++ b/basis/windows/offscreen/offscreen.factor @@ -1,8 +1,8 @@ ! Copyright (C) 2009 Joe Groff, Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: alien.c-types kernel combinators sequences -math windows.gdi32 windows.types images destructors -accessors fry locals classes.struct ; +USING: alien.c-types alien.data kernel combinators +sequences math windows.gdi32 windows.types images +destructors accessors fry locals classes.struct ; IN: windows.offscreen : (bitmap-info) ( dim -- BITMAPINFO ) diff --git a/basis/windows/ole32/ole32.factor b/basis/windows/ole32/ole32.factor index 9e117c8522..fe47a7f923 100755 --- a/basis/windows/ole32/ole32.factor +++ b/basis/windows/ole32/ole32.factor @@ -1,5 +1,5 @@ -USING: alien alien.syntax alien.c-types alien.strings math -kernel sequences windows.errors windows.types io accessors +USING: alien alien.syntax alien.c-types alien.data alien.strings +math kernel sequences windows.errors windows.types io accessors math.order namespaces make math.parser windows.kernel32 combinators locals specialized-arrays literals splitting grouping classes.struct combinators.smart ; diff --git a/basis/windows/types/types.factor b/basis/windows/types/types.factor index c882ba2e7f..544abb69a8 100755 --- a/basis/windows/types/types.factor +++ b/basis/windows/types/types.factor @@ -3,6 +3,7 @@ USING: alien alien.c-types alien.syntax namespaces kernel words sequences math math.bitwise math.vectors colors io.encodings.utf16n classes.struct accessors ; +FROM: alien.c-types => float short ; IN: windows.types TYPEDEF: char CHAR @@ -69,7 +70,8 @@ TYPEDEF: ulonglong ULARGE_INTEGER TYPEDEF: LARGE_INTEGER* PLARGE_INTEGER TYPEDEF: ULARGE_INTEGER* PULARGE_INTEGER -<< { "char*" utf16n } "wchar_t*" typedef >> +SYMBOL: wchar_t* +<< { char* utf16n } \ wchar_t* typedef >> TYPEDEF: wchar_t* LPCSTR TYPEDEF: wchar_t* LPWSTR diff --git a/basis/windows/winsock/winsock.factor b/basis/windows/winsock/winsock.factor index 87b8970b02..e29eb3e090 100755 --- a/basis/windows/winsock/winsock.factor +++ b/basis/windows/winsock/winsock.factor @@ -4,6 +4,7 @@ USING: alien alien.c-types alien.strings alien.syntax arrays byte-arrays kernel literals math sequences windows.types windows.kernel32 windows.errors math.bitwise io.encodings.utf16n classes.struct windows.com.syntax init ; +FROM: alien.c-types => short ; IN: windows.winsock TYPEDEF: void* SOCKET diff --git a/basis/x11/xlib/xlib.factor b/basis/x11/xlib/xlib.factor index 48d556de1d..0cd7704cf8 100644 --- a/basis/x11/xlib/xlib.factor +++ b/basis/x11/xlib/xlib.factor @@ -10,9 +10,10 @@ ! add to this library and are wondering what part of the file to ! modify, just find the function or data structure in the manual ! and note the section. -USING: accessors kernel arrays alien alien.c-types alien.strings -alien.syntax classes.struct math math.bitwise words sequences -namespaces continuations io io.encodings.ascii x11.syntax ; +USING: accessors kernel arrays alien alien.c-types alien.data +alien.strings alien.syntax classes.struct math math.bitwise words +sequences namespaces continuations io io.encodings.ascii x11.syntax ; +FROM: alien.c-types => short ; IN: x11.xlib LIBRARY: xlib diff --git a/core/alien/strings/strings-tests.factor b/core/alien/strings/strings-tests.factor index 6a0a42253b..c1b5a9e159 100644 --- a/core/alien/strings/strings-tests.factor +++ b/core/alien/strings/strings-tests.factor @@ -1,4 +1,4 @@ -USING: alien.strings alien.c-types tools.test kernel libc +USING: alien.strings alien.c-types alien.data tools.test kernel libc io.encodings.8-bit io.encodings.utf8 io.encodings.utf16 io.encodings.utf16n io.encodings.ascii alien io.encodings.string ; IN: alien.strings.tests diff --git a/core/math/parser/parser-docs.factor b/core/math/parser/parser-docs.factor index ebb9c8aa5e..c3ee350099 100644 --- a/core/math/parser/parser-docs.factor +++ b/core/math/parser/parser-docs.factor @@ -61,7 +61,7 @@ HELP: bin> $nl "Outputs " { $link f } " if the string does not represent a number." } ; -{ bin> POSTPONE: BIN: bin> .b } related-words +{ >bin POSTPONE: BIN: bin> .b } related-words HELP: oct> { $values { "str" string } { "n/f" "a real number or " { $link f } } } @@ -69,7 +69,7 @@ HELP: oct> $nl "Outputs " { $link f } " if the string does not represent a number." } ; -{ oct> POSTPONE: OCT: oct> .o } related-words +{ >oct POSTPONE: OCT: oct> .o } related-words HELP: hex> { $values { "str" string } { "n/f" "a real number or " { $link f } } } @@ -77,7 +77,7 @@ HELP: hex> $nl "Outputs " { $link f } " if the string does not represent a number." } ; -{ hex> POSTPONE: HEX: hex> .h } related-words +{ >hex POSTPONE: HEX: hex> .h } related-words HELP: >base { $values { "n" real } { "radix" "an integer between 2 and 36" } { "str" string } } diff --git a/core/syntax/syntax-docs.factor b/core/syntax/syntax-docs.factor index e34fb0957f..394ae3f67c 100644 --- a/core/syntax/syntax-docs.factor +++ b/core/syntax/syntax-docs.factor @@ -593,10 +593,13 @@ HELP: #! { $description "Discards all input until the end of the line." } ; HELP: HEX: -{ $syntax "HEX: integer" } -{ $values { "integer" "hexadecimal digits (0-9, a-f, A-F)" } } -{ $description "Adds an integer read from a hexadecimal literal to the parse tree." } -{ $examples { $example "USE: prettyprint" "HEX: ff ." "255" } } ; +{ $syntax "HEX: NNN" "HEX: NNN.NNNpEEE" } +{ $values { "N" "hexadecimal digit (0-9, a-f, A-F)" } { "pEEE" "decimal exponent value" } } +{ $description "Adds an integer or floating-point value read from a hexadecimal literal to the parse tree." } +{ $examples + { $example "USE: prettyprint" "HEX: ff ." "255" } + { $example "USE: prettyprint" "HEX: 1.8p5 ." "48.0" } +} ; HELP: OCT: { $syntax "OCT: integer" } diff --git a/extra/alien/inline/inline.factor b/extra/alien/inline/inline.factor index 84c3450102..ee69d954ea 100644 --- a/extra/alien/inline/inline.factor +++ b/extra/alien/inline/inline.factor @@ -41,6 +41,11 @@ SYMBOL: c-strings [ current-vocab name>> % "_" % % ] "" make ; PRIVATE> +: parse-arglist ( parameters return -- types effect ) + [ 2 group unzip [ "," ?tail drop ] map ] + [ [ { } ] [ 1array ] if-void ] + bi* ; + : append-function-body ( prototype-str body -- str ) [ swap % " {\n" % % "\n}\n" % ] "" make ; diff --git a/extra/alien/inline/syntax/syntax-tests.factor b/extra/alien/inline/syntax/syntax-tests.factor index e6a0b8b7d8..c49b2b5aae 100644 --- a/extra/alien/inline/syntax/syntax-tests.factor +++ b/extra/alien/inline/syntax/syntax-tests.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2009 Jeremy Hughes. ! See http://factorcode.org/license.txt for BSD license. USING: alien.inline alien.inline.syntax io.directories io.files -kernel namespaces tools.test alien.c-types alien.structs ; +kernel namespaces tools.test alien.c-types alien.data alien.structs ; IN: alien.inline.syntax.tests DELETE-C-LIBRARY: test diff --git a/extra/alien/inline/types/types.factor b/extra/alien/inline/types/types.factor index 070febc324..ac7f6ae17f 100644 --- a/extra/alien/inline/types/types.factor +++ b/extra/alien/inline/types/types.factor @@ -2,10 +2,11 @@ ! See http://factorcode.org/license.txt for BSD license. USING: accessors alien.c-types assocs combinators.short-circuit continuations effects fry kernel math memoize sequences -splitting strings peg.ebnf make ; +splitting strings peg.ebnf make words ; IN: alien.inline.types : cify-type ( str -- str' ) + dup word? [ name>> ] when { { CHAR: - CHAR: space } } substitute ; : factorize-type ( str -- str' ) diff --git a/extra/alien/marshall/marshall-docs.factor b/extra/alien/marshall/marshall-docs.factor index 361753a0d3..5d6ec29912 100644 --- a/extra/alien/marshall/marshall-docs.factor +++ b/extra/alien/marshall/marshall-docs.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2009 Jeremy Hughes. ! See http://factorcode.org/license.txt for BSD license. USING: help.markup help.syntax kernel quotations sequences -strings alien alien.c-types math byte-arrays ; +strings alien alien.c-types alien.data math byte-arrays ; IN: alien.marshall float short ; SPECIALIZED-ARRAY: bool SPECIALIZED-ARRAY: char SPECIALIZED-ARRAY: double @@ -22,7 +23,7 @@ SPECIALIZED-ARRAY: ushort SPECIALIZED-ARRAY: void* IN: alien.marshall -<< primitive-types [ [ "void*" = ] [ "bool" = ] bi or not ] +<< primitive-types [ [ void* = ] [ bool = ] bi or not ] filter [ define-primitive-marshallers ] each >> TUPLE: alien-wrapper { underlying alien } ; diff --git a/extra/alien/marshall/private/private.factor b/extra/alien/marshall/private/private.factor index c85b722d11..d138282ff3 100644 --- a/extra/alien/marshall/private/private.factor +++ b/extra/alien/marshall/private/private.factor @@ -3,7 +3,7 @@ USING: accessors alien alien.c-types alien.inline arrays combinators fry functors kernel lexer libc macros math sequences specialized-arrays libc.private -combinators.short-circuit ; +combinators.short-circuit alien.data ; SPECIALIZED-ARRAY: void* IN: alien.marshall.private diff --git a/extra/alien/marshall/structs/structs.factor b/extra/alien/marshall/structs/structs.factor index 54bcab45f2..3f9c8e3a7e 100644 --- a/extra/alien/marshall/structs/structs.factor +++ b/extra/alien/marshall/structs/structs.factor @@ -3,7 +3,7 @@ USING: accessors alien.c-types alien.marshall arrays assocs classes.tuple combinators destructors generalizations generic kernel libc locals parser quotations sequences slots words -alien.structs lexer vocabs.parser fry effects ; +alien.structs lexer vocabs.parser fry effects alien.data ; IN: alien.marshall.structs float ; SPECIALIZED-ARRAY: float SPECIALIZED-VECTOR: uint IN: gpu.demos.bunny diff --git a/extra/gpu/render/render.factor b/extra/gpu/render/render.factor index 0ee9ab78c5..4f2437c0c1 100644 --- a/extra/gpu/render/render.factor +++ b/extra/gpu/render/render.factor @@ -1,5 +1,5 @@ ! (c)2009 Joe Groff bsd license -USING: accessors alien alien.c-types arrays +USING: accessors alien alien.c-types alien.data arrays assocs classes classes.mixin classes.parser classes.singleton classes.tuple classes.tuple.private combinators combinators.tuple destructors fry generic generic.parser gpu gpu.buffers gpu.framebuffers @@ -9,7 +9,9 @@ lexer locals math math.order math.parser namespaces opengl opengl.gl parser quotations sequences slots sorting specialized-arrays strings ui.gadgets.worlds variants vocabs.parser words ; -SPECIALIZED-ARRAY: float +FROM: math => float ; +QUALIFIED-WITH: alien.c-types c +SPECIALIZED-ARRAY: c:float SPECIALIZED-ARRAY: int SPECIALIZED-ARRAY: uint SPECIALIZED-ARRAY: void* diff --git a/extra/gpu/shaders/shaders.factor b/extra/gpu/shaders/shaders.factor index 91bc760673..39c1792a16 100755 --- a/extra/gpu/shaders/shaders.factor +++ b/extra/gpu/shaders/shaders.factor @@ -1,11 +1,11 @@ ! (c)2009 Joe Groff bsd license -USING: accessors alien alien.c-types alien.strings arrays assocs -byte-arrays classes.mixin classes.parser classes.singleton -classes.struct combinators combinators.short-circuit definitions -destructors generic.parser gpu gpu.buffers hashtables images -io.encodings.ascii io.files io.pathnames kernel lexer literals -locals math math.parser memoize multiline namespaces opengl -opengl.gl opengl.shaders parser quotations sequences +USING: accessors alien alien.c-types alien.data alien.strings +arrays assocs byte-arrays classes.mixin classes.parser +classes.singleton classes.struct combinators combinators.short-circuit +definitions destructors generic.parser gpu gpu.buffers hashtables +images io.encodings.ascii io.files io.pathnames kernel lexer +literals locals math math.parser memoize multiline namespaces +opengl opengl.gl opengl.shaders parser quotations sequences specialized-arrays splitting strings tr ui.gadgets.worlds variants vectors vocabs vocabs.loader vocabs.parser words words.constant ; diff --git a/extra/gpu/state/state.factor b/extra/gpu/state/state.factor index 02d6046722..1a840ea0b4 100755 --- a/extra/gpu/state/state.factor +++ b/extra/gpu/state/state.factor @@ -1,9 +1,11 @@ ! (c)2009 Joe Groff bsd license -USING: accessors alien.c-types arrays byte-arrays combinators gpu -kernel literals math math.rectangles opengl opengl.gl sequences -variants specialized-arrays ; +USING: accessors alien.c-types alien.data arrays byte-arrays +combinators gpu kernel literals math math.rectangles opengl +opengl.gl sequences variants specialized-arrays ; +QUALIFIED-WITH: alien.c-types c +FROM: math => float ; SPECIALIZED-ARRAY: int -SPECIALIZED-ARRAY: float +SPECIALIZED-ARRAY: c:float IN: gpu.state UNION: ?rect rect POSTPONE: f ; diff --git a/extra/gpu/textures/textures.factor b/extra/gpu/textures/textures.factor index 8015ff9a9b..2649f7c586 100644 --- a/extra/gpu/textures/textures.factor +++ b/extra/gpu/textures/textures.factor @@ -3,6 +3,7 @@ USING: accessors alien.c-types arrays byte-arrays combinators destructors fry gpu gpu.buffers images kernel locals math opengl opengl.gl opengl.textures sequences specialized-arrays ui.gadgets.worlds variants ; +FROM: alien.c-types => float ; SPECIALIZED-ARRAY: float IN: gpu.textures diff --git a/extra/half-floats/half-floats-tests.factor b/extra/half-floats/half-floats-tests.factor index cf3d7d3690..ad3d156bc4 100644 --- a/extra/half-floats/half-floats-tests.factor +++ b/extra/half-floats/half-floats-tests.factor @@ -1,5 +1,5 @@ USING: alien.c-types alien.syntax half-floats kernel math tools.test -specialized-arrays ; +specialized-arrays alien.data ; SPECIALIZED-ARRAY: half IN: half-floats.tests diff --git a/extra/half-floats/half-floats.factor b/extra/half-floats/half-floats.factor index 2c089e4330..4d78068c03 100755 --- a/extra/half-floats/half-floats.factor +++ b/extra/half-floats/half-floats.factor @@ -1,5 +1,5 @@ ! (c)2009 Joe Groff bsd license -USING: accessors alien.c-types alien.syntax kernel math math.order ; +USING: accessors alien.c-types alien.data alien.syntax kernel math math.order ; IN: half-floats : half>bits ( float -- bits ) diff --git a/extra/io/serial/unix/unix.factor b/extra/io/serial/unix/unix.factor index 1ba8031dfc..57c30dde15 100644 --- a/extra/io/serial/unix/unix.factor +++ b/extra/io/serial/unix/unix.factor @@ -1,8 +1,9 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors alien.c-types alien.syntax combinators io.ports -io.streams.duplex system kernel math math.bitwise -vocabs.loader unix io.serial io.serial.unix.termios io.backend.unix ; +USING: accessors alien.c-types alien.syntax alien.data +combinators io.ports io.streams.duplex system kernel +math math.bitwise vocabs.loader unix io.serial +io.serial.unix.termios io.backend.unix ; IN: io.serial.unix << { diff --git a/extra/jamshred/gl/gl.factor b/extra/jamshred/gl/gl.factor index 1a03a2c941..60e9e39d9f 100644 --- a/extra/jamshred/gl/gl.factor +++ b/extra/jamshred/gl/gl.factor @@ -4,6 +4,7 @@ USING: accessors alien.c-types jamshred.game jamshred.oint jamshred.player jamshred.tunnel kernel math math.constants math.functions math.vectors opengl opengl.gl opengl.glu opengl.demo-support sequences specialized-arrays ; +FROM: alien.c-types => float ; SPECIALIZED-ARRAY: float IN: jamshred.gl diff --git a/extra/memory/piles/piles.factor b/extra/memory/piles/piles.factor index 46729c42be..a5602273d2 100644 --- a/extra/memory/piles/piles.factor +++ b/extra/memory/piles/piles.factor @@ -1,5 +1,5 @@ ! (c)2009 Joe Groff bsd license -USING: accessors alien alien.c-types destructors kernel libc math ; +USING: accessors alien alien.c-types alien.data destructors kernel libc math ; IN: memory.piles TUPLE: pile diff --git a/extra/openal/openal.factor b/extra/openal/openal.factor index 81a6621eff..bccdec1420 100644 --- a/extra/openal/openal.factor +++ b/extra/openal/openal.factor @@ -4,6 +4,7 @@ USING: kernel accessors arrays alien system combinators alien.syntax namespaces alien.c-types sequences vocabs.loader shuffle openal.backend alien.libraries generalizations specialized-arrays ; +FROM: alien.c-types => float short ; SPECIALIZED-ARRAY: uint IN: openal diff --git a/extra/qtkit/qtkit.factor b/extra/qtkit/qtkit.factor index d0567bdd48..b573cd51ab 100644 --- a/extra/qtkit/qtkit.factor +++ b/extra/qtkit/qtkit.factor @@ -1,4 +1,5 @@ -USING: classes.struct cocoa core-foundation.strings ; +USING: classes.struct cocoa cocoa.application cocoa.classes +cocoa.enumeration cocoa.plists core-foundation.strings kernel ; IN: qtkit STRUCT: QTTime @@ -74,3 +75,19 @@ IMPORT: QTMovieView IMPORT: QTSampleBuffer IMPORT: QTTrack +: ( filename -- movie ) + QTMovie swap f -> movieWithFile:error: -> retain ; + +: movie-attributes ( movie -- attributes ) + -> movieAttributes plist> ; + +: play ( movie -- ) + -> play ; +: stop ( movie -- ) + -> stop ; + +: movie-tracks ( movie -- tracks ) + -> tracks NSFastEnumeration>vector ; + +: track-attributes ( track -- attributes ) + -> trackAttributes plist> ; diff --git a/extra/synth/buffers/buffers.factor b/extra/synth/buffers/buffers.factor index 71b05ac642..978fb32d42 100644 --- a/extra/synth/buffers/buffers.factor +++ b/extra/synth/buffers/buffers.factor @@ -2,6 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: accessors alien.c-types combinators kernel locals math math.ranges openal sequences sequences.merged specialized-arrays ; +FROM: alien.c-types => short ; SPECIALIZED-ARRAY: uchar SPECIALIZED-ARRAY: short IN: synth.buffers diff --git a/extra/system-info/windows/ce/ce.factor b/extra/system-info/windows/ce/ce.factor index 13c7cb9433..8c4f81a117 100755 --- a/extra/system-info/windows/ce/ce.factor +++ b/extra/system-info/windows/ce/ce.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: alien.c-types system-info kernel math namespaces +USING: alien.c-types alien.data system-info kernel math namespaces windows windows.kernel32 system-info.backend system ; IN: system-info.windows.ce