factor/basis/compiler/cfg/write-barrier/write-barrier-tests.factor

USING: compiler.cfg.instructions compiler.cfg.write-barrier
tools.test ;
IN: compiler.cfg.write-barrier.tests

! Do need a write barrier on a random store.
[
    V{
        T{ ##peek f 1 }
        T{ ##set-slot f 2 1 3 }
        T{ ##write-barrier f 1 3 }
    }
] [
    V{
        T{ ##peek f 1 }
        T{ ##set-slot f 2 1 3 }
        T{ ##write-barrier f 1 3 }
    } write-barriers-step
] unit-test

[
    V{
        T{ ##peek f 1 }
        T{ ##set-slot-imm f 2 1 }
        T{ ##write-barrier-imm f 1 }
    }
] [
    V{
        T{ ##peek f 1 }
        T{ ##set-slot-imm f 2 1 }
        T{ ##write-barrier-imm f 1 }
    } write-barriers-step
] unit-test

! Don't need a write barrier on freshly allocated objects.
[
    V{
        T{ ##allot f 1 }
        T{ ##set-slot f 2 1 3 }
    }
] [
    V{
        T{ ##allot f 1 }
        T{ ##set-slot f 2 1 3 }
        T{ ##write-barrier f 1 3 }
    } write-barriers-step
] unit-test

[
    V{
        T{ ##allot f 1 }
        T{ ##set-slot-imm f 2 1 }
    }
] [
    V{
        T{ ##allot f 1 }
        T{ ##set-slot-imm f 2 1 }
        T{ ##write-barrier-imm f 1 }
    } write-barriers-step
] unit-test

! Do need a write barrier if there's a subroutine call between
! the allocation and the store.
[
    V{
        T{ ##allot f 1 }
        T{ ##box }
        T{ ##set-slot f 2 1 3 }
        T{ ##write-barrier f 1 3 }
    }
] [
    V{
        T{ ##allot f 1 }
        T{ ##box }
        T{ ##set-slot f 2 1 3 }
        T{ ##write-barrier f 1 3 }
    } write-barriers-step
] unit-test

[
    V{
        T{ ##allot f 1 }
        T{ ##box }
        T{ ##set-slot-imm f 2 1 }
        T{ ##write-barrier-imm f 1 }
    }
] [
    V{
        T{ ##allot f 1 }
        T{ ##box }
        T{ ##set-slot-imm f 2 1 }
        T{ ##write-barrier-imm f 1 }
    } write-barriers-step
] unit-test

! ##copy instructions
[
    V{
        T{ ##copy f 2 1 }
        T{ ##set-slot-imm f 3 1 }
        T{ ##write-barrier-imm f 2 }
    }
] [
    V{
        T{ ##copy f 2 1 }
        T{ ##set-slot-imm f 3 1 }
        T{ ##write-barrier-imm f 2 }
    } write-barriers-step
] unit-test

[
    V{
        T{ ##copy f 2 1 }
        T{ ##set-slot-imm f 3 2 }
        T{ ##write-barrier-imm f 1 }
    }
] [
    V{
        T{ ##copy f 2 1 }
        T{ ##set-slot-imm f 3 2 }
        T{ ##write-barrier-imm f 1 }
    } write-barriers-step
] unit-test

[
    V{
        T{ ##copy f 2 1 }
        T{ ##copy f 3 2 }
        T{ ##set-slot-imm f 3 1 }
        T{ ##write-barrier-imm f 2 }
    }
] [
    V{
        T{ ##copy f 2 1 }
        T{ ##copy f 3 2 }
        T{ ##set-slot-imm f 3 1 }
        T{ ##write-barrier-imm f 2 }
    } write-barriers-step
] unit-test

[
    V{
        T{ ##copy f 2 1 }
        T{ ##copy f 3 2 }
        T{ ##set-slot-imm f 4 1 }
        T{ ##write-barrier-imm f 3 }
    }
] [
    V{
        T{ ##copy f 2 1 }
        T{ ##copy f 3 2 }
        T{ ##set-slot-imm f 4 1 }
        T{ ##write-barrier-imm f 3 }
    } write-barriers-step
] unit-test