Merge branch 'master' of git://factorcode.org/git/factor

db4
Slava Pestov 2009-09-18 14:34:39 -07:00
commit 7ddad99555
120 changed files with 844 additions and 642 deletions

View File

@ -1,5 +1,5 @@
USING: help.syntax help.markup byte-arrays alien.c-types alien.data ;
IN: alien.arrays IN: alien.arrays
USING: help.syntax help.markup byte-arrays alien.c-types ;
ARTICLE: "c-arrays" "C arrays" 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" } "." "C arrays are allocated in the same manner as other C data; see " { $link "c-byte-arrays" } " and " { $link "malloc" } "."

View File

@ -1,7 +1,7 @@
! Copyright (C) 2008, 2009 Slava Pestov. ! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.strings alien.c-types alien.accessors USING: alien alien.strings alien.c-types alien.data alien.accessors
arrays words sequences math kernel namespaces fry libc cpu.architecture arrays words sequences math kernel namespaces fry cpu.architecture
io.encodings.utf8 accessors ; io.encodings.utf8 accessors ;
IN: alien.arrays 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 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 M: array c-type-boxer-quot
unclip unclip
@ -41,7 +41,7 @@ M: array c-type-boxer-quot
M: array c-type-unboxer-quot drop [ >c-ptr ] ; M: array c-type-unboxer-quot drop [ >c-ptr ] ;
PREDICATE: string-type < pair PREDICATE: string-type < pair
first2 [ "char*" = ] [ word? ] bi* and ; first2 [ char* = ] [ word? ] bi* and ;
M: string-type c-type ; 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 c-type-boxed-class drop object ;
M: string-type heap-size M: string-type heap-size
drop "void*" heap-size ; drop void* heap-size ;
M: string-type c-type-align M: string-type c-type-align
drop "void*" c-type-align ; drop void* c-type-align ;
M: string-type c-type-stack-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 M: string-type unbox-parameter
drop "void*" unbox-parameter ; drop void* unbox-parameter ;
M: string-type unbox-return M: string-type unbox-return
drop "void*" unbox-return ; drop void* unbox-return ;
M: string-type box-parameter M: string-type box-parameter
drop "void*" box-parameter ; drop void* box-parameter ;
M: string-type box-return M: string-type box-return
drop "void*" box-return ; drop void* box-return ;
M: string-type stack-size M: string-type stack-size
drop "void*" stack-size ; drop void* stack-size ;
M: string-type c-type-rep M: string-type c-type-rep
drop int-rep ; drop int-rep ;
M: string-type c-type-boxer M: string-type c-type-boxer
drop "void*" c-type-boxer ; drop void* c-type-boxer ;
M: string-type c-type-unboxer M: string-type c-type-unboxer
drop "void*" c-type-unboxer ; drop void* c-type-unboxer ;
M: string-type c-type-boxer-quot M: string-type c-type-boxer-quot
second '[ _ alien>string ] ; second '[ _ alien>string ] ;
@ -94,6 +94,8 @@ M: string-type c-type-getter
M: string-type c-type-setter M: string-type c-type-setter
drop [ set-alien-cell ] ; drop [ set-alien-cell ] ;
{ "char*" utf8 } "char*" typedef { char* utf8 } char* typedef
"char*" "uchar*" typedef char* uchar* typedef
char char* "pointer-c-type" set-word-prop
uchar uchar* "pointer-c-type" set-word-prop

View File

@ -1,7 +1,25 @@
IN: alien.c-types
USING: alien help.syntax help.markup libc kernel.private USING: alien help.syntax help.markup libc kernel.private
byte-arrays math strings hashtables alien.syntax alien.strings sequences byte-arrays math strings hashtables alien.syntax alien.strings sequences
io.encodings.string debugger destructors vocabs.loader ; 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: <c-type> HELP: <c-type>
{ $values { "type" hashtable } } { $values { "type" hashtable } }
@ -20,24 +38,6 @@ HELP: c-type
{ $description "Looks up a C type by name." } { $description "Looks up a C type by name." }
{ $errors "Throws a " { $link no-c-type } " error if the type does not exist." } ; { $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 HELP: c-getter
{ $values { "name" string } { "quot" { $quotation "( c-ptr n -- obj )" } } } { $values { "name" string } { "quot" { $quotation "( c-ptr n -- obj )" } } }
{ $description "Outputs a quotation which reads values of this C type from a C structure." } { $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." } { $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." } ; { $errors "Throws an error if the type does not exist." } ;
HELP: <c-array>
{ $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: <c-object>
{ $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." } ;
{ <c-object> 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 <c-direct-array> } "." }
{ $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." } ;
{ <c-array> <c-direct-array> malloc-array } related-words
HELP: box-parameter HELP: box-parameter
{ $values { "n" integer } { "ctype" string } } { $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." } { $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." } { $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." } ; { $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 <c-array> } " or " { $link <c-direct-array> } " 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: <c-direct-array>
{ $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" 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." "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 $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." "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 $nl
"Structure and union types are specified by the name of the structure or union." ; "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 <byte-array> } " 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 <c-object> }
{ $subsection <c-array> }
{ $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" } ;

View File

@ -43,7 +43,7 @@ TYPEDEF: int* MyIntArray
TYPEDEF: uchar* MyLPBYTE 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 } <displaced-alien> <void*> 0 B{ 1 2 3 4 } <displaced-alien> <void*>

View File

@ -1,18 +1,27 @@
! Copyright (C) 2004, 2009 Slava Pestov. ! Copyright (C) 2004, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! 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 namespaces make parser sequences strings words splitting math.parser
cpu.architecture alien alien.accessors alien.strings quotations cpu.architecture alien alien.accessors alien.strings quotations
layouts system compiler.units io io.files io.encodings.binary layouts system compiler.units io io.files io.encodings.binary
io.streams.memory accessors combinators effects continuations fry io.streams.memory accessors combinators effects continuations fry
classes vocabs vocabs.loader ; classes vocabs vocabs.loader words.symbol ;
QUALIFIED: math
IN: alien.c-types IN: alien.c-types
SYMBOLS:
char uchar
short ushort
int uint
long ulong
longlong ulonglong
float double
void* bool
void ;
DEFER: <int> DEFER: <int>
DEFER: *char DEFER: *char
: little-endian? ( -- ? ) 1 <int> *char 1 = ; foldable
TUPLE: abstract-c-type TUPLE: abstract-c-type
{ class class initial: object } { class class initial: object }
{ boxed-class class initial: object } { boxed-class class initial: object }
@ -40,149 +49,124 @@ global [
ERROR: no-c-type name ; ERROR: no-c-type name ;
: (c-type) ( name -- type/f ) PREDICATE: c-type-word < word
c-types get-global at dup [ "c-type" word-prop ;
dup string? [ (c-type) ] when
] when ; UNION: c-type-name string c-type-word ;
! C type protocol ! C type protocol
GENERIC: c-type ( name -- type ) foldable GENERIC: c-type ( name -- type ) foldable
: resolve-pointer-type ( name -- name ) GENERIC: resolve-pointer-type ( name -- c-type )
c-types get at dup string?
[ "*" append ] [ drop "void*" ] if M: word resolve-pointer-type
c-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 ) : 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 "[" split unclip
[ [ "]" ?tail drop string>number ] map ] dip prefix ; [ [ "]" ?tail drop string>number ] map ] dip ;
M: string c-type ( name -- type ) M: string c-type ( name -- type )
CHAR: ] over member? [ 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 "*" ?tail [ resolve-pointer-type ] [ no-c-type ] if
] ?if ] ?if resolve-typedef
] if ; ] if ;
M: word c-type
"c-type" word-prop resolve-typedef ;
: void? ( c-type -- ? )
{ void "void" } member? ;
GENERIC: c-struct? ( type -- ? ) GENERIC: c-struct? ( type -- ? )
M: object c-struct? M: object c-struct?
drop f ; drop f ;
M: string c-struct? M: c-type-name c-struct?
dup "void" = [ drop f ] [ c-type c-struct? ] if ; dup void? [ drop f ] [ c-type c-struct? ] if ;
! These words being foldable means that words need to be ! These words being foldable means that words need to be
! recompiled if a C type is redefined. Even so, folding the ! recompiled if a C type is redefined. Even so, folding the
! size facilitates some optimizations. ! 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: <c-array> ( len c-type -- array )
M: string <c-array>
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: <c-direct-array> ( alien len c-type -- array )
M: string <c-direct-array>
c-direct-array-constructor execute( alien len -- array ) ; inline
: malloc-array ( n type -- alien )
[ heap-size calloc ] [ <c-direct-array> ] 2bi ; inline
: (malloc-array) ( n type -- alien )
[ heap-size * malloc ] [ <c-direct-array> ] 2bi ; inline
GENERIC: c-type-class ( name -- class ) GENERIC: c-type-class ( name -- class )
M: abstract-c-type c-type-class 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 ) GENERIC: c-type-boxed-class ( name -- class )
M: abstract-c-type c-type-boxed-class boxed-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 ) GENERIC: c-type-boxer ( name -- boxer )
M: c-type c-type-boxer 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 ) GENERIC: c-type-boxer-quot ( name -- quot )
M: abstract-c-type c-type-boxer-quot boxer-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 ) GENERIC: c-type-unboxer ( name -- boxer )
M: c-type c-type-unboxer unboxer>> ; 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 ) GENERIC: c-type-unboxer-quot ( name -- quot )
M: abstract-c-type c-type-unboxer-quot unboxer-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 ) GENERIC: c-type-rep ( name -- rep )
M: c-type c-type-rep 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 ) GENERIC: c-type-getter ( name -- quot )
M: c-type c-type-getter getter>> ; 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 ) GENERIC: c-type-setter ( name -- quot )
M: c-type c-type-setter setter>> ; 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 ) GENERIC: c-type-align ( name -- n )
M: abstract-c-type c-type-align align>> ; 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 -- ? ) GENERIC: c-type-stack-align? ( name -- ? )
M: c-type c-type-stack-align? stack-align?>> ; 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-box ( n type -- )
[ c-type-rep ] [ c-type-boxer [ "No boxer" throw ] unless* ] bi [ 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: 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 -- ) GENERIC: box-return ( ctype -- )
M: c-type box-return f swap c-type-box ; 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 -- ) GENERIC: unbox-parameter ( n ctype -- )
M: c-type unbox-parameter c-type-unbox ; 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 -- ) GENERIC: unbox-return ( ctype -- )
M: c-type unbox-return f swap c-type-unbox ; 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 <int> *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 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 ; 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 <displaced-alien> ] ;
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 GENERIC: byte-length ( seq -- n ) flushable
M: byte-array byte-length length ; inline M: byte-array byte-length length ; inline
M: f byte-length drop 0 ; inline M: f byte-length drop 0 ; inline
MIXIN: value-type
: c-getter ( name -- quot ) : c-getter ( name -- quot )
c-type-getter [ c-type-getter [
[ "Cannot read struct fields with this type" throw ] [ "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 ] [ "Cannot write struct fields with this type" throw ]
] unless* ; ] unless* ;
: <c-object> ( type -- array )
heap-size <byte-array> ; 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 <displaced-alien>
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 ) : array-accessor ( type quot -- def )
[ [
\ swap , [ heap-size , [ * >fixnum ] % ] [ % ] bi* \ swap , [ heap-size , [ * >fixnum ] % ] [ % ] bi*
] [ ] make ; ] [ ] 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 ; TUPLE: long-long-type < c-type ;
@ -312,36 +282,33 @@ M: long-long-type box-return ( type -- )
: define-out ( name -- ) : define-out ( name -- )
[ "alien.c-types" constructor-word ] [ "alien.c-types" constructor-word ]
[ dup c-setter '[ _ <c-object> [ 0 @ ] keep ] ] bi [ dup c-setter '[ _ heap-size <byte-array> [ 0 @ ] keep ] ] bi
(( value -- c-ptr )) define-inline ; (( value -- c-ptr )) define-inline ;
: >c-bool ( ? -- int ) 1 0 ? ; inline
: c-bool> ( int -- ? ) 0 = not ; inline
: define-primitive-type ( type name -- ) : define-primitive-type ( type name -- )
[ typedef ] [ typedef ]
[ define-deref ] [ name>> define-deref ]
[ define-out ] [ name>> define-out ]
tri ; tri ;
: malloc-file-contents ( path -- alien len )
binary file-contents [ malloc-byte-array ] [ length ] bi ;
: if-void ( type true false -- ) : 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 CONSTANT: primitive-types
{ {
"char" "uchar" char uchar
"short" "ushort" short ushort
"int" "uint" int uint
"long" "ulong" long ulong
"longlong" "ulonglong" longlong ulonglong
"float" "double" float double
"void*" "bool" void* bool
} }
SYMBOLS:
ptrdiff_t intptr_t size_t
char* uchar* ;
[ [
<c-type> <c-type>
c-ptr >>class c-ptr >>class
@ -353,7 +320,7 @@ CONSTANT: primitive-types
[ >c-ptr ] >>unboxer-quot [ >c-ptr ] >>unboxer-quot
"box_alien" >>boxer "box_alien" >>boxer
"alien_offset" >>unboxer "alien_offset" >>unboxer
"void*" define-primitive-type \ void* define-primitive-type
<long-long-type> <long-long-type>
integer >>class integer >>class
@ -364,7 +331,7 @@ CONSTANT: primitive-types
8 >>align 8 >>align
"box_signed_8" >>boxer "box_signed_8" >>boxer
"to_signed_8" >>unboxer "to_signed_8" >>unboxer
"longlong" define-primitive-type \ longlong define-primitive-type
<long-long-type> <long-long-type>
integer >>class integer >>class
@ -375,7 +342,7 @@ CONSTANT: primitive-types
8 >>align 8 >>align
"box_unsigned_8" >>boxer "box_unsigned_8" >>boxer
"to_unsigned_8" >>unboxer "to_unsigned_8" >>unboxer
"ulonglong" define-primitive-type \ ulonglong define-primitive-type
<c-type> <c-type>
integer >>class integer >>class
@ -386,7 +353,7 @@ CONSTANT: primitive-types
bootstrap-cell >>align bootstrap-cell >>align
"box_signed_cell" >>boxer "box_signed_cell" >>boxer
"to_fixnum" >>unboxer "to_fixnum" >>unboxer
"long" define-primitive-type \ long define-primitive-type
<c-type> <c-type>
integer >>class integer >>class
@ -397,7 +364,7 @@ CONSTANT: primitive-types
bootstrap-cell >>align bootstrap-cell >>align
"box_unsigned_cell" >>boxer "box_unsigned_cell" >>boxer
"to_cell" >>unboxer "to_cell" >>unboxer
"ulong" define-primitive-type \ ulong define-primitive-type
<c-type> <c-type>
integer >>class integer >>class
@ -408,7 +375,7 @@ CONSTANT: primitive-types
4 >>align 4 >>align
"box_signed_4" >>boxer "box_signed_4" >>boxer
"to_fixnum" >>unboxer "to_fixnum" >>unboxer
"int" define-primitive-type \ int define-primitive-type
<c-type> <c-type>
integer >>class integer >>class
@ -419,7 +386,7 @@ CONSTANT: primitive-types
4 >>align 4 >>align
"box_unsigned_4" >>boxer "box_unsigned_4" >>boxer
"to_cell" >>unboxer "to_cell" >>unboxer
"uint" define-primitive-type \ uint define-primitive-type
<c-type> <c-type>
fixnum >>class fixnum >>class
@ -430,7 +397,7 @@ CONSTANT: primitive-types
2 >>align 2 >>align
"box_signed_2" >>boxer "box_signed_2" >>boxer
"to_fixnum" >>unboxer "to_fixnum" >>unboxer
"short" define-primitive-type \ short define-primitive-type
<c-type> <c-type>
fixnum >>class fixnum >>class
@ -441,7 +408,7 @@ CONSTANT: primitive-types
2 >>align 2 >>align
"box_unsigned_2" >>boxer "box_unsigned_2" >>boxer
"to_cell" >>unboxer "to_cell" >>unboxer
"ushort" define-primitive-type \ ushort define-primitive-type
<c-type> <c-type>
fixnum >>class fixnum >>class
@ -452,7 +419,7 @@ CONSTANT: primitive-types
1 >>align 1 >>align
"box_signed_1" >>boxer "box_signed_1" >>boxer
"to_fixnum" >>unboxer "to_fixnum" >>unboxer
"char" define-primitive-type \ char define-primitive-type
<c-type> <c-type>
fixnum >>class fixnum >>class
@ -463,20 +430,20 @@ CONSTANT: primitive-types
1 >>align 1 >>align
"box_unsigned_1" >>boxer "box_unsigned_1" >>boxer
"to_cell" >>unboxer "to_cell" >>unboxer
"uchar" define-primitive-type \ uchar define-primitive-type
<c-type> <c-type>
[ alien-unsigned-1 c-bool> ] >>getter [ alien-unsigned-1 0 = not ] >>getter
[ [ >c-bool ] 2dip set-alien-unsigned-1 ] >>setter [ [ 1 0 ? ] 2dip set-alien-unsigned-1 ] >>setter
1 >>size 1 >>size
1 >>align 1 >>align
"box_boolean" >>boxer "box_boolean" >>boxer
"to_boolean" >>unboxer "to_boolean" >>unboxer
"bool" define-primitive-type \ bool define-primitive-type
<c-type> <c-type>
float >>class math:float >>class
float >>boxed-class math:float >>boxed-class
[ alien-float ] >>getter [ alien-float ] >>getter
[ [ >float ] 2dip set-alien-float ] >>setter [ [ >float ] 2dip set-alien-float ] >>setter
4 >>size 4 >>size
@ -485,11 +452,11 @@ CONSTANT: primitive-types
"to_float" >>unboxer "to_float" >>unboxer
float-rep >>rep float-rep >>rep
[ >float ] >>unboxer-quot [ >float ] >>unboxer-quot
"float" define-primitive-type \ float define-primitive-type
<c-type> <c-type>
float >>class math:float >>class
float >>boxed-class math:float >>boxed-class
[ alien-double ] >>getter [ alien-double ] >>getter
[ [ >float ] 2dip set-alien-double ] >>setter [ [ >float ] 2dip set-alien-double ] >>setter
8 >>size 8 >>size
@ -498,10 +465,10 @@ CONSTANT: primitive-types
"to_double" >>unboxer "to_double" >>unboxer
double-rep >>rep double-rep >>rep
[ >float ] >>unboxer-quot [ >float ] >>unboxer-quot
"double" define-primitive-type \ double define-primitive-type
"long" "ptrdiff_t" typedef \ long \ ptrdiff_t typedef
"long" "intptr_t" typedef \ long \ intptr_t typedef
"ulong" "size_t" typedef \ ulong \ size_t typedef
] with-compilation-unit ] with-compilation-unit

