csgtree_pruning.n

csgtree_pruning.txt

none

using "none.libc"

; generate random CSG trees, attempt to optimize and evaluate robustness and
; effectivity in comparison with a full evaluation.

var INSIDE -1
var SURFACE 0
var OUTSIDE 1

function AND (x y)
    max x y
function OR (x y)
    min x y
function SUB (x y)
    max x -y

var commutative
    #= ($)
        AND true
        OR true

var opnames
    #= ($)
        AND "AND"
        OR "OR"
        SUB "SUB"

class Source
    function init (self name)
        self.name = (name or (generate-symbol null "p%i"))
        self.links = ($)
        
    function __tostring (self)
        .format self.name
        
    function __repr (self)
        .__tostring self

class Op
    function init (self op left right)
        .= self op left right
        self.links = ($)
        
    function swap-args (self)
        var tmp self.left
        self.left = self.right
        self.right = tmp
        
    function squash (self)
        ; squash tree
        var b self.left
        self.left = b.left
        b.left = b.right
        b.right = self.right
        self.right = b    
        
    function stretch (self)
        ; stretch out tree
        var b self.right
        self.right = b.right
        b.right = b.left
        b.left = self.left
        self.left = b    
        
    function commutative? (self)
        commutative # self.op
        
    function opname (self)
        opnames # self.op

    function __tostring (self)
        .format "(%s %s %s)" (.opname self) (tostring self.left) (tostring self.right)

var MAXREGS 4
var regs 0
function getreg ()
    assert (regs != 0) "register overflow"
    var b
        cttz regs
    regs = regs ^ (1 << b)
    b
    
function register? (b)
    number? b
    
function used-register? (b)
    (regs & (1 << b)) == 0

function freereg (b)
    assert (used-register? b) "register already freed"
    regs = regs | (1 << b)

function clear-registers ()
    regs =
        (1 << MAXREGS) - 1

function gather_sources (tree)
    var sources ($)
    
    function walk (node)
        if (instance? node Op)
            do
                import-from node left right
                walk left
                walk right
            do
                $.insert sources node
    
    walk tree
    sources
    
function evaluate (tree)
    function walk (node)
        if (instance? node Op)
            do
                import-from node left right
                var value1
                    walk left
                var value2
                    walk right
                node.op value1 value2
            do
                node.value or 0
    
    walk tree

; optimize tree to maximize loads on left side,
; which maximizes reuse of registers
function optimize_tree (tree)
    var maxreg
        0
        ;MAXREGS

    var usedregs 0
    function walk (node)
        if (instance? node Op)
            do
                ++ usedregs
                
                do-if
                    and 
                        .commutative? node
                        instance? node.right Op
                        node.right.op == node.op
                    print "bang!"
                    ; stretch out tree to save registers
                    .stretch node

                ### do-if
                    and 
                        .commutative? node
                        instance? node.left Op
                        node.left.op == node.op
                        or (not (instance? node.right Op))
                            node.right.op != node.op
                    print "bang!"
                    ; squash tree
                    .squash node

                import-from node left right
                var lweight
                    walk left
                var rweight
                    walk right
                
                do-if (.commutative? node)
                    if (usedregs < maxreg)
                        if (rweight < lweight)
                            .swap-args node
                        if (rweight > lweight)
                            .swap-args node
                
                if (rweight < lweight)
                    -- usedregs

                + lweight rweight 1
            do
                1
                
    walk tree

function add_skiplinks (tree)
    var nextline 0

    function walk (node inside outside)
        node.links # INSIDE = inside
        node.links # OUTSIDE = outside
        do-if (instance? node Op)
            import-from node left right
            cond
                (node.op == OR)
                    walk left (inside or node) null
                    walk right null node
                (node.op == AND)
                    walk left null (outside or node)
                    walk right node null
                (node.op == SUB)
                    walk left null (outside or node)
                    walk right null node
                else
                    walk left inside outside
                    walk right inside outside
        node.lineno = nextline
        ++ nextline

    walk tree

