171 lines
3.8 KiB
Factor
171 lines
3.8 KiB
Factor
USING: accessors arrays compiler.cfg compiler.cfg.instructions
|
|
compiler.cfg.intrinsics.slots compiler.test compiler.tree
|
|
compiler.tree.propagation.info kernel layouts literals make math
|
|
math.intervals namespaces sequences slots.private tools.test ;
|
|
IN: compiler.cfg.intrinsics.slots.tests
|
|
|
|
: call-node-1 ( -- node )
|
|
T{ #call
|
|
{ word set-slot }
|
|
{ in-d V{ 9133848 9133849 9133850 } }
|
|
{ out-d { } }
|
|
{ info
|
|
H{
|
|
{
|
|
9133848
|
|
T{ value-info-state
|
|
{ class object }
|
|
{ interval full-interval }
|
|
}
|
|
}
|
|
{
|
|
9133849
|
|
T{ value-info-state
|
|
{ class object }
|
|
{ interval full-interval }
|
|
}
|
|
}
|
|
{
|
|
9133850
|
|
T{ value-info-state
|
|
{ class object }
|
|
{ interval full-interval }
|
|
}
|
|
}
|
|
}
|
|
}
|
|
} ;
|
|
|
|
: call-node-2 ( -- node )
|
|
T{ #call
|
|
{ word set-slot }
|
|
{ in-d V{ 1 2 3 } }
|
|
{ out-d { } }
|
|
{ info
|
|
H{
|
|
{
|
|
1
|
|
T{ value-info-state
|
|
{ class object }
|
|
{ interval full-interval }
|
|
}
|
|
}
|
|
{
|
|
2
|
|
T{ value-info-state
|
|
{ class array }
|
|
{ interval full-interval }
|
|
}
|
|
}
|
|
{
|
|
3
|
|
T{ value-info-state
|
|
{ class object }
|
|
{ interval full-interval }
|
|
}
|
|
}
|
|
}
|
|
}
|
|
} ;
|
|
|
|
: call-node-3 ( -- node )
|
|
T{ #call
|
|
{ word set-slot }
|
|
{ in-d V{ 1 2 3 } }
|
|
{ out-d { } }
|
|
{ info
|
|
H{
|
|
{
|
|
1
|
|
T{ value-info-state
|
|
{ class object }
|
|
{ interval full-interval }
|
|
}
|
|
}
|
|
{
|
|
2
|
|
T{ value-info-state
|
|
{ class array }
|
|
{ interval full-interval }
|
|
}
|
|
}
|
|
{
|
|
3
|
|
T{ value-info-state
|
|
{ class fixnum }
|
|
{ interval
|
|
T{ interval
|
|
{ from { 9 t } }
|
|
{ to { 9 t } }
|
|
}
|
|
}
|
|
{ literal 9 }
|
|
{ literal? t }
|
|
}
|
|
}
|
|
}
|
|
}
|
|
} ;
|
|
|
|
! emit-set-slot
|
|
{
|
|
V{ T{ ##call { word set-slot } } T{ ##branch } }
|
|
} [
|
|
call-node-1 [ emit-set-slot ] V{ } make drop
|
|
basic-block get successors>> first instructions>>
|
|
] cfg-unit-test
|
|
|
|
{
|
|
V{
|
|
T{ ##set-slot
|
|
{ src 1 }
|
|
{ obj 2 }
|
|
{ slot 3 }
|
|
{ scale $[ cell log2 ] }
|
|
{ tag 2 }
|
|
}
|
|
T{ ##write-barrier
|
|
{ src 2 }
|
|
{ slot 3 }
|
|
{ scale $[ cell log2 ] }
|
|
{ tag 2 }
|
|
{ temp1 4 }
|
|
{ temp2 5 }
|
|
}
|
|
}
|
|
} [
|
|
call-node-2 [ emit-set-slot ] V{ } make
|
|
] cfg-unit-test
|
|
|
|
{
|
|
V{
|
|
T{ ##set-slot-imm { src 1 } { obj 2 } { slot 9 } { tag 2 } }
|
|
T{ ##write-barrier-imm
|
|
{ src 2 }
|
|
{ slot 9 }
|
|
{ tag 2 }
|
|
{ temp1 3 }
|
|
{ temp2 4 }
|
|
}
|
|
}
|
|
} [
|
|
call-node-3 [ emit-set-slot ] V{ } make
|
|
] cfg-unit-test
|
|
|
|
! immediate-slot-offset?
|
|
{ t f } [
|
|
33 immediate-slot-offset?
|
|
"foo" immediate-slot-offset?
|
|
] unit-test
|
|
|
|
! node>set-slot-data
|
|
{
|
|
t f f
|
|
t 2 f
|
|
t 2 9
|
|
} [
|
|
call-node-1 node>set-slot-data
|
|
call-node-2 node>set-slot-data
|
|
call-node-3 node>set-slot-data
|
|
] unit-test
|