From aaacd2a34942ec870ee0b2d220722d8722a31f2d Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 14 Apr 2010 22:45:30 -0700 Subject: [PATCH 1/9] unix.process: use if-zero instead of re-inventing it --- basis/unix/process/process.factor | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/basis/unix/process/process.factor b/basis/unix/process/process.factor index 4b33c37d07..1e9129af58 100644 --- a/basis/unix/process/process.factor +++ b/basis/unix/process/process.factor @@ -36,8 +36,7 @@ FUNCTION: int execve ( c-string path, c-string* argv, c-string* envp ) ; [ [ first ] [ ] bi ] dip exec-with-env ; : with-fork ( child parent -- ) - [ [ fork-process dup zero? ] dip '[ drop @ ] ] dip - if ; inline + [ fork-process ] 2dip if-zero ; inline CONSTANT: SIGKILL 9 CONSTANT: SIGTERM 15 From d8c26b7d876a29bf3a0cb697a60e9a38e93ab6e5 Mon Sep 17 00:00:00 2001 From: Erik Charlebois Date: Thu, 15 Apr 2010 01:20:57 -0700 Subject: [PATCH 2/9] Fat binary loading --- extra/macho/a2.macho | Bin 0 -> 12888 bytes extra/macho/macho-tests.factor | 10 ++++++++-- extra/macho/macho.factor | 31 ++++++++++++++++++++++++++----- 3 files changed, 34 insertions(+), 7 deletions(-) create mode 100755 extra/macho/a2.macho diff --git a/extra/macho/a2.macho b/extra/macho/a2.macho new file mode 100755 index 0000000000000000000000000000000000000000..ed9a3a9a278bdaf8c3236ad2b96012df6d46c7dc GIT binary patch literal 12888 zcmeHN-)me&6h1dun^co@+Xs!<=vG=9Y)L9YsbFCv4cX9A*Cs7NlyNtElU=#lUGCmZ zH$rhCC_g-C-8+-Ln{CqCQA{E3J-jz~{aq+28j@yQuveMpup0u}*_fJML}U=gqgSOhEr76FTZ zMZh9p5%?bF#1@EzQj zXlED$C^bDkGu_@j)Ti4aPFlv?@YXg+qsAGP! zwZJcx=XIx@>rHEW{kolUoZ8lo2Bqrd%cXKbmCAFKP;Q@JR@_+4g7oB8#F_}P8=)lXIxgw%k5@wP|wdyi*j7woMSVbQdPe)58TvZ&aZW@H?8dr zYX!=D4(>%t6>>qY)w&bEqPCaPT`0%*p`{s>TF?Et$@6E&&rF(U76#h(0WxVuFP7^J z+rwIT67gO+q01pl;r$YmPeI0?%phxk(+v0IJIFlKpB@r<4;<%2vPdNMVd7YOk<6Z> z*g+papZ#_cUJK#4e6C09HGkAA?JBat+iwQwV*J2?AXZ35#UhDvy=XR0B-agxdO>) z)0v@&b<%;hW9%M7rG|WFtj4FIUo-2o1p!)NpfD#UJ$2|-1Gh=NXfpQ-Zc&> z$B{VBFy=&hgq0*NLP4Q_qLOo@79+inEOQ)>!aMzys7za`nJs? zU=gqgSOhEr76FTZMZh9p5wHkY1S|p;fqxf){b{Ate50WduC7(eIj dup [ "resource:extra/macho/a.macho" macho-nm ] with-output-stream >string ] unit-test + +{ t } [ + "resource:extra/macho/a2.macho" [ + >c-ptr fat-binary-members first data>> >c-ptr macho-header 64-bit? + ] with-mapped-macho +] unit-test diff --git a/extra/macho/macho.factor b/extra/macho/macho.factor index 79cb59c148..70dc594e07 100644 --- a/extra/macho/macho.factor +++ b/extra/macho/macho.factor @@ -4,7 +4,7 @@ USING: accessors alien alien.c-types alien.strings alien.syntax classes classes.struct combinators combinators.short-circuit io.encodings.ascii io.encodings.string kernel literals make math sequences specialized-arrays typed fry io.mmap formatting -locals splitting ; +locals splitting io.binary arrays ; FROM: alien.c-types => short ; IN: macho @@ -812,7 +812,7 @@ C-ENUM: reloc_type_ppc PPC_RELOC_LOCAL_SECTDIFF ; ! Low-level interface -SPECIALIZED-ARRAYS: section section_64 nlist nlist_64 ; +SPECIALIZED-ARRAYS: section section_64 nlist nlist_64 fat_arch uchar ; UNION: mach_header_32/64 mach_header mach_header_64 ; UNION: segment_command_32/64 segment_command segment_command_64 ; UNION: load-command segment_command segment_command_64 @@ -826,6 +826,26 @@ UNION: section_32/64-array section-array section_64-array ; UNION: nlist_32/64 nlist nlist_64 ; UNION: nlist_32/64-array nlist-array nlist_64-array ; +TUPLE: fat-binary-member cpu-type cpu-subtype data ; +ERROR: not-fat-binary ; + +TYPED: fat-binary-members ( >c-ptr -- fat-binary-members ) + fat_header memory>struct dup magic>> { + { FAT_MAGIC [ ] } + { FAT_CIGAM [ ] } + [ 2drop not-fat-binary ] + } case dup + [ >c-ptr fat_header heap-size swap ] + [ nfat_arch>> 4 >be le> ] bi + [ + { + [ nip cputype>> 4 >be le> ] + [ nip cpusubtype>> 4 >be le> ] + [ offset>> 4 >be le> swap >c-ptr ] + [ nip size>> 4 >be le> ] + } 2cleave fat-binary-member boa + ] with { } map-as ; + TYPED: 64-bit? ( macho: mach_header_32/64 -- ? ) magic>> { { MH_MAGIC_64 [ t ] } @@ -924,12 +944,13 @@ TYPED: load-commands ( macho: mach_header_32/64 -- load-commands ) : macho-nm ( path -- ) [| macho | macho load-commands segment-commands sections-array :> sections - macho load-commands symtab-commands [| symtab | macho symtab symbols [ [ drop n_value>> "%016x " printf ] - [ drop n_sect>> sections nth sectname>> - read-array-string "%-16s" printf ] + [ + drop n_sect>> sections nth sectname>> + read-array-string "%-16s" printf + ] [ symbol-name "%s\n" printf ] 2tri ] curry each ] each From 5f71d2bb18feccc76022b3a623a0f816108bc3e8 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Thu, 15 Apr 2010 11:27:33 -0700 Subject: [PATCH 3/9] db.sqlite.ffi: remove leftover stack effects from converted FUNCTION-ALIAS:es --- basis/db/sqlite/ffi/ffi.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/basis/db/sqlite/ffi/ffi.factor b/basis/db/sqlite/ffi/ffi.factor index c06581e1a2..b5f9020ce9 100644 --- a/basis/db/sqlite/ffi/ffi.factor +++ b/basis/db/sqlite/ffi/ffi.factor @@ -119,7 +119,7 @@ FUNCTION: int sqlite3_bind_double ( sqlite3_stmt* pStmt, int index, double x ) ; FUNCTION: int sqlite3_bind_int ( sqlite3_stmt* pStmt, int index, int n ) ; FUNCTION: int sqlite3_bind_int64 ( sqlite3_stmt* pStmt, int index, sqlite3_int64 n ) ; ! Bind the same function as above, but for unsigned 64bit integers -FUNCTION-ALIAS: sqlite3-bind-uint64 ( pStmt index in64 -- int ) +FUNCTION-ALIAS: sqlite3-bind-uint64 int sqlite3_bind_int64 ( sqlite3_stmt* pStmt, int index, sqlite3_uint64 in64 ) ; FUNCTION: int sqlite3_bind_null ( sqlite3_stmt* pStmt, int n ) ; FUNCTION: int sqlite3_bind_text ( sqlite3_stmt* pStmt, int index, c-string text, int len, int destructor ) ; @@ -132,7 +132,7 @@ FUNCTION: c-string sqlite3_column_decltype ( sqlite3_stmt* pStmt, int col ) ; FUNCTION: int sqlite3_column_int ( sqlite3_stmt* pStmt, int col ) ; FUNCTION: sqlite3_int64 sqlite3_column_int64 ( sqlite3_stmt* pStmt, int col ) ; ! Bind the same function as above, but for unsigned 64bit integers -FUNCTION-ALIAS: sqlite3-column-uint64 ( pStmt col -- uint64 ) +FUNCTION-ALIAS: sqlite3-column-uint64 sqlite3_uint64 sqlite3_column_int64 ( sqlite3_stmt* pStmt, int col ) ; FUNCTION: double sqlite3_column_double ( sqlite3_stmt* pStmt, int col ) ; FUNCTION: c-string sqlite3_column_name ( sqlite3_stmt* pStmt, int col ) ; From f26bf45b4a45e7342bd5225287b0afff5d7ad133 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 15 Apr 2010 13:48:13 -0500 Subject: [PATCH 4/9] formatting: fix unit tests on Windows; libc's float formatting produces different output there --- basis/formatting/formatting-tests.factor | 148 +++++++++++------------ 1 file changed, 74 insertions(+), 74 deletions(-) mode change 100644 => 100755 basis/formatting/formatting-tests.factor diff --git a/basis/formatting/formatting-tests.factor b/basis/formatting/formatting-tests.factor old mode 100644 new mode 100755 index 35b1dfff4a..740babf866 --- a/basis/formatting/formatting-tests.factor +++ b/basis/formatting/formatting-tests.factor @@ -1,83 +1,85 @@ ! Copyright (C) 2008 John Benediktsson ! See http://factorcode.org/license.txt for BSD license -USING: calendar kernel formatting tools.test ; +USING: calendar kernel formatting tools.test system ; IN: formatting.tests [ "%s" printf ] must-infer [ "%s" sprintf ] must-infer -[ t ] [ "" "" sprintf = ] unit-test -[ t ] [ "asdf" "asdf" sprintf = ] unit-test -[ t ] [ "10" 10 "%d" sprintf = ] unit-test -[ t ] [ "+10" 10 "%+d" sprintf = ] unit-test -[ t ] [ "-10" -10 "%d" sprintf = ] unit-test -[ t ] [ " -10" -10 "%5d" sprintf = ] unit-test -[ t ] [ "-0010" -10 "%05d" sprintf = ] unit-test -[ t ] [ "+0010" 10 "%+05d" sprintf = ] unit-test -[ t ] [ "123.456000" 123.456 "%f" sprintf = ] unit-test -[ t ] [ "2.44" 2.436 "%.2f" sprintf = ] unit-test -[ t ] [ "8.950" 8.950179003580072 "%.3f" sprintf = ] unit-test -[ t ] [ "123.10" 123.1 "%01.2f" sprintf = ] unit-test -[ t ] [ "1.2346" 1.23456789 "%.4f" sprintf = ] unit-test -[ t ] [ " 1.23" 1.23456789 "%6.2f" sprintf = ] unit-test -[ t ] [ "1.234000e+08" 123400000 "%e" sprintf = ] unit-test -[ t ] [ "-1.234000e+08" -123400000 "%e" sprintf = ] unit-test -[ t ] [ "1.234567e+08" 123456700 "%e" sprintf = ] unit-test -[ t ] [ "3.625e+08" 362525200 "%.3e" sprintf = ] unit-test -[ t ] [ "2.500000e-03" 0.0025 "%e" sprintf = ] unit-test -[ t ] [ "2.500000E-03" 0.0025 "%E" sprintf = ] unit-test -[ t ] [ " 1.0E+01" 10 "%10.1E" sprintf = ] unit-test -[ t ] [ " -1.0E+01" -10 "%10.1E" sprintf = ] unit-test -[ t ] [ " -1.0E+01" -10 "%+10.1E" sprintf = ] unit-test -[ t ] [ " +1.0E+01" 10 "%+10.1E" sprintf = ] unit-test -[ t ] [ "-001.0E+01" -10 "%+010.1E" sprintf = ] unit-test -[ t ] [ "+001.0E+01" 10 "%+010.1E" sprintf = ] unit-test -[ t ] [ "ff" HEX: ff "%x" sprintf = ] unit-test -[ t ] [ "FF" HEX: ff "%X" sprintf = ] unit-test -[ t ] [ "0f" HEX: f "%02x" sprintf = ] unit-test -[ t ] [ "0F" HEX: f "%02X" sprintf = ] unit-test -[ t ] [ "2008-09-10" - 2008 9 10 "%04d-%02d-%02d" sprintf = ] unit-test -[ t ] [ "Hello, World!" - "Hello, World!" "%s" sprintf = ] unit-test -[ t ] [ "printf test" - "printf test" sprintf = ] unit-test -[ t ] [ "char a = 'a'" - CHAR: a "char %c = 'a'" sprintf = ] unit-test -[ t ] [ "00" HEX: 0 "%02x" sprintf = ] unit-test -[ t ] [ "ff" HEX: ff "%02x" sprintf = ] unit-test -[ t ] [ "0 message(s)" - 0 "message" "%d %s(s)" sprintf = ] unit-test -[ t ] [ "0 message(s) with %" - 0 "message" "%d %s(s) with %%" sprintf = ] unit-test -[ t ] [ "justif: \"left \"" - "left" "justif: \"%-10s\"" sprintf = ] unit-test -[ t ] [ "justif: \" right\"" - "right" "justif: \"%10s\"" sprintf = ] unit-test -[ t ] [ " 3: 0003 zero padded" - 3 " 3: %04d zero padded" sprintf = ] unit-test -[ t ] [ " 3: 3 left justif" - 3 " 3: %-4d left justif" sprintf = ] unit-test -[ t ] [ " 3: 3 right justif" - 3 " 3: %4d right justif" sprintf = ] unit-test -[ t ] [ " -3: -003 zero padded" - -3 " -3: %04d zero padded" sprintf = ] unit-test -[ t ] [ " -3: -3 left justif" - -3 " -3: %-4d left justif" sprintf = ] unit-test -[ t ] [ " -3: -3 right justif" - -3 " -3: %4d right justif" sprintf = ] unit-test -[ t ] [ "There are 10 monkeys in the kitchen" - 10 "kitchen" "There are %d monkeys in the %s" sprintf = ] unit-test -[ f ] [ "%d" 10 "%d" sprintf = ] unit-test -[ t ] [ "[monkey]" "monkey" "[%s]" sprintf = ] unit-test -[ t ] [ "[ monkey]" "monkey" "[%10s]" sprintf = ] unit-test -[ t ] [ "[monkey ]" "monkey" "[%-10s]" sprintf = ] unit-test -[ t ] [ "[0000monkey]" "monkey" "[%010s]" sprintf = ] unit-test -[ t ] [ "[####monkey]" "monkey" "[%'#10s]" sprintf = ] unit-test -[ t ] [ "[many monke]" "many monkeys" "[%10.10s]" sprintf = ] unit-test +[ "" ] [ "" sprintf ] unit-test +[ "asdf" ] [ "asdf" sprintf ] unit-test +[ "10" ] [ 10 "%d" sprintf ] unit-test +[ "+10" ] [ 10 "%+d" sprintf ] unit-test +[ "-10" ] [ -10 "%d" sprintf ] unit-test +[ " -10" ] [ -10 "%5d" sprintf ] unit-test +[ "-0010" ] [ -10 "%05d" sprintf ] unit-test +[ "+0010" ] [ 10 "%+05d" sprintf ] unit-test +[ "123.456000" ] [ 123.456 "%f" sprintf ] unit-test +[ "2.44" ] [ 2.436 "%.2f" sprintf ] unit-test +[ "8.950" ] [ 8.950179003580072 "%.3f" sprintf ] unit-test +[ "123.10" ] [ 123.1 "%01.2f" sprintf ] unit-test +[ "1.2346" ] [ 1.23456789 "%.4f" sprintf ] unit-test +[ " 1.23" ] [ 1.23456789 "%6.2f" sprintf ] unit-test -[ t ] [ "{ 1, 2, 3 }" { 1 2 3 } "%[%s, %]" sprintf = ] unit-test -[ t ] [ "{ 1:2, 3:4 }" H{ { 1 2 } { 3 4 } } "%[%s: %s %]" sprintf = ] unit-test +os windows? [ + [ "1.234000e+008" ] [ 123400000 "%e" sprintf ] unit-test + [ "-1.234000e+008" ] [ -123400000 "%e" sprintf ] unit-test + [ "1.234567e+008" ] [ 123456700 "%e" sprintf ] unit-test + [ "3.625e+008" ] [ 362525200 "%.3e" sprintf ] unit-test + [ "2.500000e-003" ] [ 0.0025 "%e" sprintf ] unit-test + [ "2.500000E-003" ] [ 0.0025 "%E" sprintf ] unit-test + [ " 1.0E+001" ] [ 10 "%11.1E" sprintf ] unit-test + [ " -1.0E+001" ] [ -10 "%11.1E" sprintf ] unit-test + [ " -1.0E+001" ] [ -10 "%+11.1E" sprintf ] unit-test + [ " +1.0E+001" ] [ 10 "%+11.1E" sprintf ] unit-test + [ "-001.0E+001" ] [ -10 "%+011.1E" sprintf ] unit-test + [ "+001.0E+001" ] [ 10 "%+011.1E" sprintf ] unit-test +] [ + [ "1.234000e+08" ] [ 123400000 "%e" sprintf ] unit-test + [ "-1.234000e+08" ] [ -123400000 "%e" sprintf ] unit-test + [ "1.234567e+08" ] [ 123456700 "%e" sprintf ] unit-test + [ "3.625e+08" ] [ 362525200 "%.3e" sprintf ] unit-test + [ "2.500000e-03" ] [ 0.0025 "%e" sprintf ] unit-test + [ "2.500000E-03" ] [ 0.0025 "%E" sprintf ] unit-test + [ " 1.0E+01" ] [ 10 "%10.1E" sprintf ] unit-test + [ " -1.0E+01" ] [ -10 "%10.1E" sprintf ] unit-test + [ " -1.0E+01" ] [ -10 "%+10.1E" sprintf ] unit-test + [ " +1.0E+01" ] [ 10 "%+10.1E" sprintf ] unit-test + [ "-001.0E+01" ] [ -10 "%+010.1E" sprintf ] unit-test + [ "+001.0E+01" ] [ 10 "%+010.1E" sprintf ] unit-test +] if + +[ "ff" ] [ HEX: ff "%x" sprintf ] unit-test +[ "FF" ] [ HEX: ff "%X" sprintf ] unit-test +[ "0f" ] [ HEX: f "%02x" sprintf ] unit-test +[ "0F" ] [ HEX: f "%02X" sprintf ] unit-test +[ "2008-09-10" ] [ 2008 9 10 "%04d-%02d-%02d" sprintf ] unit-test +[ "Hello, World!" ] [ "Hello, World!" "%s" sprintf ] unit-test +[ "printf test" ] [ "printf test" sprintf ] unit-test +[ "char a = 'a'" ] [ CHAR: a "char %c = 'a'" sprintf ] unit-test +[ "00" ] [ HEX: 0 "%02x" sprintf ] unit-test +[ "ff" ] [ HEX: ff "%02x" sprintf ] unit-test +[ "0 message(s)" ] [ 0 "message" "%d %s(s)" sprintf ] unit-test +[ "0 message(s) with %" ] [ 0 "message" "%d %s(s) with %%" sprintf ] unit-test +[ "justif: \"left \"" ] [ "left" "justif: \"%-10s\"" sprintf ] unit-test +[ "justif: \" right\"" ] [ "right" "justif: \"%10s\"" sprintf ] unit-test +[ " 3: 0003 zero padded" ] [ 3 " 3: %04d zero padded" sprintf ] unit-test +[ " 3: 3 left justif" ] [ 3 " 3: %-4d left justif" sprintf ] unit-test +[ " 3: 3 right justif" ] [ 3 " 3: %4d right justif" sprintf ] unit-test +[ " -3: -003 zero padded" ] [ -3 " -3: %04d zero padded" sprintf ] unit-test +[ " -3: -3 left justif" ] [ -3 " -3: %-4d left justif" sprintf ] unit-test +[ " -3: -3 right justif" ] [ -3 " -3: %4d right justif" sprintf ] unit-test +[ "There are 10 monkeys in the kitchen" ] [ 10 "kitchen" "There are %d monkeys in the %s" sprintf ] unit-test +[ "10" ] [ 10 "%d" sprintf ] unit-test +[ "[monkey]" ] [ "monkey" "[%s]" sprintf ] unit-test +[ "[ monkey]" ] [ "monkey" "[%10s]" sprintf ] unit-test +[ "[monkey ]" ] [ "monkey" "[%-10s]" sprintf ] unit-test +[ "[0000monkey]" ] [ "monkey" "[%010s]" sprintf ] unit-test +[ "[####monkey]" ] [ "monkey" "[%'#10s]" sprintf ] unit-test +[ "[many monke]" ] [ "many monkeys" "[%10.10s]" sprintf ] unit-test + +[ "{ 1, 2, 3 }" ] [ { 1 2 3 } "%[%s, %]" sprintf ] unit-test +[ "{ 1:2, 3:4 }" ] [ H{ { 1 2 } { 3 4 } } "%[%s: %s %]" sprintf ] unit-test [ "%H:%M:%S" strftime ] must-infer @@ -96,5 +98,3 @@ IN: formatting.tests [ t ] [ "October" testtime "%B" strftime = ] unit-test [ t ] [ "Thu Oct 09 12:03:15 2008" testtime "%c" strftime = ] unit-test [ t ] [ "PM" testtime "%p" strftime = ] unit-test - - From feb62f3e883ffc32cbe6ea1bd842a8bd191c3010 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Thu, 15 Apr 2010 13:48:14 -0700 Subject: [PATCH 5/9] missing USING: for system-info.linux --- basis/system-info/linux/linux.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/system-info/linux/linux.factor b/basis/system-info/linux/linux.factor index 9c6f9fbff3..2eb395b8d1 100644 --- a/basis/system-info/linux/linux.factor +++ b/basis/system-info/linux/linux.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: unix alien alien.c-types kernel math sequences strings io.backend.unix splitting io.encodings.utf8 io.encodings.string -specialized-arrays ; +specialized-arrays alien.syntax ; SPECIALIZED-ARRAY: char IN: system-info.linux From 2ace3c59560bca2f546bbfbdf1fb9123b8e96729 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 15 Apr 2010 16:06:44 -0500 Subject: [PATCH 6/9] formatting: remove platform-specific example --- basis/formatting/formatting-docs.factor | 4 ---- 1 file changed, 4 deletions(-) mode change 100644 => 100755 basis/formatting/formatting-docs.factor diff --git a/basis/formatting/formatting-docs.factor b/basis/formatting/formatting-docs.factor old mode 100644 new mode 100755 index 9625c40577..100c88c4eb --- a/basis/formatting/formatting-docs.factor +++ b/basis/formatting/formatting-docs.factor @@ -62,10 +62,6 @@ HELP: printf "USING: formatting ;" "1.23456789 \"%.3f\" printf" "1.235" } - { $example - "USING: formatting ;" - "1234567890 \"%.5e\" printf" - "1.23457e+09" } { $example "USING: formatting ;" "12 \"%'#4d\" printf" From 8f56108702e7294e695a8babf5902eccf4f37bb7 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Thu, 15 Apr 2010 14:46:13 -0700 Subject: [PATCH 7/9] cuda.ffi: add CUDA versions of double, longlong, ulonglong that always 8-byte align, and a >cuda-param-type function we can use to make structs that match kernel param space layout --- extra/cuda/ffi/ffi.factor | 26 ++++++++++++++++++++++++-- 1 file changed, 24 insertions(+), 2 deletions(-) diff --git a/extra/cuda/ffi/ffi.factor b/extra/cuda/ffi/ffi.factor index 3d41f1e4c5..b7efeff9fb 100644 --- a/extra/cuda/ffi/ffi.factor +++ b/extra/cuda/ffi/ffi.factor @@ -1,6 +1,6 @@ ! (c)2010 Joe Groff bsd license -USING: alien alien.c-types alien.libraries alien.syntax -classes.struct combinators system ; +USING: accessors alien alien.c-types alien.libraries alien.syntax +classes.struct combinators kernel system ; IN: cuda.ffi << @@ -24,6 +24,28 @@ TYPEDEF: void* CUevent TYPEDEF: void* CUstream TYPEDEF: void* CUgraphicsResource +! versions of double and longlong that always 8-byte align + +SYMBOLS: CUdouble CUlonglong CUulonglong ; + +: >cuda-param-type ( c-type -- c-type' ) + { + { CUdeviceptr [ void* ] } + { double [ CUdouble ] } + { longlong [ CUlonglong ] } + { ulonglong [ CUulonglong ] } + [ ] + } case ; + +<< +: always-8-byte-align ( c-type -- c-type ) + 8 >>align 8 >>align-first ; + +longlong c-type clone always-8-byte-align \ CUlonglong typedef +ulonglong c-type clone always-8-byte-align \ CUulonglong typedef +double c-type clone always-8-byte-align \ CUdouble typedef +>> + STRUCT: CUuuid { bytes char[16] } ; From 34771c8e10d102d27e9c863ff618bc397c9d0598 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 15 Apr 2010 17:19:20 -0500 Subject: [PATCH 8/9] benchmark.fasta: tweak it a bit --- extra/benchmark/fasta/fasta.factor | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/extra/benchmark/fasta/fasta.factor b/extra/benchmark/fasta/fasta.factor index 226287974f..8c06716ddb 100644 --- a/extra/benchmark/fasta/fasta.factor +++ b/extra/benchmark/fasta/fasta.factor @@ -13,7 +13,7 @@ CONSTANT: initial-seed 42 CONSTANT: line-length 60 : random ( seed -- seed n ) - >float IA * IC + IM mod dup IM /f ; inline + IA * IC + IM mod dup IM /f ; inline CONSTANT: ALU "GGCCGGGCGCGGTGGCTCACGCCTGTAATCCCAGCACTTTGGGAGGCCGAGGCGGGCGGATCACCTGAGGTCAGGAGTTCGAGACCAGCCTGGCCAACATGGTGAAACCCCGTCTCTACTAAAAATACAAAAATTAGCCGGGCGTGGTGGCGCGCGCCTGTAATCCCAGCTACTCGGGAGGCTGAGGCAGGAGAATCGCTTGAACCCGGGAGGCGGAGGTTGCAGTGAGCCGAGATCGCGCCACTGCACTCCAGCCTGGGCGACAGAGCGAGACTCCGTCTCAAAAA" @@ -52,7 +52,7 @@ TYPED: make-cumulative ( freq -- chars: byte-array floats: double-array ) :: select-random ( seed chars floats -- seed elt ) seed random floats [ <= ] with find drop chars nth-unsafe ; inline -TYPED: make-random-fasta ( seed: fixnum len: fixnum chars: byte-array floats: double-array -- seed: fixnum ) +TYPED: make-random-fasta ( seed: float len: fixnum chars: byte-array floats: double-array -- seed: float ) '[ _ _ select-random ] "" replicate-as print ; : write-description ( desc id -- ) @@ -63,7 +63,7 @@ TYPED: make-random-fasta ( seed: fixnum len: fixnum chars: byte-array floats: do [ [ line-length quot call ] times ] dip quot unless-zero ; inline -TYPED: write-random-fasta ( seed: fixnum n: fixnum chars: byte-array floats: double-array desc id -- seed: fixnum ) +TYPED: write-random-fasta ( seed: float n: fixnum chars: byte-array floats: double-array desc id -- seed: float ) write-description '[ _ _ make-random-fasta ] split-lines ; From ccda46921f446e74c56adac03013925f115cf224 Mon Sep 17 00:00:00 2001 From: Erik Charlebois Date: Thu, 15 Apr 2010 16:31:37 -0700 Subject: [PATCH 9/9] Don't run mach-o and elf tests on ppc until endian issue sorted out --- extra/elf/elf-tests.factor | 4 +++- extra/elf/nm/nm-tests.factor | 12 +++++++----- extra/macho/macho-tests.factor | 22 ++++++++++++---------- 3 files changed, 22 insertions(+), 16 deletions(-) diff --git a/extra/elf/elf-tests.factor b/extra/elf/elf-tests.factor index d68885e6b7..4d1bb5be06 100644 --- a/extra/elf/elf-tests.factor +++ b/extra/elf/elf-tests.factor @@ -1,8 +1,9 @@ ! Copyright (C) 2010 Erik Charlebois. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors byte-arrays elf kernel sequences tools.test ; +USING: accessors byte-arrays elf kernel sequences system tools.test ; IN: elf.tests +cpu ppc? [ { { "" @@ -178,3 +179,4 @@ unit-test ] with-mapped-elf ] unit-test +] unless diff --git a/extra/elf/nm/nm-tests.factor b/extra/elf/nm/nm-tests.factor index 9e529ae43d..90d9634750 100644 --- a/extra/elf/nm/nm-tests.factor +++ b/extra/elf/nm/nm-tests.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2010 Erik Charlebois. ! See http://factorcode.org/license.txt for BSD license. -USING: elf.nm io io.streams.string kernel multiline strings tools.test -literals ; +USING: elf.nm io io.streams.string kernel literals multiline strings +system tools.test ; IN: elf.nm.tests STRING: validation-output @@ -46,6 +46,8 @@ STRING: validation-output ; -{ $ validation-output } -[ dup [ "resource:extra/elf/a.elf" elf-nm ] with-output-stream >string ] -unit-test +cpu ppc? [ + { $ validation-output } + [ dup [ "resource:extra/elf/a.elf" elf-nm ] with-output-stream >string ] + unit-test +] unless diff --git a/extra/macho/macho-tests.factor b/extra/macho/macho-tests.factor index d52eb778f6..561a98cd70 100644 --- a/extra/macho/macho-tests.factor +++ b/extra/macho/macho-tests.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2010 Erik Charlebois. ! See http://factorcode.org/license.txt for BSD license. USING: accessors alien io io.streams.string kernel literals macho -multiline sequences strings tools.test ; +multiline sequences strings system tools.test ; IN: macho.tests STRING: validation-output @@ -21,12 +21,14 @@ STRING: validation-output ; -{ $ validation-output } -[ dup [ "resource:extra/macho/a.macho" macho-nm ] with-output-stream >string ] -unit-test - -{ t } [ - "resource:extra/macho/a2.macho" [ - >c-ptr fat-binary-members first data>> >c-ptr macho-header 64-bit? - ] with-mapped-macho -] unit-test +cpu ppc? [ + { $ validation-output } + [ dup [ "resource:extra/macho/a.macho" macho-nm ] with-output-stream >string ] + unit-test + + { t } [ + "resource:extra/macho/a2.macho" [ + >c-ptr fat-binary-members first data>> >c-ptr macho-header 64-bit? + ] with-mapped-macho + ] unit-test +] unless