Merge branch 'master' of git://factorcode.org/git/factor
Conflicts: basis/compiler/codegen/codegen.factordb4
Joe Groff
parent
952498ef69
commit
53b265f682
|
|
@ -1,7 +1,8 @@
|
|||
! Copyright (C) 2009 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: byte-arrays checksums checksums.md5 io.encodings.binary
|
||||
io.streams.byte-array kernel math namespaces tools.test ;
|
||||
io.streams.byte-array kernel math namespaces tools.test
|
||||
sequences ;
|
||||
IN: checksums.md5.tests
|
||||
|
||||
[ "d41d8cd98f00b204e9800998ecf8427e" ] [ "" >byte-array md5 checksum-bytes hex-string ] unit-test
|
||||
|
|
@ -33,3 +34,9 @@ IN: checksums.md5.tests
|
|||
<md5-state> "asdf" binary <byte-reader> add-checksum-stream
|
||||
[ get-checksum ] [ get-checksum ] bi =
|
||||
] unit-test
|
||||
|
||||
[
|
||||
t
|
||||
] [
|
||||
{ "abcd" "efg" } md5 checksum-lines length 16 =
|
||||
] unit-test
|
||||
|
|
|
|||
|
|
@ -159,9 +159,12 @@ IN: compiler.cfg.builder.tests
|
|||
{ pinned-c-ptr class fixnum } \ set-alien-cell '[ _ declare _ execute ] unit-test-cfg
|
||||
] each
|
||||
|
||||
: contains-insn? ( quot insn-check -- ? )
|
||||
: count-insns ( quot insn-check -- ? )
|
||||
[ test-mr [ instructions>> ] map ] dip
|
||||
'[ _ any? ] any? ; inline
|
||||
'[ _ count ] sigma ; inline
|
||||
|
||||
: contains-insn? ( quot insn-check -- ? )
|
||||
count-insns 0 > ; inline
|
||||
|
||||
[ t ] [ [ swap ] [ ##replace? ] contains-insn? ] unit-test
|
||||
|
||||
|
|
@ -197,14 +200,16 @@ IN: compiler.cfg.builder.tests
|
|||
[ f t ] [
|
||||
[ { byte-array fixnum } declare alien-cell 4 alien-float ]
|
||||
[ [ ##box-alien? ] contains-insn? ]
|
||||
[ [ ##box-float? ] contains-insn? ] bi
|
||||
[ [ ##allot? ] contains-insn? ] bi
|
||||
] unit-test
|
||||
|
||||
[ f t ] [
|
||||
[ { byte-array fixnum } declare alien-cell { simple-alien } declare 4 alien-float ]
|
||||
[ [ ##box-alien? ] contains-insn? ]
|
||||
[ [ ##box-float? ] contains-insn? ] bi
|
||||
[ [ ##allot? ] contains-insn? ] bi
|
||||
] unit-test
|
||||
|
||||
[ 1 ] [ [ dup float+ ] [ ##alien-double? ] count-insns ] unit-test
|
||||
] when
|
||||
|
||||
! Regression. Make sure everything is inlined correctly
|
||||
|
|
|
|||
|
|
@ -16,7 +16,7 @@ V{
|
|||
} 0 test-bb
|
||||
|
||||
V{
|
||||
T{ ##box-float f 0 1 }
|
||||
T{ ##box-alien f 0 1 }
|
||||
} 1 test-bb
|
||||
|
||||
0 1 edge
|
||||
|
|
|
|||
|
|
@ -49,24 +49,9 @@ insn-classes get [
|
|||
[ ##load-reference ]
|
||||
} cond ;
|
||||
|
||||
: ^^unbox-c-ptr ( src class -- dst )
|
||||
[ next-vreg dup ] 2dip next-vreg ##unbox-c-ptr ;
|
||||
|
||||
: ^^allot-tuple ( n -- dst )
|
||||
2 + cells tuple ^^allot ;
|
||||
|
||||
: ^^allot-array ( n -- dst )
|
||||
2 + cells array ^^allot ;
|
||||
|
||||
: ^^allot-byte-array ( n -- dst )
|
||||
2 cells + byte-array ^^allot ;
|
||||
|
||||
: ^^offset>slot ( slot -- vreg' )
|
||||
cell 4 = [ 1 ^^shr-imm ] [ any-rep ^^copy ] if ;
|
||||
|
||||
: ^^tag-offset>slot ( slot tag -- vreg' )
|
||||
[ ^^offset>slot ] dip ^^sub-imm ;
|
||||
|
||||
: ^^tag-fixnum ( src -- dst )
|
||||
tag-bits get ^^shl-imm ;
|
||||
|
||||
|
|
|
|||
|
|
@ -199,15 +199,6 @@ def: dst/int-rep
|
|||
use: src/int-rep ;
|
||||
|
||||
! Float arithmetic
|
||||
PURE-INSN: ##unbox-float
|
||||
def: dst/double-rep
|
||||
use: src/int-rep ;
|
||||
|
||||
PURE-INSN: ##box-float
|
||||
def: dst/int-rep
|
||||
use: src/double-rep
|
||||
temp: temp/int-rep ;
|
||||
|
||||
PURE-INSN: ##add-float
|
||||
def: dst/double-rep
|
||||
use: src1/double-rep src2/double-rep ;
|
||||
|
|
@ -266,18 +257,6 @@ def: dst/double-rep
|
|||
use: src/int-rep ;
|
||||
|
||||
! SIMD operations
|
||||
|
||||
PURE-INSN: ##box-vector
|
||||
def: dst/int-rep
|
||||
use: src
|
||||
literal: rep
|
||||
temp: temp/int-rep ;
|
||||
|
||||
PURE-INSN: ##unbox-vector
|
||||
def: dst
|
||||
use: src/int-rep
|
||||
literal: rep ;
|
||||
|
||||
PURE-INSN: ##zero-vector
|
||||
def: dst
|
||||
literal: rep ;
|
||||
|
|
@ -760,8 +739,6 @@ literal: n ;
|
|||
|
||||
UNION: ##allocation
|
||||
##allot
|
||||
##box-float
|
||||
##box-vector
|
||||
##box-alien
|
||||
##box-displaced-alien ;
|
||||
|
||||
|
|
|
|||
|
|
@ -3,8 +3,9 @@
|
|||
USING: accessors kernel sequences alien math classes.algebra fry
|
||||
locals combinators combinators.short-circuit cpu.architecture
|
||||
compiler.tree.propagation.info compiler.cfg.hats
|
||||
compiler.cfg.stacks compiler.cfg.instructions
|
||||
compiler.cfg.utilities compiler.cfg.builder.blocks ;
|
||||
compiler.cfg.registers compiler.cfg.stacks
|
||||
compiler.cfg.instructions compiler.cfg.utilities
|
||||
compiler.cfg.builder.blocks ;
|
||||
IN: compiler.cfg.intrinsics.alien
|
||||
|
||||
: emit-<displaced-alien>? ( node -- ? )
|
||||
|
|
@ -33,6 +34,9 @@ IN: compiler.cfg.intrinsics.alien
|
|||
[ second class>> fixnum class<= ]
|
||||
bi and ;
|
||||
|
||||
: ^^unbox-c-ptr ( src class -- dst )
|
||||
[ next-vreg dup ] 2dip next-vreg ##unbox-c-ptr ;
|
||||
|
||||
: prepare-alien-accessor ( info -- ptr-vreg offset )
|
||||
class>> [ 2inputs ^^untag-fixnum swap ] dip ^^unbox-c-ptr ^^add 0 ;
|
||||
|
||||
|
|
|
|||
|
|
@ -18,6 +18,9 @@ IN: compiler.cfg.intrinsics.allot
|
|||
: tuple-slot-regs ( layout -- vregs )
|
||||
[ second ds-load ] [ ^^load-literal ] bi prefix ;
|
||||
|
||||
: ^^allot-tuple ( n -- dst )
|
||||
2 + cells tuple ^^allot ;
|
||||
|
||||
: emit-<tuple-boa> ( node -- )
|
||||
dup node-input-infos last literal>>
|
||||
dup array? [
|
||||
|
|
@ -36,6 +39,9 @@ IN: compiler.cfg.intrinsics.allot
|
|||
: expand-<array>? ( obj -- ? )
|
||||
dup integer? [ 0 8 between? ] [ drop f ] if ;
|
||||
|
||||
: ^^allot-array ( n -- dst )
|
||||
2 + cells array ^^allot ;
|
||||
|
||||
:: emit-<array> ( node -- )
|
||||
[let | len [ node node-input-infos first literal>> ] |
|
||||
len expand-<array>? [
|
||||
|
|
@ -54,6 +60,9 @@ IN: compiler.cfg.intrinsics.allot
|
|||
|
||||
: bytes>cells ( m -- n ) cell align cell /i ;
|
||||
|
||||
: ^^allot-byte-array ( n -- dst )
|
||||
2 cells + byte-array ^^allot ;
|
||||
|
||||
: emit-allot-byte-array ( len -- dst )
|
||||
ds-drop
|
||||
dup ^^allot-byte-array
|
||||
|
|
|
|||
|
|
@ -8,6 +8,9 @@ IN: compiler.cfg.intrinsics.slots
|
|||
|
||||
: value-tag ( info -- n ) class>> class-tag ; inline
|
||||
|
||||
: ^^tag-offset>slot ( slot tag -- vreg' )
|
||||
[ ^^offset>slot ] dip ^^sub-imm ;
|
||||
|
||||
: (emit-slot) ( infos -- dst )
|
||||
[ 2inputs ] [ first value-tag ] bi*
|
||||
^^tag-offset>slot ^^slot ;
|
||||
|
|
|
|||
|
|
@ -1,8 +1,10 @@
|
|||
! Copyright (C) 2009 Slava Pestov
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel fry accessors sequences assocs sets namespaces
|
||||
arrays combinators combinators.short-circuit make locals deques
|
||||
dlists layouts cpu.architecture compiler.utilities
|
||||
arrays combinators combinators.short-circuit math make locals
|
||||
deques dlists layouts byte-arrays cpu.architecture
|
||||
compiler.utilities
|
||||
compiler.constants
|
||||
compiler.cfg
|
||||
compiler.cfg.rpo
|
||||
compiler.cfg.hats
|
||||
|
|
@ -25,24 +27,31 @@ GENERIC: emit-unbox ( dst src rep -- )
|
|||
M:: float-rep emit-box ( dst src rep -- )
|
||||
double-rep next-vreg-rep :> temp
|
||||
temp src ##single>double-float
|
||||
dst temp int-rep next-vreg-rep ##box-float ;
|
||||
dst temp double-rep emit-box ;
|
||||
|
||||
M:: float-rep emit-unbox ( dst src rep -- )
|
||||
double-rep next-vreg-rep :> temp
|
||||
temp src ##unbox-float
|
||||
temp src double-rep emit-unbox
|
||||
dst temp ##double>single-float ;
|
||||
|
||||
M: double-rep emit-box
|
||||
drop int-rep next-vreg-rep ##box-float ;
|
||||
drop
|
||||
[ drop 16 float int-rep next-vreg-rep ##allot ]
|
||||
[ float-offset swap ##set-alien-double ]
|
||||
2bi ;
|
||||
|
||||
M: double-rep emit-unbox
|
||||
drop ##unbox-float ;
|
||||
drop float-offset ##alien-double ;
|
||||
|
||||
M: vector-rep emit-box
|
||||
int-rep next-vreg-rep ##box-vector ;
|
||||
M:: vector-rep emit-box ( dst src rep -- )
|
||||
int-rep next-vreg-rep :> temp
|
||||
dst 16 2 cells + byte-array int-rep next-vreg-rep ##allot
|
||||
temp 16 tag-fixnum ##load-immediate
|
||||
temp dst 1 byte-array tag-number ##set-slot-imm
|
||||
dst byte-array-offset src rep ##set-alien-vector ;
|
||||
|
||||
M: vector-rep emit-unbox
|
||||
##unbox-vector ;
|
||||
[ byte-array-offset ] dip ##alien-vector ;
|
||||
|
||||
M:: scalar-rep emit-box ( dst src rep -- )
|
||||
int-rep next-vreg-rep :> temp
|
||||
|
|
@ -143,6 +152,9 @@ SYMBOL: costs
|
|||
! Insert conversions. This introduces new temporaries, so we need
|
||||
! to rename opearands too.
|
||||
|
||||
! Mapping from vreg,rep pairs to vregs
|
||||
SYMBOL: alternatives
|
||||
|
||||
:: emit-def-conversion ( dst preferred required -- new-dst' )
|
||||
! If an instruction defines a register with representation 'required',
|
||||
! but the register has preferred representation 'preferred', then
|
||||
|
|
@ -155,7 +167,13 @@ SYMBOL: costs
|
|||
! but the register has preferred representation 'preferred', then
|
||||
! we rename the instruction's input to a new register, which
|
||||
! becomes the output of a conversion instruction.
|
||||
required next-vreg-rep [ src required preferred emit-conversion ] keep ;
|
||||
preferred required eq? [ src ] [
|
||||
src required alternatives get [
|
||||
required next-vreg-rep :> new-src
|
||||
[ new-src ] 2dip preferred emit-conversion
|
||||
new-src
|
||||
] 2cache
|
||||
] if ;
|
||||
|
||||
SYMBOLS: renaming-set needs-renaming? ;
|
||||
|
||||
|
|
@ -236,6 +254,7 @@ M: insn conversions-for-insn , ;
|
|||
dup kill-block? [ drop ] [
|
||||
[
|
||||
[
|
||||
H{ } clone alternatives set
|
||||
[ conversions-for-insn ] each
|
||||
] V{ } make
|
||||
] change-instructions drop
|
||||
|
|
|
|||
|
|
@ -109,19 +109,15 @@ IN: compiler.cfg.value-numbering.tests
|
|||
{
|
||||
T{ ##peek f 8 D 0 }
|
||||
T{ ##peek f 9 D -1 }
|
||||
T{ ##unbox-float f 10 8 }
|
||||
T{ ##unbox-float f 11 9 }
|
||||
T{ ##compare-float-unordered f 12 10 11 cc< }
|
||||
T{ ##compare-float-unordered f 14 10 11 cc/< }
|
||||
T{ ##compare-float-unordered f 12 8 9 cc< }
|
||||
T{ ##compare-float-unordered f 14 8 9 cc/< }
|
||||
T{ ##replace f 14 D 0 }
|
||||
}
|
||||
] [
|
||||
{
|
||||
T{ ##peek f 8 D 0 }
|
||||
T{ ##peek f 9 D -1 }
|
||||
T{ ##unbox-float f 10 8 }
|
||||
T{ ##unbox-float f 11 9 }
|
||||
T{ ##compare-float-unordered f 12 10 11 cc< }
|
||||
T{ ##compare-float-unordered f 12 8 9 cc< }
|
||||
T{ ##compare-imm f 14 12 5 cc= }
|
||||
T{ ##replace f 14 D 0 }
|
||||
} value-numbering-step trim-temps
|
||||
|
|
|
|||
|
|
@ -146,8 +146,6 @@ CODEGEN: ##not %not
|
|||
CODEGEN: ##neg %neg
|
||||
CODEGEN: ##log2 %log2
|
||||
CODEGEN: ##copy %copy
|
||||
CODEGEN: ##unbox-float %unbox-float
|
||||
CODEGEN: ##box-float %box-float
|
||||
CODEGEN: ##add-float %add-float
|
||||
CODEGEN: ##sub-float %sub-float
|
||||
CODEGEN: ##mul-float %mul-float
|
||||
|
|
@ -161,14 +159,12 @@ CODEGEN: ##single>double-float %single>double-float
|
|||
CODEGEN: ##double>single-float %double>single-float
|
||||
CODEGEN: ##integer>float %integer>float
|
||||
CODEGEN: ##float>integer %float>integer
|
||||
CODEGEN: ##unbox-vector %unbox-vector
|
||||
CODEGEN: ##zero-vector %zero-vector
|
||||
CODEGEN: ##gather-vector-2 %gather-vector-2
|
||||
CODEGEN: ##gather-vector-4 %gather-vector-4
|
||||
CODEGEN: ##shuffle-vector %shuffle-vector
|
||||
CODEGEN: ##compare-vector %compare-vector
|
||||
CODEGEN: ##test-vector %test-vector
|
||||
CODEGEN: ##box-vector %box-vector
|
||||
CODEGEN: ##add-vector %add-vector
|
||||
CODEGEN: ##saturated-add-vector %saturated-add-vector
|
||||
CODEGEN: ##add-sub-vector %add-sub-vector
|
||||
|
|
|
|||
|
|
@ -46,20 +46,6 @@ IN: compiler.tests.low-level-ir
|
|||
} compile-test-bb
|
||||
] unit-test
|
||||
|
||||
! ##copy on floats. We can only run this test if float intrinsics
|
||||
! are enabled.
|
||||
\ float+ "intrinsic" word-prop [
|
||||
[ 1.5 ] [
|
||||
V{
|
||||
T{ ##load-reference f 4 1.5 }
|
||||
T{ ##unbox-float f 1 4 }
|
||||
T{ ##copy f 2 1 double-rep }
|
||||
T{ ##box-float f 3 2 }
|
||||
T{ ##copy f 0 3 int-rep }
|
||||
} compile-test-bb
|
||||
] unit-test
|
||||
] when
|
||||
|
||||
! make sure slot access works when the destination is
|
||||
! one of the sources
|
||||
[ t ] [
|
||||
|
|
|
|||
|
|
@ -197,9 +197,6 @@ HOOK: %fixnum-add cpu ( label dst src1 src2 -- )
|
|||
HOOK: %fixnum-sub cpu ( label dst src1 src2 -- )
|
||||
HOOK: %fixnum-mul cpu ( label dst src1 src2 -- )
|
||||
|
||||
HOOK: %unbox-float cpu ( dst src -- )
|
||||
HOOK: %box-float cpu ( dst src temp -- )
|
||||
|
||||
HOOK: %add-float cpu ( dst src1 src2 -- )
|
||||
HOOK: %sub-float cpu ( dst src1 src2 -- )
|
||||
HOOK: %mul-float cpu ( dst src1 src2 -- )
|
||||
|
|
@ -216,9 +213,6 @@ HOOK: %double>single-float cpu ( dst src -- )
|
|||
HOOK: %integer>float cpu ( dst src -- )
|
||||
HOOK: %float>integer cpu ( dst src -- )
|
||||
|
||||
HOOK: %box-vector cpu ( dst src temp rep -- )
|
||||
HOOK: %unbox-vector cpu ( dst src rep -- )
|
||||
|
||||
HOOK: %zero-vector cpu ( dst rep -- )
|
||||
HOOK: %gather-vector-2 cpu ( dst src1 src2 rep -- )
|
||||
HOOK: %gather-vector-4 cpu ( dst src1 src2 src3 src4 rep -- )
|
||||
|
|
|
|||
|
|
@ -230,12 +230,6 @@ M: ppc %copy ( dst src rep -- )
|
|||
} case
|
||||
] if ;
|
||||
|
||||
M: ppc %unbox-float ( dst src -- ) float-offset LFD ;
|
||||
|
||||
M:: ppc %box-float ( dst src temp -- )
|
||||
dst 16 float temp %allot
|
||||
src dst float-offset STFD ;
|
||||
|
||||
GENERIC: float-function-param* ( dst src -- )
|
||||
|
||||
M: spill-slot float-function-param* [ 1 ] dip n>> spill@ LFD ;
|
||||
|
|
@ -399,13 +393,13 @@ M: ppc %alien-cell LWZ ;
|
|||
M: ppc %alien-float LFS ;
|
||||
M: ppc %alien-double LFD ;
|
||||
|
||||
M: ppc %set-alien-integer-1 swapd STB ;
|
||||
M: ppc %set-alien-integer-2 swapd STH ;
|
||||
M: ppc %set-alien-integer-1 -rot STB ;
|
||||
M: ppc %set-alien-integer-2 -rot STH ;
|
||||
|
||||
M: ppc %set-alien-cell swapd STW ;
|
||||
M: ppc %set-alien-cell -rot STW ;
|
||||
|
||||
M: ppc %set-alien-float swapd STFS ;
|
||||
M: ppc %set-alien-double swapd STFD ;
|
||||
M: ppc %set-alien-float -rot STFS ;
|
||||
M: ppc %set-alien-double -rot STFD ;
|
||||
|
||||
: load-zone-ptr ( reg -- )
|
||||
"nursery" %load-vm-field-addr ;
|
||||
|
|
|
|||
|
|
@ -474,13 +474,6 @@ M: x86 %double>single-float CVTSD2SS ;
|
|||
M: x86 %integer>float CVTSI2SD ;
|
||||
M: x86 %float>integer CVTTSD2SI ;
|
||||
|
||||
M: x86 %unbox-float ( dst src -- )
|
||||
float-offset [+] MOVSD ;
|
||||
|
||||
M:: x86 %box-float ( dst src temp -- )
|
||||
dst 16 float temp %allot
|
||||
dst float-offset [+] src MOVSD ;
|
||||
|
||||
: %cmov-float= ( dst src -- )
|
||||
[
|
||||
"no-move" define-label
|
||||
|
|
@ -561,16 +554,6 @@ M: x86 %compare-float-ordered-branch ( label src1 src2 cc -- )
|
|||
M: x86 %compare-float-unordered-branch ( label src1 src2 cc -- )
|
||||
\ UCOMISD (%compare-float-branch) ;
|
||||
|
||||
M:: x86 %box-vector ( dst src rep temp -- )
|
||||
dst rep rep-size 2 cells + byte-array temp %allot
|
||||
16 tag-fixnum dst 1 byte-array tag-number %set-slot-imm
|
||||
dst byte-array-offset [+]
|
||||
src rep %copy ;
|
||||
|
||||
M:: x86 %unbox-vector ( dst src rep -- )
|
||||
dst src byte-array-offset [+]
|
||||
rep %copy ;
|
||||
|
||||
MACRO: available-reps ( alist -- )
|
||||
! Each SSE version adds new representations and supports
|
||||
! all old ones
|
||||
|
|
|
|||
|
|
@ -8,6 +8,7 @@ sequences.private strings words definitions macros cpu.architecture
|
|||
namespaces arrays quotations combinators combinators.short-circuit sets
|
||||
layouts ;
|
||||
QUALIFIED-WITH: alien.c-types c
|
||||
QUALIFIED: math.private
|
||||
IN: math.vectors.simd.functor
|
||||
|
||||
ERROR: bad-length got expected ;
|
||||
|
|
@ -36,8 +37,8 @@ MACRO: simd-boa ( rep class -- simd-array )
|
|||
|
||||
: can-be-unboxed? ( type -- ? )
|
||||
{
|
||||
{ c:float [ t ] }
|
||||
{ c:double [ t ] }
|
||||
{ c:float [ \ math.private:float+ "intrinsic" word-prop ] }
|
||||
{ c:double [ \ math.private:float+ "intrinsic" word-prop ] }
|
||||
[ c:heap-size cell < ]
|
||||
} case ;
|
||||
|
||||
|
|
@ -57,7 +58,7 @@ MACRO: simd-boa ( rep class -- simd-array )
|
|||
: simd-with ( rep class x -- simd-array )
|
||||
[ rep-components ] [ new ] [ '[ _ ] ] tri* swap replicate-as ; inline
|
||||
|
||||
: simd-with-fast? ( rep -- ? )
|
||||
: simd-with/nth-fast? ( rep -- ? )
|
||||
[ \ (simd-vshuffle) supported-simd-op? ]
|
||||
[ rep-component-type can-be-unboxed? ]
|
||||
bi and ;
|
||||
|
|
@ -65,16 +66,11 @@ MACRO: simd-boa ( rep class -- simd-array )
|
|||
:: define-with-custom-inlining ( word rep class -- )
|
||||
word [
|
||||
drop
|
||||
rep simd-with-fast? [
|
||||
rep simd-with/nth-fast? [
|
||||
[ rep rep-coerce rep (simd-with) class boa ]
|
||||
] [ word def>> ] if
|
||||
] "custom-inlining" set-word-prop ;
|
||||
|
||||
: simd-nth-fast? ( rep -- ? )
|
||||
[ \ (simd-vshuffle) supported-simd-op? ]
|
||||
[ rep-component-type can-be-unboxed? ]
|
||||
bi and ;
|
||||
|
||||
: simd-nth-fast ( rep -- quot )
|
||||
[ rep-components ] keep
|
||||
'[ swap _ '[ _ _ (simd-select) ] 2array ] map-index
|
||||
|
|
@ -84,7 +80,7 @@ MACRO: simd-boa ( rep class -- simd-array )
|
|||
rep-component-type dup c:c-type-getter-boxer c:array-accessor ;
|
||||
|
||||
MACRO: simd-nth ( rep -- x )
|
||||
dup simd-nth-fast? [ simd-nth-fast ] [ simd-nth-slow ] if ;
|
||||
dup simd-with/nth-fast? [ simd-nth-fast ] [ simd-nth-slow ] if ;
|
||||
|
||||
: boa-effect ( rep n -- effect )
|
||||
[ rep-components ] dip *
|
||||
|
|
|
|||
|
|
@ -30,3 +30,6 @@ IN: random.tests
|
|||
|
||||
[ 3 ] [ { 1 2 3 4 } 3 sample prune length ] unit-test
|
||||
[ 99 ] [ 100 99 sample prune length ] unit-test
|
||||
|
||||
[ ]
|
||||
[ [ 100 random-bytes ] with-system-random drop ] unit-test
|
||||
|
|
|
|||
|
|
@ -22,7 +22,7 @@ M: object random-bytes* ( n tuple -- byte-array )
|
|||
[ 2drop ] [ random-32* 4 >le swap head over push-all ] if
|
||||
] bi-curry bi* ;
|
||||
|
||||
M: object random-32* ( tuple -- r ) 4 random-bytes* le> ;
|
||||
M: object random-32* ( tuple -- r ) 4 swap random-bytes* le> ;
|
||||
|
||||
ERROR: no-random-number-generator ;
|
||||
|
||||
|
|
|
|||
|
|
@ -1,6 +1,7 @@
|
|||
! Copyright (C) 2008 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: alien.c-types alien.syntax unix.types unix.stat classes.struct ;
|
||||
USING: alien.c-types alien.syntax unix.types classes.struct
|
||||
unix.stat ;
|
||||
IN: unix.statfs.openbsd
|
||||
|
||||
CONSTANT: MFSNAMELEN 16
|
||||
|
|
@ -30,4 +31,4 @@ STRUCT: statfs
|
|||
{ f_mntfromname { char MNAMELEN } }
|
||||
{ mount_info char[160] } ;
|
||||
|
||||
FUNCTION: int statfs ( char* path, statvfs* buf ) ;
|
||||
FUNCTION: int statfs ( char* path, statfs* buf ) ;
|
||||
|
|
|
|||
Loading…
Reference in New Issue