Merge branch 'master' of factorcode.org:/git/factor
Joe Groff
commit
4022ceda8d
|
|
@ -6,7 +6,7 @@ parser.notes lexer strings.parser vocabs sequences sequences.deep
|
|||
sequences.private words memory kernel.private continuations io
|
||||
vocabs.loader system strings sets vectors quotations byte-arrays
|
||||
sorting compiler.units definitions generic generic.standard
|
||||
generic.single tools.deploy.config combinators classes
|
||||
generic.single tools.deploy.config combinators classes vocabs.loader.private
|
||||
classes.builtin slots.private grouping command-line io.pathnames ;
|
||||
QUALIFIED: bootstrap.stage2
|
||||
QUALIFIED: classes.private
|
||||
|
|
@ -349,6 +349,8 @@ IN: tools.deploy.shaker
|
|||
lexer-factory
|
||||
print-use-hook
|
||||
root-cache
|
||||
require-when-vocabs
|
||||
require-when-table
|
||||
source-files.errors:error-types
|
||||
source-files.errors:error-observers
|
||||
vocabs:dictionary
|
||||
|
|
|
|||
|
|
@ -25,7 +25,7 @@ test_program_installed() {
|
|||
|
||||
exit_script() {
|
||||
if [[ $FIND_MAKE_TARGET -eq true ]] ; then
|
||||
echo $MAKE_TARGET;
|
||||
$ECHO $MAKE_TARGET;
|
||||
fi
|
||||
exit $1
|
||||
}
|
||||
|
|
@ -37,7 +37,7 @@ ensure_program_installed() {
|
|||
$ECHO -n "Checking for $i..."
|
||||
test_program_installed $i
|
||||
if [[ $? -eq 0 ]]; then
|
||||
echo -n "not "
|
||||
$ECHO -n "not "
|
||||
else
|
||||
installed=$(( $installed + 1 ))
|
||||
fi
|
||||
|
|
@ -194,8 +194,8 @@ find_architecture() {
|
|||
}
|
||||
|
||||
write_test_program() {
|
||||
echo "#include <stdio.h>" > $C_WORD.c
|
||||
echo "int main(){printf(\"%ld\", (long)(8*sizeof(void*))); return 0; }" >> $C_WORD.c
|
||||
$ECHO "#include <stdio.h>" > $C_WORD.c
|
||||
$ECHO "int main(){printf(\"%ld\", (long)(8*sizeof(void*))); return 0; }" >> $C_WORD.c
|
||||
}
|
||||
|
||||
c_find_word_size() {
|
||||
|
|
@ -247,6 +247,7 @@ set_factor_library() {
|
|||
|
||||
set_factor_image() {
|
||||
FACTOR_IMAGE=factor.image
|
||||
FACTOR_IMAGE_FRESH=factor.image.fresh
|
||||
}
|
||||
|
||||
echo_build_info() {
|
||||
|
|
@ -275,7 +276,7 @@ check_os_arch_word() {
|
|||
$ECHO "WORD: $WORD"
|
||||
$ECHO "OS, ARCH, or WORD is empty. Please report this."
|
||||
|
||||
echo $MAKE_TARGET
|
||||
$ECHO $MAKE_TARGET
|
||||
exit_script 5
|
||||
fi
|
||||
}
|
||||
|
|
@ -344,22 +345,22 @@ invoke_git() {
|
|||
}
|
||||
|
||||
git_clone() {
|
||||
echo "Downloading the git repository from factorcode.org..."
|
||||
$ECHO "Downloading the git repository from factorcode.org..."
|
||||
invoke_git clone $GIT_URL
|
||||
}
|
||||
|
||||
update_script_name() {
|
||||
echo `dirname $0`/_update.sh
|
||||
$ECHO `dirname $0`/_update.sh
|
||||
}
|
||||
|
||||
update_script() {
|
||||
update_script=`update_script_name`
|
||||
bash_path=`which bash`
|
||||
echo "#!$bash_path" >"$update_script"
|
||||
echo "git pull \"$GIT_URL\" master" >>"$update_script"
|
||||
echo "if [[ \$? -eq 0 ]]; then exec \"$0\" $SCRIPT_ARGS; else echo \"git pull failed\"; exit 2; fi" \
|
||||
$ECHO "#!$bash_path" >"$update_script"
|
||||
$ECHO "git pull \"$GIT_URL\" master" >>"$update_script"
|
||||
$ECHO "if [[ \$? -eq 0 ]]; then exec \"$0\" $SCRIPT_ARGS; else echo \"git pull failed\"; exit 2; fi" \
|
||||
>>"$update_script"
|
||||
echo "exit 0" >>"$update_script"
|
||||
$ECHO "exit 0" >>"$update_script"
|
||||
|
||||
chmod 755 "$update_script"
|
||||
exec "$update_script"
|
||||
|
|
@ -370,16 +371,16 @@ update_script_changed() {
|
|||
}
|
||||
|
||||
git_fetch_factorcode() {
|
||||
echo "Fetching the git repository from factorcode.org..."
|
||||
$ECHO "Fetching the git repository from factorcode.org..."
|
||||
|
||||
rm -f `update_script_name`
|
||||
invoke_git fetch "$GIT_URL" master
|
||||
|
||||
if update_script_changed; then
|
||||
echo "Updating and restarting the factor.sh script..."
|
||||
$ECHO "Updating and restarting the factor.sh script..."
|
||||
update_script
|
||||
else
|
||||
echo "Updating the working tree..."
|
||||
$ECHO "Updating the working tree..."
|
||||
invoke_git pull "$GIT_URL" master
|
||||
fi
|
||||
}
|
||||
|
|
@ -414,11 +415,11 @@ backup_factor() {
|
|||
|
||||
check_makefile_exists() {
|
||||
if [[ ! -e "GNUmakefile" ]] ; then
|
||||
echo ""
|
||||
echo "***GNUmakefile not found***"
|
||||
echo "You are likely in the wrong directory."
|
||||
echo "Run this script from your factor directory:"
|
||||
echo " ./build-support/factor.sh"
|
||||
$ECHO ""
|
||||
$ECHO "***GNUmakefile not found***"
|
||||
$ECHO "You are likely in the wrong directory."
|
||||
$ECHO "Run this script from your factor directory:"
|
||||
$ECHO " ./build-support/factor.sh"
|
||||
exit_script 6
|
||||
fi
|
||||
}
|
||||
|
|
@ -438,7 +439,7 @@ make_factor() {
|
|||
}
|
||||
|
||||
update_boot_images() {
|
||||
echo "Deleting old images..."
|
||||
$ECHO "Deleting old images..."
|
||||
$DELETE checksums.txt* > /dev/null 2>&1
|
||||
# delete boot images with one or two characters after the dot
|
||||
$DELETE $BOOT_IMAGE.{?,??} > /dev/null 2>&1
|
||||
|
|
@ -451,10 +452,10 @@ update_boot_images() {
|
|||
netbsd) disk_md5=`md5 $BOOT_IMAGE | cut -f4 -d' '`;;
|
||||
*) disk_md5=`$MD5SUM $BOOT_IMAGE|cut -f1 -d' '` ;;
|
||||
esac
|
||||
echo "Factorcode md5: $factorcode_md5";
|
||||
echo "Disk md5: $disk_md5";
|
||||
$ECHO "Factorcode md5: $factorcode_md5";
|
||||
$ECHO "Disk md5: $disk_md5";
|
||||
if [[ "$factorcode_md5" == "$disk_md5" ]] ; then
|
||||
echo "Your disk boot image matches the one on factorcode.org."
|
||||
$ECHO "Your disk boot image matches the one on factorcode.org."
|
||||
else
|
||||
$DELETE $BOOT_IMAGE > /dev/null 2>&1
|
||||
get_boot_image;
|
||||
|
|
@ -465,7 +466,7 @@ update_boot_images() {
|
|||
}
|
||||
|
||||
get_boot_image() {
|
||||
echo "Downloading boot image $BOOT_IMAGE."
|
||||
$ECHO "Downloading boot image $BOOT_IMAGE."
|
||||
get_url http://factorcode.org/images/latest/$BOOT_IMAGE
|
||||
}
|
||||
|
||||
|
|
@ -473,7 +474,7 @@ get_url() {
|
|||
if [[ $DOWNLOADER -eq "" ]] ; then
|
||||
set_downloader;
|
||||
fi
|
||||
echo $DOWNLOADER $1 ;
|
||||
$ECHO $DOWNLOADER $1 ;
|
||||
$DOWNLOADER $1
|
||||
check_ret $DOWNLOADER
|
||||
}
|
||||
|
|
@ -484,8 +485,14 @@ get_config_info() {
|
|||
check_libraries
|
||||
}
|
||||
|
||||
copy_fresh_image() {
|
||||
$ECHO "Copying $FACTOR_IMAGE to $FACTOR_IMAGE_FRESH..."
|
||||
$COPY $FACTOR_IMAGE $FACTOR_IMAGE_FRESH
|
||||
}
|
||||
|
||||
bootstrap() {
|
||||
./$FACTOR_BINARY -i=$BOOT_IMAGE
|
||||
copy_fresh_image
|
||||
}
|
||||
|
||||
install() {
|
||||
|
|
@ -532,22 +539,22 @@ install_build_system_port() {
|
|||
test_program_installed git
|
||||
if [[ $? -ne 1 ]] ; then
|
||||
ensure_program_installed yes
|
||||
echo "git not found."
|
||||
echo "This script requires either git-core or port."
|
||||
echo "If it fails, install git-core or port and try again."
|
||||
$ECHO "git not found."
|
||||
$ECHO "This script requires either git-core or port."
|
||||
$ECHO "If it fails, install git-core or port and try again."
|
||||
ensure_program_installed port
|
||||
echo "Installing git-core with port...this will take awhile."
|
||||
$ECHO "Installing git-core with port...this will take awhile."
|
||||
yes | sudo port install git-core
|
||||
fi
|
||||
}
|
||||
|
||||
usage() {
|
||||
echo "usage: $0 install|install-x11|install-macosx|self-update|quick-update|update|bootstrap|dlls|net-bootstrap|make-target|report [optional-target]"
|
||||
echo "If you are behind a firewall, invoke as:"
|
||||
echo "env GIT_PROTOCOL=http $0 <command>"
|
||||
echo ""
|
||||
echo "Example for overriding the default target:"
|
||||
echo " $0 update macosx-x86-32"
|
||||
$ECHO "usage: $0 install|install-x11|install-macosx|self-update|quick-update|update|bootstrap|dlls|net-bootstrap|make-target|report [optional-target]"
|
||||
$ECHO "If you are behind a firewall, invoke as:"
|
||||
$ECHO "env GIT_PROTOCOL=http $0 <command>"
|
||||
$ECHO ""
|
||||
$ECHO "Example for overriding the default target:"
|
||||
$ECHO " $0 update macosx-x86-32"
|
||||
}
|
||||
|
||||
MAKE_TARGET=unknown
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
! Copyright (C) 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: tools.test constructors calendar kernel accessors
|
||||
combinators.short-circuit initializers math ;
|
||||
USING: accessors calendar combinators.short-circuit
|
||||
constructors eval initializers kernel math tools.test ;
|
||||
IN: constructors.tests
|
||||
|
||||
TUPLE: stock-spread stock spread timestamp ;
|
||||
|
|
@ -41,3 +41,21 @@ CONSTRUCTOR: ct4 ( a b c d -- obj )
|
|||
[ 2 ] [ 0 0 <ct2> a>> ] unit-test
|
||||
[ 3 ] [ 0 0 0 <ct3> a>> ] unit-test
|
||||
[ 4 ] [ 0 0 0 0 <ct4> a>> ] unit-test
|
||||
|
||||
[
|
||||
"""USE: constructors
|
||||
IN: constructors.tests
|
||||
TUPLE: foo a b ;
|
||||
CONSTRUCTOR: foo ( a a -- obj ) ;""" eval( -- )
|
||||
] [
|
||||
error>> repeated-constructor-parameters?
|
||||
] must-fail-with
|
||||
|
||||
[
|
||||
"""USE: constructors
|
||||
IN: constructors.tests
|
||||
TUPLE: foo a b ;
|
||||
CONSTRUCTOR: foo ( a c -- obj ) ;""" eval( -- )
|
||||
] [
|
||||
error>> unknown-constructor-parameters?
|
||||
] must-fail-with
|
||||
|
|
|
|||
|
|
@ -1,8 +1,8 @@
|
|||
! Copyright (C) 2009 Slava Pestov, Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors assocs classes classes.tuple effects.parser
|
||||
fry generalizations generic.standard kernel lexer locals macros
|
||||
parser sequences slots vocabs words arrays ;
|
||||
USING: accessors arrays assocs classes classes.tuple
|
||||
effects.parser fry generalizations generic.standard kernel
|
||||
lexer locals macros parser sequences sets slots vocabs words ;
|
||||
IN: constructors
|
||||
|
||||
! An experiment
|
||||
|
|
@ -38,6 +38,15 @@ MACRO:: slots>constructor ( class slots -- quot )
|
|||
default-params swap assoc-union values _ firstn class boa
|
||||
] ;
|
||||
|
||||
ERROR: repeated-constructor-parameters class effect ;
|
||||
|
||||
ERROR: unknown-constructor-parameters class effect unknown ;
|
||||
|
||||
: ensure-constructor-parameters ( class effect -- class effect )
|
||||
dup in>> all-unique? [ repeated-constructor-parameters ] unless
|
||||
2dup [ all-slots [ name>> ] map ] [ in>> ] bi* swap diff
|
||||
[ unknown-constructor-parameters ] unless-empty ;
|
||||
|
||||
:: (define-constructor) ( constructor-word class effect def -- word quot )
|
||||
constructor-word
|
||||
class def define-initializer
|
||||
|
|
@ -53,7 +62,8 @@ MACRO:: slots>constructor ( class slots -- quot )
|
|||
scan-word [ name>> "<" ">" surround create-in dup reset-generic ] keep ;
|
||||
|
||||
: parse-constructor ( -- class word effect def )
|
||||
scan-constructor complete-effect parse-definition ;
|
||||
scan-constructor complete-effect ensure-constructor-parameters
|
||||
parse-definition ;
|
||||
|
||||
SYNTAX: CONSTRUCTOR: parse-constructor f define-constructor ;
|
||||
|
||||
|
|
|
|||
|
|
@ -3,10 +3,10 @@
|
|||
USING: accessors alien alien.data alien.parser alien.strings
|
||||
alien.syntax arrays assocs byte-arrays classes.struct
|
||||
combinators continuations cuda.ffi cuda.memory cuda.utils
|
||||
destructors fry io io.backend io.encodings.string
|
||||
destructors fry init io io.backend io.encodings.string
|
||||
io.encodings.utf8 kernel lexer locals macros math math.parser
|
||||
namespaces nested-comments opengl.gl.extensions parser
|
||||
prettyprint quotations sequences words ;
|
||||
prettyprint quotations sequences words cuda.libraries ;
|
||||
QUALIFIED-WITH: alien.c-types a
|
||||
IN: cuda
|
||||
|
||||
|
|
@ -14,6 +14,10 @@ TUPLE: launcher
|
|||
{ device integer initial: 0 }
|
||||
{ device-flags initial: 0 } ;
|
||||
|
||||
: <launcher> ( device-id -- launcher )
|
||||
launcher new
|
||||
swap >>device ; inline
|
||||
|
||||
TUPLE: function-launcher
|
||||
dim-block dim-grid shared-size stream ;
|
||||
|
||||
|
|
|
|||
|
|
@ -1,21 +1,23 @@
|
|||
! Copyright (C) 2010 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: alien.c-types alien.strings cuda cuda.memory cuda.syntax
|
||||
destructors io io.encodings.utf8 kernel locals math sequences ;
|
||||
USING: accessors alien.c-types alien.strings cuda cuda.devices
|
||||
cuda.memory cuda.syntax cuda.utils destructors io
|
||||
io.encodings.string io.encodings.utf8 kernel locals math
|
||||
math.parser namespaces sequences ;
|
||||
IN: cuda.demos.hello-world
|
||||
|
||||
CUDA-LIBRARY: hello vocab:cuda/demos/hello-world/hello.ptx
|
||||
|
||||
CUDA-FUNCTION: helloWorld ( char* string-ptr ) ;
|
||||
|
||||
:: cuda-hello-world ( -- )
|
||||
T{ launcher { device 0 } } [
|
||||
"Hello World!" [ - ] map-index malloc-device-string
|
||||
&dispose dup :> str
|
||||
: cuda-hello-world ( -- )
|
||||
[
|
||||
cuda-launcher get device>> number>string
|
||||
"CUDA device " ": " surround write
|
||||
"Hello World!" [ - ] map-index host>device
|
||||
|
||||
{ 6 1 1 } { 2 1 } 1 3<<< helloWorld
|
||||
|
||||
str device>host utf8 alien>string print
|
||||
] with-cuda ;
|
||||
[ { 6 1 1 } { 2 1 } 2<<< helloWorld ]
|
||||
[ device>host utf8 decode print ] bi
|
||||
] with-each-cuda-device ;
|
||||
|
||||
MAIN: cuda-hello-world
|
||||
|
|
|
|||
|
|
@ -1,20 +1,27 @@
|
|||
! Copyright (C) 2010 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: alien.c-types alien.data alien.strings arrays assocs
|
||||
byte-arrays classes.struct combinators cuda.ffi cuda.utils io
|
||||
io.encodings.utf8 kernel math.parser prettyprint sequences ;
|
||||
byte-arrays classes.struct combinators cuda cuda.ffi cuda.utils
|
||||
fry io io.encodings.utf8 kernel math.parser prettyprint
|
||||
sequences ;
|
||||
IN: cuda.devices
|
||||
|
||||
: #cuda-devices ( -- n )
|
||||
init-cuda
|
||||
int <c-object> [ cuDeviceGetCount cuda-error ] keep *int ;
|
||||
|
||||
: n>cuda-device ( n -- device )
|
||||
init-cuda
|
||||
[ 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 )
|
||||
: with-each-cuda-device ( quot -- )
|
||||
[ enumerate-cuda-devices ] dip '[ <launcher> _ with-cuda ] each ; inline
|
||||
|
||||
: cuda-device-properties ( n -- properties )
|
||||
init-cuda
|
||||
[ CUdevprop <c-object> ] dip
|
||||
[ cuDeviceGetProperties cuda-error ] 2keep drop
|
||||
CUdevprop memory>struct ;
|
||||
|
|
@ -23,26 +30,31 @@ IN: cuda.devices
|
|||
enumerate-cuda-devices [ dup cuda-device-properties ] { } map>assoc ;
|
||||
|
||||
: cuda-device-name ( n -- string )
|
||||
init-cuda
|
||||
[ 256 [ <byte-array> ] keep ] dip
|
||||
[ cuDeviceGetName cuda-error ]
|
||||
[ 2drop utf8 alien>string ] 3bi ;
|
||||
|
||||
: cuda-device-capability ( n -- pair )
|
||||
init-cuda
|
||||
[ int <c-object> int <c-object> ] dip
|
||||
[ cuDeviceComputeCapability cuda-error ]
|
||||
[ drop [ *int ] bi@ ] 3bi 2array ;
|
||||
|
||||
: cuda-device-memory ( n -- bytes )
|
||||
init-cuda
|
||||
[ uint <c-object> ] dip
|
||||
[ cuDeviceTotalMem cuda-error ]
|
||||
[ drop *uint ] 2bi ;
|
||||
|
||||
: cuda-device-attribute ( attribute dev -- n )
|
||||
: cuda-device-attribute ( attribute n -- n )
|
||||
init-cuda
|
||||
[ int <c-object> ] 2dip
|
||||
[ cuDeviceGetAttribute cuda-error ]
|
||||
[ 2drop *int ] 3bi ;
|
||||
|
||||
: cuda-device. ( n -- )
|
||||
init-cuda
|
||||
{
|
||||
[ "Device: " write number>string print ]
|
||||
[ "Name: " write cuda-device-name print ]
|
||||
|
|
@ -60,6 +72,7 @@ IN: cuda.devices
|
|||
} cleave ;
|
||||
|
||||
: cuda. ( -- )
|
||||
init-cuda
|
||||
"CUDA Version: " write cuda-version number>string print nl
|
||||
#cuda-devices iota [ nl ] [ cuda-device. ] interleave ;
|
||||
|
||||
|
|
|
|||
|
|
@ -460,4 +460,3 @@ FUNCTION: CUresult cuGraphicsMapResources ( uint count, CUgraphicsResource* reso
|
|||
FUNCTION: CUresult cuGraphicsUnmapResources ( uint count, CUgraphicsResource* resources, CUstream hStream ) ;
|
||||
|
||||
FUNCTION: CUresult cuGetExportTable ( void** ppExportTable, CUuuid* pExportTableId ) ;
|
||||
|
||||
|
|
|
|||
|
|
@ -0,0 +1 @@
|
|||
Doug Coleman
|
||||
|
|
@ -0,0 +1,53 @@
|
|||
! Copyright (C) 2010 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors alien.c-types alien.data arrays assocs
|
||||
cuda.ffi cuda.utils io.backend kernel namespaces sequences ;
|
||||
IN: cuda.libraries
|
||||
|
||||
SYMBOL: cuda-libraries
|
||||
cuda-libraries [ H{ } clone ] initialize
|
||||
|
||||
SYMBOL: current-cuda-library
|
||||
|
||||
TUPLE: cuda-library name path handle ;
|
||||
|
||||
: <cuda-library> ( name path -- obj )
|
||||
\ cuda-library new
|
||||
swap >>path
|
||||
swap >>name ;
|
||||
|
||||
: add-cuda-library ( name path -- )
|
||||
normalize-path <cuda-library>
|
||||
dup name>> cuda-libraries get-global set-at ;
|
||||
|
||||
: ?delete-at ( key assoc -- old/key ? )
|
||||
2dup delete-at* [ 2nip t ] [ 2drop f ] if ; inline
|
||||
|
||||
ERROR: no-cuda-library name ;
|
||||
|
||||
: load-module ( path -- module )
|
||||
[ CUmodule <c-object> ] dip
|
||||
[ cuModuleLoad cuda-error ] 2keep drop *void* ;
|
||||
|
||||
: unload-module ( module -- )
|
||||
cuModuleUnload cuda-error ;
|
||||
|
||||
: load-cuda-library ( library -- handle )
|
||||
path>> load-module ;
|
||||
|
||||
: lookup-cuda-library ( name -- cuda-library )
|
||||
cuda-libraries get ?at [ no-cuda-library ] unless ;
|
||||
|
||||
: remove-cuda-library ( name -- library )
|
||||
cuda-libraries get ?delete-at [ no-cuda-library ] unless ;
|
||||
|
||||
: unload-cuda-library ( name -- )
|
||||
remove-cuda-library handle>> unload-module ;
|
||||
|
||||
: cached-module ( module-name -- alien )
|
||||
lookup-cuda-library
|
||||
cuda-modules get-global [ load-cuda-library ] cache ;
|
||||
|
||||
: cached-function ( module-name function-name -- alien )
|
||||
[ cached-module ] dip
|
||||
2array cuda-functions get [ first2 get-function-ptr* ] cache ;
|
||||
|
|
@ -2,7 +2,7 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors alien alien.data assocs byte-arrays cuda.ffi
|
||||
cuda.utils destructors io.encodings.string io.encodings.utf8
|
||||
kernel locals namespaces sequences ;
|
||||
kernel locals namespaces sequences strings ;
|
||||
QUALIFIED-WITH: alien.c-types a
|
||||
IN: cuda.memory
|
||||
|
||||
|
|
@ -61,14 +61,15 @@ M: cuda-memory dispose ( ptr -- )
|
|||
: memcpy-array>array ( dest-array dest-index src-array src-ptr count -- )
|
||||
cuMemcpyAtoA cuda-error ;
|
||||
|
||||
: host>device ( dest-ptr src-ptr -- )
|
||||
[ ptr>> ] dip dup length cuMemcpyHtoD cuda-error ;
|
||||
GENERIC: host>device ( obj -- ptr )
|
||||
|
||||
M: string host>device utf8 encode host>device ;
|
||||
|
||||
M: byte-array host>device ( byte-array -- ptr )
|
||||
[ length cuda-malloc ] keep
|
||||
[ [ ptr>> ] dip dup length cuMemcpyHtoD cuda-error ]
|
||||
[ drop ] 2bi ;
|
||||
|
||||
:: device>host ( ptr -- seq )
|
||||
ptr byte-length <byte-array>
|
||||
[ ptr [ ptr>> ] [ byte-length ] bi cuMemcpyDtoH cuda-error ] keep ;
|
||||
|
||||
: malloc-device-string ( string -- n )
|
||||
utf8 encode
|
||||
[ length cuda-malloc ] keep
|
||||
[ host>device ] [ drop ] 2bi ;
|
||||
|
|
|
|||
|
|
@ -0,0 +1 @@
|
|||
Doug Coleman
|
||||
|
|
@ -0,0 +1,31 @@
|
|||
! Copyright (C) 2010 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: arrays combinators.smart io.backend io.directories
|
||||
io.launcher io.pathnames kernel locals math sequences splitting
|
||||
system ;
|
||||
IN: cuda.nvcc
|
||||
|
||||
HOOK: nvcc-path os ( -- path )
|
||||
|
||||
M: object nvcc-path "nvcc" ;
|
||||
|
||||
M: macosx nvcc-path "/usr/local/cuda/bin/nvcc" ;
|
||||
|
||||
: cu>ptx ( path -- path' )
|
||||
".cu" ?tail drop ".ptx" append ;
|
||||
|
||||
: nvcc-command ( path -- seq )
|
||||
[
|
||||
[ nvcc-path "--ptx" "-o" ] dip
|
||||
[ cu>ptx ] [ file-name ] bi
|
||||
] output>array ;
|
||||
|
||||
ERROR: nvcc-failed n path ;
|
||||
|
||||
:: compile-cu ( path -- path' )
|
||||
path normalize-path :> path2
|
||||
path2 parent-directory [
|
||||
path2 nvcc-command
|
||||
run-process wait-for-process [ path2 nvcc-failed ] unless-zero
|
||||
path2 cu>ptx
|
||||
] with-directory ;
|
||||
|
|
@ -1,7 +1,7 @@
|
|||
! Copyright (C) 2010 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: alien.parser cuda cuda.utils io.backend kernel lexer
|
||||
namespaces parser ;
|
||||
USING: alien.parser cuda cuda.libraries cuda.utils io.backend
|
||||
kernel lexer namespaces parser ;
|
||||
IN: cuda.syntax
|
||||
|
||||
SYNTAX: CUDA-LIBRARY:
|
||||
|
|
@ -13,6 +13,9 @@ SYNTAX: CUDA-FUNCTION:
|
|||
scan [ create-in current-cuda-library get ] [ ] bi
|
||||
";" scan-c-args drop define-cuda-word ;
|
||||
|
||||
: 2<<< ( dim-block dim-grid -- function-launcher )
|
||||
0 f function-launcher boa ;
|
||||
|
||||
: 3<<< ( dim-block dim-grid shared-size -- function-launcher )
|
||||
f function-launcher boa ;
|
||||
|
||||
|
|
|
|||
|
|
@ -44,55 +44,6 @@ ERROR: throw-cuda-error n ;
|
|||
|
||||
: destroy-context ( context -- ) cuCtxDestroy cuda-error ;
|
||||
|
||||
SYMBOL: cuda-libraries
|
||||
cuda-libraries [ H{ } clone ] initialize
|
||||
|
||||
SYMBOL: current-cuda-library
|
||||
|
||||
TUPLE: cuda-library name path handle ;
|
||||
|
||||
: <cuda-library> ( name path -- obj )
|
||||
\ cuda-library new
|
||||
swap >>path
|
||||
swap >>name ;
|
||||
|
||||
: add-cuda-library ( name path -- )
|
||||
normalize-path <cuda-library>
|
||||
dup name>> cuda-libraries get-global set-at ;
|
||||
|
||||
: ?delete-at ( key assoc -- old/key ? )
|
||||
2dup delete-at* [ 2nip t ] [ 2drop f ] if ; inline
|
||||
|
||||
ERROR: no-cuda-library name ;
|
||||
|
||||
: load-module ( path -- module )
|
||||
[ CUmodule <c-object> ] dip
|
||||
[ cuModuleLoad cuda-error ] 2keep drop *void* ;
|
||||
|
||||
: unload-module ( module -- )
|
||||
cuModuleUnload cuda-error ;
|
||||
|
||||
: load-cuda-library ( library -- handle )
|
||||
path>> load-module ;
|
||||
|
||||
: lookup-cuda-library ( name -- cuda-library )
|
||||
cuda-libraries get ?at [ no-cuda-library ] unless ;
|
||||
|
||||
: remove-cuda-library ( name -- library )
|
||||
cuda-libraries get ?delete-at [ no-cuda-library ] unless ;
|
||||
|
||||
: unload-cuda-library ( name -- )
|
||||
remove-cuda-library handle>> unload-module ;
|
||||
|
||||
|
||||
: cached-module ( module-name -- alien )
|
||||
lookup-cuda-library
|
||||
cuda-modules get-global [ load-cuda-library ] cache ;
|
||||
|
||||
: cached-function ( module-name function-name -- alien )
|
||||
[ cached-module ] dip
|
||||
2array cuda-functions get [ first2 get-function-ptr* ] cache ;
|
||||
|
||||
: launch-function* ( function -- ) cuLaunch cuda-error ;
|
||||
|
||||
: launch-function ( -- ) cuda-function get cuLaunch cuda-error ;
|
||||
|
|
|
|||
Loading…
Reference in New Issue