770a9b576a 2007-11-16 aku: ## -*- tcl -*- 770a9b576a 2007-11-16 aku: # # ## ### ##### ######## ############# ##################### 770a9b576a 2007-11-16 aku: ## Copyright (c) 2007 Andreas Kupries. 770a9b576a 2007-11-16 aku: # 770a9b576a 2007-11-16 aku: # This software is licensed as described in the file LICENSE, which 770a9b576a 2007-11-16 aku: # you should have received as part of this distribution. 770a9b576a 2007-11-16 aku: # 770a9b576a 2007-11-16 aku: # This software consists of voluntary contributions made by many 770a9b576a 2007-11-16 aku: # individuals. For exact contribution history, see the revision 770a9b576a 2007-11-16 aku: # history and logs, available at http://fossil-scm.hwaci.com/fossil 770a9b576a 2007-11-16 aku: # # ## ### ##### ######## ############# ##################### 770a9b576a 2007-11-16 aku: 770a9b576a 2007-11-16 aku: ## This file provides a helper package for the passes 6 and 7 which 770a9b576a 2007-11-16 aku: ## contains the common code of the cycle breaking algorithm. 770a9b576a 2007-11-16 aku: 770a9b576a 2007-11-16 aku: # # ## ### ##### ######## ############# ##################### 770a9b576a 2007-11-16 aku: ## Requirements 770a9b576a 2007-11-16 aku: 770a9b576a 2007-11-16 aku: package require Tcl 8.4 ; # Required runtime. 770a9b576a 2007-11-16 aku: package require snit ; # OO system. 770a9b576a 2007-11-16 aku: package require struct::graph ; # Graph handling. 770a9b576a 2007-11-16 aku: package require struct::list ; # Higher order list operations. 770a9b576a 2007-11-16 aku: package require vc::tools::log ; # User feedback. 770a9b576a 2007-11-16 aku: package require vc::tools::misc ; # Text formatting. 770a9b576a 2007-11-16 aku: package require vc::fossil::import::cvs::project::rev ; # Project level changesets 770a9b576a 2007-11-16 aku: package require vc::fossil::import::cvs::project::revlink ; # Cycle links. 770a9b576a 2007-11-16 aku: 770a9b576a 2007-11-16 aku: # # ## ### ##### ######## ############# ##################### 770a9b576a 2007-11-16 aku: ## 770a9b576a 2007-11-16 aku: 770a9b576a 2007-11-16 aku: snit::type ::vc::fossil::import::cvs::cyclebreaker { 770a9b576a 2007-11-16 aku: # # ## ### ##### ######## ############# 770a9b576a 2007-11-16 aku: ## Public API 770a9b576a 2007-11-16 aku: 770a9b576a 2007-11-16 aku: typemethod run {changesets {savecmd {}}} { 770a9b576a 2007-11-16 aku: ::variable save $savecmd 770a9b576a 2007-11-16 aku: ::variable at 0 770a9b576a 2007-11-16 aku: 770a9b576a 2007-11-16 aku: # We create a graph of the revision changesets, using the file 770a9b576a 2007-11-16 aku: # level dependencies to construct a first approximation of the 770a9b576a 2007-11-16 aku: # dependencies at the project level. Then we look for cycles 770a9b576a 2007-11-16 aku: # in that graph and break them. 770a9b576a 2007-11-16 aku: 770a9b576a 2007-11-16 aku: # 1. Create nodes for all relevant changesets and a mapping 770a9b576a 2007-11-16 aku: # from the revisions to their changesets/nodes. 770a9b576a 2007-11-16 aku: 770a9b576a 2007-11-16 aku: log write 3 cyclebreaker "Creating changeset graph, filling with nodes" 770a9b576a 2007-11-16 aku: log write 3 cyclebreaker "Adding [nsp [llength $changesets] node]" 770a9b576a 2007-11-16 aku: 770a9b576a 2007-11-16 aku: set dg [struct::graph dg] 770a9b576a 2007-11-16 aku: 770a9b576a 2007-11-16 aku: foreach cset $changesets { 770a9b576a 2007-11-16 aku: dg node insert $cset 770a9b576a 2007-11-16 aku: dg node set $cset timerange [$cset timerange] 770a9b576a 2007-11-16 aku: } 770a9b576a 2007-11-16 aku: 770a9b576a 2007-11-16 aku: # 2. Find for all relevant changeset their revisions and their 770a9b576a 2007-11-16 aku: # dependencies. Map the latter back to changesets and 770a9b576a 2007-11-16 aku: # construct the corresponding arcs. 770a9b576a 2007-11-16 aku: 770a9b576a 2007-11-16 aku: log write 3 cyclebreaker {Setting up node dependencies} 770a9b576a 2007-11-16 aku: 770a9b576a 2007-11-16 aku: foreach cset $changesets { 770a9b576a 2007-11-16 aku: foreach succ [$cset successors] { 770a9b576a 2007-11-16 aku: # Changesets may have dependencies outside of the 770a9b576a 2007-11-16 aku: # chosen set. These are ignored 770a9b576a 2007-11-16 aku: if {![dg node exists $succ]} continue 770a9b576a 2007-11-16 aku: dg arc insert $cset $succ 770a9b576a 2007-11-16 aku: } 770a9b576a 2007-11-16 aku: } 770a9b576a 2007-11-16 aku: 770a9b576a 2007-11-16 aku: # 3. Lastly we iterate the graph topologically. We mark off 770a9b576a 2007-11-16 aku: # the nodes which have no predecessors, in order from 770a9b576a 2007-11-16 aku: # oldest to youngest, saving and removing dependencies. If 770a9b576a 2007-11-16 aku: # we find no nodes without predecessors we have a cycle, 770a9b576a 2007-11-16 aku: # and work on breaking it. 770a9b576a 2007-11-16 aku: 770a9b576a 2007-11-16 aku: log write 3 cyclebreaker {Now sorting the changesets, breaking cycles} 770a9b576a 2007-11-16 aku: 770a9b576a 2007-11-16 aku: InitializeCandidates $dg 770a9b576a 2007-11-16 aku: while {1} { 770a9b576a 2007-11-16 aku: while {[WithoutPredecessor $dg n]} { 770a9b576a 2007-11-16 aku: SaveAndRemove $dg $n 770a9b576a 2007-11-16 aku: } 770a9b576a 2007-11-16 aku: if {![llength [dg nodes]]} break 770a9b576a 2007-11-16 aku: BreakCycle $dg [FindCycle $dg] 770a9b576a 2007-11-16 aku: InitializeCandidates $dg 770a9b576a 2007-11-16 aku: } 7b3928681e 2007-11-16 aku: 7b3928681e 2007-11-16 aku: dg destroy 770a9b576a 2007-11-16 aku: 770a9b576a 2007-11-16 aku: log write 3 cyclebreaker Done. 770a9b576a 2007-11-16 aku: return 770a9b576a 2007-11-16 aku: } 770a9b576a 2007-11-16 aku: 770a9b576a 2007-11-16 aku: # # ## ### ##### ######## ############# 770a9b576a 2007-11-16 aku: ## Internal methods 770a9b576a 2007-11-16 aku: 770a9b576a 2007-11-16 aku: # Instead of searching the whole graph for the degree-0 nodes in 770a9b576a 2007-11-16 aku: # each iteration we compute the list once to start, and then only 770a9b576a 2007-11-16 aku: # update it incrementally based on the outgoing neighbours of the 770a9b576a 2007-11-16 aku: # node chosen for commit. 770a9b576a 2007-11-16 aku: 770a9b576a 2007-11-16 aku: proc InitializeCandidates {dg} { 770a9b576a 2007-11-16 aku: # bottom = list (list (node, range min, range max)) 770a9b576a 2007-11-16 aku: ::variable bottom 770a9b576a 2007-11-16 aku: foreach n [$dg nodes] { 770a9b576a 2007-11-16 aku: if {[$dg node degree -in $n]} continue 770a9b576a 2007-11-16 aku: lappend bottom [linsert [$dg node get $n timerange] 0 $n] 770a9b576a 2007-11-16 aku: } 770a9b576a 2007-11-16 aku: set bottom [lsort -index 1 -integer [lsort -index 2 -integer $bottom]] 770a9b576a 2007-11-16 aku: return 770a9b576a 2007-11-16 aku: } 770a9b576a 2007-11-16 aku: 770a9b576a 2007-11-16 aku: proc WithoutPredecessor {dg nv} { 770a9b576a 2007-11-16 aku: ::variable bottom 770a9b576a 2007-11-16 aku: 770a9b576a 2007-11-16 aku: upvar 1 $nv n 770a9b576a 2007-11-16 aku: if {![llength $bottom]} { return 0 } 770a9b576a 2007-11-16 aku: 770a9b576a 2007-11-16 aku: set n [lindex [lindex $bottom 0] 0] 770a9b576a 2007-11-16 aku: set bottom [lrange $bottom 1 end] 770a9b576a 2007-11-16 aku: set changed 0 770a9b576a 2007-11-16 aku: 770a9b576a 2007-11-16 aku: # Update list of nodes without predecessor, based on the 770a9b576a 2007-11-16 aku: # outgoing neighbours of the chosen node. This should be 770a9b576a 2007-11-16 aku: # faster than iterating of the whole set of nodes, finding all 770a9b576a 2007-11-16 aku: # without predecessors, sorting them by time, etc. pp. 770a9b576a 2007-11-16 aku: foreach out [$dg nodes -out $n] { 770a9b576a 2007-11-16 aku: if {[$dg node degree -in $out] > 1} continue 770a9b576a 2007-11-16 aku: # Degree-1 neighbour, will have no predecessors after the 770a9b576a 2007-11-16 aku: # removal of n. Put on the list. 770a9b576a 2007-11-16 aku: lappend bottom [linsert [$dg node get $out timerange] 0 $out] 770a9b576a 2007-11-16 aku: set changed 1 770a9b576a 2007-11-16 aku: } 770a9b576a 2007-11-16 aku: if {$changed} { 770a9b576a 2007-11-16 aku: set bottom [lsort -index 1 -integer [lsort -index 2 -integer $bottom]] 770a9b576a 2007-11-16 aku: } 770a9b576a 2007-11-16 aku: 770a9b576a 2007-11-16 aku: # We do not delete the node immediately, to allow the Save 770a9b576a 2007-11-16 aku: # procedure to save the dependencies as well (encoded in the 770a9b576a 2007-11-16 aku: # arcs). 770a9b576a 2007-11-16 aku: return 1 770a9b576a 2007-11-16 aku: } 770a9b576a 2007-11-16 aku: 770a9b576a 2007-11-16 aku: proc SaveAndRemove {dg n} { 770a9b576a 2007-11-16 aku: ::variable at 770a9b576a 2007-11-16 aku: ::variable save 770a9b576a 2007-11-16 aku: 770a9b576a 2007-11-16 aku: # Give the user of the cycle breaker the opportunity to work 770a9b576a 2007-11-16 aku: # with the changeset before it is removed from the graph. 770a9b576a 2007-11-16 aku: 770a9b576a 2007-11-16 aku: if {[llength $save]} { 770a9b576a 2007-11-16 aku: uplevel #0 [linsert $save end $at $n] 770a9b576a 2007-11-16 aku: } 770a9b576a 2007-11-16 aku: 770a9b576a 2007-11-16 aku: incr at 770a9b576a 2007-11-16 aku: $dg node delete $n 770a9b576a 2007-11-16 aku: return 770a9b576a 2007-11-16 aku: } 770a9b576a 2007-11-16 aku: 770a9b576a 2007-11-16 aku: proc FindCycle {dg} { 770a9b576a 2007-11-16 aku: # This procedure is run if and only the graph is not empty and 770a9b576a 2007-11-16 aku: # all nodes have predecessors. This means that each node is 770a9b576a 2007-11-16 aku: # either part of a cycle or (indirectly) depending on a node 770a9b576a 2007-11-16 aku: # in a cycle. We can start at an arbitrary node, follow its 770a9b576a 2007-11-16 aku: # incoming edges to its predecessors until we see a node a 770a9b576a 2007-11-16 aku: # second time. That node closes the cycle and the beginning is 770a9b576a 2007-11-16 aku: # its first occurence. Note that we can choose an arbitrary 770a9b576a 2007-11-16 aku: # predecessor of each node as well, we do not have to search. 770a9b576a 2007-11-16 aku: 770a9b576a 2007-11-16 aku: # We record for each node the index of the first appearance in 770a9b576a 2007-11-16 aku: # the path, making it easy at the end to cut the cycle from 770a9b576a 2007-11-16 aku: # it. 770a9b576a 2007-11-16 aku: 770a9b576a 2007-11-16 aku: # Choose arbitrary node to start our search at. 770a9b576a 2007-11-16 aku: set start [lindex [$dg nodes] 0] 770a9b576a 2007-11-16 aku: 770a9b576a 2007-11-16 aku: # Initialize state, path of seen nodes, and when seen. 770a9b576a 2007-11-16 aku: set path {} 770a9b576a 2007-11-16 aku: array set seen {} 770a9b576a 2007-11-16 aku: 770a9b576a 2007-11-16 aku: while {1} { 770a9b576a 2007-11-16 aku: # Stop searching when we have seen the current node 770a9b576a 2007-11-16 aku: # already, the circle has been closed. 770a9b576a 2007-11-16 aku: if {[info exists seen($start)]} break 770a9b576a 2007-11-16 aku: lappend path $start 770a9b576a 2007-11-16 aku: set seen($start) [expr {[llength $path]-1}] 770a9b576a 2007-11-16 aku: # Choose arbitrary predecessor 770a9b576a 2007-11-16 aku: set start [lindex [$dg nodes -in $start] 0] 770a9b576a 2007-11-16 aku: } 770a9b576a 2007-11-16 aku: 770a9b576a 2007-11-16 aku: return [struct::list reverse [lrange $path $seen($start) end]] 770a9b576a 2007-11-16 aku: } 770a9b576a 2007-11-16 aku: 770a9b576a 2007-11-16 aku: proc ID {cset} { return "<[$cset id]>" } 770a9b576a 2007-11-16 aku: 770a9b576a 2007-11-16 aku: proc BreakCycle {dg cycle} { 770a9b576a 2007-11-16 aku: # The cycle we have gotten is broken by breaking apart one or 770a9b576a 2007-11-16 aku: # more of the changesets in the cycle. This causes us to 770a9b576a 2007-11-16 aku: # create one or more changesets which are to be committed, 770a9b576a 2007-11-16 aku: # added to the graph, etc. pp. 770a9b576a 2007-11-16 aku: 770a9b576a 2007-11-16 aku: set cprint [join [struct::list map $cycle [myproc ID]] { }] 770a9b576a 2007-11-16 aku: 770a9b576a 2007-11-16 aku: lappend cycle [lindex $cycle 0] [lindex $cycle 1] 770a9b576a 2007-11-16 aku: set bestlink {} 770a9b576a 2007-11-16 aku: set bestnode {} 770a9b576a 2007-11-16 aku: 770a9b576a 2007-11-16 aku: foreach \ 770a9b576a 2007-11-16 aku: prev [lrange $cycle 0 end-2] \ 770a9b576a 2007-11-16 aku: cset [lrange $cycle 1 end-1] \ 770a9b576a 2007-11-16 aku: next [lrange $cycle 2 end] { 770a9b576a 2007-11-16 aku: 770a9b576a 2007-11-16 aku: # Each triple PREV -> CSET -> NEXT of changesets, a 770a9b576a 2007-11-16 aku: # 'link' in the cycle, is analysed and the best 770a9b576a 2007-11-16 aku: # location where to at least weaken the cycle is 770a9b576a 2007-11-16 aku: # chosen for further processing. 770a9b576a 2007-11-16 aku: 770a9b576a 2007-11-16 aku: set link [project::revlink %AUTO% $prev $cset $next] 770a9b576a 2007-11-16 aku: if {$bestlink eq ""} { 770a9b576a 2007-11-16 aku: set bestlink $link 770a9b576a 2007-11-16 aku: set bestnode $cset 770a9b576a 2007-11-16 aku: } elseif {[$link betterthan $bestlink]} { 770a9b576a 2007-11-16 aku: $bestlink destroy 770a9b576a 2007-11-16 aku: set bestlink $link 770a9b576a 2007-11-16 aku: set bestnode $cset 770a9b576a 2007-11-16 aku: } else { 770a9b576a 2007-11-16 aku: $link destroy 770a9b576a 2007-11-16 aku: } 770a9b576a 2007-11-16 aku: } 770a9b576a 2007-11-16 aku: 770a9b576a 2007-11-16 aku: log write 5 breakrcycle "Breaking cycle ($cprint) by splitting changeset <[$bestnode id]>" 770a9b576a 2007-11-16 aku: 770a9b576a 2007-11-16 aku: set newcsets [$bestlink break] 770a9b576a 2007-11-16 aku: $bestlink destroy 770a9b576a 2007-11-16 aku: 770a9b576a 2007-11-16 aku: # At this point the old changeset (BESTNODE) is gone 770a9b576a 2007-11-16 aku: # already. We remove it from the graph as well and then enter 770a9b576a 2007-11-16 aku: # the fragments generated for it. 770a9b576a 2007-11-16 aku: 770a9b576a 2007-11-16 aku: $dg node delete $bestnode 770a9b576a 2007-11-16 aku: 770a9b576a 2007-11-16 aku: foreach cset $newcsets { 770a9b576a 2007-11-16 aku: $dg node insert $cset 770a9b576a 2007-11-16 aku: $dg node set $cset timerange [$cset timerange] 770a9b576a 2007-11-16 aku: } 770a9b576a 2007-11-16 aku: 770a9b576a 2007-11-16 aku: foreach cset $newcsets { 770a9b576a 2007-11-16 aku: foreach succ [$cset successors] { 770a9b576a 2007-11-16 aku: # The new changesets may have dependencies outside of 770a9b576a 2007-11-16 aku: # the chosen set. These are ignored 770a9b576a 2007-11-16 aku: if {![$dg node exists $succ]} continue 770a9b576a 2007-11-16 aku: $dg arc insert $cset $succ 770a9b576a 2007-11-16 aku: } 770a9b576a 2007-11-16 aku: } 770a9b576a 2007-11-16 aku: return 770a9b576a 2007-11-16 aku: } 770a9b576a 2007-11-16 aku: 770a9b576a 2007-11-16 aku: typevariable at 0 ; # Counter for commit ids for the changesets. 770a9b576a 2007-11-16 aku: typevariable bottom {} ; # List of candidate nodes for committing. 770a9b576a 2007-11-16 aku: typevariable save {} ; # The command to call for each processed node 770a9b576a 2007-11-16 aku: 770a9b576a 2007-11-16 aku: # # ## ### ##### ######## ############# 770a9b576a 2007-11-16 aku: ## Configuration 770a9b576a 2007-11-16 aku: 770a9b576a 2007-11-16 aku: pragma -hasinstances no ; # singleton 770a9b576a 2007-11-16 aku: pragma -hastypeinfo no ; # no introspection 770a9b576a 2007-11-16 aku: pragma -hastypedestroy no ; # immortal 770a9b576a 2007-11-16 aku: 770a9b576a 2007-11-16 aku: # # ## ### ##### ######## ############# 770a9b576a 2007-11-16 aku: } 770a9b576a 2007-11-16 aku: 770a9b576a 2007-11-16 aku: namespace eval ::vc::fossil::import::cvs { 770a9b576a 2007-11-16 aku: namespace export cyclebreaker 770a9b576a 2007-11-16 aku: namespace eval cyclebreaker { 770a9b576a 2007-11-16 aku: namespace eval project { 770a9b576a 2007-11-16 aku: namespace import ::vc::fossil::import::cvs::project::rev 770a9b576a 2007-11-16 aku: namespace import ::vc::fossil::import::cvs::project::revlink 770a9b576a 2007-11-16 aku: } 770a9b576a 2007-11-16 aku: namespace import ::vc::tools::misc::* 770a9b576a 2007-11-16 aku: namespace import ::vc::tools::log 770a9b576a 2007-11-16 aku: log register cyclebreaker 770a9b576a 2007-11-16 aku: } 770a9b576a 2007-11-16 aku: } 770a9b576a 2007-11-16 aku: 770a9b576a 2007-11-16 aku: # # ## ### ##### ######## ############# ##################### 770a9b576a 2007-11-16 aku: ## Ready 770a9b576a 2007-11-16 aku: 770a9b576a 2007-11-16 aku: package provide vc::fossil::import::cvs::cyclebreaker 1.0 770a9b576a 2007-11-16 aku: return
File Annotation