steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Merge branch 'master' of git://github.com/slavapestov/factor

db4
John Benediktsson 2010-12-26 15:46:51 -08:00
parent de458348c0 13d6c6a698
commit 160016dab9
75 changed files with 338 additions and 337 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
basis/alien/c-types/c-types-docs.factor
View File

@ -108,14 +108,6 @@ $nl
"If this condition is not satisfied, " { $link "malloc" } " must be used instead."
{ $warning "Failure to comply with these requirements can lead to crashes, data corruption, and security exploits." } ;
ARTICLE: "c-out-params" "Output parameters in C"
"A frequently-occurring idiom in C code is the \"out parameter\". If a C function returns more than one value, the caller passes pointers of the correct type, and the C function writes its return values to those locations."
$nl
"To wrap Factor data for consumption by the FFI, we use a utility word that constructs a byte array of the correct size and converts the Factor object to a C value stored into that byte array:"
{ $subsections <ref> }
"You call the out parameter constructor with the required initial value, then pass the byte array to the C function, which receives a pointer to the start of the byte array's data area. The C function then returns, leaving the result in the byte array; you read it back using this word:"
{ $subsections deref } ;
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

21
basis/alien/c-types/c-types-tests.factor
View File

@ -9,19 +9,6 @@ CONSTANT: xyz 123
[ 492 ] [ { int xyz } heap-size ] unit-test
[ -1 ] [ -1 char <ref> char deref ] unit-test
[ -1 ] [ -1 short <ref> short deref ] unit-test
[ -1 ] [ -1 int <ref> int deref ] unit-test
! I don't care if this throws an error or works, but at least
! it should be consistent between platforms
[ -1 ] [ -1.0 int <ref> int deref ] unit-test
[ -1 ] [ -1.0 long <ref> long deref ] unit-test
[ -1 ] [ -1.0 longlong <ref> longlong deref ] unit-test
[ 1 ] [ 1.0 uint <ref> uint deref ] unit-test
[ 1 ] [ 1.0 ulong <ref> ulong deref ] unit-test
[ 1 ] [ 1.0 ulonglong <ref> ulonglong deref ] unit-test
UNION-STRUCT: foo
{ a int }
{ b int } ;
@ -62,14 +49,6 @@ TYPEDEF: int* MyIntArray
[ t ] [ void* c-type MyIntArray c-type = ] unit-test
[
0 B{ 1 2 3 4 } <displaced-alien> void* <ref>
] must-fail
os windows? cpu x86.64? and [
[ -2147467259 ] [ 2147500037 long <ref> long deref ] unit-test
] when
[ 0 ] [ -10 uchar c-type-clamp ] unit-test
[ 12 ] [ 12 uchar c-type-clamp ] unit-test
[ -10 ] [ -10 char c-type-clamp ] unit-test

9
basis/alien/c-types/c-types.factor
View File