View File

@ -0,0 +1 @@
Slava Pestov

View File

@ -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: <c-array>
{ $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: <c-object>
{ $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." } ;
{ <c-object> 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 <c-direct-array> } "." }
{ $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." } ;
{ <c-array> <c-direct-array> 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 <byte-array> } " 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 <c-object> }
{ $subsection <c-array> }
{ $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 <c-array> } " or " { $link <c-direct-array> } " 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: <c-direct-array>
{ $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 } "." ;

View File

@ -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: <c-array> ( len c-type -- array )
M: c-type-name <c-array>
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: <c-direct-array> ( alien len c-type -- array )
M: c-type-name <c-direct-array>
c-direct-array-constructor execute( alien len -- array ) ; inline
: malloc-array ( n type -- alien )
[ heap-size calloc ] [ <c-direct-array> ] 2bi ; inline
: (malloc-array) ( n type -- alien )
[ heap-size * malloc ] [ <c-direct-array> ] 2bi ; inline
: <c-object> ( type -- array )
heap-size <byte-array> ; 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 <displaced-alien>
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 <displaced-alien> ] ;
M: value-type c-type-setter ( type -- quot )
[ c-type-getter ] [ c-type-unboxer-quot ] [ heap-size ] tri
'[ @ swap @ _ memcpy ] ;

View File

@ -0,0 +1 @@
Words for allocating objects and arrays of C types

View File

@ -1,7 +1,7 @@
! (c) 2009 Joe Groff, see BSD license ! (c) 2009 Joe Groff, see BSD license
USING: accessors alien alien.c-types alien.complex USING: accessors alien alien.c-types alien.complex
alien.fortran alien.fortran.private alien.strings classes.struct alien.data alien.fortran alien.fortran.private alien.strings
arrays assocs byte-arrays combinators fry classes.struct arrays assocs byte-arrays combinators fry
generalizations io.encodings.ascii kernel macros generalizations io.encodings.ascii kernel macros
macros.expander namespaces sequences shuffle tools.test ; macros.expander namespaces sequences shuffle tools.test ;
IN: alien.fortran.tests IN: alien.fortran.tests

View File

@ -1,5 +1,5 @@
! (c) 2009 Joe Groff, see BSD license ! (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 alien.strings alien.syntax arrays ascii assocs
byte-arrays combinators combinators.short-circuit fry generalizations byte-arrays combinators combinators.short-circuit fry generalizations
kernel lexer macros math math.parser namespaces parser sequences kernel lexer macros math math.parser namespaces parser sequences
@ -429,6 +429,11 @@ PRIVATE>
MACRO: fortran-invoke ( return library function parameters -- ) MACRO: fortran-invoke ( return library function parameters -- )
{ [ 2drop nip set-fortran-abi ] [ (fortran-invoke) ] } 4 ncleave ; { [ 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* <effect> ;
:: define-fortran-function ( return library function parameters -- ) :: define-fortran-function ( return library function parameters -- )
function create-in dup reset-generic function create-in dup reset-generic
return library function parameters return [ "void" ] unless* parse-arglist return library function parameters return [ "void" ] unless* parse-arglist

View File

@ -1,16 +1,42 @@
! Copyright (C) 2008, 2009 Slava Pestov, Doug Coleman. ! Copyright (C) 2008, 2009 Slava Pestov, Doug Coleman.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.c-types arrays assocs effects grouping kernel USING: accessors alien alien.c-types arrays assocs
parser sequences splitting words fry locals lexer namespaces combinators combinators.short-circuit effects grouping
summary math ; kernel parser sequences splitting words fry locals lexer
namespaces summary math vocabs.parser ;
IN: alien.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' ) : normalize-c-arg ( type name -- type' name' )
[ length ] [ length ]
[ [
[ CHAR: * = ] trim-head [ CHAR: * = ] trim-head
[ length - CHAR: * <array> append ] keep [ length - CHAR: * <array> append ] keep
] bi ; ] bi
[ parse-c-type ] dip ;
: parse-arglist ( parameters return -- types effect ) : parse-arglist ( parameters return -- types effect )
[ [
@ -36,3 +62,9 @@ IN: alien.parser
: define-function ( return library function parameters -- ) : define-function ( return library function parameters -- )
make-function define-declared ; make-function define-declared ;
PREDICATE: alien-function-word < word
def>> {
[ length 5 = ]
[ last \ alien-invoke eq? ]
} 1&& ;

View File

@ -1,8 +1,9 @@
! Copyright (C) 2008 Slava Pestov. ! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: kernel combinators alien alien.strings alien.syntax USING: accessors kernel combinators alien alien.strings alien.c-types
math.parser prettyprint.backend prettyprint.custom alien.parser alien.syntax arrays assocs effects math.parser
prettyprint.sections ; prettyprint.backend prettyprint.custom prettyprint.sections
definitions see see.private sequences strings words ;
IN: alien.prettyprint IN: alien.prettyprint
M: alien pprint* M: alien pprint*
@ -13,3 +14,39 @@ M: alien pprint*
} cond ; } cond ;
M: dll pprint* dll-path dup "DLL\" " "\"" pprint-string ; 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 ]
[ <block "(" text pprint-function-args ")" text block> ] tri ;

View File

@ -1,6 +1,6 @@
! Copyright (C) 2007, 2008 Slava Pestov. ! Copyright (C) 2007, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! 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 ; threads words kernel.private kernel io.encodings.utf8 eval ;
IN: alien.remote-control IN: alien.remote-control

View File

@ -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 ; sequences io arrays kernel words assocs namespaces ;
IN: alien.structs IN: alien.structs

View File

@ -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 ; sequences system libc words vocabs namespaces layouts ;
IN: alien.structs.tests IN: alien.structs.tests

View File

@ -15,7 +15,7 @@ M: struct-type c-type ;
M: struct-type c-type-stack-align? drop f ; M: struct-type c-type-stack-align? drop f ;
: if-value-struct ( ctype true false -- ) : 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 M: struct-type unbox-parameter
[ %unbox-large-struct ] [ unbox-parameter ] if-value-struct ; [ %unbox-large-struct ] [ unbox-parameter ] if-value-struct ;

View File

@ -19,7 +19,7 @@ SYNTAX: FUNCTION:
(FUNCTION:) define-declared ; (FUNCTION:) define-declared ;
SYNTAX: TYPEDEF: SYNTAX: TYPEDEF:
scan scan typedef ; scan-c-type CREATE-C-TYPE typedef ;
SYNTAX: C-STRUCT: SYNTAX: C-STRUCT:
scan current-vocab parse-definition define-struct ; deprecated scan current-vocab parse-definition define-struct ; deprecated
@ -31,6 +31,9 @@ SYNTAX: C-ENUM:
";" parse-tokens ";" parse-tokens
[ [ create-in ] dip define-constant ] each-index ; [ [ create-in ] dip define-constant ] each-index ;
SYNTAX: C-TYPE:
"Primitive C type definition not supported" throw ;
ERROR: no-such-symbol name library ; ERROR: no-such-symbol name library ;
: address-of ( name library -- value ) : address-of ( name library -- value )

View File

@ -1,6 +1,6 @@
! Copyright (C) 2007, 2008 Slava Pestov. ! Copyright (C) 2007, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! 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 kernel.private sequences sequences.private byte-arrays
parser prettyprint.custom fry ; parser prettyprint.custom fry ;
IN: bit-arrays IN: bit-arrays

View File

@ -1,8 +1,8 @@
! Copyright (C) 2008 Slava Pestov ! Copyright (C) 2008 Slava Pestov
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors byte-arrays alien.c-types kernel continuations USING: accessors byte-arrays alien.c-types alien.data kernel
destructors sequences io openssl openssl.libcrypto checksums continuations destructors sequences io openssl openssl.libcrypto
checksums.stream ; checksums checksums.stream ;
IN: checksums.openssl IN: checksums.openssl
ERROR: unknown-digest name ; ERROR: unknown-digest name ;

View File

@ -1,9 +1,9 @@
! (c)Joe Groff bsd license ! (c)Joe Groff bsd license
USING: accessors alien alien.c-types arrays assocs classes USING: accessors alien alien.c-types alien.data alien.prettyprint arrays
classes.struct combinators combinators.short-circuit continuations assocs classes classes.struct combinators combinators.short-circuit
fry kernel libc make math math.parser mirrors prettyprint.backend continuations fry kernel libc make math math.parser mirrors
prettyprint.custom prettyprint.sections see.private sequences prettyprint.backend prettyprint.custom prettyprint.sections
slots strings summary words ; see.private sequences slots strings summary words ;
IN: classes.struct.prettyprint IN: classes.struct.prettyprint
<PRIVATE <PRIVATE
@ -20,7 +20,7 @@ IN: classes.struct.prettyprint
<flow \ { pprint-word <flow \ { pprint-word
f <inset { f <inset {
[ name>> text ] [ name>> text ]
[ type>> dup string? [ text ] [ pprint* ] if ] [ type>> pprint-c-type ]
[ read-only>> [ \ read-only pprint-word ] when ] [ read-only>> [ \ read-only pprint-word ] when ]
[ initial>> [ \ initial: pprint-word pprint* ] when* ] [ initial>> [ \ initial: pprint-word pprint* ] when* ]
} cleave block> } cleave block>

View File

@ -1,11 +1,13 @@
! (c)Joe Groff bsd license ! (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 assocs byte-arrays classes.struct classes.tuple.private
combinators compiler.tree.debugger compiler.units destructors combinators compiler.tree.debugger compiler.units destructors
io.encodings.utf8 io.pathnames io.streams.string kernel libc io.encodings.utf8 io.pathnames io.streams.string kernel libc
literals math mirrors multiline namespaces prettyprint literals math mirrors multiline namespaces prettyprint
prettyprint.config see sequences specialized-arrays system prettyprint.config see sequences specialized-arrays system
tools.test parser lexer eval layouts ; tools.test parser lexer eval layouts ;
FROM: math => float ;
QUALIFIED-WITH: alien.c-types c
SPECIALIZED-ARRAY: char SPECIALIZED-ARRAY: char
SPECIALIZED-ARRAY: int SPECIALIZED-ARRAY: int
SPECIALIZED-ARRAY: ushort 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 } } { "underlying" B{ 98 0 0 98 127 0 0 127 0 0 0 0 } }
{ { "x" "char" } 98 } { { "x" char } 98 }
{ { "y" "int" } HEX: 7F00007F } { { "y" int } HEX: 7F00007F }
{ { "z" "bool" } f } { { "z" bool } f }
} ] [ } ] [
B{ 98 0 0 98 127 0 0 127 0 0 0 0 } struct-test-foo memory>struct B{ 98 0 0 98 127 0 0 127 0 0 0 0 } struct-test-foo memory>struct
make-mirror >alist make-mirror >alist
@ -128,7 +130,7 @@ STRUCT: struct-test-bar
] unit-test ] unit-test
UNION-STRUCT: struct-test-float-and-bits UNION-STRUCT: struct-test-float-and-bits
{ f float } { f c:float }
{ bits uint } ; { bits uint } ;
[ 1.0 ] [ struct-test-float-and-bits <struct> 1.0 float>bits >>bits f>> ] unit-test [ 1.0 ] [ struct-test-float-and-bits <struct> 1.0 float>bits >>bits f>> ] unit-test
@ -181,14 +183,14 @@ STRUCT: struct-test-string-ptr
] with-scope ] with-scope
] unit-test ] unit-test
[ <" USING: classes.struct ; [ <" USING: alien.c-types classes.struct ;
IN: classes.struct.tests IN: classes.struct.tests
STRUCT: struct-test-foo STRUCT: struct-test-foo
{ x char initial: 0 } { y int initial: 123 } { z bool } ; { x char initial: 0 } { y int initial: 123 } { z bool } ;
"> ] "> ]
[ [ struct-test-foo see ] with-string-writer ] unit-test [ [ struct-test-foo see ] with-string-writer ] unit-test
[ <" USING: classes.struct ; [ <" USING: alien.c-types classes.struct ;
IN: classes.struct.tests IN: classes.struct.tests
UNION-STRUCT: struct-test-float-and-bits UNION-STRUCT: struct-test-float-and-bits
{ f float initial: 0.0 } { bits uint initial: 0 } ; { f float initial: 0.0 } { bits uint initial: 0 } ;
@ -201,20 +203,20 @@ UNION-STRUCT: struct-test-float-and-bits
{ offset 0 } { offset 0 }
{ initial 0 } { initial 0 }
{ class fixnum } { class fixnum }
{ type "char" } { type char }
} }
T{ struct-slot-spec T{ struct-slot-spec
{ name "y" } { name "y" }
{ offset 4 } { offset 4 }
{ initial 123 } { initial 123 }
{ class integer } { class integer }
{ type "int" } { type int }
} }
T{ struct-slot-spec T{ struct-slot-spec
{ name "z" } { name "z" }
{ offset 8 } { offset 8 }
{ initial f } { initial f }
{ type "bool" } { type bool }
{ class object } { class object }
} }
} ] [ "struct-test-foo" c-type fields>> ] unit-test } ] [ "struct-test-foo" c-type fields>> ] unit-test
@ -223,14 +225,14 @@ UNION-STRUCT: struct-test-float-and-bits
T{ struct-slot-spec T{ struct-slot-spec
{ name "f" } { name "f" }
{ offset 0 } { offset 0 }
{ type "float" } { type c:float }
{ class float } { class float }
{ initial 0.0 } { initial 0.0 }
} }
T{ struct-slot-spec T{ struct-slot-spec
{ name "bits" } { name "bits" }
{ offset 0 } { offset 0 }
{ type "uint" } { type uint }
{ class integer } { class integer }
{ initial 0 } { initial 0 }
} }
@ -277,7 +279,7 @@ STRUCT: struct-test-array-slots
] unit-test ] unit-test
STRUCT: struct-test-optimization STRUCT: struct-test-optimization
{ x { "int" 3 } } { y int } ; { x { int 3 } } { y int } ;
SPECIALIZED-ARRAY: struct-test-optimization SPECIALIZED-ARRAY: struct-test-optimization

