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

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

release
Joe Groff 2010-04-14 13:16:08 -07:00
parent dcf68af105 e1ee2c82ea
commit 1dadc4efed
142 changed files with 656 additions and 323 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
basis/bootstrap/compiler/timing/tags.txt
View File

@ -1 +1 @@
untested
not loaded

14
basis/compiler/tests/alien.factor
View File

@ -684,28 +684,30 @@ mingw? [
: fastcall-struct-return-iii-indirect ( x y z ptr -- result )
test-struct-11 { int int int } fastcall alien-indirect ;
: win32? ( -- ? ) os windows? cpu x86.32? and ;
[ 8 ] [
3 4
os windows? [ &: @ffi_test_50@8 ] [ &: ffi_test_50 ] if
win32? [ &: @ffi_test_50@8 ] [ &: ffi_test_50 ] if
fastcall-ii-indirect
] unit-test
[ 13 ] [
3 4 5
os windows? [ &: @ffi_test_51@12 ] [ &: ffi_test_51 ] if
win32? [ &: @ffi_test_51@12 ] [ &: ffi_test_51 ] if
fastcall-iii-indirect
] unit-test
mingw? [
[ 13 ] [
3 4.0 5
os windows? [ &: @ffi_test_52@12 ] [ &: ffi_test_52 ] if
win32? [ &: @ffi_test_52@12 ] [ &: ffi_test_52 ] if
fastcall-ifi-indirect
] unit-test
[ 19 ] [
3 4.0 5 6
os windows? [ &: @ffi_test_53@16 ] [ &: ffi_test_53 ] if
win32? [ &: @ffi_test_53@16 ] [ &: ffi_test_53 ] if
fastcall-ifii-indirect
] unit-test
] unless
@ -713,14 +715,14 @@ mingw? [
[ S{ test-struct-11 f 7 -1 } ]
[
3 4
os windows? [ &: @ffi_test_57@8 ] [ &: ffi_test_57 ] if
win32? [ &: @ffi_test_57@8 ] [ &: ffi_test_57 ] if
fastcall-struct-return-ii-indirect
] unit-test
[ S{ test-struct-11 f 7 -3 } ]
[
3 4 7
os windows? [ &: @ffi_test_58@12 ] [ &: ffi_test_58 ] if
win32? [ &: @ffi_test_58@12 ] [ &: ffi_test_58 ] if
fastcall-struct-return-iii-indirect
] unit-test

3
basis/compiler/tests/redefine23.factor
View File

@ -1,6 +1,7 @@
IN: compiler.tests.redefine23
USING: classes.struct specialized-arrays alien.c-types sequences
compiler.units vocabs tools.test ;
FROM: specialized-arrays.private => specialized-array-vocab ;
STRUCT: my-struct { x int } ;
SPECIALIZED-ARRAY: my-struct
@ -8,6 +9,6 @@ SPECIALIZED-ARRAY: my-struct
[ ] [
[
"specialized-arrays.instances.compiler.tests.redefine23" forget-vocab
my-struct specialized-array-vocab forget-vocab
] with-compilation-unit
] unit-test

2
basis/cpu/ppc/linux/tags.txt
View File

@ -1 +1 @@
untested
not loaded

2
basis/cpu/ppc/macosx/tags.txt
View File

@ -1 +1 @@
untested
not loaded

2
basis/cpu/ppc/tags.txt
View File

@ -1,2 +1,2 @@
compiler
untested
not loaded

2
basis/cpu/x86/32/tags.txt
View File

@ -1,2 +1,2 @@
untested
not loaded
compiler

2
basis/cpu/x86/64/tags.txt
View File

@ -1,2 +1,2 @@
untested
not loaded
compiler

2
basis/cpu/x86/64/unix/tags.txt
View File

@ -1 +1 @@
untested
not loaded

2
basis/cpu/x86/64/winnt/tags.txt
View File

@ -1 +1 @@
untested
not loaded

2
basis/cpu/x86/features/tags.txt
View File

@ -1 +1 @@
untested
not loaded

2
basis/cpu/x86/tags.txt
View File

@ -1,2 +1,2 @@
untested
not loaded
compiler

2
basis/editors/editpadlite/tags.txt
View File

@ -1 +1 @@
untested
not loaded

2
basis/editors/editpadpro/tags.txt
View File

@ -1 +1 @@
untested
not loaded

2
basis/editors/editplus/tags.txt
View File

@ -1 +1 @@
untested
not loaded

2
basis/editors/emacs/tags.txt
View File

@ -1 +1 @@
untested
not loaded

2
basis/editors/emacs/windows/tags.txt
View File

@ -1 +1 @@
untested
not loaded

2
basis/editors/emeditor/tags.txt
View File

@ -1 +1 @@
untested
not loaded

2
basis/editors/etexteditor/tags.txt
View File

@ -1 +1 @@
untested
not loaded

2
basis/editors/gedit/tags.txt
View File

@ -1 +1 @@
untested
not loaded

2
basis/editors/gvim/tags.txt
View File

@ -1 +1 @@
untested
not loaded

2
basis/editors/gvim/unix/tags.txt
View File

@ -1 +1 @@
untested
not loaded

2
basis/editors/gvim/windows/tags.txt
View File

@ -1 +1 @@
untested
not loaded

2
basis/editors/jedit/tags.txt
View File

@ -1 +1 @@
untested
not loaded

2
basis/editors/macvim/tags.txt
View File

@ -1 +1 @@
untested
not loaded

2
basis/editors/notepad/tags.txt
View File

@ -1 +1 @@
untested
not loaded

2
basis/editors/notepad2/tags.txt
View File

@ -1 +1 @@
untested
not loaded

2
basis/editors/notepadpp/tags.txt
View File

@ -1 +1 @@
untested
not loaded

2
basis/editors/scite/tags.txt
View File

@ -1 +1 @@
untested
not loaded

2
basis/editors/ted-notepad/tags.txt
View File

@ -1 +1 @@
untested
not loaded

2
basis/editors/textedit/tags.txt
View File

@ -1 +1 @@
untested
not loaded

2
basis/editors/textmate/tags.txt
View File

@ -1 +1 @@
untested
not loaded

2
basis/editors/textpad/tags.txt
View File

@ -1 +1 @@
untested
not loaded

2
basis/editors/textwrangler/tags.txt
View File

@ -1 +1 @@
untested
not loaded

2
basis/editors/ultraedit/tags.txt
View File

@ -1 +1 @@
untested
not loaded

1
basis/editors/vim/generate-syntax/tags.txt
View File

@ -1 +0,0 @@
untested

2
basis/editors/vim/tags.txt
View File

@ -1 +1 @@
untested
not loaded

2
basis/editors/wordpad/tags.txt
View File

@ -1 +1 @@
untested
not loaded

1
basis/furnace/recaptcha/tags.txt
View File

@ -1 +1,2 @@
web
web services

2
basis/math/floats/env/ppc/tags.txt vendored
View File

@ -1 +1 @@
untested
not loaded

2
basis/math/floats/env/x86/32/tags.txt vendored
View File

@ -1 +1 @@
untested
not loaded

2
basis/math/floats/env/x86/64/tags.txt vendored
View File

@ -1 +1 @@
untested
not loaded

2
basis/math/floats/env/x86/tags.txt vendored
View File

@ -1 +1 @@
untested
not loaded

26
basis/stack-checker/branches/branches.factor
View File

@ -1,9 +1,10 @@
! Copyright (C) 2008 Slava Pestov.
! Copyright (C) 2008, 2010 Slava Pestov, Joe Groff.
! See http://factorcode.org/license.txt for BSD license.
USING: arrays effects fry vectors sequences assocs math math.order accessors kernel
combinators quotations namespaces grouping locals stack-checker.state
stack-checker.backend stack-checker.errors stack-checker.visitor
stack-checker.values stack-checker.recursive-state ;
FROM: sequences.private => dispatch ;
IN: stack-checker.branches
: balanced? ( pairs -- ? )
@ -43,10 +44,9 @@ SYMBOLS: +bottom+ +top+ ;
: phi-outputs ( phi-in -- stack )
flip [ unify-values ] map ;
SYMBOL: quotations
SYMBOLS: combinator quotations ;
: simple-unbalanced-branches-error ( branches quots -- * )
[ \ if ] 2dip swap
: simple-unbalanced-branches-error ( word quots branches -- * )
[ length [ (( ..a -- ..b )) ] replicate ]
[ [ length [ "x" <array> ] bi@ <effect> ] { } assoc>map ] bi
unbalanced-branches-error ;
@ -54,9 +54,10 @@ SYMBOL: quotations
: unify-branches ( ins stacks -- in phi-in phi-out )
zip [ 0 { } { } ] [
[ keys supremum ] [ ] [ balanced? ] tri
[ dupd phi-inputs dup phi-outputs ]
[ quotations get simple-unbalanced-branches-error ]
if
[ dupd phi-inputs dup phi-outputs ] [
[ combinator get quotations get ] dip
simple-unbalanced-branches-error
] if
] if-empty ;
: branch-variable ( seq symbol -- seq )
@ -125,13 +126,13 @@ M: curried curried/composed? drop t ;
M: composed curried/composed? drop t ;
M: declared-effect curried/composed? known>> curried/composed? ;
:: declare-if-effects ( -- )
H{ } clone :> variables
V{ } clone :> branches
\ if (( ..a -- ..b )) variables branches 0 declare-effect-d
\ if (( ..a -- ..b )) variables branches 1 declare-effect-d ;
: declare-if-effects ( -- )
H{ } clone V{ } clone
[ [ \ if (( ..a -- ..b )) ] 2dip 0 declare-effect-d ]
[ [ \ if (( ..a -- ..b )) ] 2dip 1 declare-effect-d ] 2bi ;
: infer-if ( -- )
\ if combinator set
2 literals-available? [
(infer-if)
] [
@ -148,5 +149,6 @@ M: declared-effect curried/composed? known>> curried/composed? ;
] if ;
: infer-dispatch ( -- )
\ dispatch combinator set
pop-literal nip infer-branches
[ #dispatch, ] dip compute-phi-function ;

3
basis/stack-checker/row-polymorphism/row-polymorphism.factor
View File

@ -24,7 +24,7 @@ IN: stack-checker.row-polymorphism
[ with-inner-d ] 2dip (effect-here) ; inline
: (diff-variable) ( diff variable vars -- diff' )
[ at* nip ] [ '[ _ _ at - ] ] [ '[ _ _ set-at 0 ] ] 2tri if ;
[ key? ] [ '[ _ _ at - ] ] [ '[ _ _ set-at 0 ] ] 2tri if ;
: (check-variable) ( actual-count declared-count variable vars -- diff ? )
[ - ] 2dip dupd '[ _ _ (diff-variable) t ] [ dup 0 <= ] if ;
@ -63,4 +63,3 @@ IN: stack-checker.row-polymorphism
[ >>actual ] keep
2dup [ [ variables>> ] [ effect>> ] bi ] dip check-variables
[ 2drop ] [ drop combinator-unbalanced-branches-error ] if ;

5
basis/stack-checker/stack-checker-tests.factor
View File

@ -252,6 +252,11 @@ DEFER: blah4
! A typo
{ 1 0 } [ { [ ] } dispatch ] must-infer-as
! Make sure the error is correct
[
[ { [ drop ] [ dup ] } dispatch ] infer
] [ word>> \ dispatch eq? ] must-fail-with
DEFER: inline-recursive-2
: inline-recursive-1 ( -- ) inline-recursive-2 ;
: inline-recursive-2 ( -- ) inline-recursive-1 ;

2
basis/tools/disassembler/gdb/tags.txt
View File

@ -1 +1 @@
untested
not loaded

2
basis/tools/disassembler/udis/tags.txt
View File

@ -1 +1 @@
untested
not loaded

20
basis/tools/test/test.factor
View File

@ -2,11 +2,12 @@
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays assocs combinators compiler.units
continuations debugger effects fry generalizations io io.files
io.styles kernel lexer locals macros math.parser namespaces parser
vocabs.parser prettyprint quotations sequences source-files splitting
stack-checker summary unicode.case vectors vocabs vocabs.loader
vocabs.files words tools.errors source-files.errors io.streams.string
make compiler.errors ;
io.styles kernel lexer locals macros math.parser namespaces
parser vocabs.parser prettyprint quotations sequences
source-files splitting stack-checker summary unicode.case
vectors vocabs vocabs.loader vocabs.files vocabs.metadata words
tools.errors source-files.errors io.streams.string make
compiler.errors ;
IN: tools.test
TUPLE: test-failure < source-file-error continuation ;
@ -126,7 +127,7 @@ SYMBOL: forget-tests?
forget-tests? get
[ [ [ forget-source ] each ] with-compilation-unit ] [ drop ] if ;
: run-vocab-tests ( vocab -- )
: test-vocab ( vocab -- )
vocab dup [
dup source-loaded?>> [
vocab-tests
@ -136,6 +137,8 @@ SYMBOL: forget-tests?
] [ drop ] if
] [ drop ] if ;
: test-vocabs ( vocabs -- ) [ test-vocab ] each ;
PRIVATE>
TEST: unit-test
@ -154,7 +157,6 @@ M: test-failure error. ( error -- )
: :test-failures ( -- ) test-failures get errors. ;
: test ( prefix -- )
child-vocabs [ run-vocab-tests ] each ;
: test ( prefix -- ) child-vocabs test-vocabs ;
: test-all ( -- ) "" test ;
: test-all ( -- ) vocabs filter-don't-test test-vocabs ;

2
basis/ui/backend/x11/tags.txt
View File

@ -1 +1 @@
untested
not loaded

8
basis/ui/tools/error-list/error-list.factor
View File

@ -66,8 +66,8 @@ M: source-file-renderer filled-column drop 1 ;
[ invoke-primary-operation ] >>action
COLOR: dark-gray >>column-line-color
6 >>gap
5 >>min-rows
5 >>max-rows
4 >>min-rows
4 >>max-rows
60 >>min-cols
60 >>max-cols
t >>selection-required?
@ -115,8 +115,8 @@ M: error-renderer column-alignment drop { 0 1 0 0 } ;
[ invoke-primary-operation ] >>action
COLOR: dark-gray >>column-line-color
6 >>gap
5 >>min-rows
5 >>max-rows
4 >>min-rows
4 >>max-rows
60 >>min-cols
60 >>max-cols
t >>selection-required?

2
basis/unix/stat/linux/32/tags.txt
View File

@ -1 +1 @@
untested
not loaded

2
basis/unix/stat/linux/64/tags.txt
View File

@ -1 +1 @@
untested
not loaded

2
basis/unix/stat/netbsd/32/tags.txt
View File

@ -1 +1 @@
untested
not loaded

2
basis/unix/stat/netbsd/64/tags.txt
View File

@ -1 +1 @@
untested
not loaded

2
basis/unix/types/netbsd/32/tags.txt
View File

@ -1 +1 @@
untested
not loaded

2
basis/unix/types/netbsd/64/tags.txt
View File

@ -1 +1 @@
untested
not loaded

5
basis/vocabs/hierarchy/hierarchy.factor
View File

@ -97,9 +97,6 @@ MEMO: all-vocabs-recursive ( -- assoc )
<PRIVATE
: filter-unportable ( seq -- seq' )
[ vocab-name unportable? not ] filter ;
: collect-vocabs ( quot -- seq )
[ all-vocabs-recursive no-roots no-prefixes ] dip
gather natural-sort ; inline
@ -109,7 +106,7 @@ PRIVATE>
: (load) ( prefix -- failures )
[ child-vocabs-recursive no-roots no-prefixes ]
[ dup find-vocab-root [ >vocab-link prefix ] [ drop ] if ] bi
filter-unportable
filter-don't-load
require-all ;
: load ( prefix -- )

13
basis/vocabs/metadata/metadata.factor
View File

@ -103,12 +103,21 @@ ERROR: bad-platform name ;
: supported-platform? ( platforms -- ? )
[ t ] [ [ os swap class<= ] any? ] if-empty ;
: unportable? ( vocab -- ? )
: don't-load? ( vocab -- ? )
{
[ vocab-tags "untested" swap member? ]
[ vocab-tags "not loaded" swap member? ]
[ vocab-platforms supported-platform? not ]
} 1|| ;
: filter-don't-load ( vocabs -- vocabs' )
[ vocab-name don't-load? not ] filter ;
: don't-test? ( vocab -- ? )
vocab-tags "not tested" swap member? ;
: filter-don't-test ( vocabs -- vocabs' )
[ don't-test? not ] filter ;
TUPLE: unsupported-platform vocab requires ;
: unsupported-platform ( vocab requires -- )

17
core/hash-sets/hash-sets.factor
View File

@ -16,13 +16,22 @@ M: hash-set in? table>> key? ; inline
M: hash-set adjoin table>> dupd set-at ; inline
M: hash-set delete table>> delete-at ; inline
M: hash-set members table>> keys ; inline
M: hash-set set-like
drop dup hash-set? [ members <hash-set> ] unless ;
M: hash-set clone
table>> clone hash-set boa ;
M: hash-set set-like drop dup hash-set? [ members <hash-set> ] unless ;
M: hash-set clone table>> clone hash-set boa ;
M: sequence fast-set <hash-set> ;
M: f fast-set drop H{ } clone hash-set boa ;
M: sequence duplicates
f fast-set [ [ in? ] [ adjoin ] 2bi ] curry filter ;
<PRIVATE
: (all-unique?) ( elt hash -- ? )
2dup in? [ 2drop f ] [ adjoin t ] if ; inline
PRIVATE>
M: sequence all-unique?
dup length <hashtable> hash-set boa
[ (all-unique?) ] curry all? ;

10
core/io/files/files-tests.factor
View File

@ -3,7 +3,9 @@ debugger.threads destructors generic.single io io.directories
io.encodings.8-bit.latin1 io.encodings.ascii
io.encodings.binary io.encodings.string io.files
io.files.private io.files.temp io.files.unique kernel make math
sequences specialized-arrays system threads tools.test ;
sequences specialized-arrays system threads tools.test vocabs
compiler.units ;
FROM: specialized-arrays.private => specialized-array-vocab ;
SPECIALIZED-ARRAY: int
IN: io.files.tests
@ -119,6 +121,12 @@ CONSTANT: pt-array-1
pt-array-1 rest-slice sequence=
] unit-test
[ ] [
[
pt specialized-array-vocab forget-vocab
] with-compilation-unit
] unit-test
! Writing strings to binary streams should fail
[
"test.txt" temp-file binary [

3
core/sets/sets.factor
View File

@ -92,9 +92,6 @@ M: sequence set-like
M: sequence members
[ pruned ] keep like ;
M: sequence all-unique?
dup pruned sequence= ;
: combine ( sets -- set )
[ f ]
[ [ [ members ] map concat ] [ first ] bi set-like ]

2
core/vocabs/loader/test/a/tags.txt
View File

@ -1 +1 @@
untested
not loaded

2
core/vocabs/loader/test/b/tags.txt
View File

@ -1 +1 @@
untested
not loaded

2
core/vocabs/loader/test/c/tags.txt
View File

@ -1 +1 @@
untested
not loaded

2
core/vocabs/loader/test/d/tags.txt
View File

@ -1 +1 @@
untested
not loaded

2
core/vocabs/loader/test/e/tags.txt
View File

@ -1 +1 @@
untested
not loaded

2
core/vocabs/loader/test/f/tags.txt
View File

@ -1 +1 @@
untested
not loaded

2
core/vocabs/loader/test/g/tags.txt
View File

@ -1 +1 @@
untested
not loaded

2
core/vocabs/loader/test/h/tags.txt
View File

@ -1 +1 @@
untested
not loaded

2
core/vocabs/loader/test/i/tags.txt
View File

@ -1 +1 @@
untested
not loaded

2
core/vocabs/loader/test/j/tags.txt
View File

@ -1 +1 @@
untested
not loaded

2
core/vocabs/loader/test/k/tags.txt
View File

@ -1 +1 @@
untested
not loaded

2
core/vocabs/loader/test/l/tags.txt
View File

@ -1 +1 @@
untested
not loaded

2
core/vocabs/loader/test/m/tags.txt
View File

@ -1 +1 @@
untested
not loaded

2
core/vocabs/loader/test/n/tags.txt
View File

@ -1 +1 @@
untested
not loaded

2
core/vocabs/loader/test/o/tags.txt
View File

@ -1 +1 @@
untested
not loaded

1
extra/bit/ly/authors.txt Normal file
View File

@ -0,0 +1 @@
Slava Pestov

33
extra/bit/ly/ly.factor Normal file
View File

@ -0,0 +1,33 @@
! Copyright (C) 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: assocs http.client json.reader kernel namespaces urls ;
IN: bit.ly
SYMBOLS: login api-key ;
<PRIVATE
: of ( assoc key -- value ) swap at ;
: make-request ( long-url -- request )
"http://api.bit.ly/v3/shorten" >url
login get "login" set-query-param
api-key get "apiKey" set-query-param
"json" "format" set-query-param
swap "longUrl" set-query-param ;
ERROR: bad-response json status ;
: check-response ( json -- json )
dup "status_code" of 200 = [
dup "status_txt" of
bad-response
] unless ;
: parse-response ( response data -- short-url )
nip json> check-response "data" of "url" of ;
PRIVATE>
: shorten-url ( long-url -- short-url )
make-request http-get parse-response ;

1
extra/bit/ly/summary.txt Normal file
View File

@ -0,0 +1 @@
Wrapper for bit.ly URL shortening web service

1
extra/bit/ly/tags.txt Normal file
View File

@ -0,0 +1 @@
web services

9
extra/classes/struct/vectored/vectored-tests.factor
View File

@ -1,6 +1,7 @@
! (c)2009 Joe Groff bsd license
USING: accessors alien.c-types classes.struct classes.struct.vectored
kernel sequences specialized-arrays tools.test ;
kernel sequences specialized-arrays tools.test vocabs compiler.units ;
FROM: specialized-arrays.private => specialized-array-vocab ;
SPECIALIZED-ARRAYS: int ushort float ;
IN: classes.struct.vectored.tests
@ -71,3 +72,9 @@ VECTORED-STRUCT: foo
{ w ushort-array{ 15 25 35 45 } }
} third vectored-element>
] unit-test
[ ] [
[
foo specialized-array-vocab forget-vocab
] with-compilation-unit
] unit-test

2
extra/couchdb/tags.txt
View File

@ -1 +1 @@
untested
not tested

1
extra/cuda/authors.txt Normal file
View File

@ -0,0 +1 @@
Doug Coleman

7
extra/cuda/cuda-tests.factor Normal file
View File

@ -0,0 +1,7 @@
! Copyright (C) 2010 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: cuda kernel tools.test ;
IN: cuda.tests
! [ ] [ [ 0 0 [ drop ] with-cuda-context ] with-cuda ] unit-test
! [ ] [ 100 cuda-malloc cuda-free ] unit-test

77
extra/cuda/cuda.factor Normal file
View File

@ -0,0 +1,77 @@
! Copyright (C) 2010 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: alien.c-types alien.data assocs classes.struct
combinators continuations cuda.ffi fry io.backend kernel
sequences ;
IN: cuda
ERROR: throw-cuda-error n ;
: cuda-error ( n -- )
{
{ CUDA_SUCCESS [ ] }
[ throw-cuda-error ]
} case ;
: cuda-version ( -- n )
int <c-object> [ cuDriverGetVersion cuda-error ] keep *int ;
: init-cuda ( -- )
0 cuInit cuda-error ;
: with-cuda ( quot -- )
init-cuda [ ] [ ] cleanup ; inline
<PRIVATE
: #cuda-devices ( -- n )
int <c-object> [ cuDeviceGetCount cuda-error ] keep *int ;
: n>cuda-device ( n -- device )
[ CUdevice <c-object> ] dip [ cuDeviceGet cuda-error ] 2keep drop *int ;
: enumerate-cuda-devices ( -- devices )
#cuda-devices iota [ n>cuda-device ] map ;
: cuda-device>properties ( device -- properties )
[ CUdevprop <c-object> ] dip
[ cuDeviceGetProperties cuda-error ] 2keep drop
CUdevprop memory>struct ;
: cuda-device-properties ( -- properties )
enumerate-cuda-devices [ cuda-device>properties ] map ;
PRIVATE>
: cuda-devices ( -- assoc )
enumerate-cuda-devices [ dup cuda-device>properties ] { } map>assoc ;
: with-cuda-context ( flags device quot -- )
[
[ CUcontext <c-object> ] 2dip
[ cuCtxCreate cuda-error ] 3keep 2drop *void*
] dip
[ '[ _ @ ] ]
[ drop '[ _ cuCtxDestroy cuda-error ] ] 2bi
[ ] cleanup ; inline
: with-cuda-module ( path quot -- )
[
normalize-path
[ CUmodule <c-object> ] dip
[ cuModuleLoad cuda-error ] 2keep drop *void*
] dip
[ '[ _ @ ] ]
[ drop '[ _ cuModuleUnload cuda-error ] ] 2bi
[ ] cleanup ; inline
: get-cuda-function ( module string -- function )
[ CUfunction <c-object> ] 2dip
[ cuModuleGetFunction cuda-error ] 3keep 2drop *void* ;
: cuda-malloc ( n -- ptr )
[ CUdeviceptr <c-object> ] dip
[ cuMemAlloc cuda-error ] 2keep drop *int ;
: cuda-free ( ptr -- )
cuMemFree cuda-error ;

4
extra/cuda/ffi/ffi.factor
View File

@ -307,12 +307,12 @@ FUNCTION: CUresult cuCtxPopCurrent ( CUcontext* pctx ) ;
FUNCTION: CUresult cuCtxGetDevice ( CUdevice* device ) ;
FUNCTION: CUresult cuCtxSynchronize ( ) ;
FUNCTION: CUresult cuModuleLoad ( CUmodule* module, char* fname ) ;
FUNCTION: CUresult cuModuleLoad ( CUmodule* module, c-string fname ) ;
FUNCTION: CUresult cuModuleLoadData ( CUmodule* module, void* image ) ;
FUNCTION: CUresult cuModuleLoadDataEx ( CUmodule* module, void* image, uint numOptions, CUjit_option* options, void** optionValues ) ;
FUNCTION: CUresult cuModuleLoadFatBinary ( CUmodule* module, void* fatCubin ) ;
FUNCTION: CUresult cuModuleUnload ( CUmodule hmod ) ;
FUNCTION: CUresult cuModuleGetFunction ( CUfunction* hfunc, CUmodule hmod, char* name ) ;
FUNCTION: CUresult cuModuleGetFunction ( CUfunction* hfunc, CUmodule hmod, c-string name ) ;
FUNCTION: CUresult cuModuleGetGlobal ( CUdeviceptr* dptr, uint* bytes, CUmodule hmod, char* name ) ;
FUNCTION: CUresult cuModuleGetTexRef ( CUtexref* pTexRef, CUmodule hmod, char* name ) ;

1
extra/cuda/ffi/tags.txt Normal file
View File

@ -0,0 +1 @@
not tested

1
extra/cuda/tags.txt Normal file
View File

@ -0,0 +1 @@
not tested

2
extra/ecdsa/tags.txt
View File

@ -1 +1 @@
untested
not tested

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

@ -1,6 +1,6 @@
! Copyright (C) 2009 Matthew Willis.
! See http://factorcode.org/license.txt for BSD license.
USING: alien.libraries alien.syntax system sequences combinators kernel alien.c-types ;
USING: alien alien.libraries alien.syntax system sequences combinators kernel alien.c-types ;
IN: llvm.core

2
extra/llvm/core/tags.txt
View File

@ -1 +1 @@
untested
not tested

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

@ -1,6 +1,6 @@
! Copyright (C) 2009 Matthew Willis.
! See http://factorcode.org/license.txt for BSD license.
USING: alien.libraries alien.syntax llvm.core ;
USING: alien.c-types alien.libraries alien.syntax llvm.core ;
IN: llvm.engine
<<

2
extra/llvm/engine/tags.txt
View File

@ -1 +1 @@
untested
not tested

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

@ -45,7 +45,7 @@ TUPLE: function name alien return params ;
] [ ] make swap function-effect [ define-declared ] with-compilation-unit ;
: install-module ( name -- )
thejit get mps>> at [
current-jit mps>> at [
module>> functions [ install-function ] each
] [ "no such module" throw ] if* ;

2
extra/llvm/invoker/tags.txt
View File

@ -1 +1 @@
untested
not tested

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

@ -5,8 +5,6 @@ kernel llvm.core llvm.engine llvm.wrappers namespaces ;
IN: llvm.jit
SYMBOL: thejit
TUPLE: jit ee mps ;
: empty-engine ( -- engine )
@ -15,8 +13,11 @@ TUPLE: jit ee mps ;
: <jit> ( -- jit )
jit new empty-engine >>ee H{ } clone >>mps ;
: current-jit ( -- jit )
\ current-jit global [ drop <jit> ] cache ;
: (remove-functions) ( function -- )
thejit get ee>> value>> over LLVMFreeMachineCodeForFunction
current-jit ee>> value>> over LLVMFreeMachineCodeForFunction
LLVMGetNextFunction dup ALIEN: 0 = [ drop ] [ (remove-functions) ] if ;
: remove-functions ( module -- )
@ -24,26 +25,24 @@ TUPLE: jit ee mps ;
LLVMGetFirstFunction dup ALIEN: 0 = [ drop ] [ (remove-functions) ] if ;
: remove-provider ( provider -- )
thejit get ee>> value>> swap value>> f <void*> f <void*>
current-jit ee>> value>> swap value>> f <void*> f <void*>
[ LLVMRemoveModuleProvider drop ] 2keep *void* [ llvm-throw ] when*
*void* module new swap >>value
[ value>> remove-functions ] with-disposal ;
: remove-module ( name -- )
dup thejit get mps>> at [
dup current-jit mps>> at [
remove-provider
thejit get mps>> delete-at
current-jit mps>> delete-at
] [ drop ] if* ;
: add-module ( module name -- )
[ <provider> ] dip [ remove-module ] keep
thejit get ee>> value>> pick
current-jit ee>> value>> pick
[ [ value>> LLVMAddModuleProvider ] [ t >>disposed drop ] bi ] with-disposal
thejit get mps>> set-at ;
current-jit mps>> set-at ;
: function-pointer ( name -- alien )
thejit get ee>> value>> dup
current-jit ee>> value>> dup
rot f <void*> [ LLVMFindFunction drop ] keep
*void* LLVMGetPointerToGlobal ;
thejit [ <jit> ] initialize
*void* LLVMGetPointerToGlobal ;

2
extra/llvm/jit/tags.txt
View File

@ -1 +1 @@
untested
not tested

2
extra/llvm/reader/tags.txt
View File

@ -1 +1 @@
untested
not tested

2
extra/llvm/tags.txt
View File

@ -1,2 +1,2 @@
bindings
untested
not tested

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