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

db4
Daniel Ehrenberg 2010-04-17 14:05:40 -05:00
commit 865285cdd7
33 changed files with 669 additions and 96 deletions

View File

@ -32,7 +32,7 @@
<key>CFBundlePackageType</key>
<string>APPL</string>
<key>CFBundleVersion</key>
<string>0.93</string>
<string>0.94</string>
<key>NSHumanReadableCopyright</key>
<string>Copyright © 2003-2010 Factor developers</string>
<key>NSServices</key>

View File

@ -4,7 +4,7 @@ ifdef CONFIG
AR = ar
LD = ld
VERSION = 0.93
VERSION = 0.94
BUNDLE = Factor.app
LIBPATH = -L/usr/X11R6/lib

View File

@ -9,7 +9,9 @@ IN: binary-search.tests
[ 4 ] [ 5.5 { 1 2 3 4 5 6 7 8 } [ <=> ] with search drop ] unit-test
[ 10 ] [ 10 20 iota [ <=> ] with search drop ] unit-test
[ t ] [ "hello" { "alligator" "cat" "fish" "hello" "ikarus" "java" } sorted-member? ] unit-test
[ 0 ] [ "alligator" { "alligator" "cat" "fish" "hello" "ikarus" "java" } sorted-index ] unit-test
[ 3 ] [ "hey" { "alligator" "cat" "fish" "hello" "ikarus" "java" } sorted-index ] unit-test
[ 5 ] [ "java" { "alligator" "cat" "fish" "hello" "ikarus" "java" } sorted-index ] unit-test
[ t ] [ "hello" { "alligator" "cat" "fish" "hello" "ikarus" "java" } sorted-member? ] unit-test
[ f ] [ "hello" { "alligator" "cat" "fish" "ikarus" "java" } sorted-member? ] unit-test
[ f ] [ "zebra" { "alligator" "cat" "fish" "ikarus" "java" } sorted-member? ] unit-test

View File