View File

@ -1,12 +1,12 @@
! (c)Joe Groff bsd license ! (c)Joe Groff bsd license
USING: accessors alien alien.c-types arrays byte-arrays classes USING: accessors alien alien.c-types alien.data alien.parser arrays
classes.parser classes.tuple classes.tuple.parser byte-arrays classes classes.parser classes.tuple classes.tuple.parser
classes.tuple.private combinators combinators.short-circuit classes.tuple.private combinators combinators.short-circuit
combinators.smart cpu.architecture definitions functors.backend combinators.smart cpu.architecture definitions functors.backend
fry generalizations generic.parser kernel kernel.private lexer fry generalizations generic.parser kernel kernel.private lexer
libc locals macros make math math.order parser quotations libc locals macros make math math.order parser quotations
sequences slots slots.private specialized-arrays vectors words sequences slots slots.private specialized-arrays vectors words
summary namespaces assocs ; summary namespaces assocs vocabs.parser ;
IN: classes.struct IN: classes.struct
SPECIALIZED-ARRAY: uchar SPECIALIZED-ARRAY: uchar
@ -126,7 +126,7 @@ M: struct-c-type c-type ;
M: struct-c-type c-type-stack-align? drop f ; M: struct-c-type c-type-stack-align? drop f ;
: if-value-struct ( ctype true false -- ) : 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 M: struct-c-type unbox-parameter
[ %unbox-large-struct ] [ unbox-parameter ] if-value-struct ; [ %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 ; [ type>> c-type-align ] [ max ] map-reduce ;
PRIVATE> 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 M: struct byte-length class "struct-size" word-prop ; foldable
! class definition ! class definition
@ -259,7 +245,7 @@ M: struct byte-length class "struct-size" word-prop ; foldable
[ check-struct-slots ] _ [ struct-align [ align ] keep ] tri [ check-struct-slots ] _ [ struct-align [ align ] keep ] tri
(struct-word-props) (struct-word-props)
] ]
[ drop [ c-type-for-class ] [ name>> ] bi typedef ] 2tri ; inline [ drop [ c-type-for-class ] keep typedef ] 2tri ; inline
PRIVATE> PRIVATE>
: define-struct-class ( class slots -- ) : define-struct-class ( class slots -- )
@ -284,9 +270,6 @@ ERROR: invalid-struct-slot token ;
[ [ dup empty? ] [ peel-off-attributes ] until drop ] tri* ; [ [ dup empty? ] [ peel-off-attributes ] until drop ] tri* ;
<PRIVATE <PRIVATE
: scan-c-type ( -- c-type )
scan dup "{" = [ drop \ } parse-until >array ] when ;
: parse-struct-slot ( -- slot ) : parse-struct-slot ( -- slot )
scan scan-c-type \ } parse-until <struct-slot-spec> ; scan scan-c-type \ } parse-until <struct-slot-spec> ;
@ -317,7 +300,7 @@ SYNTAX: S@
<PRIVATE <PRIVATE
: scan-c-type` ( -- c-type/param ) : scan-c-type` ( -- c-type/param )
scan dup "{" = [ drop \ } parse-until >array ] [ >string-param ] if ; scan dup "{" = [ drop \ } parse-until >array ] [ search ] if ;
: parse-struct-slot` ( accum -- accum ) : parse-struct-slot` ( accum -- accum )
scan-string-param scan-c-type` \ } parse-until scan-string-param scan-c-type` \ } parse-until

View File

