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

db4
Joe Groff 2010-04-25 12:19:28 -07:00
commit 4022ceda8d
15 changed files with 214 additions and 118 deletions

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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 ;

View File

@ -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 ;

View File

@ -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

View File

@ -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 ;

View File

@ -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 ) ;

View File

@ -0,0 +1 @@
Doug Coleman

View File

@ -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 ;

View File

@ -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 ;

View File

@ -0,0 +1 @@
Doug Coleman

View File

@ -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 ;

View File

@ -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 ;

View File

@ -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 ;