The cyclic_array.tcl Type Mapping File

The following listing shows the callback and utility procedures as well as the TV::prototype commands needed to implement a type mapping that allows you to view a distributed array.

# Check that the type is what we expect, and that we can 
# locate the appropriate fields.
#
# We're expecting
#    struct cyclic_array 
#    {
#        int * local_elements;
#        int local_count;
#        int global_count;
#        int numprocs;
#        int myproc;
#    };
    
proc da_validate {instance_id} {
    global _da_info
    
    set fields [TV::type get $instance_id struct_fields]
    #
    # We'll save four properties of each type:
    #    The offset of the pointer to the local array.
    #    The target type identifier.
    #    The target type size
    #    The offset of the local_count
    #    The offset of the global count
    set typeinfo [list {} {} {} {} {}]
    set matched 0
    
    foreach field $fields {
        set name [lindex $field 0]
        set addressing [lindex $field 2]
    
        switch -- $name {
            local_elements  {
                set typeinfo [lreplace $typeinfo 0 0 \
                        [extract_offset $addressing]]
                # Extract the target type too.
                set field_typeid \
                        [TV::type get [lindex $field 1] target]
    
                set typeinfo [lreplace $typeinfo 1 1 $field_typeid]
                set typeinfo [lreplace $typeinfo 2 2 \
                        [TV::type get $field_typeid length]]
    
                incr matched
            }
    
            local_count {
                set typeinfo [lreplace $typeinfo 3 3 \
                        [extract_offset $addressing]]
                incr matched
            }
    
            global_count {
                set typeinfo [lreplace $typeinfo 4 4 \
                        [extract_offset $addressing]]
                incr matched
            }
        }
    }
    
    if {$matched != 3} {
        return false
    }
    
    set _da_info($instance_id) $typeinfo
    return true;
}
    
    
#
# Copy any properties we require when defining a new type as a 
# typedef for a type which already has this prototype.
#
proc da_typedef {new_id old_id} {
    global _da_info
    set _da_info($new_id) $_da_info($old_id)
}
    
#
# Return the target type for this array.
#
proc da_type {instance_id} {
    global _da_info
    set typeinfo $_da_info($instance_id)
    
    return [lindex $typeinfo 1]
}
    
#
# It's a two-dimensional array.
#
proc da_rank {type_id} {
    return 2
}
    
#
# Compute the bounds of the required element of the array.
#
proc da_bounds {type_id address} {
    global _da_info
    set typeinfo $_da_info($type_id)

    set address [expr $address + [lindex $typeinfo 4]]
    set bound [read_store $address int]
    
    return "\[$bound\]\[$bound\]"
}
    
#
# Compute the address of the required element of the array.
#
proc da_address {type_id address indices replication} {
    #
    # Each element lives in only one place, so we return a null
    # result if asked for other places for it.
    if {$replication != 0} {
        return ""
    }
    
    global _da_info _da_nprocs
    
    set typeinfo $_da_info($type_id)
    set bound [read_store \
                    [expr $address + [lindex $typeinfo 4]] int]
    
    set distributed_index [lindex $indices 0]
    set other_index [lindex $indices 1]
    set node [expr $distributed_index%$_da_nprocs]
    set local_index [expr $distributed_index/$_da_nprocs]
    
    set element_size [lindex $typeinfo 2]
    
    #
    # We have to work out the whole address.
    #
    set delta [expr $element_size* \
                ($other_index+$bound*$local_index)]
    
    return \
        "$node {addc [lindex $typeinfo 0]; indirect; addc $delta}"
}
    
#
# Return the list of process/thread identifiers over which this
# array is distributed. In this simple example, any of these 
# arrays are distributed over all the processes.  
    
proc da_distribution {type_id address} {
    #
    # For the moment we assume this is all items in our 
    # workers group.
    global GROUP WGROUP _da_nprocs
    
    # Choose the first process in the focus set.
    set proc [lindex [TV::focus_processes] 0]
    
    # Find the relevant worker group identifier.
    set group_id $WGROUP($proc)
    
    # Extract the member identifiers from the worker
    # contents.
    set res [lrange $GROUP($group_id) 1 end]
    
    # Save the number of processes for later.
    set _da_nprocs [llength $res]
    
    return $res
}