function flatten_tree (tree f)
    function walk (node)
        var inside
            (node.links # INSIDE)
        var outside
            (node.links # OUTSIDE)
        var inside_jmp (inside and (inside.lineno - node.lineno) or 0)
        var outside_jmp (outside and (outside.lineno - node.lineno) or 0)
        assert ((inside_jmp == 0) or (outside_jmp == 0))
        var jmp
            cond
                (inside_jmp > 0)
                    -inside_jmp
                (outside_jmp > 0)
                    outside_jmp
                else
                    0
    
        if (instance? node Op)
            do
                import-from node left right
                left = 
                    walk left
                right = 
                    walk right
                
                assert (register? left)
                assert (register? right)
                
                if (register? right)
                    freereg right
                
                f (.opname node) left right jmp
                left
            do
                var target-register (getreg)
                f "LOAD" target-register node.name jmp
                target-register
        
    clear-registers ;
    var r
        walk tree
    f "RET" r
    

function process_tree (tree)
    optimize_tree tree
    var sources
        gather_sources tree
    var sourcemap ($)
    foreach s sources
        sourcemap # s.name = s
        
    print tree
    add_skiplinks tree
    
    var program ($)    
    var numloads 0
    flatten_tree tree
        function (op dst src jmp)
            print op dst src jmp
            if (op == "LOAD")
                ++ numloads
            $.insert program
                .= ($) op dst src jmp
    
    ; test all states for equivalency
    var numsources (len sources)
    var numstates (3 ** numsources)
    
    print
        .format "%i loads, %i instructions, %i possible input states" numloads (len program) numstates
    
    var sumloads 0
    var minload numloads
    var suminstr 0
    var mininstr (len program)
    var worstinstr 0
    var worstloads 0
    loop i (0 (numstates - 1))
        var x i
        var params ($)
        loop k (1 numsources)
            var v
                (x % 3) - 1
            sources # k . value = v
            $.insert params v
            x = x // 3
        var refoutput
            evaluate tree
        
        ; evaluate program
        var retval
        var registers ($)
        var ip 1
        var instructions 0
        var loads 0
        while true
            var instr
                program # ip
            ++ instructions
            ++ suminstr
            var result
                switch instr.op
                    "LOAD"
                        ++ loads
                        ++ sumloads
                        registers # instr.dst = sourcemap # instr.src . value
                    "RET"
                        retval = registers # instr.dst
                        break ;
                    "OR"
                        registers # instr.dst =
                            min
                                registers # instr.dst
                                registers # instr.src
                    "AND"
                        registers # instr.dst =
                            max
                                registers # instr.dst
                                registers # instr.src
                    "SUB"
                        registers # instr.dst =
                            max
                                registers # instr.dst
                                - (registers # instr.src)
                    else
                        error
                            "illegal op:" .. instr.op
            cond
                ((result == OUTSIDE) and (instr.jmp > 0))
                    ip += instr.jmp
                ((result == INSIDE) and (instr.jmp < 0))
                    ip -= instr.jmp
            
            ip = ip + 1
        assert (refoutput == retval)
        
        if (loads == numloads)
            ++ worstloads
        if (instructions == (len program))
            ++ worstinstr
        
        minload =
            min minload loads
        mininstr =
            min mininstr instructions
        ;print (repr params) refoutput retval
        
    print
        .format "%i avg loads, %i min, %i%% inputs unoptimized" (sumloads / numstates) minload 
            worstloads * 100 / numstates
    print
        .format "%i avg instr, %i min, %i%% inputs unoptimized" (suminstr / numstates) mininstr
            worstinstr * 100 / numstates
        

var tree

"
A    B
 \  /
  OR   C  D   E
   \  /    \ /
    OR    AND
     \   /
      SUB  F
       \  /
        OR
"

process_tree
    Op OR
        Op SUB 
            Op OR
                Op OR (Source "A") (Source "B")
                Source "C"
            Op AND (Source "D") (Source "E")
        Source "F"

"
    A    B C    D
     \  /   \  /
     AND    SUB
       \   /
        OR   E
         \  /
          OR
"     

print ;
process_tree
    Op OR
        Op OR
            Op AND (Source "A") (Source "B")
            Op SUB (Source "C") (Source "D")
        Source "E"

print ;
process_tree
    Op OR
        Op OR
            Op OR
                Op OR
                    Op SUB
                        Source "E"
                        Op OR
                            Op OR
                                Op OR
                                    Source "A"
                                    Source "B"
                                Source "C"
                            Source "D"
                    Source "F"
                Source "G"
            Source "H"
        Source "I"
        
print ;
process_tree
    Op OR
        Op OR
            Op OR
                Source "A"
                Source "B"
            Op OR
                Source "C"
                Source "D"
        Op OR
            Op OR
                Source "E"
                Source "F"
            Op OR
                Source "G"
                Source "H"
        
null