Fossil

	set mypos       {} ; # Commit location is not known yet.

	# Keep track of the generated changesets and of the inverse
	# mapping from items to them.
	lappend mychangesets   $self
	lappend mytchangesets($cstype) $self
	set     myidmap($myid) $self
	foreach iid $items {
	    set key [list $cstype $iid]
	    set myitemmap($key) $self
	    lappend mytitems $key
	    log write 8 csets {MAP+ item <$key> $self = [$self str]}
	}

	return
    }

    destructor {
	# The main thing is to keep track of the itemmap and remove
	# the object from it. The lists of changesets (mychangesets,
	# mytchangesets) are not maintained (= reduced), for the
	# moment. We may be able to get rid of this entirely, at least
	# for (de)construction and pass InitCSets.

	foreach iid $myitems {
	    set key [list $mytype $iid]
	    unset myitemmap($key)
	    log write 8 csets {MAP- item <$key> $self = [$self str]}
	}
	return
    }

    method str {} {
	set str    "<"
	set detail ""
	if {[$mytypeobj bysymbol]} {
................................................................................
	##

	# This method inspects the changesets for internal
	# dependencies. Nothing is done if there are no
	# such. Otherwise the changeset is split into a set of
	# fragments without internal dependencies, transforming the
	# internal dependencies into external ones. The new changesets

	# are added to the list of all changesets.

	# We perform all necessary splits in one go, instead of only
	# one. The previous algorithm, adapted from cvs2svn, computed
	# a lot of state which was thrown away and then computed again
	# for each of the fragments. It should be easier to update and
	# reuse that state.

	# The code checks only successor dependencies, as this
	# automatically covers the predecessor dependencies as well (A
	# successor dependency a -> b is also a predecessor dependency
	# b -> a).

	# Array of dependencies (parent -> child). This is pulled from
	# the state, and limited to successors within the changeset.

	array set dependencies {}
	$mytypeobj internalsuccessors dependencies $myitems
	if {![array size dependencies]} {
	    return {}
	} ; # Nothing to break.

	log write 5 csets ...[$self str].......................................................
	vc::tools::mem::mark

	# We have internal dependencies to break. We now iterate over
	# all positions in the list (which is chronological, at least
	# as far as the timestamps are correct and unique) and
	# determine the best position for the break, by trying to
	# break as many dependencies as possible in one go. When a
	# break was found this is redone for the fragments coming and
	# after, after upding the crossing information.

	# Data structures:
	# Map:  POS   revision id      -> position in list.
	#       CROSS position in list -> number of dependencies crossing it
	#       DEPC  dependency       -> positions it crosses
	# List: RANGE Of the positions itself.
	# Map:  DELTA position in list -> time delta between its revision
	#                                 and the next, if any.
	# A dependency is a single-element map parent -> child

	# InitializeBreakState initializes their contents after
	# upvar'ing them from this scope. It uses the information in
	# DEPENDENCIES to do so.

	InitializeBreakState $myitems

	set fragments {}
	set new       [list $range]
	array set breaks {}

	# Instead of one list holding both processed and pending
	# fragments we use two, one for the framents to process, one
	# to hold the new fragments, and the latter is copied to the
	# former when they run out. This keeps the list of pending
	# fragments short without sacrificing speed by shifting stuff
	# down. We especially drop the memory of fragments broken
	# during processing after a short time, instead of letting it
	# consume memory.


	while {[llength $new]} {


	    set pending $new
	    set new     {}
	    set at      0

	    while {$at < [llength $pending]} {
		set current [lindex $pending $at]

		log write 6 csets {. . .. ... ..... ........ .............}
		log write 6 csets {Scheduled   [join [PRs [lrange $pending $at end]] { }]}
		log write 6 csets {Considering [PR $current] \[$at/[llength $pending]\]}

		set best [FindBestBreak $current]

		if {$best < 0} {
		    # The inspected range has no internal
		    # dependencies. This is a complete fragment.
		    lappend fragments $current

		    log write 6 csets "No breaks, final"
		} else {
		    # Split the range and schedule the resulting
		    # fragments for further inspection. Remember the
		    # number of dependencies cut before we remove them
		    # from consideration, for documentation later.

		    set breaks($best) $cross($best)

		    log write 6 csets "Best break @ $best, cutting [nsp $cross($best) dependency dependencies]"

		    # Note: The value of best is an abolute location
		    # in myitems. Use the start of current to make it
		    # an index absolute to current.

		    set brel [expr {$best - [lindex $current 0]}]
		    set bnext $brel ; incr bnext
		    set fragbefore [lrange $current 0 $brel]
		    set fragafter  [lrange $current $bnext end]

		    log write 6 csets "New pieces  [PR $fragbefore] [PR $fragafter]"

		    integrity assert {[llength $fragbefore]} {Found zero-length fragment at the beginning}
		    integrity assert {[llength $fragafter]}  {Found zero-length fragment at the end}

		    lappend new $fragbefore $fragafter
		    CutAt $best
		}

		incr at
	    }
	}

	log write 6 csets ". . .. ... ..... ........ ............."

	# (*) We clear out the associated part of the myitemmap
	# in-memory index in preparation for new data. A simple unset
	# is enough, we have no symbol changesets at this time, and
	# thus never more than one reference in the list.

	foreach iid $myitems {
	    set key [list $mytype $iid]
	    unset myitemmap($key)
	    log write 8 csets {MAP- item <$key> $self = [$self str]}
	}

	# Create changesets for the fragments, reusing the current one
	# for the first fragment. We sort them in order to allow
	# checking for gaps and nice messages.

	set newcsets  {}
	set fragments [lsort -index 0 -integer $fragments]

	#puts \t.[join [PRs $fragments] .\n\t.].

	Border [lindex $fragments 0] firsts firste

	integrity assert {$firsts == 0} {Bad fragment start @ $firsts, gap, or before beginning of the range}

	set laste $firste
	foreach fragment [lrange $fragments 1 end] {
	    Border $fragment s e
	    integrity assert {$laste == ($s - 1)} {Bad fragment border <$laste | $s>, gap or overlap}

	    set new [$type %AUTO% $myproject $mytype $mysrcid [lrange $myitems $s $e]]
	    lappend newcsets $new
	    incr counter

            log write 4 csets "Breaking [$self str ] @ $laste, new [$new str], cutting $breaks($laste)"

	    set laste $e
	}

	integrity assert {
	    $laste == ([llength $myitems]-1)
	} {Bad fragment end @ $laste, gap, or beyond end of the range}

	# Put the first fragment into the current changeset, and
	# update the in-memory index. We can simply (re)add the items
	# because we cleared the previously existing information, see
	# (*) above. Persistence does not matter here, none of the
	# changesets has been saved to the persistent state yet.

	set myitems  [lrange $myitems  0 $firste]
	set mytitems [lrange $mytitems 0 $firste]
	foreach iid $myitems {
	    set key [list $mytype $iid]
	    set myitemmap($key) $self
	    log write 8 csets {MAP+ item <$key> $self = [$self str]}
	}

	return $newcsets

    }

    method persist {} {
	set tid $mycstype($mytype)
	set pid [$myproject id]
	set pos 0

................................................................................
	state transaction {
	    state run {
		DELETE FROM changeset   WHERE cid = $myid;
		DELETE FROM csitem      WHERE cid = $myid;
		DELETE FROM cssuccessor WHERE cid = $myid;
	    }
	}

	foreach iid $myitems {
	    set key [list $mytype $iid]
	    unset myitemmap($key)
	    log write 8 csets {MAP- item <$key> $self = [$self str]}
	}
	set pos          [lsearch -exact $mychangesets $self]
	set mychangesets [lreplace $mychangesets $pos $pos]
	set pos                    [lsearch -exact $mytchangesets($mytype) $self]
	set mytchangesets($mytype) [lreplace $mytchangesets($mytype) $pos $pos]

	# Return the list of predecessors so that they can be adjusted.
	return [struct::list map [state run {
	    SELECT cid
	    FROM   cssuccessor
	    WHERE  nid = $myid
	}] [mytypemethod of]]
................................................................................
	# Initialize the counter from the state
	log write 2 csets {Loading changeset counter}
	set mycounter [state one { SELECT MAX(cid) FROM changeset }]
	return
    }

    typemethod num {} { return $mycounter }













































































































































































    proc InitializeBreakState {revisions} {
	upvar 1 pos pos cross cross range range depc depc delta delta \
	    dependencies dependencies

	# First we create a map of positions to make it easier to
	# determine whether a dependency crosses a particular index.
................................................................................
	return <${s}...${e}>
    }

    proc Border {range sv ev} {
	upvar 1 $sv s $ev e
	set s [lindex $range 0]
	set e [lindex $range end]





























	return
    }

    # # ## ### ##### ######## #############

    typevariable mychangesets         {} ; # List of all known
					   # changesets.

	set mypos       {} ; # Commit location is not known yet.

	# Keep track of the generated changesets and of the inverse
	# mapping from items to them.
	lappend mychangesets   $self
	lappend mytchangesets($cstype) $self
	set     myidmap($myid) $self
	foreach iid $items { lappend mytitems [list $cstype $iid] }





	MapItems $cstype $items
	return
    }

    destructor {
	# The main thing is to keep track of the itemmap and remove
	# the object from it. The lists of changesets (mychangesets,
	# mytchangesets) are not maintained (= reduced), for the
	# moment. We may be able to get rid of this entirely, at least
	# for (de)construction and pass InitCSets.

	UnmapItems $mytype $myitems




	return
    }

    method str {} {
	set str    "<"
	set detail ""
	if {[$mytypeobj bysymbol]} {
................................................................................
	##

	# This method inspects the changesets for internal
	# dependencies. Nothing is done if there are no
	# such. Otherwise the changeset is split into a set of
	# fragments without internal dependencies, transforming the
	# internal dependencies into external ones. The new changesets
	# generated from the fragment information are added to the
	# list of all changesets.







	# The code checks only successor dependencies, as this
	# automatically covers the predecessor dependencies as well (A
	# successor dependency a -> b is also a predecessor dependency
	# b -> a).

	# Array of dependencies (parent -> child). This is pulled from
	# the state, and limited to successors within the changeset.



































	array set breaks {}









	set fragments [BreakDirectDependencies $myitems breaks]


	if {![llength $fragments]} { return {} }















































































































	return [$self CreateFromFragments $fragments counter breaks]
    }

    method persist {} {
	set tid $mycstype($mytype)
	set pid [$myproject id]
	set pos 0

................................................................................
	state transaction {
	    state run {
		DELETE FROM changeset   WHERE cid = $myid;
		DELETE FROM csitem      WHERE cid = $myid;
		DELETE FROM cssuccessor WHERE cid = $myid;
	    }
	}

	UnmapItems $mytype $myitems




	set pos                    [lsearch -exact $mychangesets $self]
	set mychangesets           [lreplace       $mychangesets $pos $pos]
	set pos                    [lsearch -exact $mytchangesets($mytype) $self]
	set mytchangesets($mytype) [lreplace       $mytchangesets($mytype) $pos $pos]

	# Return the list of predecessors so that they can be adjusted.
	return [struct::list map [state run {
	    SELECT cid
	    FROM   cssuccessor
	    WHERE  nid = $myid
	}] [mytypemethod of]]
................................................................................
	# Initialize the counter from the state
	log write 2 csets {Loading changeset counter}
	set mycounter [state one { SELECT MAX(cid) FROM changeset }]
	return
    }

    typemethod num {} { return $mycounter }

    # # ## ### ##### ######## #############

    method CreateFromFragments {fragments cv bv} {
	upvar 1 $cv counter $bv breaks
	UnmapItems $mytype $myitems

	# Create changesets for the fragments, reusing the current one
	# for the first fragment. We sort them in order to allow
	# checking for gaps and nice messages.

	set newcsets  {}
	set fragments [lsort -index 0 -integer $fragments]

	#puts \t.[join [PRs $fragments] .\n\t.].

	Border [lindex $fragments 0] firsts firste

	integrity assert {$firsts == 0} {Bad fragment start @ $firsts, gap, or before beginning of the range}

	set laste $firste
	foreach fragment [lrange $fragments 1 end] {
	    Border $fragment s e
	    integrity assert {$laste == ($s - 1)} {Bad fragment border <$laste | $s>, gap or overlap}

	    set new [$type %AUTO% $myproject $mytype $mysrcid [lrange $myitems $s $e]]
	    lappend newcsets $new
	    incr counter

            log write 4 csets "Breaking [$self str ] @ $laste, new [$new str], cutting $breaks($laste)"

	    set laste $e
	}

	integrity assert {
	    $laste == ([llength $myitems]-1)
	} {Bad fragment end @ $laste, gap, or beyond end of the range}

	# Put the first fragment into the current changeset, and
	# update the in-memory index. We can simply (re)add the items
	# because we cleared the previously existing information, see
	# 'UnmapItems' above. Persistence does not matter here, none
	# of the changesets has been saved to the persistent state
	# yet.

	set myitems  [lrange $myitems  0 $firste]
	set mytitems [lrange $mytitems 0 $firste]
	MapItems $mytype $myitems
	return $newcsets
    }

    # # ## ### ##### ######## #############

    proc BreakDirectDependencies {theitems bv} {
	upvar 1 mytypeobj mytypeobj self self $bv breaks

	array set dependencies {}
	$mytypeobj internalsuccessors dependencies $theitems
	if {![array size dependencies]} {
	    return {}
	} ; # Nothing to break.

	log write 5 csets ...[$self str].......................................................
	vc::tools::mem::mark

	return [BreakerCore $theitems dependencies breaks]
    }

    proc BreakerCore {theitems dv bv} {
	# Break a set of revisions into fragments which have no
	# internal dependencies.

	# We perform all necessary splits in one go, instead of only
	# one. The previous algorithm, adapted from cvs2svn, computed
	# a lot of state which was thrown away and then computed again
	# for each of the fragments. It should be easier to update and
	# reuse that state.

	upvar 1 $dv dependencies $bv breaks

	# We have internal dependencies to break. We now iterate over
	# all positions in the list (which is chronological, at least
	# as far as the timestamps are correct and unique) and
	# determine the best position for the break, by trying to
	# break as many dependencies as possible in one go. When a
	# break was found this is redone for the fragments coming and
	# after, after upding the crossing information.

	# Data structures:
	# Map:  POS   revision id      -> position in list.
	#       CROSS position in list -> number of dependencies crossing it
	#       DEPC  dependency       -> positions it crosses
	# List: RANGE Of the positions itself.
	# Map:  DELTA position in list -> time delta between its revision
	#                                 and the next, if any.
	# A dependency is a single-element map parent -> child

	# InitializeBreakState initializes their contents after
	# upvar'ing them from this scope. It uses the information in
	# DEPENDENCIES to do so.

	InitializeBreakState $theitems

	set fragments {}
	set new       [list $range]

	# Instead of one list holding both processed and pending
	# fragments we use two, one for the framents to process, one
	# to hold the new fragments, and the latter is copied to the
	# former when they run out. This keeps the list of pending
	# fragments short without sacrificing speed by shifting stuff
	# down. We especially drop the memory of fragments broken
	# during processing after a short time, instead of letting it
	# consume memory.

	while {[llength $new]} {

	    set pending $new
	    set new     {}
	    set at      0

	    while {$at < [llength $pending]} {
		set current [lindex $pending $at]

		log write 6 csets {. . .. ... ..... ........ .............}
		log write 6 csets {Scheduled   [join [PRs [lrange $pending $at end]] { }]}
		log write 6 csets {Considering [PR $current] \[$at/[llength $pending]\]}

		set best [FindBestBreak $current]

		if {$best < 0} {
		    # The inspected range has no internal
		    # dependencies. This is a complete fragment.
		    lappend fragments $current

		    log write 6 csets "No breaks, final"
		} else {
		    # Split the range and schedule the resulting
		    # fragments for further inspection. Remember the
		    # number of dependencies cut before we remove them
		    # from consideration, for documentation later.

		    set breaks($best) $cross($best)

		    log write 6 csets "Best break @ $best, cutting [nsp $cross($best) dependency dependencies]"

		    # Note: The value of best is an abolute location
		    # in myitems. Use the start of current to make it
		    # an index absolute to current.

		    set brel [expr {$best - [lindex $current 0]}]
		    set bnext $brel ; incr bnext
		    set fragbefore [lrange $current 0 $brel]
		    set fragafter  [lrange $current $bnext end]

		    log write 6 csets "New pieces  [PR $fragbefore] [PR $fragafter]"

		    integrity assert {[llength $fragbefore]} {Found zero-length fragment at the beginning}
		    integrity assert {[llength $fragafter]}  {Found zero-length fragment at the end}

		    lappend new $fragbefore $fragafter
		    CutAt $best
		}

		incr at
	    }
	}

	log write 6 csets ". . .. ... ..... ........ ............."

	return $fragments
    }

    proc InitializeBreakState {revisions} {
	upvar 1 pos pos cross cross range range depc depc delta delta \
	    dependencies dependencies

	# First we create a map of positions to make it easier to
	# determine whether a dependency crosses a particular index.
................................................................................
	return <${s}...${e}>
    }

    proc Border {range sv ev} {
	upvar 1 $sv s $ev e
	set s [lindex $range 0]
	set e [lindex $range end]
	return
    }

    # # ## ### ##### ######## #############

    proc UnmapItems {thetype theitems} {
	# (*) We clear out the associated part of the myitemmap
	# in-memory index in preparation for new data, or as part of
	# object destruction. A simple unset is enough, we have no
	# symbol changesets at this time, and thus never more than one
	# reference in the list.

	upvar 1 myitemmap myitemmap self self
	foreach iid $theitems {
	    set key [list $thetype $iid]
	    unset myitemmap($key)
	    log write 8 csets {MAP- item <$key> $self = [$self str]}
	}
	return
    }

    proc MapItems {thetype theitems} {
	upvar 1 myitemmap myitemmap self self

	foreach iid $theitems {
	    set key [list $thetype $iid]
	    set myitemmap($key) $self
	    log write 8 csets {MAP+ item <$key> $self = [$self str]}
	}
	return
    }

    # # ## ### ##### ######## #############

    typevariable mychangesets         {} ; # List of all known
					   # changesets.