@ -1,17 +1,16 @@
! Copyright (C) 2008 Joe Groff. ! Copyright (C) 2008 Joe Groff.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors kernel classes.struct cocoa cocoa.types alien.c-types USING: accessors kernel classes.struct cocoa cocoa.runtime cocoa.types alien.data
locals math sequences vectors fry libc destructors ; locals math sequences vectors fry libc destructors specialized-arrays ;
SPECIALIZED-ARRAY: id
IN: cocoa.enumeration IN: cocoa.enumeration
<< "id" require-c-array >>
CONSTANT: NS-EACH-BUFFER-SIZE 16 CONSTANT: NS-EACH-BUFFER-SIZE 16
: with-enumeration-buffers ( quot -- ) : with-enumeration-buffers ( quot -- )
'[ '[
NSFastEnumerationState malloc-struct &free NSFastEnumerationState malloc-struct &free
NS-EACH-BUFFER-SIZE "id" malloc-array &free NS-EACH-BUFFER-SIZE id malloc-array &free
NS-EACH-BUFFER-SIZE NS-EACH-BUFFER-SIZE
@ @
] with-destructors ; inline ] with-destructors ; inline
@ -19,7 +18,7 @@ CONSTANT: NS-EACH-BUFFER-SIZE 16
:: (NSFastEnumeration-each) ( object quot: ( elt -- ) state stackbuf count -- ) :: (NSFastEnumeration-each) ( object quot: ( elt -- ) state stackbuf count -- )
object state stackbuf count -> countByEnumeratingWithState:objects:count: :> items-count object state stackbuf count -> countByEnumeratingWithState:objects:count: :> items-count
items-count 0 = [ items-count 0 = [
state itemsPtr>> [ items-count "id" <c-direct-array> ] [ stackbuf ] if* :> items state itemsPtr>> [ items-count id <c-direct-array> ] [ stackbuf ] if* :> items
items-count iota [ items nth quot call ] each items-count iota [ items nth quot call ] each
object quot state stackbuf count (NSFastEnumeration-each) object quot state stackbuf count (NSFastEnumeration-each)
] unless ; inline recursive ] unless ; inline recursive

View File

@ -4,8 +4,8 @@
USING: strings arrays hashtables assocs sequences fry macros USING: strings arrays hashtables assocs sequences fry macros
cocoa.messages cocoa.classes cocoa.application cocoa kernel cocoa.messages cocoa.classes cocoa.application cocoa kernel
namespaces io.backend math cocoa.enumeration byte-arrays namespaces io.backend math cocoa.enumeration byte-arrays
combinators alien.c-types words core-foundation quotations combinators alien.c-types alien.data words core-foundation
core-foundation.data core-foundation.utilities ; quotations core-foundation.data core-foundation.utilities ;
IN: cocoa.plists IN: cocoa.plists
: >plist ( value -- plist ) >cf -> autorelease ; : >plist ( value -- plist ) >cf -> autorelease ;

View File

@ -456,7 +456,7 @@ TUPLE: callback-context ;
: callback-return-quot ( ctype -- quot ) : callback-return-quot ( ctype -- quot )
return>> { return>> {
{ [ dup "void" = ] [ drop [ ] ] } { [ dup void? ] [ drop [ ] ] }
{ [ dup large-struct? ] [ heap-size '[ _ memcpy ] ] } { [ dup large-struct? ] [ heap-size '[ _ memcpy ] ] }
[ c-type c-type-unboxer-quot ] [ c-type c-type-unboxer-quot ]
} cond ; } cond ;

View File

@ -5,6 +5,7 @@ io.streams.string kernel math memory namespaces
namespaces.private parser quotations sequences namespaces.private parser quotations sequences
specialized-arrays stack-checker stack-checker.errors specialized-arrays stack-checker stack-checker.errors
system threads tools.test words ; system threads tools.test words ;
FROM: alien.c-types => float short ;
SPECIALIZED-ARRAY: float SPECIALIZED-ARRAY: float
SPECIALIZED-ARRAY: char SPECIALIZED-ARRAY: char
IN: compiler.tests.alien IN: compiler.tests.alien

View File

@ -4,6 +4,7 @@ namespaces.private slots.private sequences.private byte-arrays alien
alien.accessors layouts words definitions compiler.units io alien.accessors layouts words definitions compiler.units io
combinators vectors grouping make alien.c-types combinators.short-circuit combinators vectors grouping make alien.c-types combinators.short-circuit
math.order math.libm math.parser ; math.order math.libm math.parser ;
FROM: math => float ;
QUALIFIED: namespaces.private QUALIFIED: namespaces.private
IN: compiler.tests.codegen IN: compiler.tests.codegen

View File

@ -3,8 +3,9 @@ math math.constants math.private math.integers.private sequences
strings tools.test words continuations sequences.private strings tools.test words continuations sequences.private
hashtables.private byte-arrays system random layouts vectors hashtables.private byte-arrays system random layouts vectors
sbufs strings.private slots.private alien math.order 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 ; namespaces libc io.encodings.ascii classes compiler ;
FROM: math => float ;
IN: compiler.tests.intrinsics IN: compiler.tests.intrinsics
! Make sure that intrinsic ops compile to correct code. ! Make sure that intrinsic ops compile to correct code.

View File

@ -16,6 +16,7 @@ compiler.tree.propagation
compiler.tree.propagation.info compiler.tree.propagation.info
compiler.tree.checker compiler.tree.checker
compiler.tree.debugger ; compiler.tree.debugger ;
FROM: math => float ;
IN: compiler.tree.cleanup.tests IN: compiler.tree.cleanup.tests
[ t ] [ [ [ 1 ] [ 2 ] if ] cleaned-up-tree [ #if? ] contains-node? ] unit-test [ t ] [ [ [ 1 ] [ 2 ] if ] cleaned-up-tree [ #if? ] contains-node? ] unit-test

View File

@ -10,6 +10,7 @@ compiler.tree.debugger compiler.tree.checker
slots.private words hashtables classes assocs locals slots.private words hashtables classes assocs locals
specialized-arrays system sorting math.libm specialized-arrays system sorting math.libm
math.intervals quotations effects alien ; math.intervals quotations effects alien ;
FROM: math => float ;
SPECIALIZED-ARRAY: double SPECIALIZED-ARRAY: double
IN: compiler.tree.propagation.tests IN: compiler.tree.propagation.tests

View File

@ -1,6 +1,7 @@
! Copyright (C) 2009 Slava Pestov. ! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: alien.c-types alien.syntax kernel math core-foundation ; USING: alien.c-types alien.syntax kernel math core-foundation ;
FROM: math => float ;
IN: core-foundation.numbers IN: core-foundation.numbers
TYPEDEF: void* CFNumberRef TYPEDEF: void* CFNumberRef

View File

@ -2,13 +2,14 @@
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors assocs sequences kernel combinators make math USING: accessors assocs sequences kernel combinators make math
math.order math.ranges system namespaces locals layouts words 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 cpu.ppc.assembler cpu.ppc.assembler.backend compiler.cfg.registers
compiler.cfg.instructions compiler.cfg.comparisons compiler.cfg.instructions compiler.cfg.comparisons
compiler.codegen.fixup compiler.cfg.intrinsics compiler.codegen.fixup compiler.cfg.intrinsics
compiler.cfg.stack-frame compiler.cfg.build-stack-frame compiler.cfg.stack-frame compiler.cfg.build-stack-frame
compiler.units compiler.constants compiler.codegen ; compiler.units compiler.constants compiler.codegen ;
FROM: cpu.ppc.assembler => B ; FROM: cpu.ppc.assembler => B ;
FROM: math => float ;
IN: cpu.ppc IN: cpu.ppc
! PowerPC register assignments: ! PowerPC register assignments:
@ -770,5 +771,5 @@ USE: vocabs.loader
4 >>align 4 >>align
"box_boolean" >>boxer "box_boolean" >>boxer
"to_boolean" >>unboxer "to_boolean" >>unboxer
"bool" define-primitive-type bool define-primitive-type
] with-compilation-unit ] with-compilation-unit

View File

