io.encodings.string debugger destructors vocabs.loader
classes.struct ;
QUALIFIED: math
+QUALIFIED: sequences
IN: alien.c-types
HELP: byte-length
{ $subsection *void* }
"Note that while structure and union types do not get these words defined for them, there is no loss of generality since " { $link <void*> } " and " { $link *void* } " may be used." ;
-ARTICLE: "c-types-specs" "C type specifiers"
-"C types are identified by special words, and type names occur as parameters to the " { $link alien-invoke } ", " { $link alien-indirect } " and " { $link alien-callback } " words. New C types can be defined by the words " { $link POSTPONE: STRUCT: } ", " { $link POSTPONE: UNION-STRUCT: } ", " { $link POSTPONE: CALLBACK: } ", and " { $link POSTPONE: TYPEDEF: } "."
-$nl
-"The following numerical types are available; a " { $snippet "u" } " prefix denotes an unsigned type:"
+ARTICLE: "c-types.primitives" "Primitive C types"
+"The following numerical types are defined in the " { $vocab-link "alien.c-types" } " vocabulary; a " { $snippet "u" } " prefix denotes an unsigned type:"
{ $table
{ "C type" "Notes" }
{ { $link char } "always 1 byte" }
{ { $link ulonglong } { } }
{ { $link float } { "single-precision float (not the same as Factor's " { $link math:float } " class!)" } }
{ { $link double } { "double-precision float (the same format as Factor's " { $link math:float } " objects)" } }
+}
+"The following C99 complex number types are defined in the " { $vocab-link "alien.complex" } " vocabulary:"
+{ $table
{ { $link complex-float } { "C99 or Fortran " { $snippet "complex float" } " type, converted to and from Factor " { $link math:complex } " values" } }
{ { $link complex-double } { "C99 or Fortran " { $snippet "complex double" } " type, converted to and from Factor " { $link math:complex } " values" } }
}
-"When making alien calls, Factor numbers are converted to and from the above types in a canonical way. Converting a Factor number to a C value may result in a loss of precision."
-$nl
+"When making alien calls, Factor numbers are converted to and from the above types in a canonical way. Converting a Factor number to a C value may result in a loss of precision." ;
+
+ARTICLE: "c-types.pointers" "Pointer and array types"
"Pointer types are specified by suffixing a C type with " { $snippet "*" } ", for example " { $snippet "float*" } ". One special case is " { $link void* } ", which denotes a generic pointer; " { $link void } " by itself is not a valid C type specifier. With the exception of strings (see " { $link "c-strings" } "), all pointer types are identical to " { $snippet "void*" } " as far as the C library interface is concerned."
$nl
"Fixed-size array types are supported; the syntax consists of a C type name followed by dimension sizes in brackets; the following denotes a 3 by 4 array of integers:"
{ $code "int[3][4]" }
-"Fixed-size arrays differ from pointers in that they are allocated inside structures and unions; however when used as function parameters they behave exactly like pointers and thus the dimensions only serve as documentation."
-$nl
-"Structure and union types are specified by the name of the structure or union." ;
+"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." ;
+
+ARTICLE: "c-types.ambiguity" "Word name clashes with C types"
+"Note that some of the C type word names clash with commonly-used Factor words:"
+{ $list
+ { { $link short } " clashes with the " { $link sequences:short } " word in the " { $vocab-link "sequences" } " vocabulary" }
+ { { $link float } " clashes with the " { $link math:float } " word in the " { $vocab-link "math" } " vocabulary" }
+}
+"If you use the wrong vocabulary, you will see a " { $link no-c-type } " error. For example, the following is " { $strong "not" } " valid, and will raise an error because the " { $link math:float } " word from the " { $vocab-link "math" } " vocabulary is not a C type:"
+{ $code
+ "USING: alien.syntax math prettyprint ;"
+ "FUNCTION: float magic_number ( ) ;"
+ "magic_number 3.0 + ."
+}
+"The following won't work either; now the problem is that there are two vocabularies in the search path that define a word named " { $snippet "float" } ":"
+{ $code
+ "USING: alien.c-types alien.syntax math prettyprint ;"
+ "FUNCTION: float magic_number ( ) ;"
+ "magic_number 3.0 + ."
+}
+"The correct solution is to use one of " { $link POSTPONE: FROM: } ", " { $link POSTPONE: QUALIFIED: } " or " { $link POSTPONE: QUALIFIED-WITH: } " to disambiguate word lookup:"
+{ $code
+ "USING: alien.syntax math prettyprint ;"
+ "QUALIFIED-WITH: alien.c-types c"
+ "FUNCTION: c:float magic_number ( ) ;"
+ "magic_number 3.0 + ."
+}
+"See " { $link "word-search-semantics" } " for details." ;
+
+ARTICLE: "c-types.structs" "Struct and union types"
+"Struct and union types are identified by their class word. See " { $link "classes.struct" } "." ;
+
+ARTICLE: "c-types-specs" "C type specifiers"
+"C types are identified by special words, and type names occur as parameters to the " { $link alien-invoke } ", " { $link alien-indirect } " and " { $link alien-callback } " words. New C types can be defined by the words " { $link POSTPONE: STRUCT: } ", " { $link POSTPONE: UNION-STRUCT: } ", " { $link POSTPONE: CALLBACK: } ", and " { $link POSTPONE: TYPEDEF: } "."
+{ $subsection "c-types.primitives" }
+{ $subsection "c-types.pointers" }
+{ $subsection "c-types.ambiguity" }
+{ $subsection "c-types.structs" }
+;
+
+ABOUT: "c-types-specs"
} ;
ARTICLE: "classes.struct" "Struct classes"
-{ $link struct } " classes are similar to " { $link tuple } "s, but their slots exhibit value semantics, and they are backed by a contiguous structured block of memory. Structs can be used for structured access to C memory or Factor byte arrays and for passing struct values in and out of the FFI."
+"The " { $vocab-link "classes.struct" } " vocabulary implements " { $link struct } " classes. They are similar to " { $link tuple } " classes, but their slots exhibit value semantics, and they are backed by a contiguous structured block of memory. Structs can be used for space-efficient storage of data in the Factor heap, as well as for passing data to and from C libraries using the " { $link "alien" } "."
{ $subsection "classes.struct.examples" }
{ $subsection "classes.struct.define" }
{ $subsection "classes.struct.create" }
io.streams.string kernel math memory namespaces
namespaces.private parser quotations sequences
specialized-arrays stack-checker stack-checker.errors
-system threads tools.test words ;
+system threads tools.test words alien.complex ;
FROM: alien.c-types => float short ;
SPECIALIZED-ARRAY: float
SPECIALIZED-ARRAY: char
! [ { HEX: f2 HEX: 41 HEX: 0f HEX: 11 HEX: 04 HEX: 24 } ] [ [ R12 [] XMM0 MOVSD ] { } make ] unit-test
! 3-operand r-rm-imm sse instructions
-[ { HEX: 66 HEX: 0f HEX: 70 HEX: c1 HEX: 02 } ] [ [ XMM0 XMM1 2 PSHUFD ] { } make ] unit-test
-[ { HEX: 0f HEX: c6 HEX: c1 HEX: 02 } ] [ [ XMM0 XMM1 2 SHUFPS ] { } make ] unit-test
+[ { HEX: 66 HEX: 0f HEX: 70 HEX: c1 HEX: 02 } ]
+[ [ XMM0 XMM1 2 PSHUFD ] { } make ] unit-test
+
+[ { HEX: 0f HEX: c6 HEX: c1 HEX: 02 } ]
+[ [ XMM0 XMM1 2 SHUFPS ] { } make ] unit-test
+
+! shufflers with arrays of indexes
+[ { HEX: 66 HEX: 0f HEX: 70 HEX: c1 HEX: 02 } ]
+[ [ XMM0 XMM1 { 2 0 0 0 } PSHUFD ] { } make ] unit-test
+
+[ { HEX: 0f HEX: c6 HEX: c1 HEX: 63 } ]
+[ [ XMM0 XMM1 { 3 0 2 1 } SHUFPS ] { } make ] unit-test
+
+[ { HEX: 66 HEX: 0f HEX: c6 HEX: c1 HEX: 2 } ]
+[ [ XMM0 XMM1 { 0 1 } SHUFPD ] { } make ] unit-test
+
+[ { HEX: 66 HEX: 0f HEX: c6 HEX: c1 HEX: 1 } ]
+[ [ XMM0 XMM1 { 1 0 } SHUFPD ] { } make ] unit-test
! scalar register insert/extract sse instructions
[ { HEX: 66 HEX: 0f HEX: c4 HEX: c1 HEX: 02 } ] [ [ XMM0 ECX 2 PINSRW ] { } make ] unit-test
! Copyright (C) 2005, 2009 Slava Pestov, Joe Groff.
! See http://factorcode.org/license.txt for BSD license.
-USING: arrays io.binary kernel combinators kernel.private math locals
-namespaces make sequences words system layouts math.order accessors
-cpu.x86.assembler.operands cpu.x86.assembler.operands.private ;
+USING: arrays io.binary kernel combinators kernel.private math
+math.bitwise locals namespaces make sequences words system
+layouts math.order accessors cpu.x86.assembler.operands
+cpu.x86.assembler.operands.private ;
QUALIFIED: sequences
IN: cpu.x86.assembler
: MOVDQA ( dest src -- ) { HEX: 6f HEX: 7f } HEX: 66 2-operand-rm-mr-sse ;
: MOVDQU ( dest src -- ) { HEX: 6f HEX: 7f } HEX: f3 2-operand-rm-mr-sse ;
-: PSHUFD ( dest src imm -- ) HEX: 70 HEX: 66 3-operand-rm-sse ;
-: PSHUFLW ( dest src imm -- ) HEX: 70 HEX: f2 3-operand-rm-sse ;
-: PSHUFHW ( dest src imm -- ) HEX: 70 HEX: f3 3-operand-rm-sse ;
+: 2shuffler ( indexes/mask -- mask )
+ dup integer? [ first2 { 1 0 } bitfield ] unless ;
+: 4shuffler ( indexes/mask -- mask )
+ dup integer? [ first4 { 6 4 2 0 } bitfield ] unless ;
+
+: PSHUFD ( dest src imm -- ) 4shuffler HEX: 70 HEX: 66 3-operand-rm-sse ;
+: PSHUFLW ( dest src imm -- ) 4shuffler HEX: 70 HEX: f2 3-operand-rm-sse ;
+: PSHUFHW ( dest src imm -- ) 4shuffler HEX: 70 HEX: f3 3-operand-rm-sse ;
<PRIVATE
: MOVNTI ( dest src -- ) { HEX: 0f HEX: c3 } (2-operand) ;
: PINSRW ( dest src imm -- ) HEX: c4 HEX: 66 3-operand-rm-sse ;
-: SHUFPS ( dest src imm -- ) HEX: c6 f 3-operand-rm-sse ;
-: SHUFPD ( dest src imm -- ) HEX: c6 HEX: 66 3-operand-rm-sse ;
+: SHUFPS ( dest src imm -- ) 4shuffler HEX: c6 f 3-operand-rm-sse ;
+: SHUFPD ( dest src imm -- ) 2shuffler HEX: c6 HEX: 66 3-operand-rm-sse ;
: ADDSUBPD ( dest src -- ) HEX: d0 HEX: 66 2-operand-rm-sse ;
: ADDSUBPS ( dest src -- ) HEX: d0 HEX: f2 2-operand-rm-sse ;
M: x86 %set-slot-imm ( src obj slot tag -- ) (%slot-imm) swap MOV ;
:: two-operand ( dst src1 src2 rep -- dst src )
- dst src2 eq? [ "Cannot handle this case" throw ] when
+ dst src2 eq? dst src1 eq? not and [ "Cannot handle this case" throw ] when
dst src1 rep %copy
dst src2 ; inline
reverse [ { } ] suffix
'[ _ cond ] ;
-M: x86 %broadcast-vector ( dst src rep -- )
- {
- { float-4-rep [ [ float-4-rep %copy ] [ drop dup 0 SHUFPS ] 2bi ] }
- { double-2-rep [ [ double-2-rep %copy ] [ drop dup UNPCKLPD ] 2bi ] }
+: unsign-rep ( rep -- rep' )
+ dup {
+ { uint-4-rep int-4-rep }
+ { ulonglong-2-rep longlong-2-rep }
+ { ushort-8-rep short-8-rep }
+ { uchar-16-rep char-16-rep }
+ } at* [ nip ] [ drop ] if ;
+
+M:: x86 %broadcast-vector ( dst src rep -- )
+ rep unsign-rep {
+ { float-4-rep [
+ dst src float-4-rep %copy
+ dst dst { 0 0 0 0 } SHUFPS
+ ] }
+ { double-2-rep [
+ dst src MOVDDUP
+ ] }
+ { longlong-2-rep [
+ dst src = [
+ dst dst PUNPCKLQDQ
+ ] [
+ dst src { 0 1 0 1 } PSHUFD
+ ] if
+ ] }
+ { int-4-rep [ dst src { 0 0 0 0 } PSHUFD ] }
+ { short-8-rep [
+ dst src { 0 0 0 0 } PSHUFLW
+ dst dst PUNPCKLQDQ
+ ] }
+ { char-16-rep [
+ dst src char-16-rep %copy
+ dst dst PUNPCKLBW
+ dst dst { 0 0 0 0 } PSHUFLW
+ dst dst PUNPCKLQDQ
+ ] }
} case ;
M: x86 %broadcast-vector-reps
{
! Can't do this with sse1 since it will want to unbox
! a double-precision float and convert to single precision
- { sse2? { float-4-rep double-2-rep } }
+ { sse2? {
+ float-4-rep double-2-rep
+ longlong-2-rep ulonglong-2-rep
+ int-4-rep uint-4-rep
+ short-8-rep ushort-8-rep
+ char-16-rep uchar-16-rep
+ } }
} available-reps ;
M:: x86 %gather-vector-4 ( dst src1 src2 src3 src4 rep -- )
- {
- {
- [ rep float-4-rep eq? ]
- [
- dst src1 float-4-rep %copy
- dst src2 UNPCKLPS
- src3 src4 UNPCKLPS
- dst src3 MOVLHPS
- ]
- }
- {
- [ rep { int-4-rep uint-4-rep } memq? ]
- [
- dst src1 int-4-rep %copy
- dst src2 PUNPCKLDQ
- src3 src4 PUNPCKLDQ
- dst src3 PUNPCKLQDQ
- ]
- }
- } cond ;
+ rep unsign-rep {
+ { float-4-rep [
+ dst src1 float-4-rep %copy
+ dst src2 UNPCKLPS
+ src3 src4 UNPCKLPS
+ dst src3 MOVLHPS
+ ] }
+ { int-4-rep [
+ dst src1 int-4-rep %copy
+ dst src2 PUNPCKLDQ
+ src3 src4 PUNPCKLDQ
+ dst src3 PUNPCKLQDQ
+ ] }
+ } case ;
M: x86 %gather-vector-4-reps
{
} available-reps ;
M:: x86 %gather-vector-2 ( dst src1 src2 rep -- )
- rep {
- {
- double-2-rep
- [
- dst src1 double-2-rep %copy
- dst src2 UNPCKLPD
- ]
- }
+ rep unsign-rep {
+ { double-2-rep [
+ dst src1 double-2-rep %copy
+ dst src2 UNPCKLPD
+ ] }
+ { longlong-2-rep [
+ dst src1 longlong-2-rep %copy
+ dst src2 PUNPCKLQDQ
+ ] }
} case ;
M: x86 %gather-vector-2-reps
{
- { sse2? { double-2-rep } }
+ { sse2? { double-2-rep longlong-2-rep ulonglong-2-rep } }
} available-reps ;
M: x86 %add-vector ( dst src1 src2 rep -- )
a b + c - { a b c } [ [ - abs ] keep 2array ] with map
sort-keys first second ;
-:: png-unfilter-line ( prev curr filter -- curr' )
+:: png-unfilter-line ( width prev curr filter -- curr' )
prev :> c
- prev 3 tail-slice :> b
+ prev width tail-slice :> b
curr :> a
- curr 3 tail-slice :> x
+ curr width tail-slice :> x
x length [0,b)
filter {
{ filter-none [ drop ] }
{ filter-average [ [| n | n x nth n a nth n b nth + 2/ + 256 wrap n x set-nth ] each ] }
{ filter-paeth [ [| n | n x nth n a nth n b nth n c nth paeth + 256 wrap n x set-nth ] each ] }
} case
- curr 3 tail ;
+ curr width tail ;
-: reverse-png-filter ( lines -- byte-array )
- dup first length 0 <array> prefix
- [ { 0 0 } prepend ] map
+:: reverse-png-filter ( n lines -- byte-array )
+ lines dup first length 0 <array> prefix
+ [ n 1 - 0 <array> prepend ] map
2 clump [
- first2 dup [ third ] [ [ 0 2 ] dip set-nth ] bi
+ n swap first2 [ ] [ n 1 - swap nth ] [ [ 0 n 1 - ] dip set-nth ] tri
png-unfilter-line
] map B{ } concat-as ;
: png-image-bytes ( loading-png -- byte-array )
- [ inflate-data ] [ png-group-width ] bi group reverse-png-filter ;
+ [ png-bytes-per-pixel ] [ inflate-data ] [ png-group-width ] tri group reverse-png-filter ;
: decode-greyscale ( loading-png -- image )
unimplemented-color-type ;
IN: math.vectors.specialization.tests
USING: compiler.tree.debugger math.vectors tools.test kernel
kernel.private math specialized-arrays ;
-SPECIALIZED-ARRAY: double
-SPECIALIZED-ARRAY: complex-float
-SPECIALIZED-ARRAY: float
+QUALIFIED-WITH: alien.c-types c
+QUALIFIED-WITH: alien.complex c
+SPECIALIZED-ARRAY: c:double
+SPECIALIZED-ARRAY: c:complex-float
+SPECIALIZED-ARRAY: c:float
[ V{ t } ] [
[ { double-array double-array } declare distance 0.0 < not ] final-literals
{ $examples
"With saturation:"
{ $example
- "USING: math.vectors prettyprint specialized-arrays ;"
+ "USING: alien.c-types math.vectors prettyprint specialized-arrays ;"
"SPECIALIZED-ARRAY: uchar"
"uchar-array{ 100 200 150 } uchar-array{ 70 70 70 } vs+ ."
"uchar-array{ 170 255 220 }"
}
"Without saturation:"
{ $example
- "USING: math.vectors prettyprint specialized-arrays ;"
+ "USING: alien.c-types math.vectors prettyprint specialized-arrays ;"
"SPECIALIZED-ARRAY: uchar"
"uchar-array{ 100 200 150 } uchar-array{ 70 70 70 } v+ ."
"uchar-array{ 170 14 220 }"
IN: math.vectors.tests
USING: math.vectors tools.test kernel specialized-arrays compiler
-kernel.private ;
+kernel.private alien.c-types ;
SPECIALIZED-ARRAY: int
[ { 1 2 3 } ] [ 1/2 { 2 4 6 } n*v ] unit-test
IN: pango.layouts.tests
-USING: pango.layouts tools.test glib fonts accessors
+USING: pango.layouts pango.cairo tools.test glib fonts accessors
sequences combinators.short-circuit math destructors ;
[ t ] [
HELP: complex-sequence
{ $class-description "Sequence wrapper class that transforms a sequence of " { $link real } " number values into a sequence of " { $link complex } " values, treating the underlying sequence as pairs of alternating real and imaginary values." }
{ $examples { $example """USING: prettyprint specialized-arrays
-sequences.complex sequences arrays ;
+sequences.complex sequences alien.c-types arrays ;
SPECIALIZED-ARRAY: double
double-array{ 1.0 -1.0 -2.0 2.0 3.0 0.0 } <complex-sequence> >array ."""
"{ C{ 1.0 -1.0 } C{ -2.0 2.0 } C{ 3.0 0.0 } }" } } ;
{ $values { "sequence" sequence } { "complex-sequence" complex-sequence } }
{ $description "Wraps " { $snippet "sequence" } " in a " { $link complex-sequence } "." }
{ $examples { $example """USING: prettyprint specialized-arrays
-sequences.complex sequences arrays ;
+sequences.complex sequences alien.c-types arrays ;
SPECIALIZED-ARRAY: double
double-array{ 1.0 -1.0 -2.0 2.0 3.0 0.0 } <complex-sequence> second ."""
"C{ -2.0 2.0 }" } } ;
USING: tools.test kernel serialize io io.streams.byte-array
alien arrays byte-arrays bit-arrays specialized-arrays
sequences math prettyprint parser classes math.constants
-io.encodings.binary random assocs serialize.private ;
+io.encodings.binary random assocs serialize.private alien.c-types ;
SPECIALIZED-ARRAY: double
IN: serialize.tests
[ ] [
"""
IN: specialized-arrays.tests
-USING: classes.struct specialized-arrays ;
+USING: alien.c-types classes.struct specialized-arrays ;
STRUCT: __does_not_exist__ { x int } ;
IN: specialized-vectors.tests
USING: specialized-arrays specialized-vectors
-tools.test kernel sequences ;
+tools.test kernel sequences alien.c-types ;
SPECIALIZED-ARRAY: float
SPECIALIZED-VECTOR: float
SPECIALIZED-VECTOR: double
STRUCT: sockaddr-un
{ family ushort }
- { path { "char" max-un-path } } ;
+ { path { char max-un-path } } ;
CONSTANT: SOCK_STREAM 1
CONSTANT: SOCK_DGRAM 2
$nl
"The C library interface is entirely self-contained; there is no C code which one must write in order to wrap a library."
$nl
-"C library interface words are found in the " { $vocab-link "alien" } " vocabulary."
+"C library interface words are found in the " { $vocab-link "alien" } " vocabulary and its subvocabularies."
{ $warning "C does not perform runtime type checking, automatic memory management or array bounds checks. Incorrect usage of C library functions can lead to crashes, data corruption, and security exploits." }
{ $subsection "loading-libs" }
{ $subsection "alien-invoke" }
{ $subsection "alien-callback" }
{ $subsection "c-data" }
+{ $subsection "classes.struct" }
{ $subsection "dll.private" }
{ $subsection "embedding" } ;
USING: kernel math namespaces make tools.test vectors sequences
sequences.private hashtables io prettyprint assocs
-continuations specialized-arrays ;
+continuations specialized-arrays alien.c-types ;
SPECIALIZED-ARRAY: double
IN: assocs.tests
fry namespaces combinators.smart splitting io.encodings.ascii
arrays io.files.info unicode.case io.directories.search literals
math.functions continuations ;
+FROM: alien.c-types => uchar ;
IN: id3
<PRIVATE
: mp3>id3 ( path -- id3/f )
[
- [ <id3> ] dip "uchar" <mapped-array>
+ [ <id3> ] dip uchar <mapped-array>
[ dup id3v1? [ read-v1-tags merge-id3v1 ] [ drop ] if ]
[ dup id3v1+? [ read-v1+-tags merge-id3v1 ] [ drop ] if ]
[ dup id3v2? [ read-v2-tags ] [ drop ] if ]
! Copyright (C) 2007, 2008 Alex Chapman
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays jamshred.oint jamshred.tunnel kernel
-math.vectors sequences specialized-arrays tools.test ;
+math.vectors sequences specialized-arrays tools.test
+alien.c-types ;
SPECIALIZED-ARRAY: float
IN: jamshred.tunnel.tests
set iskeyword=!,@,33-35,%,$,38-64,A-Z,91-96,a-z,123-126,128-255
endif
-syn cluster factorCluster contains=factorComment,factorKeyword,factorRepeat,factorConditional,factorBoolean,factorCompileDirective,factorString,factorSbuf,@factorNumber,@factorNumErr,factorDelimiter,factorChar,factorCharErr,factorBackslash,@factorWordOps,factorAlien,factorTuple,factorStruct
+syn cluster factorCluster contains=factorComment,factorKeyword,factorRepeat,factorConditional,factorBoolean,factorCompileDirective,factorString,factorTriString,factorSbuf,@factorNumber,@factorNumErr,factorDelimiter,factorChar,factorCharErr,factorBackslash,@factorWordOps,factorAlien,factorTuple,factorStruct
syn match factorTodo /\(TODO\|FIXME\|XXX\):\=/ contained
syn match factorComment /\<#!\>.*/ contains=factorTodo