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

Conflicts:
	basis/compiler/codegen/codegen.factor

basis/checksums/md5/md5-tests.factor

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

basis/compiler/cfg/builder/builder-tests.factor

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

basis/compiler/cfg/gc-checks/gc-checks-tests.factor

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

basis/compiler/cfg/hats/hats.factor

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

basis/compiler/cfg/instructions/instructions.factor

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

basis/compiler/cfg/intrinsics/alien/alien.factor

@@ -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.registers compiler.cfg.stacks
-compiler.cfg.utilities compiler.cfg.builder.blocks ;
+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 ;
 

basis/compiler/cfg/intrinsics/allot/allot.factor

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

basis/compiler/cfg/intrinsics/slots/slots.factor

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

basis/compiler/cfg/representations/representations.factor

@@ -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
+arrays combinators combinators.short-circuit math make locals
-dlists layouts cpu.architecture compiler.utilities
+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
+M:: vector-rep emit-box ( dst src rep -- )
-    int-rep next-vreg-rep ##box-vector ;
+    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

basis/compiler/cfg/value-numbering/value-numbering-tests.factor

@@ -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{ ##compare-float-unordered f 12 8 9 cc< }
-        T{ ##unbox-float f 11 9 }
+        T{ ##compare-float-unordered f 14 8 9 cc/< }
-        T{ ##compare-float-unordered f 12 10 11 cc< }
-        T{ ##compare-float-unordered f 14 10 11 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{ ##compare-float-unordered f 12 8 9 cc< }
-        T{ ##unbox-float f 11 9 }
-        T{ ##compare-float-unordered f 12 10 11 cc< }
         T{ ##compare-imm f 14 12 5 cc= }
         T{ ##replace f 14 D 0 }
     } value-numbering-step trim-temps

basis/compiler/codegen/codegen.factor

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

basis/compiler/tests/low-level-ir.factor

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

basis/cpu/architecture/architecture.factor

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

basis/cpu/ppc/ppc.factor

@@ -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-1 -rot STB ;
-M: ppc %set-alien-integer-2 swapd STH ;
+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-float -rot STFS ;
-M: ppc %set-alien-double swapd STFD ;
+M: ppc %set-alien-double -rot STFD ;
 
 : load-zone-ptr ( reg -- )
     "nursery" %load-vm-field-addr ;

basis/cpu/x86/x86.factor

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

basis/math/vectors/simd/functor/functor.factor

@@ -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:float [ \ math.private:float+ "intrinsic" word-prop ] }
-        { c:double [ t ] }
+        { 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 *

basis/random/random-tests.factor

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

basis/random/random.factor

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

basis/unix/statfs/openbsd/openbsd.factor

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