@ -16,9 +16,10 @@ M: float-regs param-regs
M: x86.64 reserved-area-size 0 ; M: x86.64 reserved-area-size 0 ;
! The ABI for passing structs by value is pretty messed up SYMBOL: (stack-value)
<< "void*" c-type clone "__stack_value" define-primitive-type ! The ABI for passing structs by value is pretty great
stack-params "__stack_value" c-type (>>rep) >> << void* c-type clone \ (stack-value) define-primitive-type
stack-params \ (stack-value) c-type (>>rep) >>
: struct-types&offset ( struct-type -- pairs ) : struct-types&offset ( struct-type -- pairs )
fields>> [ fields>> [
@ -33,12 +34,12 @@ stack-params "__stack_value" c-type (>>rep) >>
: flatten-small-struct ( c-type -- seq ) : flatten-small-struct ( c-type -- seq )
struct-types&offset split-struct [ struct-types&offset split-struct [
[ c-type c-type-rep reg-class-of ] map [ 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 ; ] map ;
: flatten-large-struct ( c-type -- seq ) : flatten-large-struct ( c-type -- seq )
heap-size cell align heap-size cell align
cell /i "__stack_value" c-type <repetition> ; cell /i \ (stack-value) c-type <repetition> ;
: flatten-struct ( c-type -- seq ) : flatten-struct ( c-type -- seq )
dup heap-size 16 > [ dup heap-size 16 > [

View File

@ -25,8 +25,8 @@ M: x86.64 dummy-fp-params? t ;
M: x86.64 temp-reg RAX ; M: x86.64 temp-reg RAX ;
<< <<
"longlong" "ptrdiff_t" typedef longlong ptrdiff_t typedef
"longlong" "intptr_t" typedef longlong intptr_t typedef
"int" c-type "long" define-primitive-type int c-type long define-primitive-type
"uint" c-type "ulong" define-primitive-type uint c-type ulong define-primitive-type
>> >>

View File

@ -1,8 +1,8 @@
! Copyright (C) 2009 Slava Pestov. ! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: system kernel math math.order math.parser namespaces USING: system kernel math math.order math.parser namespaces
alien.syntax combinators locals init io cpu.x86 compiler alien.c-types alien.syntax combinators locals init io cpu.x86
compiler.units accessors ; compiler compiler.units accessors ;
IN: cpu.x86.features IN: cpu.x86.features
<PRIVATE <PRIVATE

View File

@ -12,6 +12,7 @@ compiler.cfg.comparisons
compiler.cfg.stack-frame compiler.cfg.stack-frame
compiler.codegen compiler.codegen
compiler.codegen.fixup ; compiler.codegen.fixup ;
FROM: math => float ;
IN: cpu.x86 IN: cpu.x86
<< enable-fixnum-log2 >> << enable-fixnum-log2 >>

View File

@ -2,11 +2,11 @@
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: arrays continuations db io kernel math namespaces USING: arrays continuations db io kernel math namespaces
quotations sequences db.postgresql.ffi alien alien.c-types quotations sequences db.postgresql.ffi alien alien.c-types
db.types tools.walker ascii splitting math.parser combinators alien.data db.types tools.walker ascii splitting math.parser
libc calendar.format byte-arrays destructors prettyprint combinators libc calendar.format byte-arrays destructors
accessors strings serialize io.encodings.binary io.encodings.utf8 prettyprint accessors strings serialize io.encodings.binary
alien.strings io.streams.byte-array summary present urls io.encodings.utf8 alien.strings io.streams.byte-array summary
specialized-arrays db.private ; present urls specialized-arrays db.private ;
SPECIALIZED-ARRAY: uint SPECIALIZED-ARRAY: uint
SPECIALIZED-ARRAY: void* SPECIALIZED-ARRAY: void*
IN: db.postgresql.lib IN: db.postgresql.lib

View File

@ -1,6 +1,6 @@
! Copyright (C) 2008 Chris Double, Doug Coleman. ! Copyright (C) 2008 Chris Double, Doug Coleman.
! See http://factorcode.org/license.txt for BSD license. ! 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 namespaces sequences db.sqlite.ffi db combinators
continuations db.types calendar.format serialize continuations db.types calendar.format serialize
io.streams.byte-array byte-arrays io.encodings.binary io.streams.byte-array byte-arrays io.encodings.binary

View File

@ -1,8 +1,9 @@
! Copyright (C) 2008 Doug Coleman. ! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.c-types alien.strings alien.syntax kernel USING: alien alien.c-types alien.data alien.strings
layouts sequences system unix environment io.encodings.utf8 alien.syntax kernel layouts sequences system unix
unix.utilities vocabs.loader combinators alien.accessors ; environment io.encodings.utf8 unix.utilities vocabs.loader
combinators alien.accessors ;
IN: environment.unix IN: environment.unix
HOOK: environ os ( -- void* ) HOOK: environ os ( -- void* )

View File

@ -1,15 +1,14 @@
! Copyright (C) 2008 Doug Coleman. ! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: alien.strings fry io.encodings.utf16n kernel USING: alien.strings fry io.encodings.utf16n kernel
splitting windows windows.kernel32 system environment splitting windows windows.kernel32 windows.types system
alien.c-types sequences windows.errors io.streams.memory environment alien.data sequences windows.errors
io.encodings io ; io.streams.memory io.encodings io specialized-arrays ;
SPECIALIZED-ARRAY: TCHAR
IN: environment.winnt IN: environment.winnt
<< "TCHAR" require-c-array >>
M: winnt os-env ( key -- value ) M: winnt os-env ( key -- value )
MAX_UNICODE_PATH "TCHAR" <c-array> MAX_UNICODE_PATH TCHAR <c-array>
[ dup length GetEnvironmentVariable ] keep over 0 = [ [ dup length GetEnvironmentVariable ] keep over 0 = [
2drop f 2drop f
] [ ] [

View File

@ -1,5 +1,6 @@
USING: classes.struct functors tools.test math words kernel USING: classes.struct functors tools.test math words kernel
multiline parser io.streams.string generic ; multiline parser io.streams.string generic ;
QUALIFIED-WITH: alien.c-types c
IN: functors.tests IN: functors.tests
<< <<
@ -160,15 +161,15 @@ T-class DEFINES-CLASS ${T}
WHERE WHERE
STRUCT: T-class STRUCT: T-class
{ NAME int } { NAME c:int }
{ x { TYPE 4 } } { x { TYPE 4 } }
{ y { "short" N } } { y { c:short N } }
{ z TYPE initial: 5 } { z TYPE initial: 5 }
{ float { "float" 2 } } ; { float { c:float 2 } } ;
;FUNCTOR ;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 } { offset 0 }
{ class integer } { class integer }
{ initial 0 } { initial 0 }
{ type "int" } { type c:int }
} }
T{ struct-slot-spec T{ struct-slot-spec
{ name "x" } { name "x" }
{ offset 4 } { offset 4 }
{ class object } { class object }
{ initial f } { initial f }
{ type { "char" 4 } } { type { c:char 4 } }
} }
T{ struct-slot-spec T{ struct-slot-spec
{ name "y" } { name "y" }
{ offset 8 } { offset 8 }
{ class object } { class object }
{ initial f } { initial f }
{ type { "short" 2 } } { type { c:short 2 } }
} }
T{ struct-slot-spec T{ struct-slot-spec
{ name "z" } { name "z" }
{ offset 12 } { offset 12 }
{ class fixnum } { class fixnum }
{ initial 5 } { initial 5 }
{ type "char" } { type c:char }
} }
T{ struct-slot-spec T{ struct-slot-spec
{ name "float" } { name "float" }
{ offset 16 } { offset 16 }
{ class object } { class object }
{ initial f } { initial f }
{ type { "float" 2 } } { type { c:float 2 } }
} }
} }
] [ a-struct struct-slots ] unit-test ] [ a-struct struct-slots ] unit-test

View File

@ -6,7 +6,7 @@ math.rectangles namespaces parser sequences shuffle
specialized-arrays ui.backend.windows vectors windows.com specialized-arrays ui.backend.windows vectors windows.com
windows.dinput windows.dinput.constants windows.errors windows.dinput windows.dinput.constants windows.errors
windows.kernel32 windows.messages windows.ole32 windows.kernel32 windows.messages windows.ole32
windows.user32 classes.struct ; windows.user32 classes.struct alien.data ;
SPECIALIZED-ARRAY: DIDEVICEOBJECTDATA SPECIALIZED-ARRAY: DIDEVICEOBJECTDATA
IN: game-input.dinput IN: game-input.dinput
@ -160,19 +160,24 @@ SYMBOLS: +dinput+ +keyboard-device+ +keyboard-state+
[ device-attached? not ] filter [ device-attached? not ] filter
[ remove-controller ] each ; [ remove-controller ] each ;
: device-interface? ( dbt-broadcast-hdr -- ? ) : ?device-interface ( dbt-broadcast-hdr -- ? )
dbch_devicetype>> DBT_DEVTYP_DEVICEINTERFACE = ; dup dbch_devicetype>> DBT_DEVTYP_DEVICEINTERFACE =
[ >c-ptr DEV_BROADCAST_DEVICEW memory>struct ]
[ drop f ] if ; inline
: device-arrived ( dbt-broadcast-hdr -- ) : device-arrived ( dbt-broadcast-hdr -- )
device-interface? [ find-controllers ] when ; ?device-interface [ find-controllers ] when ; inline
: device-removed ( dbt-broadcast-hdr -- ) : device-removed ( dbt-broadcast-hdr -- )
device-interface? [ find-and-remove-detached-devices ] when ; ?device-interface [ find-and-remove-detached-devices ] when ; inline
: <DEV_BROADCAST_HDR> ( wParam -- struct )
<alien> DEV_BROADCAST_HDR memory>struct ;
: handle-wm-devicechange ( hWnd uMsg wParam lParam -- ) : handle-wm-devicechange ( hWnd uMsg wParam lParam -- )
[ 2drop ] 2dip swap { [ 2drop ] 2dip swap {
{ [ dup DBT_DEVICEARRIVAL = ] [ drop <alien> device-arrived ] } { [ dup DBT_DEVICEARRIVAL = ] [ drop <DEV_BROADCAST_HDR> device-arrived ] }
{ [ dup DBT_DEVICEREMOVECOMPLETE = ] [ drop <alien> device-removed ] } { [ dup DBT_DEVICEREMOVECOMPLETE = ] [ drop <DEV_BROADCAST_HDR> device-removed ] }
[ 2drop ] [ 2drop ]
} cond ; } cond ;

View File

@ -1,5 +1,5 @@
USING: sequences sequences.private math alien.c-types USING: sequences sequences.private math
accessors ; accessors alien.data ;
IN: game-input.dinput.keys-array IN: game-input.dinput.keys-array
TUPLE: keys-array TUPLE: keys-array

View File

@ -3,7 +3,8 @@ kernel cocoa.enumeration destructors math.parser cocoa.application
sequences locals combinators.short-circuit threads sequences locals combinators.short-circuit threads
namespaces assocs arrays combinators hints alien namespaces assocs arrays combinators hints alien
core-foundation.run-loop accessors sequences.private 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 IN: game-input.iokit
SINGLETON: iokit-game-input-backend SINGLETON: iokit-game-input-backend

View File

@ -1,7 +1,7 @@
! Copyright (C) 2009 Slava Pestov. ! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien.c-types destructors fry images kernel USING: accessors alien.c-types alien.data destructors fry images
libc math sequences ; kernel libc math sequences ;
IN: images.memory IN: images.memory
! Some code shared by core-graphics and cairo for constructing ! Some code shared by core-graphics and cairo for constructing

View File

@ -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 destructors generic io.mmap io.ports io.backend.windows io.files.windows
kernel libc math math.bitwise namespaces quotations sequences windows kernel libc math math.bitwise namespaces quotations sequences windows
windows.advapi32 windows.kernel32 io.backend system accessors windows.advapi32 windows.kernel32 io.backend system accessors

View File

@ -1,7 +1,7 @@
IN: io.buffers.tests IN: io.buffers.tests
USING: alien alien.c-types io.buffers kernel kernel.private libc USING: alien alien.c-types alien.data io.buffers kernel
sequences tools.test namespaces byte-arrays strings accessors kernel.private libc sequences tools.test namespaces byte-arrays
destructors ; strings accessors destructors ;
: buffer-set ( string buffer -- ) : buffer-set ( string buffer -- )
over >byte-array over ptr>> byte-array>memory over >byte-array over ptr>> byte-array>memory

View File

@ -2,8 +2,8 @@
! Copyright (C) 2006, 2008 Slava Pestov. ! Copyright (C) 2006, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien alien.accessors alien.c-types USING: accessors alien alien.accessors alien.c-types
alien.syntax kernel libc math sequences byte-arrays strings alien.data alien.syntax kernel libc math sequences byte-arrays
hints math.order destructors combinators ; strings hints math.order destructors combinators ;
IN: io.buffers IN: io.buffers
TUPLE: buffer TUPLE: buffer

View File

@ -6,7 +6,7 @@ windows.time windows accessors alien.c-types combinators
generalizations system alien.strings io.encodings.utf16n generalizations system alien.strings io.encodings.utf16n
sequences splitting windows.errors fry continuations destructors sequences splitting windows.errors fry continuations destructors
calendar ascii combinators.short-circuit locals classes.struct calendar ascii combinators.short-circuit locals classes.struct
specialized-arrays ; specialized-arrays alien.data ;
SPECIALIZED-ARRAY: ushort SPECIALIZED-ARRAY: ushort
IN: io.files.info.windows IN: io.files.info.windows

View File

@ -6,7 +6,7 @@ io.backend.windows kernel math splitting fry alien.strings
windows windows.kernel32 windows.time calendar combinators windows windows.kernel32 windows.time calendar combinators
math.functions sequences namespaces make words system math.functions sequences namespaces make words system
destructors accessors math.bitwise continuations windows.errors destructors accessors math.bitwise continuations windows.errors
arrays byte-arrays generalizations ; arrays byte-arrays generalizations alien.data ;
IN: io.files.windows IN: io.files.windows
: open-file ( path access-mode create-mode flags -- handle ) : open-file ( path access-mode create-mode flags -- handle )

View File

@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: continuations destructors io.files io.files.info USING: continuations destructors io.files io.files.info
io.backend kernel quotations system alien alien.accessors 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 ; math ;
IN: io.mmap IN: io.mmap

View File

@ -1,7 +1,7 @@
! Copyright (C) 2008 Doug Coleman, Slava Pestov. ! Copyright (C) 2008 Doug Coleman, Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.c-types alien.strings libc destructors locals USING: alien alien.c-types alien.data alien.strings libc destructors
kernel math assocs namespaces make continuations sequences locals kernel math assocs namespaces make continuations sequences
hashtables sorting arrays combinators math.bitwise strings hashtables sorting arrays combinators math.bitwise strings
system accessors threads splitting io.backend io.backend.windows system accessors threads splitting io.backend io.backend.windows
io.backend.windows.nt io.files.windows.nt io.monitors io.ports io.backend.windows.nt io.files.windows.nt io.monitors io.ports

View File

@ -1,10 +1,10 @@
! Copyright (C) 2007, 2008, Slava Pestov, Elie CHAFTARI. ! Copyright (C) 2007, 2008, Slava Pestov, Elie CHAFTARI.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors byte-arrays kernel sequences namespaces math USING: accessors byte-arrays kernel sequences namespaces math
math.order combinators init alien alien.c-types alien.strings math.order combinators init alien alien.c-types alien.data
libc continuations destructors summary splitting assocs random alien.strings libc continuations destructors summary splitting
math.parser locals unicode.case openssl openssl.libcrypto assocs random math.parser locals unicode.case openssl
openssl.libssl io.backend io.ports io.pathnames openssl.libcrypto openssl.libssl io.backend io.ports io.pathnames
io.encodings.8-bit io.timeouts io.sockets.secure ; io.encodings.8-bit io.timeouts io.sockets.secure ;
IN: io.sockets.secure.openssl IN: io.sockets.secure.openssl

View File

@ -6,7 +6,7 @@ arrays io.encodings io.ports io.streams.duplex io.encodings.ascii
alien.strings io.binary accessors destructors classes byte-arrays alien.strings io.binary accessors destructors classes byte-arrays
parser alien.c-types math.parser splitting grouping math assocs parser alien.c-types math.parser splitting grouping math assocs
summary system vocabs.loader combinators present fry vocabs.parser summary system vocabs.loader combinators present fry vocabs.parser
classes.struct ; classes.struct alien.data ;
IN: io.sockets IN: io.sockets
<< { << {

View File

@ -5,7 +5,7 @@ threads sequences byte-arrays io.binary io.backend.unix
io.streams.duplex io.backend io.pathnames io.sockets.private io.streams.duplex io.backend io.pathnames io.sockets.private
io.files.private io.encodings.utf8 math.parser continuations io.files.private io.encodings.utf8 math.parser continuations
libc combinators system accessors destructors unix locals init libc combinators system accessors destructors unix locals init
classes.struct ; classes.struct alien.data ;
EXCLUDE: namespaces => bind ; EXCLUDE: namespaces => bind ;
EXCLUDE: io => read write ; EXCLUDE: io => read write ;

View File

@ -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 continuations destructors io.ports io.timeouts io.sockets
io.sockets.private io namespaces io.streams.duplex io.sockets.private io namespaces io.streams.duplex
io.backend.windows io.sockets.windows io.backend.windows.nt io.backend.windows io.sockets.windows io.backend.windows.nt

View File

@ -2,29 +2,29 @@
! Copyright (C) 2007, 2009 Slava Pestov ! Copyright (C) 2007, 2009 Slava Pestov
! Copyright (C) 2007, 2008 Doug Coleman ! Copyright (C) 2007, 2008 Doug Coleman
! See http://factorcode.org/license.txt for BSD license. ! 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 ; namespaces accessors sets summary destructors destructors.private ;
IN: libc IN: libc
: errno ( -- int ) : errno ( -- int )
"int" "factor" "err_no" { } alien-invoke ; int "factor" "err_no" { } alien-invoke ;
: clear-errno ( -- ) : clear-errno ( -- )
"void" "factor" "clear_err_no" { } alien-invoke ; void "factor" "clear_err_no" { } alien-invoke ;
<PRIVATE <PRIVATE
: (malloc) ( size -- alien ) : (malloc) ( size -- alien )
"void*" "libc" "malloc" { "ulong" } alien-invoke ; void* "libc" "malloc" { ulong } alien-invoke ;
: (calloc) ( count size -- alien ) : (calloc) ( count size -- alien )
"void*" "libc" "calloc" { "ulong" "ulong" } alien-invoke ; void* "libc" "calloc" { ulong ulong } alien-invoke ;
: (free) ( alien -- ) : (free) ( alien -- )
"void" "libc" "free" { "void*" } alien-invoke ; void "libc" "free" { void* } alien-invoke ;
: (realloc) ( alien size -- newalien ) : (realloc) ( alien size -- newalien )
"void*" "libc" "realloc" { "void*" "ulong" } alien-invoke ; void* "libc" "realloc" { void* ulong } alien-invoke ;
! We stick malloc-ptr instances in the global disposables set ! We stick malloc-ptr instances in the global disposables set
TUPLE: malloc-ptr value continuation ; TUPLE: malloc-ptr value continuation ;
@ -81,15 +81,15 @@ PRIVATE>
>c-ptr [ delete-malloc ] [ (free) ] bi ; >c-ptr [ delete-malloc ] [ (free) ] bi ;
: memcpy ( dst src size -- ) : 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 ) : 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 -- ? ) : memory= ( a b size -- ? )
memcmp 0 = ; memcmp 0 = ;
: strlen ( alien -- len ) : strlen ( alien -- len )
"size_t" "libc" "strlen" { "char*" } alien-invoke ; size_t "libc" "strlen" { char* } alien-invoke ;
DESTRUCTOR: free DESTRUCTOR: free

View File

@ -1,10 +1,11 @@
USING: accessors alien alien.c-types arrays byte-arrays combinators USING: accessors alien alien.c-types alien.data arrays
combinators.short-circuit fry kernel locals macros byte-arrays combinators combinators.short-circuit fry
math math.blas.ffi math.blas.vectors math.blas.vectors.private kernel locals macros math math.blas.ffi math.blas.vectors
math.complex math.functions math.order functors words math.blas.vectors.private math.complex math.functions
sequences sequences.merged sequences.private shuffle math.order functors words sequences sequences.merged
parser prettyprint.backend prettyprint.custom ascii sequences.private shuffle parser prettyprint.backend
specialized-arrays ; prettyprint.custom ascii specialized-arrays ;
FROM: alien.c-types => float ;
SPECIALIZED-ARRAY: float SPECIALIZED-ARRAY: float
SPECIALIZED-ARRAY: double SPECIALIZED-ARRAY: double
SPECIALIZED-ARRAY: complex-float SPECIALIZED-ARRAY: complex-float

View File

@ -3,6 +3,7 @@ combinators.short-circuit fry kernel math math.blas.ffi
math.complex math.functions math.order sequences sequences.private math.complex math.functions math.order sequences sequences.private
functors words locals parser prettyprint.backend prettyprint.custom functors words locals parser prettyprint.backend prettyprint.custom
specialized-arrays ; specialized-arrays ;
FROM: alien.c-types => float ;
SPECIALIZED-ARRAY: float SPECIALIZED-ARRAY: float
SPECIALIZED-ARRAY: double SPECIALIZED-ARRAY: double
SPECIALIZED-ARRAY: complex-float SPECIALIZED-ARRAY: complex-float

View File

@ -1,62 +1,62 @@
! Copyright (C) 2006 Slava Pestov. ! Copyright (C) 2006 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: alien ; USING: alien alien.c-types ;
IN: math.libm IN: math.libm
: facos ( x -- y ) : facos ( x -- y )
"double" "libm" "acos" { "double" } alien-invoke ; double "libm" "acos" { double } alien-invoke ;
: fasin ( x -- y ) : fasin ( x -- y )
"double" "libm" "asin" { "double" } alien-invoke ; double "libm" "asin" { double } alien-invoke ;
: fatan ( x -- y ) : fatan ( x -- y )
"double" "libm" "atan" { "double" } alien-invoke ; double "libm" "atan" { double } alien-invoke ;
: fatan2 ( x y -- z ) : fatan2 ( x y -- z )
"double" "libm" "atan2" { "double" "double" } alien-invoke ; double "libm" "atan2" { double double } alien-invoke ;
: fcos ( x -- y ) : fcos ( x -- y )
"double" "libm" "cos" { "double" } alien-invoke ; double "libm" "cos" { double } alien-invoke ;
: fsin ( x -- y ) : fsin ( x -- y )
"double" "libm" "sin" { "double" } alien-invoke ; double "libm" "sin" { double } alien-invoke ;
: ftan ( x -- y ) : ftan ( x -- y )
"double" "libm" "tan" { "double" } alien-invoke ; double "libm" "tan" { double } alien-invoke ;
: fcosh ( x -- y ) : fcosh ( x -- y )
"double" "libm" "cosh" { "double" } alien-invoke ; double "libm" "cosh" { double } alien-invoke ;
: fsinh ( x -- y ) : fsinh ( x -- y )
"double" "libm" "sinh" { "double" } alien-invoke ; double "libm" "sinh" { double } alien-invoke ;
: ftanh ( x -- y ) : ftanh ( x -- y )
"double" "libm" "tanh" { "double" } alien-invoke ; double "libm" "tanh" { double } alien-invoke ;
: fexp ( x -- y ) : fexp ( x -- y )
"double" "libm" "exp" { "double" } alien-invoke ; double "libm" "exp" { double } alien-invoke ;
: flog ( x -- y ) : flog ( x -- y )
"double" "libm" "log" { "double" } alien-invoke ; double "libm" "log" { double } alien-invoke ;
: flog10 ( x -- y ) : flog10 ( x -- y )
"double" "libm" "log10" { "double" } alien-invoke ; double "libm" "log10" { double } alien-invoke ;
: fpow ( x y -- z ) : fpow ( x y -- z )
"double" "libm" "pow" { "double" "double" } alien-invoke ; double "libm" "pow" { double double } alien-invoke ;
: fsqrt ( x -- y ) : fsqrt ( x -- y )
"double" "libm" "sqrt" { "double" } alien-invoke ; double "libm" "sqrt" { double } alien-invoke ;
! Windows doesn't have these... ! Windows doesn't have these...
: flog1+ ( x -- y ) : flog1+ ( x -- y )
"double" "libm" "log1p" { "double" } alien-invoke ; double "libm" "log1p" { double } alien-invoke ;
: facosh ( x -- y ) : facosh ( x -- y )
"double" "libm" "acosh" { "double" } alien-invoke ; double "libm" "acosh" { double } alien-invoke ;
: fasinh ( x -- y ) : fasinh ( x -- y )
"double" "libm" "asinh" { "double" } alien-invoke ; double "libm" "asinh" { double } alien-invoke ;
: fatanh ( x -- y ) : fatanh ( x -- y )
"double" "libm" "atanh" { "double" } alien-invoke ; double "libm" "atanh" { double } alien-invoke ;

View File

@ -9,14 +9,16 @@ ERROR: bad-length got expected ;
FUNCTOR: define-simd-128 ( T -- ) 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-CLASS ${T}-${N}
>A DEFINES >${A} >A DEFINES >${A}
A{ DEFINES ${A}{ A{ DEFINES ${A}{
NTH [ T dup c-type-getter-boxer array-accessor ] NTH [ T-TYPE dup c-type-getter-boxer array-accessor ]
SET-NTH [ T dup c-setter array-accessor ] SET-NTH [ T-TYPE dup c-setter array-accessor ]
A-rep IS ${A}-rep A-rep IS ${A}-rep
A-vv->v-op DEFINES-PRIVATE ${A}-vv->v-op 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 ! Synthesize 256-bit vectors from a pair of 128-bit vectors
FUNCTOR: define-simd-256 ( T -- ) 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 / ] N/2 [ N 2 / ]
A/2 IS ${T}-${N/2} A/2 IS ${T}-${N/2}

View File

@ -1,6 +1,6 @@
! Copyright (C) 2009 Slava Pestov. ! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! 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 IN: math.vectors.simd.intrinsics
ERROR: bad-simd-call ; ERROR: bad-simd-call ;

View File

@ -5,6 +5,8 @@ kernel math math.functions math.vectors
math.vectors.simd.functor math.vectors.simd.intrinsics math.vectors.simd.functor math.vectors.simd.intrinsics
math.vectors.specialization parser prettyprint.custom sequences math.vectors.specialization parser prettyprint.custom sequences
sequences.private locals assocs words fry ; sequences.private locals assocs words fry ;
FROM: alien.c-types => float ;
QUALIFIED-WITH: math m
IN: math.vectors.simd IN: math.vectors.simd
<< <<
@ -136,7 +138,7 @@ DEFER: double-4
PRIVATE> 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 ] } { 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 ] } { sum [ [ (simd-sum) ] float-4-v->n-op ] }
} simd-vector-words } 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 ] } { 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 ] } { sum [ [ (simd-sum) ] double-2-v->n-op ] }
} simd-vector-words } 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 ] } { 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 ] } { sum [ [ (simd-sum) ] [ + ] float-8-v->n-op ] }
} simd-vector-words } 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 ] } { v- [ [ (simd-v-) ] double-4-vv->v-op ] }
{ v* [ [ (simd-v*) ] double-4-vv->v-op ] } { v* [ [ (simd-v*) ] double-4-vv->v-op ] }

