Curbside Collection for Object Systems

SDW writes:

Curbside Collection is a TCL answer to the problem answered by Garbage Collection in other systems.

The idea behind Curbside Collection is that the developer is a better judge of what should and should not be automagically dumped by the system. For performance reasons, most applications need certain objects to always exist at a given name, and having to request the object be transparently created for each call gets to be expensive. Especially because we are using script to create the objects, not C code or Java bytecodes. Yes, one could design several mechanisms into the Garbage Collection system that would allow an object to side step it. But why?

Curbside Collection uses a central mechanism that registers objects that are known by the developer to be temporary and fleeting. I call this mechanism "thanatos", after the Greek God of Death. Mythology aside, in principle it acts just like garbage collection in most Urban areas.

In everyday life Trash men do not go through your house and decide for themselves what should or should not be picked up. Nor do residents phone in every smelly diaper and spent food container. Nor to trash men walk up to your door, to and ask the resident to give them refuse. Not at all. How does trash collection work in real life? The truck drives by periodically. And anything that is on the curb is tossed in.

In object systems you have generally 2 types of objects. One is the useful fixtures. The other are time-sensitive data blobs that exist temporarily as objects. Kind of like cartons of milk. So, like cartons of milk, Curbside Collection stamps objects under its care with an expiration date. Once the expiration date is reached, on object goes on the curb. Every time an object is called, its expiration date is bumped back. Thus frequently used objects tend to stay off the curb, but once and done items are collected.

The record keeping in Thanatos is simply two arrays. One stores the object handle and a clock seconds time stamp of when the object was last referenced. The other stores the object handle and a script to call to destroy the object. Objects interact with thantatos through several simple procedures:

   ::thanatos::alloc OBJECT DESTROYSCRIPT - Register an object and destroy procedure with thanatos
   ::thanatos::kiss OBJECT                            - Manually put an object on the curb 
   ::thanatos::free OBJECT                            - De-Register and object 
   ::thanatos::touch OBJECT                         - Mark that an object has been used

In the background thanatos periodically runs a polling script. The script looks through the objects in its care. If an object has not been "touched" in a while, it is put on the curb. After the polling script, thanatos politely tells the object to die. Well, actually it calls the destructor or the object system's delete mechanism as appropriate. Polite objects will call ::thanatos::free in their destructor, but just in case thanatos will also free the object after the delete call.

Here is a completely artificial example:

 # ladd adds a value to a list, but only if it would be unique.
 # ldelete picks through a list, deleting all references to a value

 package provide thanatos 0.1
 
 namespace eval ::thanatos {
    variable object_pool
    variable kill_time    60
    variable kiss_list
    if ![info exist kiss_list] {
        set kiss_list {}
    }
           
    array set object_pool       {}
            
    proc alloc {object killscript} {
        variable object_pool
        variable object_destroy
        set   object_pool($object) [clock seconds]
        set   object_destroy($object) $killscript
    }
             
    proc free {object} {
        variable object_pool
        variable kiss_list
        array unset object_pool $object
        set n {}
        ldelete kiss_list $object
    }
           
    proc touch object {
        variable object_pool
        if [info exists object_pool($object)] {
            set object_pool($object) [clock seconds]
        }
    }
                 
    proc kiss object {
        variable kiss_list
        ladd kiss_list $kiss_list
        set ::tao(kiss_pending) 1
    }
           
    ###
    #  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 {} {
        set ::tao(kiss_pending) 0
        variable object_pool
        variable object_destroy
        variable kill_time
        variable kiss_list

        ###
        #  Start with a list of all objects
        ###
        set pool [array names object_pool]

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

        foreach item $pool {
            if { [lsearch $kiss_list $item] < 0 } {
                if { $object_pool($item) > $cutoff } {
                    ldelete pool $item
                }
            }
        }

        ###
        #  Everything left, delete
        ###
        foreach item $pool {
            set script [lindex [array get object_destroy $item] 1]
            if { $script != {} } { 
               catch $script
            }
            free $item
        }

    }

    proc periodic {} {
        variable event
        if [info exists event] {after cancel $event}
        set event [after 60000 ::thanatos::periodic]
        cleanup
    }
 }

 ###
 # Start the collector
 ###
 ::thanatos::periodic

A real-life implementation is used by the TAOHTTPD to cache records. Instead of using the general case, it adds a few features that allow records to exempt themselves from the record-keeping process. It also uses an internal task manager to perform the periodic system calls. Note that ODIE refers to an older architecture that has since been replaces by TAO.

 ###
 #  TAO 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.
 ###
        
 package provide tao-thanatos 0.1

 namespace eval ::tao {
    variable object_pool
    variable kill_time    60
    variable kiss_list
    if ![info exist kiss_list] {
        set kiss_list {}
    }
           
    array set object_pool       {}
            
    proc alloc {object} {
        variable object_pool
        set   object_pool($object) [clock seconds]
    }
             
    proc free {object} {
        ::tao::cache::clear $object
        variable object_pool
        variable kiss_list
        array unset object_pool $object
        ldelete kiss_list $object
    }
           
    proc touch object {
        variable object_pool
        if [info exists object_pool($object)] {
            set object_pool($object) [clock seconds]
        }
    }
                 
    proc kiss object {
        variable kiss_list
        ladd kiss_list $kiss_list
        set ::tao(kiss_pending) 1
    }
           
    ###
    #  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 {} {
        set ::tao(kiss_pending) 0
        variable object_pool
        variable kill_time
        variable kiss_list

        ###
        #  Start with a list of all objects
        ###
        set pool [array names object_pool]
    
        ###
        #  Clean out any immortals the strayed off the reservation
        ###
        foreach item $pool {
            if [catch {set i [$item Immortal]}] {
                set i 1  
            }
            if $i {
                free $item
            }
        }
        set pool [array names object_pool]
        
        ###
        #  Step 2 eliminate everything that
        #  has been accessed in the last
        #  n seconds
        ###
        set cutoff [expr [clock seconds] - $kill_time]
        
        foreach item $pool {
            if { [lsearch $kiss_list $item] < 0 } { 
                if { $object_pool($item) > $cutoff } {
                    ldelete pool $item
                }
            }
        }
        
        ###
        #  Everything left, delete
        ###
        foreach item $pool {
            catch {::tao::delete $item} err
            free $item
        }
        
    }
   }
 }


 ###
 #   Interface to the tao garbage collector
 ###
        
 tao::class ::thanatos::mortal {
    proc Immortal {} {
        return 0
    }
        
    
    metaconstructor {
        ::tao::alloc $this  
    }
        

    chain Regenerate {} {
        ::tao::kiss $this
    }   
           
    destructor {
        ::tao::free $this
     }
 }
        
        
 ::tao::class ::thanatos::immortal {
    proc Immortal {} { 
        return 1
    }
                 
             
    proc Regenerate {} {
        return {}
    }
        
    metaconstructor {
        ::tao::free $this   
    }
             
 }

     
 ###
 #  Startup Garbage Collector
 ###
         
 ::chronos JobCreate ::chronos::job::script \
    -interval $::tao::kill_time -job_name "Garbage Collector" \
    -script ::tao::cleanup