Merge branch 'master' of git://factorcode.org/git/factor into cuda-changes

db4
Joe Groff 2010-05-05 16:36:12 -07:00
commit bc210fa8d4
4 changed files with 28 additions and 12 deletions

View File

@ -4,7 +4,8 @@ USING: kernel math math.order sequences accessors arrays
byte-arrays layouts classes.tuple.private fry locals byte-arrays layouts classes.tuple.private fry locals
compiler.tree.propagation.info compiler.cfg.hats compiler.tree.propagation.info compiler.cfg.hats
compiler.cfg.instructions compiler.cfg.stacks compiler.cfg.instructions compiler.cfg.stacks
compiler.cfg.utilities compiler.cfg.builder.blocks ; compiler.cfg.utilities compiler.cfg.builder.blocks
compiler.constants cpu.architecture alien.c-types ;
IN: compiler.cfg.intrinsics.allot IN: compiler.cfg.intrinsics.allot
: ##set-slots ( regs obj class -- ) : ##set-slots ( regs obj class -- )
@ -73,10 +74,16 @@ IN: compiler.cfg.intrinsics.allot
dup node-input-infos first literal>> dup expand-(byte-array)? dup node-input-infos first literal>> dup expand-(byte-array)?
[ nip emit-allot-byte-array drop ] [ drop emit-primitive ] if ; [ nip emit-allot-byte-array drop ] [ drop emit-primitive ] if ;
:: zero-byte-array ( len reg -- )
0 ^^load-literal :> elt
reg ^^tagged>integer :> reg
len cell align cell /i iota [
[ elt reg ] dip cells byte-array-offset + int-rep f ##store-memory-imm
] each ;
:: emit-<byte-array> ( node -- ) :: emit-<byte-array> ( node -- )
node node-input-infos first literal>> dup expand-<byte-array>? [ node node-input-infos first literal>> dup expand-<byte-array>? [
:> len :> len
0 ^^load-literal :> elt
len emit-allot-byte-array :> reg len emit-allot-byte-array :> reg
len reg elt byte-array store-initial-element len reg zero-byte-array
] [ drop node emit-primitive ] if ; ] [ drop node emit-primitive ] if ;

View File