View File

@ -8,6 +8,7 @@ math.parser opengl.gl combinators combinators.smart arrays
sequences splitting words byte-arrays assocs vocabs sequences splitting words byte-arrays assocs vocabs
colors colors.constants accessors generalizations locals fry colors colors.constants accessors generalizations locals fry
specialized-arrays ; specialized-arrays ;
FROM: alien.c-types => float ;
SPECIALIZED-ARRAY: float SPECIALIZED-ARRAY: float
SPECIALIZED-ARRAY: uint SPECIALIZED-ARRAY: uint
IN: opengl IN: opengl

View File

@ -1,7 +1,7 @@
! Copyright (C) 2008 Joe Groff. ! Copyright (C) 2008 Joe Groff.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: kernel opengl.gl alien.c-types continuations namespaces 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 macros arrays io.encodings.ascii fry specialized-arrays
destructors accessors ; destructors accessors ;
SPECIALIZED-ARRAY: uint SPECIALIZED-ARRAY: uint

View File

@ -19,6 +19,9 @@ HELP: length-limit
HELP: line-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." } ; { $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? HELP: string-limit?
{ $var-description "Toggles whether printed strings are truncated to the margin." } ; { $var-description "Toggles whether printed strings are truncated to the margin." } ;

View File

@ -28,6 +28,7 @@ ARTICLE: "prettyprint-variables" "Prettyprint control variables"
{ $subsection nesting-limit } { $subsection nesting-limit }
{ $subsection length-limit } { $subsection length-limit }
{ $subsection line-limit } { $subsection line-limit }
{ $subsection number-base }
{ $subsection string-limit? } { $subsection string-limit? }
{ $subsection boa-tuples? } { $subsection boa-tuples? }
{ $subsection c-object-pointers? } { $subsection c-object-pointers? }
@ -202,8 +203,8 @@ HELP: .o
{ $description "Outputs an integer in octal." } ; { $description "Outputs an integer in octal." } ;
HELP: .h HELP: .h
{ $values { "n" "an integer" } } { $values { "n" "an integer or floating-point value" } }
{ $description "Outputs an integer in hexadecimal." } ; { $description "Outputs an integer or floating-point value in hexadecimal." } ;
HELP: stack. HELP: stack.
{ $values { "seq" "a sequence" } } { $values { "seq" "a sequence" } }

View File

