Merge branch 'master' of git://factorcode.org/git/factor
commit
8e0a31669f
|
@ -295,6 +295,4 @@ os windows? [
|
||||||
4 "double" c-type (>>align)
|
4 "double" c-type (>>align)
|
||||||
] unless
|
] unless
|
||||||
|
|
||||||
USE: vocabs.loader
|
|
||||||
|
|
||||||
"cpu.x86.features" require
|
"cpu.x86.features" require
|
||||||
|
|
|
@ -1,7 +1,7 @@
|
||||||
USING: cpu.x86.features tools.test kernel sequences math system ;
|
USING: cpu.x86.features tools.test kernel sequences math math.order system ;
|
||||||
IN: cpu.x86.features.tests
|
IN: cpu.x86.features.tests
|
||||||
|
|
||||||
cpu x86? [
|
cpu x86? [
|
||||||
[ t ] [ sse2? { t f } member? ] unit-test
|
[ t ] [ sse-version 0 42 between? ] unit-test
|
||||||
[ t ] [ [ 10000 [ ] times ] count-instructions integer? ] unit-test
|
[ t ] [ [ 10000 [ ] times ] count-instructions integer? ] unit-test
|
||||||
] when
|
] when
|
||||||
|
|
|
@ -129,8 +129,9 @@ ERROR: not-absolute-path ;
|
||||||
[ first Letter? ]
|
[ first Letter? ]
|
||||||
} 1&& [ 2 head "\\" append ] [ not-absolute-path ] if ;
|
} 1&& [ 2 head "\\" append ] [ not-absolute-path ] if ;
|
||||||
|
|
||||||
M: winnt file-system-info ( path -- file-system-info )
|
<PRIVATE
|
||||||
normalize-path root-directory
|
|
||||||
|
: (file-system-info) ( path -- file-system-info )
|
||||||
dup [ volume-information ] [ file-system-space ] bi
|
dup [ volume-information ] [ file-system-space ] bi
|
||||||
\ win32-file-system-info new
|
\ win32-file-system-info new
|
||||||
swap *ulonglong >>free-space
|
swap *ulonglong >>free-space
|
||||||
|
@ -144,6 +145,11 @@ M: winnt file-system-info ( path -- file-system-info )
|
||||||
swap >>mount-point
|
swap >>mount-point
|
||||||
calculate-file-system-info ;
|
calculate-file-system-info ;
|
||||||
|
|
||||||
|
PRIVATE>
|
||||||
|
|
||||||
|
M: winnt file-system-info ( path -- file-system-info )
|
||||||
|
normalize-path root-directory (file-system-info) ;
|
||||||
|
|
||||||
: volume>paths ( string -- array )
|
: volume>paths ( string -- array )
|
||||||
16384 <ushort-array> tuck dup length
|
16384 <ushort-array> tuck dup length
|
||||||
0 <uint> dup [ GetVolumePathNamesForVolumeName 0 = ] dip swap [
|
0 <uint> dup [ GetVolumePathNamesForVolumeName 0 = ] dip swap [
|
||||||
|
@ -180,7 +186,7 @@ M: winnt file-system-info ( path -- file-system-info )
|
||||||
M: winnt file-systems ( -- array )
|
M: winnt file-systems ( -- array )
|
||||||
find-volumes [ volume>paths ] map
|
find-volumes [ volume>paths ] map
|
||||||
concat [
|
concat [
|
||||||
[ file-system-info ]
|
[ (file-system-info) ]
|
||||||
[ drop \ file-system-info new swap >>mount-point ] recover
|
[ drop \ file-system-info new swap >>mount-point ] recover
|
||||||
] map ;
|
] map ;
|
||||||
|
|
||||||
|
|
|
@ -76,7 +76,7 @@ PREDICATE: vector-word < word vector-words key? ;
|
||||||
dup "specializations" word-prop
|
dup "specializations" word-prop
|
||||||
[ ] [ V{ } clone [ "specializations" set-word-prop ] keep ] ?if ;
|
[ ] [ V{ } clone [ "specializations" set-word-prop ] keep ] ?if ;
|
||||||
|
|
||||||
M: vector-word subwords specializations values ;
|
M: vector-word subwords specializations values [ word? ] filter ;
|
||||||
|
|
||||||
: add-specialization ( new-word signature word -- )
|
: add-specialization ( new-word signature word -- )
|
||||||
specializations set-at ;
|
specializations set-at ;
|
||||||
|
|
|
@ -2,7 +2,8 @@ IN: specialized-arrays.tests
|
||||||
USING: tools.test alien.syntax specialized-arrays sequences
|
USING: tools.test alien.syntax specialized-arrays sequences
|
||||||
specialized-arrays.int specialized-arrays.bool
|
specialized-arrays.int specialized-arrays.bool
|
||||||
specialized-arrays.ushort alien.c-types accessors kernel
|
specialized-arrays.ushort alien.c-types accessors kernel
|
||||||
specialized-arrays.char specialized-arrays.uint arrays combinators ;
|
specialized-arrays.char specialized-arrays.uint
|
||||||
|
specialized-arrays.float arrays combinators compiler ;
|
||||||
|
|
||||||
[ t ] [ { 1 2 3 } >int-array int-array? ] unit-test
|
[ t ] [ { 1 2 3 } >int-array int-array? ] unit-test
|
||||||
|
|
||||||
|
|
|
@ -129,8 +129,11 @@ CONSTANT: button-clicked-background COLOR: FactorDarkSlateBlue
|
||||||
<border-button-state-pen> dup dup
|
<border-button-state-pen> dup dup
|
||||||
<button-pen> ;
|
<button-pen> ;
|
||||||
|
|
||||||
|
: border-button-label-theme ( gadget -- )
|
||||||
|
dup label? [ [ clone t >>bold? ] change-font ] when drop ;
|
||||||
|
|
||||||
: border-button-theme ( gadget -- gadget )
|
: border-button-theme ( gadget -- gadget )
|
||||||
dup children>> first font>> t >>bold? drop
|
dup children>> first border-button-label-theme
|
||||||
horizontal >>orientation
|
horizontal >>orientation
|
||||||
<border-button-pen> >>interior
|
<border-button-pen> >>interior
|
||||||
dup dup interior>> pen-pref-dim >>min-dim
|
dup dup interior>> pen-pref-dim >>min-dim
|
||||||
|
|
|
@ -33,7 +33,7 @@ USING: mason.child mason.config tools.test namespaces io kernel sequences ;
|
||||||
] with-scope
|
] with-scope
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
[ { "./factor.com" "-i=boot.x86.32.image" "-no-user-init" } ] [
|
[ { "./factor.com" "-i=boot.x86.32.image" "-no-user-init" "-sse-version=30" } ] [
|
||||||
[
|
[
|
||||||
"winnt" target-os set
|
"winnt" target-os set
|
||||||
"x86.32" target-cpu set
|
"x86.32" target-cpu set
|
||||||
|
|
Loading…
Reference in New Issue