### BEGIN COPYRIGHT BLURB
#   
#   TAO - Tcl Architecture of Objects
#   Copyright (C) 2007 Sean Woods
#   
#   See the file "license.terms" for information on usage and redistribution
#   of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#   
### END COPYRIGHT BLURB

###
#  Odie object allocation and garbage collection mechanism
#
#  All objects created are "allocated" through this 
#  mechanism. It records when they were created and when they
#  were last accessed. 
#
#  Nodes record the nodes they depend upon, and container
#  objects are preserved accordingly.
###

###
#   Interface to the odie garbage collector
###

namespace eval ::thanatos {
    variable object_pool
    variable kill_time    60
    variable kiss_list
    variable object_pool  {}

    if ![info exist kiss_list] { 
	set kiss_list {}
    }



    proc alloc {object} {
	###
	#  Clean out any immortals the strayed off the reservation
	###
	variable object_pool
	dict set object_pool $object [clock seconds]
    }

    proc free {object} {


	variable object_pool
	variable kiss_list
	dict unset object_pool $object
	ldelete kiss_list $object
    }

    proc touch object {
	variable object_pool
	if [dict exists $object_pool $object] {
	    dict set object_pool $object [clock seconds]
	}
    }

    proc kiss object {
	variable kiss_list 
	variable kiss_pending 1
	ladd kiss_list $object
    }

    ###
    #  Is anyone in need of a good killing?
    ###
    proc knock {} { 
	variable kiss_list
	if { [llength [get kiss_list]] > 0 } {
	    return 1
	}
	return 0
    }

    proc cleanup {} {
	variable kiss_pending 0
	variable object_pool
	variable kill_time
	variable kiss_list

	###
	#  Start with a list of all objects
	###
	set killList $kiss_list

	###
	#  Eliminate everything that
	#  has been accessed in the last
	#  n seconds
	###
	set cutoff [expr [clock seconds] - $kill_time]

	dict for {object lastaccess} $object_pool {
	    if { $lastaccess > $cutoff } {
		ladd killList $object
	    }
	}

	###
	#  Everything left, delete
	###
	foreach item $killList {
	    catch {[$item scythe] $item} err	    
	    ###
	    #  TEMPORARILY DISABLED
	    ###
	    free $item
	}

    }

    namespace export *
    namespace ensemble create
}