@ -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 combinators.short-circuit continuations destructors init kernel
locals namespaces random windows.advapi32 windows.errors locals namespaces random windows.advapi32 windows.errors
windows.kernel32 math.bitwise ; windows.kernel32 math.bitwise ;

View File

@ -4,7 +4,8 @@ specialized-arrays.private sequences alien.c-types accessors
kernel arrays combinators compiler compiler.units classes.struct kernel arrays combinators compiler compiler.units classes.struct
combinators.smart compiler.tree.debugger math libc destructors combinators.smart compiler.tree.debugger math libc destructors
sequences.private multiline eval words vocabs namespaces sequences.private multiline eval words vocabs namespaces
assocs prettyprint ; assocs prettyprint alien.data ;
FROM: alien.c-types => float ;
SPECIALIZED-ARRAY: int SPECIALIZED-ARRAY: int
SPECIALIZED-ARRAY: bool SPECIALIZED-ARRAY: bool

View File

@ -1,7 +1,7 @@
! Copyright (C) 2008, 2009 Slava Pestov. ! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien alien.c-types assocs byte-arrays classes USING: accessors alien alien.c-types alien.data alien.parser assocs
compiler.units functors kernel lexer libc math byte-arrays classes compiler.units functors kernel lexer libc math
math.vectors.specialization namespaces parser prettyprint.custom math.vectors.specialization namespaces parser prettyprint.custom
sequences sequences.private strings summary vocabs vocabs.loader sequences sequences.private strings summary vocabs vocabs.loader
vocabs.parser words fry combinators ; vocabs.parser words fry combinators ;
@ -103,13 +103,21 @@ A T c-type-boxed-class f specialize-vector-words
;FUNCTOR ;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' ) : underlying-type ( c-type -- c-type' )
dup c-types get at { dup (underlying-type) {
{ [ dup not ] [ drop no-c-type ] } { [ dup not ] [ drop no-c-type ] }
{ [ dup string? ] [ nip underlying-type ] } { [ dup c-type-name? ] [ nip underlying-type ] }
[ drop ] [ drop ]
} cond ; } cond ;
: underlying-type-name ( c-type -- name )
underlying-type dup word? [ name>> ] when ;
: specialized-array-vocab ( c-type -- vocab ) : specialized-array-vocab ( c-type -- vocab )
"specialized-arrays.instances." prepend ; "specialized-arrays.instances." prepend ;
@ -125,31 +133,31 @@ PRIVATE>
] ?if ; inline ] ?if ; inline
: define-array-vocab ( type -- vocab ) : define-array-vocab ( type -- vocab )
underlying-type underlying-type-name
[ specialized-array-vocab ] [ '[ _ define-array ] ] bi [ specialized-array-vocab ] [ '[ _ define-array ] ] bi
generate-vocab ; 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 ; ERROR: specialized-array-vocab-not-loaded c-type ;
M: string c-array-constructor M: c-type-name c-array-constructor
underlying-type underlying-type-name
dup [ "<" "-array>" surround ] [ specialized-array-vocab ] bi lookup dup [ "<" "-array>" surround ] [ specialized-array-vocab ] bi lookup
[ ] [ specialized-array-vocab-not-loaded ] ?if ; foldable [ ] [ specialized-array-vocab-not-loaded ] ?if ; foldable
M: string c-(array)-constructor M: c-type-name c-(array)-constructor
underlying-type underlying-type-name
dup [ "(" "-array)" surround ] [ specialized-array-vocab ] bi lookup dup [ "(" "-array)" surround ] [ specialized-array-vocab ] bi lookup
[ ] [ specialized-array-vocab-not-loaded ] ?if ; foldable [ ] [ specialized-array-vocab-not-loaded ] ?if ; foldable
M: string c-direct-array-constructor M: c-type-name c-direct-array-constructor
underlying-type underlying-type-name
dup [ "<direct-" "-array>" surround ] [ specialized-array-vocab ] bi lookup dup [ "<direct-" "-array>" surround ] [ specialized-array-vocab ] bi lookup
[ ] [ specialized-array-vocab-not-loaded ] ?if ; foldable [ ] [ specialized-array-vocab-not-loaded ] ?if ; foldable
SYNTAX: SPECIALIZED-ARRAY: SYNTAX: SPECIALIZED-ARRAY:
scan define-array-vocab use-vocab ; scan-c-type define-array-vocab use-vocab ;
"prettyprint" vocab [ "prettyprint" vocab [
"specialized-arrays.prettyprint" require "specialized-arrays.prettyprint" require

View File

@ -19,7 +19,7 @@ TUPLE: alien-callback-params < alien-node-params quot xt ;
: alien-stack ( params extra -- ) : alien-stack ( params extra -- )
over parameters>> length + consume-d >>in-d 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 ; drop ;
: return-prep-quot ( node -- quot ) : return-prep-quot ( node -- quot )

View File

@ -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 ; kernel math ;
IN: tools.deploy.config IN: tools.deploy.config

View File

@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.c-types arrays byte-arrays combinators USING: alien alien.c-types arrays byte-arrays combinators
destructors generic io kernel libc math sequences system tr destructors generic io kernel libc math sequences system tr
vocabs.loader words ; vocabs.loader words alien.data ;
IN: tools.disassembler IN: tools.disassembler
GENERIC: disassemble ( obj -- ) GENERIC: disassemble ( obj -- )

View File

@ -4,7 +4,7 @@ USING: tools.disassembler namespaces combinators
alien alien.syntax alien.c-types lexer parser kernel alien alien.syntax alien.c-types lexer parser kernel
sequences layouts math math.order alien.libraries sequences layouts math math.order alien.libraries
math.parser system make fry arrays libc destructors math.parser system make fry arrays libc destructors
tools.disassembler.utils splitting ; tools.disassembler.utils splitting alien.data ;
IN: tools.disassembler.udis IN: tools.disassembler.udis
<< <<

View File

@ -1,10 +1,10 @@
! Copyright (C) 2006, 2008 Slava Pestov ! Copyright (C) 2006, 2008 Slava Pestov
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien alien.c-types alien.strings arrays assocs USING: accessors alien alien.c-types alien.data alien.strings
cocoa kernel math cocoa.messages cocoa.subclassing cocoa.classes arrays assocs cocoa kernel math cocoa.messages cocoa.subclassing
cocoa.views cocoa.application cocoa.pasteboard cocoa.types cocoa.classes cocoa.views cocoa.application cocoa.pasteboard
cocoa.windows sequences io.encodings.utf8 ui ui.private ui.gadgets cocoa.types cocoa.windows sequences io.encodings.utf8 ui ui.private
ui.gadgets.private ui.gadgets.worlds ui.gestures ui.gadgets ui.gadgets.private ui.gadgets.worlds ui.gestures
core-foundation.strings core-graphics core-graphics.types threads core-foundation.strings core-graphics core-graphics.types threads
combinators math.rectangles ; combinators math.rectangles ;
IN: ui.backend.cocoa.views IN: ui.backend.cocoa.views

View File

@ -13,7 +13,7 @@ opengl ui.render math.bitwise locals accessors math.rectangles
math.order calendar ascii sets io.encodings.utf16n math.order calendar ascii sets io.encodings.utf16n
windows.errors literals ui.pixel-formats windows.errors literals ui.pixel-formats
ui.pixel-formats.private memoize classes ui.pixel-formats.private memoize classes
specialized-arrays classes.struct ; specialized-arrays classes.struct alien.data ;
SPECIALIZED-ARRAY: POINT SPECIALIZED-ARRAY: POINT
IN: ui.backend.windows IN: ui.backend.windows

View File

@ -1,6 +1,6 @@
USING: kernel alien.c-types alien.strings sequences math alien.syntax USING: kernel alien.c-types alien.data alien.strings sequences
unix namespaces continuations threads assocs io.backend.unix math alien.syntax unix namespaces continuations threads assocs
io.encodings.utf8 unix.utilities fry ; io.backend.unix io.encodings.utf8 unix.utilities fry ;
IN: unix.process IN: unix.process
! Low-level Unix process launching utilities. These are used ! Low-level Unix process launching utilities. These are used

View File

@ -1,6 +1,6 @@
! Copyright (C) 2008 Doug Coleman. ! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license. ! 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 combinators.short-circuit fry kernel layouts sequences accessors
specialized-arrays ; specialized-arrays ;
IN: unix.utilities IN: unix.utilities

View File

@ -1,9 +1,9 @@
! Copyright (C) 2008 Doug Coleman. ! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: alien.c-types alien.syntax combinators continuations USING: alien.c-types alien.data alien.syntax combinators
io.encodings.string io.encodings.utf8 kernel sequences strings continuations io.encodings.string io.encodings.utf8 kernel
unix calendar system accessors unix.time calendar.unix sequences strings unix calendar system accessors unix.time
vocabs.loader ; calendar.unix vocabs.loader ;
IN: unix.utmpx IN: unix.utmpx
CONSTANT: EMPTY 0 CONSTANT: EMPTY 0

View File

@ -1,6 +1,6 @@
USING: alien alien.c-types alien.destructors windows.com.syntax USING: alien alien.c-types alien.destructors windows.com.syntax
windows.ole32 windows.types continuations kernel alien.syntax windows.ole32 windows.types continuations kernel alien.syntax
libc destructors accessors ; libc destructors accessors alien.data ;
IN: windows.com IN: windows.com
LIBRARY: ole32 LIBRARY: ole32

View File

@ -67,7 +67,7 @@ unless
: (stack-effect-from-return-and-parameters) ( return parameters -- stack-effect ) : (stack-effect-from-return-and-parameters) ( return parameters -- stack-effect )
swap swap
[ [ second ] map ] [ [ second ] map ]
[ dup "void" = [ drop { } ] [ 1array ] if ] bi* [ dup void? [ drop { } ] [ 1array ] if ] bi*
<effect> ; <effect> ;
: (define-word-for-function) ( function interface n -- ) : (define-word-for-function) ( function interface n -- )

View File

@ -1,9 +1,9 @@
USING: alien alien.c-types alien.accessors windows.com.syntax USING: alien alien.c-types alien.data alien.accessors
init windows.com.syntax.private windows.com continuations kernel windows.com.syntax init windows.com.syntax.private windows.com
namespaces windows.ole32 libc vocabs assocs accessors arrays continuations kernel namespaces windows.ole32 libc vocabs
sequences quotations combinators math words compiler.units assocs accessors arrays sequences quotations combinators math
destructors fry math.parser generalizations sets words compiler.units destructors fry math.parser generalizations
specialized-arrays windows.kernel32 classes.struct ; sets specialized-arrays windows.kernel32 classes.struct ;
SPECIALIZED-ARRAY: void* SPECIALIZED-ARRAY: void*
IN: windows.com.wrapper IN: windows.com.wrapper

View File

@ -1,8 +1,9 @@
USING: windows.dinput windows.kernel32 windows.ole32 windows.com USING: windows.dinput windows.kernel32 windows.ole32 windows.com
windows.com.syntax alien alien.c-types alien.syntax kernel system namespaces windows.com.syntax alien alien.c-types alien.data alien.syntax
combinators sequences fry math accessors macros words quotations kernel system namespaces combinators sequences fry math accessors
libc continuations generalizations splitting locals assocs init macros words quotations libc continuations generalizations
specialized-arrays memoize classes.struct ; splitting locals assocs init specialized-arrays memoize
classes.struct strings arrays ;
SPECIALIZED-ARRAY: DIOBJECTDATAFORMAT SPECIALIZED-ARRAY: DIOBJECTDATAFORMAT
IN: windows.dinput.constants IN: windows.dinput.constants
@ -22,12 +23,17 @@ SYMBOLS:
MEMO: c-type* ( name -- c-type ) c-type ; MEMO: c-type* ( name -- c-type ) c-type ;
MEMO: heap-size* ( c-type -- n ) heap-size ; 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 ) : (field-spec-of) ( field struct -- field-spec )
c-type* fields>> [ name>> = ] with find nip ; c-type* fields>> [ name>> = ] with find nip ;
: (offsetof) ( field struct -- offset ) : (offsetof) ( field struct -- offset )
[ (field-spec-of) offset>> ] [ drop 0 ] if* ; [ (field-spec-of) offset>> ] [ drop 0 ] if* ;
: (sizeof) ( field struct -- size ) : (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 ) : (flag) ( thing -- integer )
{ {

View File

@ -1,17 +1,16 @@
USING: alien.strings io.encodings.utf16n windows.com USING: alien.strings io.encodings.utf16n windows.com
windows.com.wrapper combinators windows.kernel32 windows.ole32 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 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 IN: windows.dragdrop-listener
<< "WCHAR" require-c-array >>
: filenames-from-hdrop ( hdrop -- filenames ) : filenames-from-hdrop ( hdrop -- filenames )
dup HEX: FFFFFFFF f 0 DragQueryFile ! get count of files dup HEX: FFFFFFFF f 0 DragQueryFile ! get count of files
[ [
2dup f 0 DragQueryFile 1 + ! get size of filename buffer 2dup f 0 DragQueryFile 1 + ! get size of filename buffer
dup "WCHAR" <c-array> dup WCHAR <c-array>
[ swap DragQueryFile drop ] keep [ swap DragQueryFile drop ] keep
utf16n alien>string utf16n alien>string
] with map ; ] with map ;

View File

@ -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 windows.kernel32 sequences byte-arrays unicode.categories
io.encodings.string io.encodings.utf16n alien.strings io.encodings.string io.encodings.utf16n alien.strings
arrays literals ; arrays literals windows.types specialized-arrays ;
SPECIALIZED-ARRAY: TCHAR
IN: windows.errors IN: windows.errors
<< "TCHAR" require-c-array >>
CONSTANT: ERROR_SUCCESS 0 CONSTANT: ERROR_SUCCESS 0
CONSTANT: ERROR_INVALID_FUNCTION 1 CONSTANT: ERROR_INVALID_FUNCTION 1
CONSTANT: ERROR_FILE_NOT_FOUND 2 CONSTANT: ERROR_FILE_NOT_FOUND 2
@ -698,8 +697,6 @@ CONSTANT: FORMAT_MESSAGE_MAX_WIDTH_MASK HEX: 000000FF
: make-lang-id ( lang1 lang2 -- n ) : make-lang-id ( lang1 lang2 -- n )
10 shift bitor ; inline 10 shift bitor ; inline
<< "TCHAR" require-c-array >>
ERROR: error-message-failed id ; ERROR: error-message-failed id ;
:: n>win32-error-string ( id -- string ) :: n>win32-error-string ( id -- string )
{ {
@ -709,7 +706,7 @@ ERROR: error-message-failed id ;
f f
id id
LANG_NEUTRAL SUBLANG_DEFAULT make-lang-id LANG_NEUTRAL SUBLANG_DEFAULT make-lang-id
32768 [ "TCHAR" <c-array> ] [ ] bi 32768 [ TCHAR <c-array> ] [ ] bi
f pick [ FormatMessage 0 = [ id error-message-failed ] when ] dip f pick [ FormatMessage 0 = [ id error-message-failed ] when ] dip
utf16n alien>string [ blank? ] trim ; utf16n alien>string [ blank? ] trim ;

View File

@ -1,8 +1,8 @@
! Copyright (C) 2009 Joe Groff, Slava Pestov. ! Copyright (C) 2009 Joe Groff, Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: alien.c-types kernel combinators sequences USING: alien.c-types alien.data kernel combinators
math windows.gdi32 windows.types images destructors sequences math windows.gdi32 windows.types images
accessors fry locals classes.struct ; destructors accessors fry locals classes.struct ;
IN: windows.offscreen IN: windows.offscreen
: (bitmap-info) ( dim -- BITMAPINFO ) : (bitmap-info) ( dim -- BITMAPINFO )

View File

@ -1,5 +1,5 @@
USING: alien alien.syntax alien.c-types alien.strings math USING: alien alien.syntax alien.c-types alien.data alien.strings
kernel sequences windows.errors windows.types io accessors math kernel sequences windows.errors windows.types io accessors
math.order namespaces make math.parser windows.kernel32 math.order namespaces make math.parser windows.kernel32
combinators locals specialized-arrays literals splitting combinators locals specialized-arrays literals splitting
grouping classes.struct combinators.smart ; grouping classes.struct combinators.smart ;

View File

@ -3,6 +3,7 @@
USING: alien alien.c-types alien.syntax namespaces kernel words USING: alien alien.c-types alien.syntax namespaces kernel words
sequences math math.bitwise math.vectors colors sequences math math.bitwise math.vectors colors
io.encodings.utf16n classes.struct accessors ; io.encodings.utf16n classes.struct accessors ;
FROM: alien.c-types => float short ;
IN: windows.types IN: windows.types
TYPEDEF: char CHAR TYPEDEF: char CHAR
@ -69,7 +70,8 @@ TYPEDEF: ulonglong ULARGE_INTEGER
TYPEDEF: LARGE_INTEGER* PLARGE_INTEGER TYPEDEF: LARGE_INTEGER* PLARGE_INTEGER
TYPEDEF: ULARGE_INTEGER* PULARGE_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* LPCSTR
TYPEDEF: wchar_t* LPWSTR TYPEDEF: wchar_t* LPWSTR

View File

@ -4,6 +4,7 @@ USING: alien alien.c-types alien.strings alien.syntax arrays
byte-arrays kernel literals math sequences windows.types byte-arrays kernel literals math sequences windows.types
windows.kernel32 windows.errors math.bitwise io.encodings.utf16n windows.kernel32 windows.errors math.bitwise io.encodings.utf16n
classes.struct windows.com.syntax init ; classes.struct windows.com.syntax init ;
FROM: alien.c-types => short ;
IN: windows.winsock IN: windows.winsock
TYPEDEF: void* SOCKET TYPEDEF: void* SOCKET

View File

@ -10,9 +10,10 @@
! add to this library and are wondering what part of the file to ! add to this library and are wondering what part of the file to
! modify, just find the function or data structure in the manual ! modify, just find the function or data structure in the manual
! and note the section. ! and note the section.
USING: accessors kernel arrays alien alien.c-types alien.strings USING: accessors kernel arrays alien alien.c-types alien.data
alien.syntax classes.struct math math.bitwise words sequences alien.strings alien.syntax classes.struct math math.bitwise words
namespaces continuations io io.encodings.ascii x11.syntax ; sequences namespaces continuations io io.encodings.ascii x11.syntax ;
FROM: alien.c-types => short ;
IN: x11.xlib IN: x11.xlib
LIBRARY: xlib LIBRARY: xlib

View File

@ -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.8-bit io.encodings.utf8 io.encodings.utf16
io.encodings.utf16n io.encodings.ascii alien io.encodings.string ; io.encodings.utf16n io.encodings.ascii alien io.encodings.string ;
IN: alien.strings.tests IN: alien.strings.tests

View File

@ -61,7 +61,7 @@ HELP: bin>
$nl $nl
"Outputs " { $link f } " if the string does not represent a number." } ; "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> HELP: oct>
{ $values { "str" string } { "n/f" "a real number or " { $link f } } } { $values { "str" string } { "n/f" "a real number or " { $link f } } }
@ -69,7 +69,7 @@ HELP: oct>
$nl $nl
"Outputs " { $link f } " if the string does not represent a number." } ; "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> HELP: hex>
{ $values { "str" string } { "n/f" "a real number or " { $link f } } } { $values { "str" string } { "n/f" "a real number or " { $link f } } }
@ -77,7 +77,7 @@ HELP: hex>
$nl $nl
"Outputs " { $link f } " if the string does not represent a number." } ; "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 HELP: >base
{ $values { "n" real } { "radix" "an integer between 2 and 36" } { "str" string } } { $values { "n" real } { "radix" "an integer between 2 and 36" } { "str" string } }

View File

@ -593,10 +593,13 @@ HELP: #!
{ $description "Discards all input until the end of the line." } ; { $description "Discards all input until the end of the line." } ;
HELP: HEX: HELP: HEX:
{ $syntax "HEX: integer" } { $syntax "HEX: NNN" "HEX: NNN.NNNpEEE" }
{ $values { "integer" "hexadecimal digits (0-9, a-f, A-F)" } } { $values { "N" "hexadecimal digit (0-9, a-f, A-F)" } { "pEEE" "decimal exponent value" } }
{ $description "Adds an integer read from a hexadecimal literal to the parse tree." } { $description "Adds an integer or floating-point value read from a hexadecimal literal to the parse tree." }
{ $examples { $example "USE: prettyprint" "HEX: ff ." "255" } } ; { $examples
{ $example "USE: prettyprint" "HEX: ff ." "255" }
{ $example "USE: prettyprint" "HEX: 1.8p5 ." "48.0" }
} ;
HELP: OCT: HELP: OCT:
{ $syntax "OCT: integer" } { $syntax "OCT: integer" }

View File

@ -41,6 +41,11 @@ SYMBOL: c-strings
[ current-vocab name>> % "_" % % ] "" make ; [ current-vocab name>> % "_" % % ] "" make ;
PRIVATE> PRIVATE>
: parse-arglist ( parameters return -- types effect )
[ 2 group unzip [ "," ?tail drop ] map ]
[ [ { } ] [ 1array ] if-void ]
bi* <effect> ;
: append-function-body ( prototype-str body -- str ) : append-function-body ( prototype-str body -- str )
[ swap % " {\n" % % "\n}\n" % ] "" make ; [ swap % " {\n" % % "\n}\n" % ] "" make ;

View File

@ -1,7 +1,7 @@
! Copyright (C) 2009 Jeremy Hughes. ! Copyright (C) 2009 Jeremy Hughes.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: alien.inline alien.inline.syntax io.directories io.files 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 IN: alien.inline.syntax.tests
DELETE-C-LIBRARY: test DELETE-C-LIBRARY: test

View File

@ -2,10 +2,11 @@
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien.c-types assocs combinators.short-circuit USING: accessors alien.c-types assocs combinators.short-circuit
continuations effects fry kernel math memoize sequences continuations effects fry kernel math memoize sequences
splitting strings peg.ebnf make ; splitting strings peg.ebnf make words ;
IN: alien.inline.types IN: alien.inline.types
: cify-type ( str -- str' ) : cify-type ( str -- str' )
dup word? [ name>> ] when
{ { CHAR: - CHAR: space } } substitute ; { { CHAR: - CHAR: space } } substitute ;
: factorize-type ( str -- str' ) : factorize-type ( str -- str' )

View File

@ -1,7 +1,7 @@
! Copyright (C) 2009 Jeremy Hughes. ! Copyright (C) 2009 Jeremy Hughes.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: help.markup help.syntax kernel quotations sequences 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 IN: alien.marshall
<PRIVATE <PRIVATE

View File

@ -3,9 +3,10 @@
USING: accessors alien alien.c-types alien.inline.types USING: accessors alien alien.c-types alien.inline.types
alien.marshall.private alien.strings byte-arrays classes alien.marshall.private alien.strings byte-arrays classes
combinators combinators.short-circuit destructors fry combinators combinators.short-circuit destructors fry
io.encodings.utf8 kernel libc sequences io.encodings.utf8 kernel libc sequences alien.data
specialized-arrays strings unix.utilities vocabs.parser specialized-arrays strings unix.utilities vocabs.parser
words libc.private locals generalizations math ; words libc.private locals generalizations math ;
FROM: alien.c-types => float short ;
SPECIALIZED-ARRAY: bool SPECIALIZED-ARRAY: bool
SPECIALIZED-ARRAY: char SPECIALIZED-ARRAY: char
SPECIALIZED-ARRAY: double SPECIALIZED-ARRAY: double
@ -22,7 +23,7 @@ SPECIALIZED-ARRAY: ushort
SPECIALIZED-ARRAY: void* SPECIALIZED-ARRAY: void*
IN: alien.marshall IN: alien.marshall
<< primitive-types [ [ "void*" = ] [ "bool" = ] bi or not ] << primitive-types [ [ void* = ] [ bool = ] bi or not ]
filter [ define-primitive-marshallers ] each >> filter [ define-primitive-marshallers ] each >>
TUPLE: alien-wrapper { underlying alien } ; TUPLE: alien-wrapper { underlying alien } ;

View File

@ -3,7 +3,7 @@
USING: accessors alien alien.c-types alien.inline arrays USING: accessors alien alien.c-types alien.inline arrays
combinators fry functors kernel lexer libc macros math combinators fry functors kernel lexer libc macros math
sequences specialized-arrays libc.private sequences specialized-arrays libc.private
combinators.short-circuit ; combinators.short-circuit alien.data ;
SPECIALIZED-ARRAY: void* SPECIALIZED-ARRAY: void*
IN: alien.marshall.private IN: alien.marshall.private

Some files were not shown because too many files have changed in this diff Show More