@ -468,12 +468,3 @@ M: double-2-rep rep-component-type drop double ;
: c-type-clamp ( value c-type -- value' )
dup { float double } member-eq?
[ drop ] [ c-type-interval clamp ] if ; inline
: <ref> ( value c-type -- c-ptr )
[ heap-size <byte-array> ] keep
'[ 0 _ set-alien-value ] keep ; inline
: deref ( c-ptr c-type -- value )
[ 0 ] dip alien-value ; inline
: little-endian? ( -- ? ) 1 int <ref> char deref 1 = ; foldable

33
basis/alien/data/data-docs.factor
View File

@ -1,7 +1,7 @@
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 classes.struct quotations ;
vocabs.loader classes.struct quotations kernel ;
IN: alien.data
HELP: <c-array>
@ -10,11 +10,6 @@ HELP: <c-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." }
{ $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." } ;
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." } ;
@ -125,6 +120,10 @@ ARTICLE: "c-pointers" "Passing pointers to C functions"
{ $warning
"The Factor garbage collector can move byte arrays around, and code passing byte arrays, or objects backed by byte arrays, must obey important guidelines. See " { $link "byte-arrays-gc" } "." } ;
ARTICLE: "c-boxes" "C value boxes"
"Sometimes it is useful to create a byte array storing a single C value, like a struct with a single field. A pair of utility macros exist to make this more convenient:"
{ $subsections <ref> deref } ;
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
@ -135,13 +134,12 @@ $nl
"malloc"
"c-strings"
"c-out-params"
"c-boxes"
}
"Important guidelines for passing data in byte arrays:"
{ $subsections "byte-arrays-gc" }
"C-style enumerated types are supported:"
{ $subsections "alien.enums" POSTPONE: ENUM: }
"C types can be aliased for convenience and consistency with native library documentation:"
{ $subsections POSTPONE: TYPEDEF: }
{ $subsections "alien.enums" }
"A utility for defining " { $link "destructors" } " for deallocating memory:"
{ $subsections "alien.destructors" }
"C struct and union types can be defined with " { $link POSTPONE: STRUCT: } " and " { $link POSTPONE: UNION: } ". See " { $link "classes.struct" } " for details. For passing arrays to and from C, use the " { $link "specialized-arrays" } " vocabulary." ;
@ -190,3 +188,20 @@ $nl
{ $subsections alien>string }
"For example, if a C function returns a " { $link c-string } " but stipulates that the caller must deallocate the memory afterward, you must define the function as returning " { $snippet "char*" } " and call " { $link (free) } " yourself." ;
HELP: <ref>
{ $values { "value" object } { "c-type" "a C type" } { "c-ptr" c-ptr } }
{ $description "Creates a new byte array to store a Factor object as a C value." }
{ $examples
{ $example "USING: alien.c-types alien.data prettyprint sequences ;" "123 int <ref> length ." "4" }
} ;
HELP: deref
{ $values { "c-ptr" c-ptr } { "c-type" "a C type" } { "value" object } }
{ $description "Loads a C value from a byte array." }
{ $examples
{ $example "USING: alien.c-types alien.data prettyprint sequences ;" "321 int <ref> int deref ." "321" }
} ;
ARTICLE: "c-out-params" "Output parameters in C"
"A frequently-occurring idiom in C code is the \"out parameter\". If a C function returns more than one value, the caller passes pointers of the correct type, and the C function writes its return values to those locations."
{ $subsection with-out-parameters } ;

29
basis/alien/data/data-tests.factor
View File

@ -1,9 +1,32 @@
USING: alien alien.c-types alien.data alien.syntax
USING: alien alien.data alien.syntax
classes.struct kernel sequences specialized-arrays
specialized-arrays.private tools.test compiler.units vocabs ;
specialized-arrays.private tools.test compiler.units vocabs
system ;
QUALIFIED-WITH: alien.c-types c
IN: alien.data.tests
STRUCT: foo { a int } { b void* } { c bool } ;
[ -1 ] [ -1 c:char <ref> c:char deref ] unit-test
[ -1 ] [ -1 c:short <ref> c:short deref ] unit-test
[ -1 ] [ -1 c:int <ref> c:int deref ] unit-test
! I don't care if this throws an error or works, but at least
! it should be consistent between platforms
[ -1 ] [ -1.0 c:int <ref> c:int deref ] unit-test
[ -1 ] [ -1.0 c:long <ref> c:long deref ] unit-test
[ -1 ] [ -1.0 c:longlong <ref> c:longlong deref ] unit-test
[ 1 ] [ 1.0 c:uint <ref> c:uint deref ] unit-test
[ 1 ] [ 1.0 c:ulong <ref> c:ulong deref ] unit-test
[ 1 ] [ 1.0 c:ulonglong <ref> c:ulonglong deref ] unit-test
[
0 B{ 1 2 3 4 } <displaced-alien> c:void* <ref>
] must-fail
os windows? cpu x86.64? and [
[ -2147467259 ] [ 2147500037 c:long <ref> c:long deref ] unit-test
] when
STRUCT: foo { a c:int } { b c:void* } { c c:bool } ;
SPECIALIZED-ARRAY: foo

18
basis/alien/data/data.factor
View File

@ -7,6 +7,15 @@ stack-checker.dependencies combinators.short-circuit ;
QUALIFIED: math
IN: alien.data
: <ref> ( value c-type -- c-ptr )
[ heap-size <byte-array> ] keep
'[ 0 _ set-alien-value ] keep ; inline
: deref ( c-ptr c-type -- value )
[ 0 ] dip alien-value ; inline
: little-endian? ( -- ? ) 1 int <ref> char deref 1 = ; foldable
GENERIC: require-c-array ( c-type -- )
M: array require-c-array first require-c-array ;
@ -44,15 +53,6 @@ M: pointer <c-direct-array>
: malloc-array ( n type -- array )
[ 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-byte-array ( byte-array -- alien )
binary-object [ nip malloc dup ] 2keep memcpy ;

8
basis/alien/enums/enums-docs.factor
View File

@ -23,14 +23,6 @@ HELP: number>enum
}
{ $description "Convert a number to an enum." } ;
ARTICLE: "alien.enums" "Enumeration types"
"The " { $vocab-link "alien.enums" } " vocab contains the implementation for " { $link POSTPONE: ENUM: } " C types, and provides words for converting between enum singletons and integers. It is possible to dispatch off of members of an enum."
$nl
"Defining enums at run-time:"
{ $subsection define-enum }
"Conversions between enums and integers:"
{ $subsections enum>number number>enum } ;
{ POSTPONE: ENUM: define-enum enum>number number>enum } related-words
ABOUT: "alien.enums"

2
basis/alien/fortran/fortran-tests.factor
View File

@ -239,7 +239,7 @@ intel-unix-abi fortran-abi [
[ [
! [<fortran-result>]
[ complex-float <c-object> ] 1 ndip
[ complex-float heap-size <byte-array> ] 1 ndip
! [fortran-args>c-args]
{ [ { [ ] } spread ] [ { [ drop ] } spread ] } 1 ncleave
! [fortran-invoke]

2
basis/alien/fortran/fortran.factor
View File

@ -310,7 +310,7 @@ M: misc-type (fortran-result>)
GENERIC: (<fortran-result>) ( type -- quot )
M: fortran-type (<fortran-result>)
(fortran-type>c-type) \ <c-object> [ ] 2sequence ;
(fortran-type>c-type) \ heap-size \ <byte-array> [ ] 3sequence ;
M: character-type (<fortran-result>)
fix-character-type dims>> product dup

10
basis/alien/syntax/syntax-docs.factor
View File

@ -123,3 +123,13 @@ HELP: C-GLOBAL:
{ $syntax "C-GLOBAL: type name" }
{ $values { "type" "a C type" } { "name" "a C global variable name" } }
{ $description "Defines a new word named " { $snippet "name" } " which accesses a global variable in the current library, set with " { $link POSTPONE: LIBRARY: } "." } ;
ARTICLE: "alien.enums" "Enumeration types"
"The " { $vocab-link "alien.enums" } " vocab contains the implementation for " { $link POSTPONE: ENUM: } " C types, and provides words for converting between enum singletons and integers. It is possible to dispatch off of members of an enum."
$nl
"Defining enums:"
{ $subsection POSTPONE: ENUM: }
"Defining enums at run-time:"
{ $subsection define-enum }
"Conversions between enums and integers:"
{ $subsections enum>number number>enum } ;

4
basis/calendar/unix/unix.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.c-types alien.syntax arrays calendar
kernel math unix unix.time unix.types namespaces system
USING: alien alien.c-types alien.data alien.syntax arrays
calendar kernel math unix unix.time unix.types namespaces system
accessors classes.struct ;
IN: calendar.unix

12
basis/checksums/md5/md5.factor
View File

@ -1,11 +1,11 @@
! Copyright (C) 2006, 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: alien.c-types kernel io io.binary io.files io.streams.byte-array math
math.functions math.parser namespaces splitting grouping strings
sequences byte-arrays locals sequences.private macros fry
io.encodings.binary math.bitwise checksums accessors
checksums.common checksums.stream combinators combinators.smart
specialized-arrays literals hints ;
USING: alien.c-types alien.data kernel io io.binary io.files
io.streams.byte-array math math.functions math.parser namespaces
splitting grouping strings sequences byte-arrays locals
sequences.private macros fry io.encodings.binary math.bitwise
checksums accessors checksums.common checksums.stream
combinators combinators.smart specialized-arrays literals hints ;
SPECIALIZED-ARRAY: uint
IN: checksums.md5

2
basis/compiler/tests/codegen.factor
View File

@ -3,7 +3,7 @@ kernel.private math hashtables.private math.private namespaces
sequences tools.test namespaces.private slots.private
sequences.private byte-arrays alien alien.accessors layouts
words definitions compiler.units io combinators vectors grouping
make alien.c-types combinators.short-circuit math.order
make alien.c-types alien.data combinators.short-circuit math.order
math.libm math.parser math.functions alien.syntax memory
stack-checker ;
FROM: math => float ;

14
basis/compiler/tree/cleanup/cleanup-tests.factor
View File

@ -1,11 +1,11 @@
USING: tools.test kernel.private kernel arrays sequences
math.private math generic words quotations alien alien.c-types
strings sbufs sequences.private slots.private combinators
definitions system layouts vectors math.partial-dispatch
math.order math.functions accessors hashtables classes assocs
io.encodings.utf8 io.encodings.ascii io.encodings fry slots
sorting.private combinators.short-circuit grouping prettyprint
generalizations
alien.data strings sbufs sequences.private slots.private
combinators definitions system layouts vectors
math.partial-dispatch math.order math.functions accessors
hashtables classes assocs io.encodings.utf8 io.encodings.ascii
io.encodings fry slots sorting.private combinators.short-circuit
grouping prettyprint generalizations
compiler.tree
compiler.tree.combinators
compiler.tree.cleanup
@ -521,8 +521,6 @@ cell-bits 32 = [
] cleaned-up-tree nodes>quot
] unit-test
USING: alien alien.c-types ;
[ t ] [
[ int { } cdecl [ 2 2 + ] alien-callback ]
{ + } inlined?

6
basis/compression/zlib/zlib.factor
View File

@ -1,8 +1,8 @@
! Copyright (C) 2009 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.c-types alien.syntax byte-arrays combinators
kernel math math.functions sequences system accessors
libc ;
USING: alien alien.c-types alien.data alien.syntax byte-arrays
combinators kernel math math.functions sequences system
accessors libc ;
QUALIFIED: compression.zlib.ffi
IN: compression.zlib

2
basis/concurrency/combinators/combinators-docs.factor
View File

@ -43,6 +43,6 @@ $nl
parallel-spread
parallel-napply
}
"The " { $vocab-link "concurrency.semaphores" } " vocabulary can be used in conjuction with the above combinators to limit the maximum number of concurrent operations." ;
"The " { $vocab-link "concurrency.semaphores" } " vocabulary can be used in conjunction with the above combinators to limit the maximum number of concurrent operations." ;
ABOUT: "concurrency.combinators"

3
basis/core-foundation/numbers/numbers.factor
View File

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

8
basis/core-graphics/core-graphics.factor
View File

@ -1,9 +1,9 @@
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.c-types alien.destructors alien.syntax accessors
destructors fry kernel math math.bitwise sequences libc colors
images images.memory core-graphics.types core-foundation.utilities
opengl.gl literals ;
USING: alien alien.c-types alien.data alien.destructors
alien.syntax accessors destructors fry kernel math math.bitwise
sequences libc colors images images.memory core-graphics.types
core-foundation.utilities opengl.gl literals ;
IN: core-graphics
TYPEDEF: int CGImageAlphaInfo

2
basis/cpu/x86/sse/sse.factor
View File

@ -1,6 +1,6 @@
! Copyright (C) 2009, 2010 Joe Groff, Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: alien.c-types arrays assocs combinators fry kernel locals
USING: alien.data arrays assocs combinators fry kernel locals
macros math math.vectors namespaces quotations sequences system
compiler.cfg.comparisons compiler.cfg.intrinsics
compiler.codegen.fixup cpu.architecture cpu.x86

4
basis/cpu/x86/x87/x87.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: alien.c-types combinators kernel locals system namespaces
compiler.codegen.fixup compiler.constants
USING: alien.c-types alien.data combinators kernel locals system
namespaces compiler.codegen.fixup compiler.constants
compiler.cfg.comparisons compiler.cfg.intrinsics
cpu.architecture cpu.x86 cpu.x86.assembler
cpu.x86.assembler.operands ;

2
basis/endian/endian.factor
View File

@ -1,6 +1,6 @@
! Copyright (C) 2009 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: alien.c-types namespaces io.binary fry
USING: alien.c-types alien.data namespaces io.binary fry
kernel math grouping sequences math.bitwise ;
IN: endian

12
basis/game/input/dinput/dinput.factor
View File

@ -1,12 +1,12 @@
USING: accessors alien alien.c-types alien.strings arrays assocs
byte-arrays combinators combinators.short-circuit continuations
game.input game.input.dinput.keys-array io.encodings.utf16
io.encodings.utf16n kernel locals math math.bitwise
math.rectangles namespaces parser sequences shuffle
USING: accessors alien alien.c-types alien.data alien.strings
arrays assocs byte-arrays combinators combinators.short-circuit
continuations game.input game.input.dinput.keys-array
io.encodings.utf16 io.encodings.utf16n kernel locals math
math.bitwise math.rectangles namespaces parser sequences shuffle
specialized-arrays ui.backend.windows vectors windows.com
windows.directx.dinput windows.directx.dinput.constants
windows.kernel32 windows.messages windows.ole32 windows.errors
windows.user32 classes.struct alien.data ;
windows.user32 classes.struct ;
SPECIALIZED-ARRAY: DIDEVICEOBJECTDATA
IN: game.input.dinput

2
basis/io/backend/unix/multiplexers/select/select.factor
View File

@ -1,6 +1,6 @@
! Copyright (C) 2004, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: alien.c-types kernel bit-arrays sequences assocs math
USING: alien.data kernel bit-arrays sequences assocs math
namespaces accessors math.order locals fry io.ports
io.backend.unix io.backend.unix.multiplexers unix unix.ffi
unix.time ;

14
basis/io/backend/unix/unix.factor
View File

@ -1,12 +1,12 @@
! Copyright (C) 2004, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.c-types alien.syntax generic assocs kernel
kernel.private math io.ports sequences strings sbufs threads
unix unix.ffi vectors io.buffers io.backend io.encodings math.parser
continuations system libc namespaces make io.timeouts
io.encodings.utf8 destructors destructors.private accessors
summary combinators locals unix.time unix.types fry
io.backend.unix.multiplexers ;
USING: alien alien.c-types alien.data alien.syntax generic
assocs kernel kernel.private math io.ports sequences strings
sbufs threads unix unix.ffi vectors io.buffers io.backend
io.encodings math.parser continuations system libc namespaces
make io.timeouts io.encodings.utf8 destructors
destructors.private accessors summary combinators locals
unix.time unix.types fry io.backend.unix.multiplexers ;
QUALIFIED: io
IN: io.backend.unix

4
basis/io/directories/search/search-docs.factor
View File

@ -64,7 +64,7 @@ HELP: find-by-extension
}
{ $description "Searches a directory for all files with the given extension. File extension and filenames are converted to lower-case and compared using the " { $link tail? } " word. The file extension should contain the period." }
{ $examples
{ $unchecked-example
{ $code
"USING: io.directories.search ;"
"\"/\" \".mp3\" find-by-extension"
}
@ -77,7 +77,7 @@ HELP: find-by-extensions
}
{ $description "Searches a directory for all files in the given list of extensions. File extensions and filenames are converted to lower-case and compared using the " { $link tail? } " word. File extensions should contain the period." }
{ $examples
{ $unchecked-example
{ $code
"USING: io.directories.search ;"
"\"/\" { \".jpg\" \".gif\" \".tiff\" \".png\" \".bmp\" } find-by-extensions"
}

4
basis/io/directories/unix/linux/linux.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2009 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: alien.c-types io.directories.unix kernel system unix
classes.struct unix.ffi ;
USING: alien.c-types alien.data io.directories.unix kernel
system unix classes.struct unix.ffi ;
IN: io.directories.unix.linux
M: linux find-next-file ( DIR* -- dirent )

11
basis/io/directories/unix/unix.factor
View File

@ -1,10 +1,11 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien.c-types alien.strings combinators
continuations destructors fry io io.backend io.backend.unix
io.directories io.encodings.binary io.encodings.utf8 io.files
io.pathnames io.files.types kernel math.bitwise sequences system
unix unix.stat vocabs.loader classes.struct unix.ffi literals ;
USING: accessors alien.c-types alien.data alien.strings
combinators continuations destructors fry io io.backend
io.backend.unix io.directories io.encodings.binary
io.encodings.utf8 io.files io.pathnames io.files.types kernel
math.bitwise sequences system unix unix.stat vocabs.loader
classes.struct unix.ffi literals ;
IN: io.directories.unix
CONSTANT: touch-mode flags{ O_WRONLY O_APPEND O_CREAT O_EXCL }

10
basis/io/files/info/unix/macosx/macosx.factor
View File

@ -1,10 +1,10 @@
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien.c-types alien.strings combinators
grouping io.encodings.utf8 io.files kernel math sequences system
unix io.files.unix arrays unix.statfs.macosx unix.statvfs.macosx
unix.getfsstat.macosx io.files.info.unix io.files.info
classes.struct specialized-arrays ;
USING: accessors alien.c-types alien.data alien.strings
combinators grouping io.encodings.utf8 io.files kernel math
sequences system unix io.files.unix arrays unix.statfs.macosx
unix.statvfs.macosx unix.getfsstat.macosx io.files.info.unix
io.files.info classes.struct specialized-arrays ;
SPECIALIZED-ARRAY: uint
SPECIALIZED-ARRAY: statfs64
IN: io.files.info.unix.macosx

7
basis/io/files/info/unix/unix-docs.factor
View File

@ -102,16 +102,15 @@ HELP: set-file-permissions
{ "path" "a pathname string" } { "n" "an integer, interepreted as a string of bits" } }
{ $description "Sets the file permissions for a given file with the supplied Unix permissions integer. Supplying an octal number with " { $link POSTPONE: OCT: } " is recommended." }
{ $examples "Using the tradidional octal value:"
{ $unchecked-example "USING: io.files.info.unix kernel ;"
{ $code "USING: io.files.info.unix kernel ;"
"\"resource:license.txt\" OCT: 755 set-file-permissions"
""
}
"Higher-level, setting named bits:"
{ $unchecked-example "USING: io.files.info.unix kernel literals ;"
{ $code "USING: io.files.info.unix kernel literals ;"
"\"resource:license.txt\""
"flags{ USER-ALL GROUP-READ GROUP-EXECUTE OTHER-READ OTHER-EXECUTE }"
"set-file-permissions"
"" }
}
} ;
HELP: set-file-times

16
basis/io/files/windows/windows.factor Normal file → Executable file
View File

@ -3,13 +3,13 @@
USING: accessors alien alien.c-types alien.data alien.strings
alien.syntax arrays assocs classes.struct combinators
combinators.short-circuit continuations destructors environment
io io.backend io.binary io.buffers
io.encodings.utf16n io.files io.files.private io.files.types
io.pathnames io.ports io.streams.c io.streams.null io.timeouts
kernel libc literals locals make math math.bitwise namespaces
sequences specialized-arrays system
threads tr windows windows.errors windows.handles
windows.kernel32 windows.shell32 windows.time windows.types ;
io io.backend io.binary io.buffers io.encodings.utf16n io.files
io.files.private io.files.types io.pathnames io.ports
io.streams.c io.streams.null io.timeouts kernel libc literals
locals make math math.bitwise namespaces sequences
specialized-arrays system threads tr windows windows.errors
windows.handles windows.kernel32 windows.shell32 windows.time
windows.types ;
SPECIALIZED-ARRAY: ushort
IN: io.files.windows
@ -52,7 +52,7 @@ C: <FileArgs> FileArgs
[ handle>> handle>> ]
[ buffer>> ]
[ buffer>> buffer-length ]
[ drop DWORD <c-object> ]
[ drop 0 DWORD <ref> ]
[ FileArgs-overlapped ]
} cleave <FileArgs> ;

2
basis/io/sockets/windows/windows.factor
View File

@ -99,7 +99,7 @@ M: winnt WSASocket-flags ( -- DWORD )
{ void* }
[
void* heap-size
DWORD <c-object>
0 DWORD <ref>
f
f
WSAIoctl SOCKET_ERROR = [

2
basis/multiline/multiline-docs.factor
View File

@ -17,7 +17,7 @@ HELP: /*
HELP: HEREDOC:
{ $syntax "HEREDOC: marker\n...text...\nmarker" }
{ $values { "marker" "a word (token)" } { "text" "arbitrary text" } { "value" string } }
{ $description "Returns a string delimited by an arbitrary user-defined token. This delimiter must be exactly the text beginning at the first non-blank character after " { $link POSTPONE: HEREDOC: } " until the end of the line containing " { $link POSTPONE: HEREDOC: } ". Text is captured until a line is found conatining exactly this delimter string." }
{ $description "Returns a string delimited by an arbitrary user-defined token. This delimiter must be exactly the text beginning at the first non-blank character after " { $link POSTPONE: HEREDOC: } " until the end of the line containing " { $link POSTPONE: HEREDOC: } ". Text is captured until a line is found containing exactly this delimiter string." }
{ $warning "Whitespace is significant." }
{ $examples
{ $example "USING: multiline prettyprint ;"

6
basis/opengl/shaders/shaders.factor
View File

@ -1,9 +1,9 @@
! Copyright (C) 2008 Joe Groff.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel opengl.gl alien.c-types continuations namespaces
assocs alien alien.data alien.strings libc opengl math sequences combinators
macros arrays io.encodings.ascii fry specialized-arrays
destructors accessors ;
assocs alien alien.data alien.strings libc opengl math sequences
combinators macros arrays io.encodings.ascii fry
specialized-arrays destructors accessors ;
SPECIALIZED-ARRAY: uint
IN: opengl.shaders

8
basis/random/random.factor
View File

@ -1,9 +1,9 @@
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien.c-types arrays assocs byte-arrays
byte-vectors combinators fry io.backend io.binary kernel locals
math math.bitwise math.constants math.functions math.order
math.ranges namespaces sequences sets summary system
USING: accessors alien.c-types alien.data arrays assocs
byte-arrays byte-vectors combinators fry io.backend io.binary
kernel locals math math.bitwise math.constants math.functions
math.order math.ranges namespaces sequences sets summary system
vocabs.loader ;
IN: random

4
basis/random/sfmt/sfmt.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2009 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien.c-types kernel locals math math.ranges
math.bitwise math.vectors math.vectors.simd random
USING: accessors alien.c-types alien.data kernel locals math
math.ranges math.bitwise math.vectors math.vectors.simd random
sequences specialized-arrays sequences.private classes.struct
combinators.short-circuit fry ;
SPECIALIZED-ARRAY: uint

2
basis/specialized-arrays/specialized-arrays-docs.factor
View File

@ -86,7 +86,7 @@ $nl
}
"Finally, sometimes a C library returns a pointer to an array in unmanaged memory, together with a length. In this case, a specialized array can be constructed to view this memory using " { $snippet "<direct-T-array>" } ":"
{ $code
"USING: alien.c-types classes.struct ;"
"USING: alien.c-types alien.data classes.struct ;"
""
"STRUCT: device_info"
" { id int }"

3
basis/specialized-arrays/specialized-arrays-tests.factor
View File

@ -6,7 +6,8 @@ multiline eval words vocabs namespaces assocs prettyprint
alien.data math.vectors definitions compiler.test ;
FROM: specialized-arrays.private => specialized-array-vocab ;
FROM: alien.c-types => int float bool char float ulonglong ushort uint
heap-size little-endian? ;
heap-size ;
FROM: alien.data => little-endian? ;
IN: specialized-arrays.tests
SPECIALIZED-ARRAY: int

2
basis/system-info/macosx/macosx.factor
View File

@ -1,6 +1,6 @@
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.c-types alien.strings alien.syntax
USING: alien alien.c-types alien.data alien.strings alien.syntax
byte-arrays kernel namespaces sequences unix
system-info.backend system io.encodings.utf8 ;
IN: system-info.macosx

9
basis/system-info/windows/windows.factor
View File

@ -1,10 +1,9 @@
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien alien.c-types alien.strings byte-arrays
classes.struct combinators kernel math namespaces
specialized-arrays system
system-info.backend vocabs.loader windows windows.advapi32
windows.errors windows.kernel32 words ;
USING: accessors alien alien.c-types alien.data alien.strings
byte-arrays classes.struct combinators kernel math namespaces
specialized-arrays system system-info.backend vocabs.loader
windows windows.advapi32 windows.errors windows.kernel32 words ;
SPECIALIZED-ARRAY: ushort
IN: system-info.windows

6
basis/tools/deploy/config/config-docs.factor
View File

@ -40,13 +40,15 @@ HELP: deploy-c-types?
$nl
"Off by default."
$nl
"The optimizing compiler is able to fold away calls to various words which take a C type as an input if the C type is a literal string:"
"The optimizing compiler is able to fold away calls to various words which take a C type as an input if the C type is a literal string, for example,"
{ $list
{ $link c-type }
{ $link heap-size }
{ $link <c-object> }
{ $link <c-array> }
{ $link <c-direct-array> }
{ $link malloc-array }
{ $link <ref> }
{ $link deref }
}
"If your program looks up C types dynamically or from words which do not have a stack effect, you must enable this flag, because in these situations the C type lookup code is not folded away and the word properties must be consulted at runtime." } ;

36
basis/ui/backend/windows/windows.factor
View File

@ -1,19 +1,19 @@
! Copyright (C) 2005, 2006 Doug Coleman.
! Portions copyright (C) 2007, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.c-types alien.strings arrays assocs ui
USING: alien alien.data alien.strings arrays assocs ui
ui.private ui.gadgets ui.gadgets.private ui.backend
ui.clipboards ui.gadgets.worlds ui.gestures ui.event-loop io
kernel math math.vectors namespaces make sequences strings
vectors words windows.dwmapi system-info.windows windows.kernel32
windows.gdi32 windows.user32 windows.opengl32 windows.messages
windows.types windows.offscreen windows threads libc combinators
fry combinators.short-circuit continuations command-line shuffle
opengl ui.render math.bitwise locals accessors math.rectangles
math.order calendar ascii sets io.encodings.utf16n
windows.errors literals ui.pixel-formats
vectors words windows.dwmapi system-info.windows
windows.kernel32 windows.gdi32 windows.user32 windows.opengl32
windows.messages windows.types windows.offscreen windows threads
libc combinators fry combinators.short-circuit continuations
command-line shuffle opengl ui.render math.bitwise locals
accessors math.rectangles math.order calendar ascii sets
io.encodings.utf16n windows.errors literals ui.pixel-formats
ui.pixel-formats.private memoize classes colors
specialized-arrays classes.struct alien.data ;
specialized-arrays classes.struct ;
FROM: namespaces => set ;
SPECIALIZED-ARRAY: POINT
QUALIFIED-WITH: alien.c-types c
@ -60,14 +60,14 @@ PIXEL-FORMAT-ATTRIBUTE-TABLE: WGL_ARB { $ WGL_SUPPORT_OPENGL_ARB 1 } H{
drop f ;
: arb-make-pixel-format ( world attributes -- pf )
[ handle>> hDC>> ] dip >WGL_ARB-int-array f 1 { int int }
[ handle>> hDC>> ] dip >WGL_ARB-int-array f 1 { c:int c:int }
[ wglChoosePixelFormatARB win32-error=0/f ] with-out-parameters drop ;
: arb-pixel-format-attribute ( pixel-format attribute -- value )
>WGL_ARB
[ drop f ] [
[ [ world>> handle>> hDC>> ] [ handle>> ] bi 0 1 ] dip
first int <ref> { int }
first c:int <ref> { c:int }
[ wglGetPixelFormatAttribivARB win32-error=0/f ]
with-out-parameters
] if-empty ;
@ -96,7 +96,7 @@ CONSTANT: pfd-flag-map H{
: >pfd ( attributes -- pfd )
[ PIXELFORMATDESCRIPTOR <struct> ] dip
{
[ drop PIXELFORMATDESCRIPTOR heap-size >>nSize ]
[ drop PIXELFORMATDESCRIPTOR c:heap-size >>nSize ]
[ drop 1 >>nVersion ]
[ >pfd-flags >>dwFlags ]
[ drop PFD_TYPE_RGBA >>iPixelType ]
@ -122,12 +122,12 @@ CONSTANT: pfd-flag-map H{
: get-pfd ( pixel-format -- pfd )
[ world>> handle>> hDC>> ] [ handle>> ] bi
PIXELFORMATDESCRIPTOR heap-size
PIXELFORMATDESCRIPTOR c:heap-size
PIXELFORMATDESCRIPTOR <struct>
[ DescribePixelFormat win32-error=0/f ] keep ;
: pfd-flag? ( pfd flag -- ? )
[ dwFlags>> ] dip bitand c-bool> ;
[ dwFlags>> ] dip bitand c:c-bool> ;
: (pfd-pixel-format-attribute) ( pfd attribute -- value )
{
@ -525,7 +525,7 @@ SYMBOL: nc-buttons
: make-TRACKMOUSEEVENT ( hWnd -- alien )
TRACKMOUSEEVENT <struct>
swap >>hwndTrack
TRACKMOUSEEVENT heap-size >>cbSize ;
TRACKMOUSEEVENT c:heap-size >>cbSize ;
: handle-wm-mousemove ( hWnd uMsg wParam lParam -- )
2nip
@ -614,7 +614,7 @@ SYMBOL: trace-messages?
! return 0 if you handle the message, else just let DefWindowProc return its val
: ui-wndproc ( -- object )
uint { void* uint long long } stdcall [
c:uint { c:void* c:uint c:long c:long } stdcall [
pick
trace-messages? get-global
@ -636,7 +636,7 @@ M: windows-ui-backend do-events
:: register-window-class ( class-name-ptr -- )
WNDCLASSEX <struct> f GetModuleHandle
class-name-ptr pick GetClassInfoEx 0 = [
WNDCLASSEX heap-size >>cbSize
WNDCLASSEX c:heap-size >>cbSize
flags{ CS_HREDRAW CS_VREDRAW CS_OWNDC } >>style
ui-wndproc >>lpfnWndProc
0 >>cbClsExtra
@ -799,7 +799,7 @@ M: windows-ui-backend system-alert
: fullscreen-RECT ( hwnd -- RECT )
MONITOR_DEFAULTTONEAREST MonitorFromWindow
MONITORINFOEX <struct>
MONITORINFOEX heap-size >>cbSize
MONITORINFOEX c:heap-size >>cbSize
[ GetMonitorInfo win32-error=0/f ] keep rcMonitor>> ;
: client-area>RECT ( hwnd -- RECT )

6
basis/ui/pixel-formats/pixel-formats-docs.factor
View File

@ -45,8 +45,7 @@ ARTICLE: "ui.pixel-formats-attributes" "Pixel format attributes"
}
{ $examples
"The following " { $link world } " subclass will request a double-buffered window with minimum 24-bit color and depth buffers, and will throw an error if the requirements aren't met:"
{ $code """
USING: kernel ui.worlds ui.pixel-formats ;
{ $code """USING: kernel ui.gadgets.worlds ui.pixel-formats ;
IN: ui.pixel-formats.examples
TUPLE: picky-depth-buffered-world < world ;
@ -63,8 +62,7 @@ M: picky-depth-buffered-world check-world-pixel-format
[ double-buffered pixel-format-attribute 0 = [ "Not double buffered!" throw ] when ]
[ color-bits pixel-format-attribute 24 < [ "Not enough color bits!" throw ] when ]
[ depth-bits pixel-format-attribute 24 < [ "Not enough depth bits!" throw ] when ]
tri ;
""" } }
tri ;""" } }
;
HELP: double-buffered

4
basis/unix/groups/groups.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien alien.c-types alien.strings assocs
byte-arrays classes.struct combinators
USING: accessors alien alien.c-types alien.data alien.strings
assocs byte-arrays classes.struct combinators
combinators.short-circuit continuations fry io.backend.unix
io.encodings.utf8 kernel math math.parser namespaces sequences
splitting strings unix unix.ffi unix.users unix.utilities ;

2
basis/unix/types/linux/linux.factor
View File

@ -31,5 +31,3 @@ TYPEDEF: ulonglong __fsblkcnt64_t
TYPEDEF: ulonglong __fsfilcnt64_t
TYPEDEF: ulonglong ino64_t
TYPEDEF: ulonglong off64_t
: <time_t> ( n -- long ) long <ref> ;

7
basis/windows/com/com-tests.factor
View File

@ -1,7 +1,8 @@
USING: kernel windows.com windows.com.syntax windows.ole32
windows.types alien alien.syntax tools.test libc alien.c-types
namespaces arrays continuations accessors math windows.com.wrapper
windows.com.wrapper.private destructors effects compiler.units ;
windows.types alien alien.data alien.syntax tools.test libc
alien.c-types namespaces arrays continuations accessors math
windows.com.wrapper windows.com.wrapper.private destructors
effects compiler.units ;
IN: windows.com.tests
COM-INTERFACE: ISimple IUnknown {216fb341-0eb2-44b1-8edb-60b76e353abc}

6
basis/windows/com/syntax/syntax.factor Normal file → Executable file
View File

@ -1,6 +1,6 @@
USING: alien alien.c-types alien.accessors alien.parser
effects kernel windows.ole32 parser lexer splitting grouping
sequences namespaces assocs quotations generalizations
USING: alien alien.c-types alien.data alien.accessors
alien.parser effects kernel windows.ole32 parser lexer splitting
grouping sequences namespaces assocs quotations generalizations
accessors words macros alien.syntax fry arrays layouts math
classes.struct windows.kernel32 locals ;
FROM: alien.parser.private => parse-pointers return-type-name ;

2
basis/windows/iphlpapi/iphlpapi.factor
View File

@ -1,6 +1,6 @@
! Copyright (C) 2010 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien alien.c-types alien.syntax
USING: accessors alien alien.c-types alien.data alien.syntax
classes.struct io.encodings.string io.encodings.utf8 kernel
make sequences windows.errors windows.types ;
IN: windows.iphlpapi

34
basis/windows/registry/registry.factor
View File

@ -13,7 +13,7 @@ samDesired lpSecurityAttributes phkResult lpdwDisposition ;
CONSTANT: registry-value-max-length 16384
:: open-key ( key subkey mode -- hkey )
key subkey 0 mode HKEY <c-object>
key subkey 0 mode 0 HKEY <ref>
[
RegOpenKeyEx dup ERROR_SUCCESS = [
drop
@ -21,16 +21,16 @@ CONSTANT: registry-value-max-length 16384
[ key subkey mode ] dip n>win32-error-string
open-key-failed
] if
] keep uint deref ;
] keep HKEY deref ;
:: create-key* ( hKey lpSubKey lpClass dwOptions samDesired lpSecurityAttributes -- hkey new? )
hKey lpSubKey 0 lpClass dwOptions samDesired lpSecurityAttributes
HKEY <c-object>
DWORD <c-object>
f :> ret!
hKey lpSubKey 0 lpClass dwOptions samDesired lpSecurityAttributes
0 HKEY <ref>
0 DWORD <ref>
[ RegCreateKeyEx ret! ] 2keep
[ uint deref ]
[ uint deref REG_CREATED_NEW_KEY = ] bi*
[ HKEY deref ]
[ DWORD deref REG_CREATED_NEW_KEY = ] bi*
ret ERROR_SUCCESS = [
[
hKey lpSubKey 0 lpClass dwOptions samDesired
@ -103,9 +103,9 @@ TUPLE: registry-enum-key ;
registry-value-max-length TCHAR <c-array> dup :> registry-value
registry-value length dup :> registry-value-length
f
DWORD <c-object> dup :> type
f ! BYTE <c-object> dup :> data
f ! BYTE <c-object> dup :> buffer
0 DWORD <ref> dup :> type
f ! 0 BYTE <ref> dup :> data
f ! 0 BYTE <ref> dup :> buffer
RegEnumKeyEx dup ERROR_SUCCESS = [
] [
@ -118,13 +118,13 @@ TUPLE: registry-enum-key ;
dup TCHAR <c-array> dup :> class-buffer
swap int <ref> dup :> class-buffer-length
f
DWORD <c-object> dup :> sub-keys
DWORD <c-object> dup :> longest-subkey
DWORD <c-object> dup :> longest-class-string
DWORD <c-object> dup :> #values
DWORD <c-object> dup :> max-value
DWORD <c-object> dup :> max-value-data
DWORD <c-object> dup :> security-descriptor
0 DWORD <ref> dup :> sub-keys
0 DWORD <ref> dup :> longest-subkey
0 DWORD <ref> dup :> longest-class-string
0 DWORD <ref> dup :> #values
0 DWORD <ref> dup :> max-value
0 DWORD <ref> dup :> max-value-data
0 DWORD <ref> dup :> security-descriptor
FILETIME <struct> dup :> last-write-time
RegQueryInfoKey :> ret
ret ERROR_SUCCESS = [

4
basis/x11/clipboard/clipboard.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2006, 2010 Slava Pestov
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien.c-types alien.strings classes.struct
io.encodings.utf8 kernel namespaces sequences
USING: accessors alien.c-types alien.data alien.strings
classes.struct io.encodings.utf8 kernel namespaces sequences
specialized-arrays x11 x11.constants x11.xlib ;
SPECIALIZED-ARRAY: int
IN: x11.clipboard

7
basis/x11/windows/windows.factor
View File

@ -1,8 +1,9 @@
! Copyright (C) 2005, 2010 Eduardo Cavazos, Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien.c-types kernel math math.bitwise
math.vectors namespaces sequences arrays fry classes.struct
literals x11 x11.xlib x11.constants x11.events x11.glx ;
USING: accessors alien.c-types alien.data kernel math
math.bitwise math.vectors namespaces sequences arrays fry
classes.struct literals x11 x11.xlib x11.constants x11.events
x11.glx ;
IN: x11.windows
CONSTANT: create-window-mask

6
basis/x11/xim/xim.factor
View File

@ -1,8 +1,8 @@
! Copyright (C) 2007, 2008 Slava Pestov
! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.c-types alien.strings arrays byte-arrays
hashtables io io.encodings.string kernel math namespaces
sequences strings continuations x11 x11.xlib
USING: alien alien.c-types alien.data alien.strings arrays
byte-arrays hashtables io io.encodings.string kernel math
namespaces sequences strings continuations x11 x11.xlib
specialized-arrays accessors io.encodings.utf16n ;
SPECIALIZED-ARRAY: uint
IN: x11.xim

4
basis/x11/xinput2/xinput2.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2010 Niklas Waern.
! See http://factorcode.org/license.txt for BSD license.
USING: alien.c-types combinators kernel namespaces x11
x11.constants x11.xinput2.ffi ;
USING: alien.c-types alien.data combinators kernel namespaces
x11 x11.constants x11.xinput2.ffi ;
IN: x11.xinput2
: (xi2-available?) ( display -- ? )

2
core/io/encodings/utf16n/utf16n-tests.factor
View File

@ -1,4 +1,4 @@
USING: accessors alien.c-types kernel
USING: accessors alien.c-types alien.data kernel
io.encodings.utf16 io.streams.byte-array tools.test ;
IN: io.encodings.utf16n

61
core/sequences/sequences-docs.factor
View File

@ -15,7 +15,7 @@ HELP: length
HELP: set-length
{ $values { "n" "a non-negative integer" } { "seq" "a resizable sequence" } }
{ $contract "Resizes a sequence. The initial contents of the new area is undefined." }
{ $errors "Throws a " { $link no-method } " error if the sequence is not resizable, and a " { $link bounds-error } " if the new length is negative." }
{ $errors "Throws a " { $link no-method } " error if the sequence is not resizable, and a " { $link bounds-error } " if the new length is negative." }
{ $side-effects "seq" } ;
HELP: lengthen
@ -45,7 +45,7 @@ HELP: nths
{ "indices" sequence } { "seq" sequence }
{ "seq'" sequence } }
{ $description "Outputs a sequence of elements from the input sequence indexed by the indices." }
{ $examples
{ $examples
{ $example "USING: prettyprint sequences ;"
"{ 0 2 } { \"a\" \"b\" \"c\" } nths ."
"{ \"a\" \"c\" }"
@ -248,7 +248,7 @@ HELP: array-nth
{ $warning "This word is in the " { $vocab-link "sequences.private" } " vocabulary because it is unsafe. It does not check types or array bounds, and improper use can corrupt memory. User code must use " { $link nth } " instead." } ;
HELP: set-array-nth
{ $values { "elt" object } { "n" "a non-negative fixnum" } { "array" "an array" } }
{ $values { "elt" object } { "n" "a non-negative fixnum" } { "array" "an array" } }
{ $description "Low-level array element mutator." }
{ $warning "This word is in the " { $vocab-link "sequences.private" } " vocabulary because it is unsafe. It does not check types or array bounds, and improper use can corrupt memory. User code must use " { $link set-nth } " instead." } ;
@ -430,7 +430,7 @@ HELP: all?
HELP: push-if
{ $values { "elt" object } { "quot" { $quotation "( ..a elt -- ..b ? )" } } { "accum" "a resizable mutable sequence" } }
{ $description "Adds the element at the end of the sequence if the quotation yields a true value." }
{ $description "Adds the element at the end of the sequence if the quotation yields a true value." }
{ $notes "This word is a factor of " { $link filter } "." } ;
HELP: filter
@ -557,7 +557,7 @@ HELP: append!
HELP: prefix
{ $values { "seq" sequence } { "elt" object } { "newseq" sequence } }
{ $description "Outputs a new sequence obtained by adding " { $snippet "elt" } " at the beginning of " { $snippet "seq" } "." }
{ $errors "Throws an error if the type of " { $snippet "elt" } " is not permitted in sequences of the same class as " { $snippet "seq1" } "." }
{ $errors "Throws an error if the type of " { $snippet "elt" } " is not permitted in sequences of the same class as " { $snippet "seq1" } "." }
{ $examples
{ $example "USING: prettyprint sequences ;" "{ 1 2 3 } 0 prefix ." "{ 0 1 2 3 }" }
} ;
@ -713,7 +713,7 @@ HELP: append
{ $values { "seq1" sequence } { "seq2" sequence } { "newseq" sequence } }
{ $description "Outputs a new sequence of the same type as " { $snippet "seq1" } " consisting of the elements of " { $snippet "seq1" } " followed by " { $snippet "seq2" } "." }
{ $errors "Throws an error if " { $snippet "seq2" } " contains elements not permitted in sequences of the same class as " { $snippet "seq1" } "." }
{ $examples
{ $examples
{ $example "USING: prettyprint sequences ;"
"{ 1 2 } B{ 3 4 } append ."
"{ 1 2 3 4 }"
@ -728,7 +728,7 @@ HELP: append-as
{ $values { "seq1" sequence } { "seq2" sequence } { "exemplar" sequence } { "newseq" sequence } }
{ $description "Outputs a new sequence of the same type as " { $snippet "exemplar" } " consisting of the elements of " { $snippet "seq1" } " followed by " { $snippet "seq2" } "." }
{ $errors "Throws an error if " { $snippet "seq1" } " or " { $snippet "seq2" } " contain elements not permitted in sequences of the same class as " { $snippet "exemplar" } "." }
{ $examples
{ $examples
{ $example "USING: prettyprint sequences ;"
"{ 1 2 } B{ 3 4 } B{ } append-as ."
"B{ 1 2 3 4 }"
@ -992,7 +992,7 @@ HELP: selector
{ $values
{ "quot" { $quotation "( ... elt -- ... ? )" } }
{ "selector" { $quotation "( ... elt -- ... )" } } { "accum" vector } }
{ $description "Creates a new vector to accumulate the values which return true for a predicate. Returns a new quotation which accepts an object to be tested and stored in the collector if the test yields true. The collector is left on the stack for convenience." }
{ $description "Creates a new vector to accumulate the values which return true for a predicate. Returns a new quotation which accepts an object to be tested and stored in the collector if the test yields true. The collector is left on the stack for convenience." }
{ $example "! Find all the even numbers:" "USING: prettyprint sequences math kernel ;"
"10 iota [ even? ] selector [ each ] dip ."
"V{ 0 2 4 6 8 }"
@ -1004,7 +1004,7 @@ HELP: trim-head
{ "seq" sequence } { "quot" quotation }
{ "newseq" sequence } }
{ $description "Removes elements starting from the left side of a sequence if they match a predicate. Once an element does not match, the test stops and the rest of the sequence is left on the stack as a new sequence." }
{ $example "" "USING: prettyprint math sequences ;"
{ $example "USING: prettyprint math sequences ;"
"{ 0 0 1 2 3 0 0 } [ zero? ] trim-head ."
"{ 1 2 3 0 0 }"
} ;
@ -1014,7 +1014,7 @@ HELP: trim-head-slice
{ "seq" sequence } { "quot" quotation }
{ "slice" slice } }
{ $description "Removes elements starting from the left side of a sequence if they match a predicate. Once an element does not match, the test stops and the rest of the sequence is left on the stack as a slice" }
{ $example "" "USING: prettyprint math sequences ;"
{ $example "USING: prettyprint math sequences ;"
"{ 0 0 1 2 3 0 0 } [ zero? ] trim-head-slice ."
"T{ slice { from 2 } { to 7 } { seq { 0 0 1 2 3 0 0 } } }"
} ;
@ -1024,7 +1024,7 @@ HELP: trim-tail
{ "seq" sequence } { "quot" quotation }
{ "newseq" sequence } }
{ $description "Removes elements starting from the right side of a sequence if they match a predicate. Once an element does not match, the test stops and the rest of the sequence is left on the stack as a new sequence." }
{ $example "" "USING: prettyprint math sequences ;"
{ $example "USING: prettyprint math sequences ;"
"{ 0 0 1 2 3 0 0 } [ zero? ] trim-tail ."
"{ 0 0 1 2 3 }"
} ;
@ -1034,7 +1034,7 @@ HELP: trim-tail-slice
{ "seq" sequence } { "quot" quotation }
{ "slice" slice } }
{ $description "Removes elements starting from the right side of a sequence if they match a predicate. Once an element does not match, the test stops and the rest of the sequence is left on the stack as a slice." }
{ $example "" "USING: prettyprint math sequences ;"
{ $example "USING: prettyprint math sequences ;"
"{ 0 0 1 2 3 0 0 } [ zero? ] trim-tail-slice ."
"T{ slice { from 0 } { to 5 } { seq { 0 0 1 2 3 0 0 } } }"
} ;
@ -1044,7 +1044,7 @@ HELP: trim
{ "seq" sequence } { "quot" quotation }
{ "newseq" sequence } }
{ $description "Removes elements starting from the left and right sides of a sequence if they match a predicate. Once an element does not match, the test stops and the rest of the sequence is left on the stack as a new sequence." }
{ $example "" "USING: prettyprint math sequences ;"
{ $example "USING: prettyprint math sequences ;"
"{ 0 0 1 2 3 0 0 } [ zero? ] trim ."
"{ 1 2 3 }"
} ;
@ -1054,7 +1054,7 @@ HELP: trim-slice
{ "seq" sequence } { "quot" quotation }
{ "slice" slice } }
{ $description "Removes elements starting from the left and right sides of a sequence if they match a predicate. Once an element does not match, the test stops and the rest of the sequence is left on the stack as a slice." }
{ $example "" "USING: prettyprint math sequences ;"
{ $example "USING: prettyprint math sequences ;"
"{ 0 0 1 2 3 0 0 } [ zero? ] trim-slice ."
"T{ slice { from 2 } { to 5 } { seq { 0 0 1 2 3 0 0 } } }"
} ;
@ -1065,8 +1065,8 @@ HELP: sift
{ $values
{ "seq" sequence }
{ "newseq" sequence } }
{ $description "Outputs a new sequence with all instance of " { $link f } " removed." }
{ $examples
{ $description "Outputs a new sequence with all instance of " { $link f } " removed." }
{ $examples
{ $example "USING: prettyprint sequences ;"
"{ \"a\" 3 { } f } sift ."
"{ \"a\" 3 { } }"
@ -1078,7 +1078,7 @@ HELP: harvest
{ "seq" sequence }
{ "newseq" sequence } }
{ $description "Outputs a new sequence with all empty sequences removed." }
{ $examples
{ $examples
{ $example "USING: prettyprint sequences ;"
"{ { } { 2 3 } { 5 } { } } harvest ."
"{ { 2 3 } { 5 } }"
@ -1091,9 +1091,9 @@ HELP: set-first
{ $values
{ "first" object } { "seq" sequence } }
{ $description "Sets the first element of a sequence." }
{ $examples
{ $examples
{ $example "USING: prettyprint kernel sequences ;"
"{ 1 2 3 4 } 5 over set-first ."
"{ 1 2 3 4 } 5 over set-first ."
"{ 5 2 3 4 }"
}
} ;
@ -1102,9 +1102,9 @@ HELP: set-second
{ $values
{ "second" object } { "seq" sequence } }
{ $description "Sets the second element of a sequence." }
{ $examples
{ $examples
{ $example "USING: prettyprint kernel sequences ;"
"{ 1 2 3 4 } 5 over set-second ."
"{ 1 2 3 4 } 5 over set-second ."
"{ 1 5 3 4 }"
}
} ;
@ -1113,9 +1113,9 @@ HELP: set-third
{ $values
{ "third" object } { "seq" sequence } }
{ $description "Sets the third element of a sequence." }
{ $examples
{ $examples
{ $example "USING: prettyprint kernel sequences ;"
"{ 1 2 3 4 } 5 over set-third ."
"{ 1 2 3 4 } 5 over set-third ."
"{ 1 2 5 4 }"
}
} ;
@ -1124,9 +1124,9 @@ HELP: set-fourth
{ $values
{ "fourth" object } { "seq" sequence } }
{ $description "Sets the fourth element of a sequence." }
{ $examples
{ $examples
{ $example "USING: prettyprint kernel sequences ;"
"{ 1 2 3 4 } 5 over set-fourth ."
"{ 1 2 3 4 } 5 over set-fourth ."
"{ 1 2 3 5 }"
}
} ;
@ -1138,7 +1138,7 @@ HELP: replicate
{ "len" integer } { "quot" { $quotation "( ... -- ... newelt )" } }
{ "newseq" sequence } }
{ $description "Calls the quotation " { $snippet "len" } " times, collecting results into a new array." }
{ $examples
{ $examples
{ $unchecked-example "USING: kernel prettyprint random sequences ;"
"5 [ 100 random ] replicate ."
"{ 52 10 45 81 30 }"
@ -1150,7 +1150,7 @@ HELP: replicate-as
{ "len" integer } { "quot" { $quotation "( ... -- ... newelt )" } } { "exemplar" sequence }
{ "newseq" sequence } }
{ $description "Calls the quotation " { $snippet "len" } " times, collecting results into a new sequence of the same type as the exemplar sequence." }
{ $examples
{ $examples
{ $unchecked-example "USING: prettyprint kernel sequences ;"
"5 [ 100 random ] B{ } replicate-as ."
"B{ 44 8 2 33 18 }"
@ -1163,8 +1163,8 @@ HELP: partition
{ $values
{ "seq" sequence } { "quot" quotation }
{ "trueseq" sequence } { "falseseq" sequence } }
{ $description "Calls a predicate quotation on each element of the input sequence. If the test yields true, the element is added to " { $snippet "trueseq" } "; if false, it's added to " { $snippet "falseseq" } "." }
{ $examples
{ $description "Calls a predicate quotation on each element of the input sequence. If the test yields true, the element is added to " { $snippet "trueseq" } "; if false, it's added to " { $snippet "falseseq" } "." }
{ $examples
{ $example "USING: prettyprint kernel math sequences ;"
"{ 1 2 3 4 5 } [ even? ] partition [ . ] bi@"
"{ 2 4 }\n{ 1 3 5 }"
@ -1343,10 +1343,9 @@ HELP: assert-sequence=
{ $description "Throws an error if all the elements of two sequences, taken pairwise, are not equal." }
{ $notes "The sequences need not be of the same type." }
{ $examples
{ $example
{ $code
"USING: prettyprint sequences ;"
"{ 1 2 3 } V{ 1 2 3 } assert-sequence="
""
}
} ;

20
core/syntax/syntax-docs.factor
View File

@ -195,7 +195,7 @@ ARTICLE: "syntax-hash-sets" "Hash set syntax"
ARTICLE: "syntax-tuples" "Tuple syntax"
{ $subsections POSTPONE: T{ }
"Tuples are documented in " { $link "tuples" } "." ;
"Tuples are documented in " { $link "tuples" } "." ;
ARTICLE: "syntax-quots" "Quotation syntax"
{ $subsections
@ -340,37 +340,37 @@ $nl
HELP: {
{ $syntax "{ elements... }" }
{ $values { "elements" "a list of objects" } }
{ $description "Marks the beginning of a literal array. Literal arrays are terminated by " { $link POSTPONE: } } "." }
{ $description "Marks the beginning of a literal array. Literal arrays are terminated by " { $link POSTPONE: } } "." }
{ $examples { $code "{ 1 2 3 }" } } ;
HELP: V{
{ $syntax "V{ elements... }" }
{ $values { "elements" "a list of objects" } }
{ $description "Marks the beginning of a literal vector. Literal vectors are terminated by " { $link POSTPONE: } } "." }
{ $description "Marks the beginning of a literal vector. Literal vectors are terminated by " { $link POSTPONE: } } "." }
{ $examples { $code "V{ 1 2 3 }" } } ;
HELP: B{
{ $syntax "B{ elements... }" }
{ $values { "elements" "a list of integers" } }
{ $description "Marks the beginning of a literal byte array. Literal byte arrays are terminated by " { $link POSTPONE: } } "." }
{ $description "Marks the beginning of a literal byte array. Literal byte arrays are terminated by " { $link POSTPONE: } } "." }
{ $examples { $code "B{ 1 2 3 }" } } ;
HELP: H{
{ $syntax "H{ { key value }... }" }
{ $values { "key" "an object" } { "value" "an object" } }
{ $description "Marks the beginning of a literal hashtable, given as a list of two-element arrays holding key/value pairs. Literal hashtables are terminated by " { $link POSTPONE: } } "." }
{ $description "Marks the beginning of a literal hashtable, given as a list of two-element arrays holding key/value pairs. Literal hashtables are terminated by " { $link POSTPONE: } } "." }
{ $examples { $code "H{ { \"tuna\" \"fish\" } { \"jalapeno\" \"vegetable\" } }" } } ;
HELP: HS{
{ $syntax "HS{ members ... }" }
{ $values { "members" "a list of objects" } }
{ $description "Marks the beginning of a literal hash set, given as a list of its members. Literal hashtables are terminated by " { $link POSTPONE: } } "." }
{ $description "Marks the beginning of a literal hash set, given as a list of its members. Literal hashtables are terminated by " { $link POSTPONE: } } "." }
{ $examples { $code "HS{ 3 \"foo\" }" } } ;
HELP: C{
{ $syntax "C{ real-part imaginary-part }" }
{ $values { "real-part" "a real number" } { "imaginary-part" "a real number" } }
{ $description "Parses a complex number given in rectangular form as a pair of real numbers. Literal complex numbers are terminated by " { $link POSTPONE: } } "." } ;
{ $description "Parses a complex number given in rectangular form as a pair of real numbers. Literal complex numbers are terminated by " { $link POSTPONE: } } "." } ;
HELP: T{
{ $syntax "T{ class }" "T{ class f slot-values... }" "T{ class { slot-name slot-value } ... }" }
@ -453,7 +453,7 @@ HELP: SINGLETON:
{ $examples
{ $example "USING: classes.singleton kernel io ;" "IN: singleton-demo" "USE: prettyprint SINGLETON: foo\nGENERIC: bar ( obj -- )\nM: foo bar drop \"a foo!\" print ;\nfoo bar" "a foo!" }
} ;
HELP: SINGLETONS:
{ $syntax "SINGLETONS: words... ;" }
{ $values { "words" "a sequence of new words to define" } }
@ -560,7 +560,7 @@ HELP: FROM:
HELP: EXCLUDE:
{ $syntax "EXCLUDE: vocab => words ... ;" }
{ $description "Adds all words except for " { $snippet "words" } " from " { $snippet "vocab" } " to the search path." }
{ $description "Adds all words except for " { $snippet "words" } " from " { $snippet "vocab" } " to the search path." }
{ $examples { $code
"EXCLUDE: math.parser => bin> hex> ;" "! imports everything but bin> and hex>" } } ;
@ -728,7 +728,7 @@ HELP: HOOK:
"TUPLE: air-transport ;"
"HOOK: deliver transport ( destination -- )"
"M: land-transport deliver \"Land delivery to \" write print ;"
"M: air-transport deliver \"Air delivery to \" write print ;"
"M: air-transport deliver \"Air delivery to \" write print ;"
"T{ air-transport } transport set"
"\"New York City\" deliver"
"Air delivery to New York City"

4
core/vocabs/parser/parser-docs.factor
View File

@ -1,7 +1,7 @@
USING: help.markup help.syntax parser strings words assocs vocabs ;
IN: vocabs.parser
ARTICLE: "word-search-errors" "Word lookup errors"
ARTICLE: "word-search-errors" "Word lookup errors"
"If the parser cannot not find a word in the current vocabulary search path, it attempts to look for the word in all loaded vocabularies."
$nl
"If " { $link auto-use? } " mode is off, a restartable error is thrown with a restart for each vocabulary in question, together with a restart which defers the word in the current vocabulary, as if " { $link POSTPONE: DEFER: } " was used."
@ -142,7 +142,7 @@ HELP: add-words-from
HELP: add-words-excluding
{ $values { "vocab" "a vocabulary specifier" } { "words" "a sequence of word names" } }
{ $description "Adds all words except for " { $snippet "words" } " from " { $snippet "vocab" } " to the manifest." }
{ $description "Adds all words except for " { $snippet "words" } " from " { $snippet "vocab" } " to the manifest." }
{ $notes "This word is used to implement " { $link POSTPONE: EXCLUDE: } "." } ;
HELP: add-renamed-word

6
extra/alien/cxx/demangle/libstdcxx/libstdcxx.factor
View File

@ -1,7 +1,7 @@
! (c)2010 Joe Groff bsd license
USING: alien alien.c-types alien.libraries alien.strings
alien.syntax combinators destructors io.encodings.ascii kernel
libc locals sequences system ;
USING: alien alien.c-types alien.data alien.libraries
alien.strings alien.syntax combinators destructors
io.encodings.ascii kernel libc locals sequences system ;
IN: alien.cxx.demangle.libstdcxx
FUNCTION: char* __cxa_demangle ( char* mangled_name, char* output_buffer, size_t* length, int* status ) ;

20
extra/audio/engine/engine.factor
View File

@ -1,8 +1,8 @@
! (c)2009 Joe Groff bsd license
USING: accessors alien audio classes.struct fry calendar timers
combinators combinators.short-circuit destructors generalizations
kernel literals locals math openal sequences
sequences.generalizations specialized-arrays strings ;
USING: accessors alien alien.data audio classes.struct fry
calendar timers combinators combinators.short-circuit
destructors generalizations kernel literals locals math openal
sequences sequences.generalizations specialized-arrays strings ;
QUALIFIED-WITH: alien.c-types c
SPECIALIZED-ARRAYS: c:float c:uchar c:uint ;
IN: audio.engine
@ -122,7 +122,7 @@ ERROR: audio-context-not-available device-name ;
:: flush-source ( al-source -- )
al-source alSourceStop
0 c:uint c:<ref> :> dummy-buffer
0 c:uint <ref> :> dummy-buffer
al-source AL_BUFFERS_PROCESSED get-source-param [
al-source 1 dummy-buffer alSourceUnqueueBuffers
] times
@ -161,7 +161,7 @@ ERROR: audio-context-not-available device-name ;
audio-clip t >>done? drop
] [
al-buffer audio-clip openal-format data size audio-clip sample-rate>> alBufferData
al-source 1 al-buffer c:uint c:<ref> alSourceQueueBuffers
al-source 1 al-buffer c:uint <ref> alSourceQueueBuffers
] if
] unless ;
@ -190,10 +190,10 @@ M: static-audio-clip (update-audio-clip)
M:: streaming-audio-clip (update-audio-clip) ( audio-clip -- )
audio-clip al-source>> :> al-source
0 c:uint c:<ref> :> buffer
0 c:uint <ref> :> buffer
al-source AL_BUFFERS_PROCESSED get-source-param [
al-source 1 buffer alSourceUnqueueBuffers
audio-clip buffer c:uint c:deref queue-clip-buffer
audio-clip buffer c:uint deref queue-clip-buffer
] times ;
: update-audio-clip ( audio-clip -- )
@ -256,7 +256,7 @@ M: audio-engine dispose*
audio-engine get-available-source :> al-source
al-source [
1 0 c:uint c:<ref> [ alGenBuffers ] keep c:uint c:deref :> al-buffer
1 0 c:uint <ref> [ alGenBuffers ] keep c:uint deref :> al-buffer
al-buffer audio { [ openal-format ] [ data>> ] [ size>> ] [ sample-rate>> ] } cleave
alBufferData
@ -301,7 +301,7 @@ M: audio-clip dispose*
M: static-audio-clip dispose*
[ call-next-method ]
[ [ 1 ] dip al-buffer>> c:uint c:<ref> alDeleteBuffers ] bi ;
[ [ 1 ] dip al-buffer>> c:uint <ref> alDeleteBuffers ] bi ;
M: streaming-audio-clip dispose*
[ call-next-method ]

10
extra/audio/vorbis/vorbis.factor
View File

@ -1,9 +1,9 @@
! (c)2007, 2010 Chris Double, Joe Groff bsd license
USING: accessors alien alien.c-types audio.engine byte-arrays
classes.struct combinators destructors fry io io.files
io.encodings.binary kernel libc locals make math math.order
math.parser ogg ogg.vorbis sequences specialized-arrays
specialized-vectors ;
USING: accessors alien alien.c-types alien.data audio.engine
byte-arrays classes.struct combinators destructors fry io
io.files io.encodings.binary kernel libc locals make math
math.order math.parser ogg ogg.vorbis sequences
specialized-arrays specialized-vectors ;
FROM: alien.c-types => float short void* ;
SPECIALIZED-ARRAYS: float void* ;
SPECIALIZED-VECTOR: short

6
extra/cuda/contexts/contexts.factor
View File

@ -9,14 +9,14 @@ IN: cuda.contexts
: create-context ( device flags -- context )
swap
[ CUcontext <c-object> ] 2dip
[ cuCtxCreate cuda-error ] 3keep 2drop void* deref ; inline
[ { CUcontext } ] 2dip
'[ _ _ cuCtxCreate cuda-error ] with-out-parameters ; inline
: sync-context ( -- )
cuCtxSynchronize cuda-error ; inline
: context-device ( -- n )
CUdevice <c-object> [ cuCtxGetDevice cuda-error ] keep int deref ; inline
{ CUdevice } [ cuCtxGetDevice cuda-error ] with-out-parameters ; inline
: destroy-context ( context -- ) cuCtxDestroy cuda-error ; inline

2
extra/cuda/cuda.factor
View File

@ -16,7 +16,7 @@ TUPLE: cuda-error code ;
dup CUDA_SUCCESS = [ drop ] [ \ cuda-error boa throw ] if ;
: cuda-version ( -- n )
c:int <c-object> [ cuDriverGetVersion cuda-error ] keep c:int c:deref ;
{ c:int } [ cuDriverGetVersion cuda-error ] with-out-parameters ;
: init-cuda ( -- )
0 cuInit cuda-error ; inline

21
extra/cuda/devices/devices.factor
View File

@ -8,11 +8,10 @@ prettyprint sequences ;
IN: cuda.devices
: #cuda-devices ( -- n )
int <c-object> [ cuDeviceGetCount cuda-error ] keep int deref ;
{ int } [ cuDeviceGetCount cuda-error ] with-out-parameters ;
: n>cuda-device ( n -- device )
[ CUdevice <c-object> ] dip [ cuDeviceGet cuda-error ] 2keep
drop int deref ;
[ { CUdevice } ] dip '[ _ cuDeviceGet cuda-error ] with-out-parameters ;
: enumerate-cuda-devices ( -- devices )
#cuda-devices iota [ n>cuda-device ] map ;
@ -33,19 +32,17 @@ IN: cuda.devices
[ 2drop utf8 alien>string ] 3bi ;
: cuda-device-capability ( n -- pair )
[ int <c-object> int <c-object> ] dip
[ cuDeviceComputeCapability cuda-error ]
[ drop [ int deref ] bi@ ] 3bi 2array ;
[ { int int } ] dip
'[ _ cuDeviceComputeCapability cuda-error ] with-out-parameters
2array ;
: cuda-device-memory ( n -- bytes )
[ uint <c-object> ] dip
[ cuDeviceTotalMem cuda-error ]
[ drop uint deref ] 2bi ;
[ { uint } ] dip
'[ _ cuDeviceTotalMem cuda-error ] with-out-parameters ;
: cuda-device-attribute ( attribute n -- n )
[ int <c-object> ] 2dip
[ cuDeviceGetAttribute cuda-error ]
[ 2drop int deref ] 3bi ;
[ { int } ] 2dip
'[ _ _ cuDeviceGetAttribute cuda-error ] with-out-parameters ;
: cuda-device. ( n -- )
{

14
extra/cuda/gl/gl.factor
View File

@ -6,25 +6,25 @@ IN: cuda.gl
: create-gl-cuda-context ( device flags -- context )
swap
[ CUcontext <c-object> ] 2dip
[ cuGLCtxCreate cuda-error ] 3keep 2drop void* deref ; inline
[ { CUcontext } ] 2dip
'[ _ _ cuGLCtxCreate cuda-error ] with-out-parameters ; inline
: with-gl-cuda-context ( device flags quot -- )
[ set-up-cuda-context create-gl-cuda-context ] dip (with-cuda-context) ; inline
: gl-buffer>resource ( gl-buffer flags -- resource )
enum>number
[ CUgraphicsResource <c-object> ] 2dip
[ cuGraphicsGLRegisterBuffer cuda-error ] 3keep 2drop void* deref ; inline
[ { CUgraphicsResource } ] 2dip
'[ _ _ cuGraphicsGLRegisterBuffer cuda-error ] with-out-parameters ; inline
: buffer>resource ( buffer flags -- resource )
[ handle>> ] dip gl-buffer>resource ; inline
: map-resource ( resource -- device-ptr size )
[ 1 swap void* <ref> f cuGraphicsMapResources cuda-error ] [
[ CUdeviceptr <c-object> uint <c-object> ] dip
[ cuGraphicsResourceGetMappedPointer cuda-error ] 3keep drop
[ uint deref ] [ uint deref ] bi*
[ { CUdeviceptr uint } ] dip
'[ _ cuGraphicsResourceGetMappedPointer cuda-error ]
with-out-parameters
] bi ; inline
: unmap-resource ( resource -- )

12
extra/cuda/libraries/libraries.factor
View File

@ -74,8 +74,8 @@ M: sequence grid-dim
PRIVATE>
: load-module ( path -- module )
[ CUmodule <c-object> ] dip
[ cuModuleLoad cuda-error ] 2keep drop c:void* c:deref ;
[ { CUmodule } ] dip
'[ _ cuModuleLoad cuda-error ] with-out-parameters ;
: unload-module ( module -- )
cuModuleUnload cuda-error ;
@ -151,8 +151,8 @@ MACRO: cuda-arguments ( c-types abi -- quot: ( args... function -- ) )
[ [ 0 cuda-param-size ] ] swap '[ _ [cuda-arguments] ] if-empty ;
: get-function-ptr ( module string -- function )
[ CUfunction <c-object> ] 2dip
[ cuModuleGetFunction cuda-error ] 3keep 2drop c:void* c:deref ;
[ { CUfunction } ] 2dip
'[ _ _ cuModuleGetFunction cuda-error ] with-out-parameters ;
: cached-module ( module-name -- alien )
lookup-cuda-library
@ -170,9 +170,9 @@ MACRO: cuda-invoke ( module-name function-name arguments -- )
] ;
: cuda-global* ( module-name symbol-name -- device-ptr size )
[ CUdeviceptr <c-object> c:uint <c-object> ] 2dip
[ { CUdeviceptr { c:uint initial: 0 } } ] 2dip
[ cached-module ] dip
'[ _ _ cuModuleGetGlobal cuda-error ] 2keep [ c:uint c:deref ] bi@ ; inline
'[ _ _ cuModuleGetGlobal cuda-error ] with-out-parameters ; inline
: cuda-global ( module-name symbol-name -- device-ptr )
cuda-global* drop ; inline

5
extra/cuda/memory/memory.factor
View File

@ -8,9 +8,8 @@ QUALIFIED-WITH: alien.c-types c
IN: cuda.memory
: cuda-malloc ( n -- ptr )
[ CUdeviceptr <c-object> ] dip
'[ _ cuMemAlloc cuda-error ] keep
c:int c:deref ; inline
[ { CUdeviceptr } ] dip
'[ _ cuMemAlloc cuda-error ] with-out-parameters ; inline
: cuda-malloc-type ( n type -- ptr )
c:heap-size * cuda-malloc ; inline

8
extra/gpu/framebuffers/framebuffers.factor
View File

@ -1,8 +1,8 @@
! (c)2009 Joe Groff bsd license
USING: accessors alien.c-types arrays byte-arrays combinators
destructors gpu gpu.buffers gpu.private gpu.textures
gpu.textures.private images kernel locals math math.rectangles opengl
opengl.framebuffers opengl.gl opengl.textures sequences
USING: accessors alien.c-types alien.data arrays byte-arrays
combinators destructors gpu gpu.buffers gpu.private gpu.textures
gpu.textures.private images kernel locals math math.rectangles
opengl opengl.framebuffers opengl.gl opengl.textures sequences
specialized-arrays typed ui.gadgets.worlds variants ;
SPECIALIZED-ARRAY: int
SPECIALIZED-ARRAY: uint

4
extra/javascriptcore/javascriptcore.factor
View File

@ -37,8 +37,8 @@ SYMBOL: js-context
: eval-js ( string -- result-string )
[ js-context get dup ] dip
JSStringCreateWithUTF8CString f f 0 JSValueRef <c-object>
[ JSEvaluateScript ] keep void* deref
JSStringCreateWithUTF8CString f f 0
{ { void* initial: f } } [ JSEvaluateScript ] with-out-parameters
dup [ nip JSValueRef>string javascriptcore-error ] [ drop JSValueRef>string ] if ;
: eval-js-standalone ( string -- result-string )

5
extra/llvm/jit/jit.factor
View File

@ -1,7 +1,8 @@
! Copyright (C) 2009 Matthew Willis.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien.c-types alien.syntax assocs destructors
kernel llvm.core llvm.engine llvm.wrappers namespaces ;
USING: accessors alien.c-types alien.data alien.syntax assocs
destructors kernel llvm.core llvm.engine llvm.wrappers
namespaces ;
IN: llvm.jit

5
extra/llvm/reader/reader.factor
View File

@ -1,7 +1,8 @@
! Copyright (C) 2009 Matthew Willis.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien.c-types alien.syntax destructors kernel
llvm.core llvm.engine llvm.jit llvm.wrappers ;
USING: accessors alien.c-types alien.data alien.syntax
destructors kernel llvm.core llvm.engine llvm.jit llvm.wrappers
;
IN: llvm.reader

2
extra/llvm/wrappers/wrappers.factor
View File

@ -1,6 +1,6 @@
! Copyright (C) 2009 Matthew Willis.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien.c-types alien.strings
USING: accessors alien.c-types alien.data alien.strings
io.encodings.utf8 destructors kernel
llvm.core llvm.engine ;

2
extra/openal/alut/macosx/macosx.factor
View File

@ -1,6 +1,6 @@
! Copyright (C) 2007 Chris Double.
! See http://factorcode.org/license.txt for BSD license.
USING: alien.c-types kernel alien alien.syntax shuffle
USING: alien.c-types alien.data kernel alien alien.syntax shuffle
openal openal.alut.backend namespaces system generalizations ;
IN: openal.alut.macosx

4
extra/openal/alut/other/other.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2007 Chris Double.
! See http://factorcode.org/license.txt for BSD license.
USING: alien.c-types alien.syntax combinators generalizations
kernel openal openal.alut.backend ;
USING: alien.c-types alien.data alien.syntax combinators
generalizations kernel openal openal.alut.backend ;
IN: openal.alut.other
LIBRARY: alut

7
extra/openal/openal.factor
View File

@ -1,10 +1,11 @@
! Copyright (C) 2007 Chris Double.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel accessors arrays alien system combinators
alien.syntax namespaces alien.c-types sequences vocabs.loader
alien.syntax namespaces sequences vocabs.loader
shuffle alien.libraries generalizations
specialized-arrays alien.destructors ;
FROM: alien.c-types => float short ;
specialized-arrays alien.destructors alien.data ;
FROM: alien.c-types => char double float int short uchar uint
ushort void ;
SPECIALIZED-ARRAY: uint
IN: openal

9
extra/opencl/opencl.factor
View File

@ -1,9 +1,10 @@
! Copyright (C) 2010 Erik Charlebois.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien alien.c-types arrays byte-arrays combinators
combinators.smart destructors io.encodings.ascii io.encodings.string
kernel libc locals math namespaces opencl.ffi sequences shuffle
specialized-arrays variants ;
USING: accessors alien alien.c-types alien.data arrays
byte-arrays combinators combinators.smart destructors
io.encodings.ascii io.encodings.string kernel libc locals math
namespaces opencl.ffi sequences shuffle specialized-arrays
variants ;
IN: opencl
SPECIALIZED-ARRAYS: void* char size_t ;

5
extra/tokyo/assoc-functor/assoc-functor.factor
View File

@ -1,7 +1,8 @@
! Copyright (C) 2009 Bruno Deferrari
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien.c-types arrays assocs destructors fry functors
kernel locals sequences serialize tokyo.alien.tcutil tokyo.utils vectors ;
USING: accessors alien.c-types alien.data arrays assocs
destructors fry functors kernel locals sequences serialize
tokyo.alien.tcutil tokyo.utils vectors ;
IN: tokyo.assoc-functor
FUNCTOR: define-tokyo-assoc-api ( T N -- )