@ -373,6 +373,9 @@ M:: ppc %box-displaced-alien ( dst displacement base temp base-class -- )
"end" resolve-label "end" resolve-label
] with-scope ; ] with-scope ;
: (%memory) ( val base displacement scale offset rep c-type -- base val displacement rep c-type )
[ [ 0 assert= ] bi@ swapd ] 2dip ; inline
M: ppc %load-memory-imm ( dst base offset rep c-type -- ) M: ppc %load-memory-imm ( dst base offset rep c-type -- )
[ [
{ {
@ -380,6 +383,8 @@ M: ppc %load-memory-imm ( dst base offset rep c-type -- )
{ c:uchar [ LBZ ] } { c:uchar [ LBZ ] }
{ c:short [ LHA ] } { c:short [ LHA ] }
{ c:ushort [ LHZ ] } { c:ushort [ LHZ ] }
{ c:int [ LWZ ] }
{ c:uint [ LWZ ] }
} case } case
] [ ] [
{ {
@ -389,9 +394,6 @@ M: ppc %load-memory-imm ( dst base offset rep c-type -- )
} case } case
] ?if ; ] ?if ;
: (%memory) ( val base displacement scale offset rep c-type -- base val displacement rep c-type )
[ [ 0 assert= ] bi@ swapd ] 2dip ; inline
M: ppc %load-memory ( dst base displacement scale offset rep c-type -- ) M: ppc %load-memory ( dst base displacement scale offset rep c-type -- )
(%memory) [ (%memory) [
{ {
@ -399,6 +401,8 @@ M: ppc %load-memory ( dst base displacement scale offset rep c-type -- )
{ c:uchar [ LBZX ] } { c:uchar [ LBZX ] }
{ c:short [ LHAX ] } { c:short [ LHAX ] }
{ c:ushort [ LHZX ] } { c:ushort [ LHZX ] }
{ c:int [ LWZX ] }
{ c:uint [ LWZX ] }
} case } case
] [ ] [
{ {
@ -415,6 +419,8 @@ M: ppc %store-memory-imm ( src base offset rep c-type -- )
{ c:uchar [ STB ] } { c:uchar [ STB ] }
{ c:short [ STH ] } { c:short [ STH ] }
{ c:ushort [ STH ] } { c:ushort [ STH ] }
{ c:int [ STW ] }
{ c:uint [ STW ] }
} case } case
] [ ] [
{ {
@ -431,6 +437,8 @@ M: ppc %store-memory ( src base displacement scale offset rep c-type -- )
{ c:uchar [ STBX ] } { c:uchar [ STBX ] }
{ c:short [ STHX ] } { c:short [ STHX ] }
{ c:ushort [ STHX ] } { c:ushort [ STHX ] }
{ c:int [ STWX ] }
{ c:uint [ STWX ] }
} case } case
] [ ] [
{ {

View File

@ -5,10 +5,11 @@ arrays kernel fry math namespaces sequences system layouts io
vocabs.loader accessors init classes.struct combinators vocabs.loader accessors init classes.struct combinators
command-line make words compiler compiler.units command-line make words compiler compiler.units
compiler.constants compiler.alien compiler.codegen compiler.constants compiler.alien compiler.codegen
compiler.codegen.fixup compiler.cfg.instructions compiler.codegen.alien compiler.codegen.fixup
compiler.cfg.builder compiler.cfg.intrinsics compiler.cfg.instructions compiler.cfg.builder
compiler.cfg.stack-frame cpu.x86.assembler compiler.cfg.intrinsics compiler.cfg.stack-frame
cpu.x86.assembler.operands cpu.x86 cpu.architecture vm ; cpu.x86.assembler cpu.x86.assembler.operands cpu.x86
cpu.architecture vm ;
FROM: layouts => cell ; FROM: layouts => cell ;
IN: cpu.x86.32 IN: cpu.x86.32
@ -358,7 +359,7 @@ M: x86.32 dummy-fp-params? f ;
! Dreadful ! Dreadful
M: struct-c-type flatten-c-type stack-params (flatten-c-type) ; M: struct-c-type flatten-c-type stack-params (flatten-c-type) ;
M: long-long-type flatten-c-type stack-params (flatten-c-type) ; M: long-long-type flatten-c-type stack-params (flatten-c-type) ;
M: c-type flatten-c-type dup rep>> int-rep? int-rep stack-params ? (flatten-c-type)) ; M: c-type flatten-c-type dup rep>> int-rep? int-rep stack-params ? (flatten-c-type) ;
M: x86.32 struct-return-pointer-type M: x86.32 struct-return-pointer-type
os linux? void* (stack-value) ? ; os linux? void* (stack-value) ? ;

View File

@ -58,7 +58,7 @@ HELP: clamp
{ $description "Outputs " { $snippet "x" } " if contained in the interval " { $snippet "[min,max]" } " or else outputs one of the endpoints." } ; { $description "Outputs " { $snippet "x" } " if contained in the interval " { $snippet "[min,max]" } " or else outputs one of the endpoints." } ;
HELP: between? HELP: between?
{ $values { "x" object } { "y" object } { "z" real } { "?" "a boolean" } } { $values { "x" object } { "y" object } { "z" object } { "?" "a boolean" } }
{ $description "Tests if " { $snippet "x" } " is in the interval " { $snippet "[y,z]" } "." } { $description "Tests if " { $snippet "x" } " is in the interval " { $snippet "[y,z]" } "." }
{ $notes "As per the closed interval notation, the end-points are included in the interval." } ; { $notes "As per the closed interval notation, the end-points are included in the interval." } ;