@ -1,41 +1,29 @@
! Copyright (C) 2008, 2009 Slava Pestov.
! Copyright (C) 2008, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel sequences sequences.private accessors math
math.order combinators hints arrays ;
USING: accessors arrays combinators hints kernel locals math
math.order sequences ;
IN: binary-search
<PRIVATE
: midpoint ( seq -- elt )
[ midpoint@ ] keep nth-unsafe ; inline
:: (search) ( seq from to quot: ( elt -- <=> ) -- i elt )
from to + 2/ :> midpoint@
midpoint@ seq nth :> midpoint
: decide ( quot seq -- quot seq <=> )
[ midpoint swap call ] 2keep rot ; inline
: finish ( quot slice -- i elt )
[ [ from>> ] [ midpoint@ ] bi + ] [ seq>> ] bi
[ drop ] [ dup ] [ ] tri* nth ; inline
DEFER: (search)
: keep-searching ( seq quot -- slice )
[ dup midpoint@ ] dip call collapse-slice slice boa (search) ; inline
: (search) ( ... quot: ( ... elt -- ... <=> ) seq -- ... i elt )
dup length 1 <= [
finish
to from - 1 <= [
midpoint@ midpoint
] [
decide {
{ +eq+ [ finish ] }
{ +lt+ [ [ (head) ] keep-searching ] }
{ +gt+ [ [ (tail) ] keep-searching ] }
midpoint quot call {
{ +eq+ [ midpoint@ midpoint ] }
{ +lt+ [ seq from midpoint@ quot (search) ] }
{ +gt+ [ seq midpoint@ to quot (search) ] }
} case
] if ; inline recursive
PRIVATE>
: search ( seq quot -- i elt )
over empty? [ 2drop f f ] [ swap <flat-slice> (search) ] if ;
: search ( seq quot: ( elt -- <=> ) -- i elt )
over empty? [ 2drop f f ] [ [ 0 over length ] dip (search) ] if ;
inline
: natural-search ( obj seq -- i elt )

View File

@ -193,25 +193,6 @@ M: number detect-number ;
! Regression
[ 4 [ + ] ] [ 2 2 [ [ + ] [ call ] keep ] compile-call ] unit-test
! Regression
USE: sorting
USE: binary-search
USE: binary-search.private
: old-binsearch ( elt quot: ( ..a -- ..b ) seq -- elt quot i )
dup length 1 <= [
from>>
] [
[ midpoint swap call ] 3keep [ rot ] dip swap dup zero?
[ drop dup from>> swap midpoint@ + ]
[ drop dup midpoint@ head-slice old-binsearch ] if
] if ; inline recursive
[ 10 ] [
10 20 iota <flat-slice>
[ [ - ] swap old-binsearch ] compile-call 2nip
] unit-test
! Regression
: empty-compound ( -- ) ;

View File

@ -679,16 +679,11 @@ HELP: collapse-slice
{ $description "Prepares to take the slice of a slice by adjusting the start and end indices accordingly, and replacing the slice with its underlying sequence." }
;
HELP: <flat-slice>
{ $values { "seq" sequence } { "slice" slice } }
{ $description "Outputs a slice with the same elements as " { $snippet "seq" } ", and " { $snippet "from" } " equal to 0 and " { $snippet "to" } " equal to the length of " { $snippet "seq" } "." }
{ $notes "Some words create slices then proceed to read the " { $snippet "to" } " and " { $snippet "from" } " slots of the slice. To behave predictably when they are themselves given a slice as input, they apply this word first to get a canonical slice." } ;
HELP: <slice>
{ $values { "from" "a non-negative integer" } { "to" "a non-negative integer" } { "seq" sequence } { "slice" slice } }
{ $description "Outputs a new virtual sequence sharing storage with the subrange of elements in " { $snippet "seq" } " with indices starting from and including " { $snippet "m" } ", and up to but not including " { $snippet "n" } "." }
{ $errors "Throws an error if " { $snippet "m" } " or " { $snippet "n" } " is out of bounds." }
{ $notes "Taking the slice of a slice outputs a slice of the underlying sequence of the original slice. Keep this in mind when writing code which depends on the values of " { $snippet "from" } " and " { $snippet "to" } " being equal to the inputs to this word. The " { $link <flat-slice> } " word might be helpful in such situations." } ;
{ $notes "Taking the slice of a slice outputs a slice of the underlying sequence, instead of a slice of a slice. This means that you cannot assume that the " { $snippet "from" } " and " { $snippet "to" } " slots of the resulting slice will be equal to the values you passed to " { $link <slice> } "." } ;
{ <slice> subseq } related-words
@ -1534,8 +1529,6 @@ $nl
{ $subsections rest-slice but-last-slice }
"Taking a sequence apart into a head and a tail:"
{ $subsections unclip-slice unclip-last-slice cut-slice }
"A utility for words which use slices as iterators:"
{ $subsections <flat-slice> }
"Replacing slices with new elements:"
{ $subsections replace-slice } ;

View File

@ -898,11 +898,6 @@ PRIVATE>
: unclip-last-slice ( seq -- butlast-slice last )
[ but-last-slice ] [ last ] bi ; inline
: <flat-slice> ( seq -- slice )
dup slice? [ { } like ] when
[ drop 0 ] [ length ] [ ] tri <slice> ;
inline
<PRIVATE
: (trim-head) ( seq quot -- seq n )

View File

@ -1,12 +1,10 @@
! Copyright (C) 2008 Slava Pestov.
! Copyright (C) 2008, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: binary-search compiler.units kernel math.primes math.ranges
memoize prettyprint sequences ;
USING: binary-search kernel math.primes math.ranges memoize
prettyprint sequences ;
IN: benchmark.binary-search
[
MEMO: primes-under-million ( -- seq ) 1000000 primes-upto ;
] with-compilation-unit
MEMO: primes-under-million ( -- seq ) 1000000 primes-upto ;
! Force computation of the primes list before benchmarking the binary search
primes-under-million drop

View File

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

View File

@ -0,0 +1 @@
Dmitry Shubin

View File

@ -0,0 +1,59 @@
! Copyright (C) 2010 Dmitry Shubin.
! See http://factorcode.org/license.txt for BSD license.
USING: boyer-moore.private help.markup help.syntax kernel sequences ;
IN: boyer-moore
HELP: <boyer-moore>
{ $values
{ "pat" sequence } { "bm" boyer-moore }
}
{ $description
"Given a pattern performs pattern preprocessing and returns "
"results as an (opaque) object that is reusable across "
"searches in different sequences via " { $link search-from }
" generic word."
} ;
HELP: search-from
{ $values
{ "seq" sequence }
{ "from" "a non-negative integer" }
{ "obj" object }
{ "i/f" "the index of first match or " { $link f } }
}
{ $description "Performs an attempt to find the first "
"occurence of pattern in " { $snippet "seq" }
" starting from " { $snippet "from" } " using "
"Boyer-Moore search algorithm. Output is the index "
"if the attempt was succeessful and " { $link f }
" otherwise."
} ;
HELP: search
{ $values
{ "seq" sequence }
{ "obj" object }
{ "i/f" "the index of first match or " { $link f } }
}
{ $description "A simpler variant of " { $link search-from }
" that starts searching from the beginning of the sequence."
} ;
ARTICLE: "boyer-moore" "The Boyer-Moore algorithm"
{ $heading "Summary" }
"The " { $vocab-link "boyer-moore" } " vocabulary "
"implements a Boyer-Moore string search algorithm with "
"so-called 'strong good suffix shift rule'. Since algorithm is "
"alphabet-independent it is applicable to searching in any "
"collection that implements " { $links "sequence-protocol" } "."
{ $heading "Complexity" }
"Let " { $snippet "n" } " and " { $snippet "m" } " be lengths "
"of the sequences being searched " { $emphasis "in" } " and "
{ $emphasis "for" } " respectively. Then searching runs in "
{ $snippet "O(n)" } " time in its worst case using additional "
{ $snippet "O(m)" } " space. The preprocessing phase runs in "
{ $snippet "O(m)" } " time."
;
ABOUT: "boyer-moore"

View File

@ -0,0 +1,10 @@
! Copyright (C) 2010 Dmitry Shubin.
! See http://factorcode.org/license.txt for BSD license.
USING: tools.test boyer-moore ;
IN: boyer-moore.tests
[ 0 ] [ "qwerty" "" search ] unit-test
[ 0 ] [ "" "" search ] unit-test
[ f ] [ "qw" "qwerty" search ] unit-test
[ 3 ] [ "qwerty" "r" search ] unit-test
[ 8 ] [ "qwerasdfqwer" 2 "qwe" search-from ] unit-test

View File

@ -0,0 +1,78 @@
! Copyright (C) 2010 Dmitry Shubin.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays assocs kernel locals math math.order
math.ranges sequences sequences.private z-algorithm ;
IN: boyer-moore
<PRIVATE
:: (normal-suffixes) ( i zs ss -- )
i zs nth-unsafe ss
[ [ i ] unless* ] change-nth-unsafe ; inline
: normal-suffixes ( zs -- ss )
[ length [ f <array> ] [ [1,b) ] bi ] keep pick
[ (normal-suffixes) ] 2curry each ; inline
:: (partial-suffixes) ( len old elt i -- len old/new old )
len elt i 1 + = [ len elt - ] [ old ] if old ; inline
: partial-suffixes ( zs -- ss )
[ length dup ] [ <reversed> ] bi
[ (partial-suffixes) ] map-index 2nip ; inline
: <gs-table> ( seq -- table )
z-values [ partial-suffixes ] [ normal-suffixes ] bi
[ [ nip ] when* ] 2map reverse! ; inline
: insert-bc-shift ( table elt len i -- table )
1 + swap - swap pick 2dup key?
[ 3drop ] [ set-at ] if ; inline
: <bc-table> ( seq -- table )
H{ } clone swap [ length ] keep
[ insert-bc-shift ] with each-index ; inline
TUPLE: boyer-moore pattern bc-table gs-table ;
: gs-shift ( i c bm -- s ) nip gs-table>> nth-unsafe ; inline
: bc-shift ( i c bm -- s ) bc-table>> at dup 1 ? + ; inline
: do-shift ( pos i c bm -- newpos )
[ gs-shift ] [ bc-shift ] bi-curry 2bi max + ; inline
: match? ( i1 s1 i2 s2 -- ? ) [ nth-unsafe ] 2bi@ = ; inline
:: mismatch? ( s1 s2 pos len -- i/f )
len 1 - [ [ pos + s1 ] keep s2 match? not ]
find-last-integer ; inline
:: (search-from) ( seq from bm -- i/f )
bm pattern>> :> pat
pat length :> plen
seq length plen - :> lim
from
[
dup lim <=
[
seq pat pick plen mismatch?
[ 2dup + seq nth-unsafe bm do-shift t ] [ f ] if*
] [ drop f f ] if
] loop ; inline
PRIVATE>
: <boyer-moore> ( pat -- bm )
dup <reversed> [ <bc-table> ] [ <gs-table> ] bi
boyer-moore boa ;
GENERIC: search-from ( seq from obj -- i/f )
M: sequence search-from
dup length zero?
[ 3drop 0 ] [ <boyer-moore> (search-from) ] if ;
M: boyer-moore search-from (search-from) ;
: search ( seq obj -- i/f ) [ 0 ] dip search-from ;

View File

@ -0,0 +1 @@
Boyer-Moore string search algorithm

View File

@ -0,0 +1 @@
algorithms

103
extra/cuda/prefix-sum.cu Normal file
View File

@ -0,0 +1,103 @@
#include <stdio.h>
#include <stdlib.h>
#include <cuda_runtime.h>
static const int LOG_BANK_COUNT = 4;
static inline __device__ __host__ unsigned shared_offset(unsigned i)
{
return i + (i >> LOG_BANK_COUNT);
}
static inline __device__ __host__ unsigned offset_a(unsigned offset, unsigned i)
{
return shared_offset(offset * (2*i + 1) - 1);
}
static inline __device__ __host__ unsigned offset_b(unsigned offset, unsigned i)
{
return shared_offset(offset * (2*i + 2) - 1);
}
static inline __device__ __host__ unsigned lpot(unsigned x)
{
--x; x |= x>>1; x|=x>>2; x|=x>>4; x|=x>>8; x|=x>>16; return ++x;
}
template<typename T>
__global__ void prefix_sum_block(T *in, T *out, unsigned n)
{
extern __shared__ T temp[];
int idx = threadIdx.x;
int blocksize = blockDim.x;
temp[shared_offset(idx )] = (idx < n) ? in[idx ] : 0;
temp[shared_offset(idx + blocksize)] = (idx + blocksize < n) ? in[idx + blocksize] : 0;
int offset, d;
for (offset = 1, d = blocksize; d > 0; d >>= 1, offset <<= 1) {
__syncthreads();
if (idx < d) {
unsigned a = offset_a(offset, idx), b = offset_b(offset, idx);
temp[b] += temp[a];
}
}
if (idx == 0) temp[shared_offset(blocksize*2 - 1)] = 0;
for (d = 1; d <= blocksize; d <<= 1) {
offset >>= 1;
__syncthreads();
if (idx < d) {
unsigned a = offset_a(offset, idx), b = offset_b(offset, idx);
unsigned t = temp[a];
temp[a] = temp[b];
temp[b] += t;
}
}
__syncthreads();
if (idx < n) out[idx ] = temp[shared_offset(idx )];
if (idx + blocksize < n) out[idx + blocksize] = temp[shared_offset(idx + blocksize)];
}
template<typename T>
void prefix_sum(T *in, T *out, unsigned n)
{
char *device_values;
unsigned n_lpot = lpot(n);
size_t n_pitch;
cudaError_t error = cudaMallocPitch((void**)&device_values, &n_pitch, sizeof(T)*n, 2);
if (error != 0) {
printf("error %u allocating width %lu height %u\n", error, sizeof(T)*n, 2);
exit(1);
}
cudaMemcpy(device_values, in, sizeof(T)*n, cudaMemcpyHostToDevice);
prefix_sum_block<<<1, n_lpot/2, shared_offset(n_lpot)*sizeof(T)>>>
((T*)device_values, (T*)(device_values + n_pitch), n);
cudaMemcpy(out, device_values + n_pitch, sizeof(T)*n, cudaMemcpyDeviceToHost);
cudaFree(device_values);
}
int main()
{
sranddev();
static unsigned in_values[1024], out_values[1024];
for (int i = 0; i < 1024; ++i)
in_values[i] = rand() >> 21;
prefix_sum(in_values, out_values, 1024);
for (int i = 0; i < 1024; ++i)
printf("%5d => %5d\n", in_values[i], out_values[i]);
return 0;
}

222
extra/cuda/prefix-sum.ptx Normal file
View File

@ -0,0 +1,222 @@
.version 1.4
.target sm_10, map_f64_to_f32
// compiled with /usr/local/cuda/bin/../open64/lib//be
// nvopencc 3.0 built on 2010-03-11
//-----------------------------------------------------------
// Compiling /tmp/tmpxft_00000236_00000000-7_prefix-sum.cpp3.i (/var/folders/K6/K6oI14wZ2RWhSE+BYqTjA++++TI/-Tmp-/ccBI#.0ATpGM)
//-----------------------------------------------------------
//-----------------------------------------------------------
// Options:
//-----------------------------------------------------------
// Target:ptx, ISA:sm_10, Endian:little, Pointer Size:32
// -O3 (Optimization level)
// -g0 (Debug level)
// -m2 (Report advisories)
//-----------------------------------------------------------
.file 1 "<command-line>"
.file 2 "/tmp/tmpxft_00000236_00000000-6_prefix-sum.cudafe2.gpu"
.file 3 "/usr/lib/gcc/i686-apple-darwin10/4.2.1/include/stddef.h"
.file 4 "/usr/local/cuda/bin/../include/crt/device_runtime.h"
.file 5 "/usr/local/cuda/bin/../include/host_defines.h"
.file 6 "/usr/local/cuda/bin/../include/builtin_types.h"
.file 7 "/usr/local/cuda/bin/../include/device_types.h"
.file 8 "/usr/local/cuda/bin/../include/driver_types.h"
.file 9 "/usr/local/cuda/bin/../include/texture_types.h"
.file 10 "/usr/local/cuda/bin/../include/vector_types.h"
.file 11 "/usr/local/cuda/bin/../include/device_launch_parameters.h"
.file 12 "/usr/local/cuda/bin/../include/crt/storage_class.h"
.file 13 "/usr/include/i386/_types.h"
.file 14 "/usr/include/time.h"
.file 15 "prefix-sum.cu"
.file 16 "/usr/local/cuda/bin/../include/common_functions.h"
.file 17 "/usr/local/cuda/bin/../include/crt/func_macro.h"
.file 18 "/usr/local/cuda/bin/../include/math_functions.h"
.file 19 "/usr/local/cuda/bin/../include/device_functions.h"
.file 20 "/usr/local/cuda/bin/../include/math_constants.h"
.file 21 "/usr/local/cuda/bin/../include/sm_11_atomic_functions.h"
.file 22 "/usr/local/cuda/bin/../include/sm_12_atomic_functions.h"
.file 23 "/usr/local/cuda/bin/../include/sm_13_double_functions.h"
.file 24 "/usr/local/cuda/bin/../include/common_types.h"
.file 25 "/usr/local/cuda/bin/../include/sm_20_atomic_functions.h"
.file 26 "/usr/local/cuda/bin/../include/sm_20_intrinsics.h"
.file 27 "/usr/local/cuda/bin/../include/texture_fetch_functions.h"
.file 28 "/usr/local/cuda/bin/../include/math_functions_dbl_ptx1.h"
.extern .shared .align 4 .b8 temp[];
.entry _Z16prefix_sum_blockIjEvPT_S1_j (
.param .u32 __cudaparm__Z16prefix_sum_blockIjEvPT_S1_j_in,
.param .u32 __cudaparm__Z16prefix_sum_blockIjEvPT_S1_j_out,
.param .u32 __cudaparm__Z16prefix_sum_blockIjEvPT_S1_j_n)
{
.reg .u32 %r<81>;
.reg .pred %p<11>;
.loc 15 28 0
$LBB1__Z16prefix_sum_blockIjEvPT_S1_j:
ld.param.u32 %r1, [__cudaparm__Z16prefix_sum_blockIjEvPT_S1_j_n];
cvt.s32.u16 %r2, %tid.x;
setp.lt.u32 %p1, %r2, %r1;
@!%p1 bra $Lt_0_7938;
.loc 15 35 0
ld.param.u32 %r3, [__cudaparm__Z16prefix_sum_blockIjEvPT_S1_j_in];
mul24.lo.u32 %r4, %r2, 4;
add.u32 %r5, %r3, %r4;
ld.global.u32 %r6, [%r5+0];
bra.uni $Lt_0_7682;
$Lt_0_7938:
mov.u32 %r6, 0;
$Lt_0_7682:
mov.u32 %r7, temp;
shr.u32 %r8, %r2, 4;
add.u32 %r9, %r2, %r8;
mul.lo.u32 %r10, %r9, 4;
add.u32 %r11, %r10, %r7;
st.shared.u32 [%r11+0], %r6;
cvt.s32.u16 %r12, %ntid.x;
add.s32 %r13, %r12, %r2;
.loc 15 28 0
ld.param.u32 %r1, [__cudaparm__Z16prefix_sum_blockIjEvPT_S1_j_n];
.loc 15 35 0
setp.lt.u32 %p2, %r13, %r1;
@!%p2 bra $Lt_0_8450;
.loc 15 36 0
ld.param.u32 %r14, [__cudaparm__Z16prefix_sum_blockIjEvPT_S1_j_in];
mul.lo.u32 %r15, %r13, 4;
add.u32 %r16, %r14, %r15;
ld.global.u32 %r17, [%r16+0];
bra.uni $Lt_0_8194;
$Lt_0_8450:
mov.u32 %r17, 0;
$Lt_0_8194:
shr.u32 %r18, %r13, 4;
add.u32 %r19, %r13, %r18;
mul.lo.u32 %r20, %r19, 4;
add.u32 %r21, %r20, %r7;
st.shared.u32 [%r21+0], %r17;
.loc 15 39 0
mov.s32 %r22, %r12;
mov.u32 %r23, 0;
setp.le.s32 %p3, %r12, %r23;
mov.s32 %r24, 1;
@%p3 bra $Lt_0_13314;
$Lt_0_9218:
//<loop> Loop body line 39, nesting depth: 1, estimated iterations: unknown
.loc 15 40 0
bar.sync 0;
setp.le.s32 %p4, %r22, %r2;
@%p4 bra $Lt_0_9474;
//<loop> Part of loop body line 39, head labeled $Lt_0_9218
.loc 15 43 0
mul24.lo.u32 %r25, %r2, 2;
add.u32 %r26, %r25, 1;
add.u32 %r27, %r25, 2;
mul.lo.u32 %r28, %r24, %r26;
mul.lo.u32 %r29, %r24, %r27;
sub.u32 %r30, %r29, 1;
shr.u32 %r31, %r30, 4;
add.u32 %r32, %r29, %r31;
mul.lo.u32 %r33, %r32, 4;
add.u32 %r34, %r33, %r7;
ld.shared.u32 %r35, [%r34+-4];
sub.u32 %r36, %r28, 1;
shr.u32 %r37, %r36, 4;
add.u32 %r38, %r28, %r37;
mul.lo.u32 %r39, %r38, 4;
add.u32 %r40, %r7, %r39;
ld.shared.u32 %r41, [%r40+-4];
add.u32 %r42, %r35, %r41;
st.shared.u32 [%r34+-4], %r42;
$Lt_0_9474:
//<loop> Part of loop body line 39, head labeled $Lt_0_9218
.loc 15 39 0
shr.s32 %r22, %r22, 1;
shl.b32 %r24, %r24, 1;
mov.u32 %r43, 0;
setp.gt.s32 %p5, %r22, %r43;
@%p5 bra $Lt_0_9218;
bra.uni $Lt_0_8706;
$Lt_0_13314:
$Lt_0_8706:
mov.u32 %r44, 0;
setp.ne.s32 %p6, %r2, %r44;
@%p6 bra $Lt_0_10242;
.loc 15 47 0
mul24.lo.s32 %r45, %r12, 2;
mov.u32 %r46, 0;
sub.u32 %r47, %r45, 1;
shr.u32 %r48, %r47, 4;
add.u32 %r49, %r45, %r48;
mul.lo.u32 %r50, %r49, 4;
add.u32 %r51, %r7, %r50;
st.shared.u32 [%r51+-4], %r46;
$Lt_0_10242:
mov.u32 %r52, 1;
setp.lt.s32 %p7, %r12, %r52;
@%p7 bra $Lt_0_10754;
mov.s32 %r22, 1;
$Lt_0_11266:
//<loop> Loop body line 47, nesting depth: 1, estimated iterations: unknown
.loc 15 50 0
shr.s32 %r24, %r24, 1;
.loc 15 51 0
bar.sync 0;
setp.le.s32 %p8, %r22, %r2;
@%p8 bra $Lt_0_11522;
//<loop> Part of loop body line 47, head labeled $Lt_0_11266
.loc 15 55 0
mul24.lo.u32 %r53, %r2, 2;
add.u32 %r54, %r53, 1;
mul.lo.u32 %r55, %r24, %r54;
sub.u32 %r56, %r55, 1;
shr.u32 %r57, %r56, 4;
add.u32 %r58, %r55, %r57;
mul.lo.u32 %r59, %r58, 4;
add.u32 %r60, %r59, %r7;
ld.shared.u32 %r61, [%r60+-4];
.loc 15 56 0
add.u32 %r62, %r53, 2;
mul.lo.u32 %r63, %r24, %r62;
sub.u32 %r64, %r63, 1;
shr.u32 %r65, %r64, 4;
add.u32 %r66, %r63, %r65;
mul.lo.u32 %r67, %r66, 4;
add.u32 %r68, %r67, %r7;
ld.shared.u32 %r69, [%r68+-4];
st.shared.u32 [%r60+-4], %r69;
.loc 15 57 0
ld.shared.u32 %r70, [%r68+-4];
add.u32 %r71, %r70, %r61;
st.shared.u32 [%r68+-4], %r71;
$Lt_0_11522:
//<loop> Part of loop body line 47, head labeled $Lt_0_11266
.loc 15 49 0
shl.b32 %r22, %r22, 1;
setp.le.s32 %p9, %r22, %r12;
@%p9 bra $Lt_0_11266;
$Lt_0_10754:
.loc 15 60 0
bar.sync 0;
@!%p1 bra $Lt_0_12290;
.loc 15 62 0
ld.shared.u32 %r72, [%r11+0];
ld.param.u32 %r73, [__cudaparm__Z16prefix_sum_blockIjEvPT_S1_j_out];
mul24.lo.u32 %r74, %r2, 4;
add.u32 %r75, %r73, %r74;
st.global.u32 [%r75+0], %r72;
$Lt_0_12290:
@!%p2 bra $Lt_0_12802;
.loc 15 63 0
ld.shared.u32 %r76, [%r21+0];
ld.param.u32 %r77, [__cudaparm__Z16prefix_sum_blockIjEvPT_S1_j_out];
mul.lo.u32 %r78, %r13, 4;
add.u32 %r79, %r77, %r78;
st.global.u32 [%r79+0], %r76;
$Lt_0_12802:
.loc 15 64 0
exit;
$LDWend__Z16prefix_sum_blockIjEvPT_S1_j:
} // _Z16prefix_sum_blockIjEvPT_S1_j

View File

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

View File

@ -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 }
[ <string-writer> dup [ "resource:extra/elf/a.elf" elf-nm ] with-output-stream >string ]
unit-test
cpu ppc? [
{ $ validation-output }
[ <string-writer> dup [ "resource:extra/elf/a.elf" elf-nm ] with-output-stream >string ]
unit-test
] unless

BIN
extra/macho/a2.macho Executable file

Binary file not shown.

View File

@ -1,7 +1,7 @@
! Copyright (C) 2010 Erik Charlebois.
! See http://factorcode.org/license.txt for BSD license.
USING: io io.streams.string kernel literals macho multiline strings
tools.test ;
USING: accessors alien io io.streams.string kernel literals macho
multiline sequences strings system tools.test ;
IN: macho.tests
STRING: validation-output
@ -21,6 +21,14 @@ STRING: validation-output
;
{ $ validation-output }
[ <string-writer> dup [ "resource:extra/macho/a.macho" macho-nm ] with-output-stream >string ]
unit-test
cpu ppc? [
{ $ validation-output }
[ <string-writer> 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

View File

@ -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 <displaced-alien> ]
[ nfat_arch>> 4 >be le> ] bi
<direct-fat_arch-array> [
{
[ nip cputype>> 4 >be le> ]
[ nip cpusubtype>> 4 >be le> ]
[ offset>> 4 >be le> swap >c-ptr <displaced-alien> ]
[ nip size>> 4 >be le> <direct-uchar-array> ]
} 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

View File

@ -10,9 +10,6 @@ IN: mason.version.files
: remote-directory ( string -- string' )
[ upload-directory get ] dip "/" glue ;
: remote ( string version -- string )
remote-directory swap "/" glue ;
: platform ( builder -- string )
[ os>> ] [ cpu>> ] bi (platform) ;
@ -30,10 +27,10 @@ IN: mason.version.files
] [ drop ] 2bi release-directory ;
: remote-binary-release-name ( version builder -- string )
[ binary-release-name ] [ drop ] 2bi remote ;
binary-release-name remote-directory ;
: source-release-name ( version -- string )
[ "factor-src-" ".zip" surround ] keep release-directory ;
: remote-source-release-name ( version -- string )
[ source-release-name ] keep remote ;
source-release-name remote-directory ;

View File

@ -13,7 +13,7 @@ IN: mason.version
: make-release-directory ( version -- )
"Creating release directory..." print flush
[ "mkdir -p " % "" release-directory % "\n" % ] "" make
[ "mkdir -p " % "" release-directory remote-directory % "\n" % ] "" make
execute-on-server ;
: tweet-release ( version announcement-url -- )

View File

@ -28,7 +28,7 @@
<table border="1">
<tr><td>Host name:</td><td><t:xml t:name="host-name" /></td></tr>
<tr><td>Last heartbeat:</td><td><t:xml t:name="last-heartbeat" /></td></tr>
<tr><td>Last heartbeat:</td><td><t:label t:name="heartbeat-timestamp" /></td></tr>
<tr><td>Current status:</td><td><t:xml t:name="status" /></td></tr>
<tr><td>Last build:</td><td><t:xml t:name="last-build" /></td></tr>
<tr><td>Last clean build:</td><td><t:xml t:name="last-clean-build" /></td></tr>

View File

@ -6,7 +6,12 @@ IN: webapps.mason.make-release
: <make-release-action> ( -- action )
<page-action>
[ { { "version" [ v-one-line ] } } validate-params ] >>validate
[
{
{ "version" [ v-one-line ] }
{ "announcement-url" [ v-url ] }
} validate-params
] >>validate
[
[
"version" value "announcement-url" value do-release

View File

@ -0,0 +1 @@
Dmitry Shubin

View File

@ -0,0 +1 @@
Z algorithm for pattern preprocessing

View File

@ -0,0 +1 @@
algorithms

View File

@ -0,0 +1,49 @@
! Copyright (C) 2010 Dmitry Shubin.
! See http://factorcode.org/license.txt for BSD license.
USING: arrays help.markup help.syntax sequences ;
IN: z-algorithm
HELP: lcp
{ $values
{ "seq1" sequence } { "seq2" sequence }
{ "n" "a non-negative integer" }
}
{ $description
"Outputs the length of longest common prefix of two sequences."
} ;
HELP: z-values
{ $values
{ "seq" sequence } { "Z" array }
}
{ $description
"Outputs an array of the same length as " { $snippet "seq" }
", containing Z-values for given sequence. See "
{ $link "z-algorithm" } " for details."
} ;
ARTICLE: "z-algorithm" "Z algorithm"
{ $heading "Definition" }
"Given the sequence " { $snippet "S" } " and the index "
{ $snippet "i" } ", let " { $snippet "i" } "-th Z value of "
{ $snippet "S" } " be the length of the longest subsequence of "
{ $snippet "S" } " that starts at " { $snippet "i" }
" and matches the prefix of " { $snippet "S" } "."
{ $heading "Example" }
"Here is an example for string " { $snippet "\"abababaca\"" } ":"
{ $table
{ { $snippet "i:" } "0" "1" "2" "3" "4" "5" "6" "7" "8" }
{ { $snippet "S:" } "a" "b" "a" "b" "a" "b" "a" "c" "a" }
{ { $snippet "Z:" } "9" "0" "5" "0" "3" "0" "1" "0" "1" }
}
{ $heading "Summary" }
"The " { $vocab-link "z-algorithm" }
" vocabulary implements algorithm for finding all Z values for sequence "
{ $snippet "S" }
" in linear time. In contrast to naive approach which takes "
{ $snippet "Θ(n^2)" } " time."
;
ABOUT: "z-algorithm"

View File

@ -0,0 +1,13 @@
! Copyright (C) 2010 Dmitry Shubin.
! See http://factorcode.org/license.txt for BSD license.
USING: tools.test z-algorithm ;
IN: z-algorithm.tests
[ 0 ] [ "qwerty" "" lcp ] unit-test
[ 0 ] [ "qwerty" "asdf" lcp ] unit-test
[ 3 ] [ "qwerty" "qwe" lcp ] unit-test
[ 3 ] [ "qwerty" "qwet" lcp ] unit-test
[ { } ] [ "" z-values ] unit-test
[ { 1 } ] [ "q" z-values ] unit-test
[ { 9 0 5 0 3 0 1 0 1 } ] [ "abababaca" z-values ] unit-test

View File

@ -0,0 +1,38 @@
! Copyright (C) 2010 Dmitry Shubin.
! See http://factorcode.org/license.txt for BSD license.
USING: arrays combinators.smart kernel locals math math.ranges
sequences sequences.private ;
IN: z-algorithm
: lcp ( seq1 seq2 -- n )
[ min-length ] 2keep mismatch [ nip ] when* ;
<PRIVATE
:: out-of-zbox ( seq Z l r k -- seq Z l r )
seq k tail-slice seq lcp :> Zk
Zk Z push seq Z
Zk 0 > [ k Zk k + 1 - ] [ l r ] if ; inline
:: inside-zbox ( seq Z l r k -- seq Z l r )
k l - Z nth :> Zk'
r k - 1 + :> b
seq Z Zk' b <
[ Zk' Z push l r ] ! still inside
[
seq r 1 + seq b [ tail-slice ] 2bi@ lcp :> q
q b + Z push k q r +
] if ; inline
: (z-value) ( seq Z l r k -- seq Z l r )
2dup < [ out-of-zbox ] [ inside-zbox ] if ; inline
:: (z-values) ( seq -- Z )
V{ } clone 0 0 seq length :> ( Z l r len )
len Z push [ seq Z l r 1 len [a,b) [ (z-value) ] each ]
drop-outputs Z ; inline
PRIVATE>
: z-values ( seq -- Z )
dup length 0 > [ (z-values) ] when >array ;

View File

@ -174,8 +174,11 @@ interacting with a factor listener is at your disposal.
(setq fuel-stack-mode-string "/S")
(when fuel-mode-stack-p (fuel-stack-mode fuel-mode))
(when (and fuel-mode (not (file-exists-p (buffer-file-name))))
(fuel-scaffold--maybe-insert)))
(let ((file-name (buffer-file-name)))
(when (and fuel-mode
file-name
(not (file-exists-p file-name)))
(fuel-scaffold--maybe-insert))))
;;; Keys: