committing:
	chameneos-redux.chpl (finally a working version, but can be optimized and cleaned up a bit)
	chameneos-redux-bug.chpl (copy of a non-working version that sometimes allows a chameneos
				  to meet itself, still haven't figured out why yet)
	test-chameneos-redux.sh (tests the correctness of multiple runs of chameneos-redux.chpl, see
				 comments for usage)

future:
	clean up, and assess performance

git-svn-id: 88467cb1fb04b8a755be7e1ee1026be4190196ef@17392 3a8e244f-b0f2-452b-bcba-4c88e055c3ca

/*	- The Chameneos game is as follows:    REVISE ME!!!
	  	A population of n chameneos gathers at a common meeting place, where
	  	m meetings take place concurrently.  A meeting may take place between
		exactly 2 chameneos, where each chameneos may be either blue, red, or yellow.
		At each meeting, the chameneos exchange information about the other chameneos'
		color, then change its own color to the complement of its original color and
		the other chameneos' color.  (The complement is respective to two colors, its own,
		and its partner's, such that if both colors are the same, no change, otherwise
		each chameneos changes to the color you and your partner both are not.)

	- (description of benchmark: http://shootout.alioth.debian.org/u32q/benchmark.php?test=chameneosredux&lang=all */

// TODO
// explore non-deterministic output (maybe have two counts, total meetings, sum of meetings with self , counts*/
// non-predictable output guard with a nonfig const, verbose, controls print out of non-det output
config const N : int = 1;	// specify number of meetings to take place
				// better varialbe name : N => numMeetings

class MeetingPlace {
	var color1$, color2$: sync Color;
	var id1$, id2$: sync int;
	var meetingsLeft$ : sync int; // should be spotsLeft or ...

 	/* fill => setNumMeetings, do n*2 internally */
	def fill(numMeetings : int) {
		meetingsLeft$.writeXF(numMeetings);
	}
	// better to have constructor that sets numMeetings
	// in that case, also should have a reset method,
	// clears the meetingsLeft$, sets to new numMeetings

	/* if called by chameneos who arrives 1st,
	   returns color of chameneos who arrives 2nd
	   otherwise returns color of chameneos who arrives 1st
           (denies meetings of 3+ chameneos) */
	def meet(chameneos : Chameneos) {
		var otherColor : Color;
		var meetingsLeftTemp = meetingsLeft$;
		if (meetingsLeftTemp == 0) {
			meetingsLeft$ = 0;
			return (false, chameneos.color);
		}
		/* save this copy, make another copy and try to
		  get rid of color1 and id1 as sync */
		if (meetingsLeftTemp % 2 == 0) {
			meetingsLeft$ = meetingsLeftTemp - 1;
			color1$ = chameneos.color;
			id1$ = chameneos.id;
			otherColor = color2$;
			if (id1$ == id2$) {
				halt("halt");
				chameneos.meetingsWithSelf += 1;
			}
			meetingsLeft$ = meetingsLeftTemp - 2;
		} else if (meetingsLeftTemp % 2 == 1) {
			id2$ = chameneos.id;
			color2$ = chameneos.color;
			otherColor = color1$;
		}
		chameneos.meetings += 1;
		return (true, otherColor);
	}
}

class Color {
	var value: int;

	/* returns the compliment of this and another color:
	   if this and the other color are of the same value, return own value
  	   otherwise return the color that is neither this or the other color */
	def getComplement(otherColor: Color) {
		var result : Color;
		if (value == otherColor.value) {
			result = new Color(value);
		} else {
			result = new Color(3 - value - otherColor.value);
		}
		return result;2
	}

	/* returns string representation of this color */
	def string() {
		select value {
			when 0 do return "blue";
			when 1 do return "red";
			when 2 do return "yellow";
			otherwise return "unexpected color value: " + value;
		}
	}

}

class Chameneos {
	var id: int;
	var meetingPlace: MeetingPlace; // take out!
	var color : Color;
	var meetings: int;
	var meetingsWithSelf: int;

	def start() {
		/* see if can change while to do while, to move local vars inside do while
		calling otherComplement more efficient or having if statement inside while,
		think of better name for openToMeet  */
		var openToMeet : bool = true;
		var otherColor : Color;
		while (openToMeet) {
			(openToMeet, otherColor) = meetingPlace.meet(this);
			color = color.getComplement(otherColor);
		}
	}
}

def printColorChange(meetingPlace : MeetingPlace, color1 : Color,  color2 : Color) {
	/* use enum for colors instead of string (clumsy).. ?*/
	var ch1 : Chameneos = new Chameneos(0, meetingPlace, color1);
	var ch2 : Chameneos = new Chameneos(1, meetingPlace, color2);

	write(ch1.color.string(), " + ",  ch2.color.string(),  " -> ");

	meetingPlace.fill(N*2);
	cobegin {
		ch1.start();
		ch2.start();
	}

	if (ch1.color.value == ch2.color.value) {
		writeln(ch1.color.string());
	} else {
		writeln("unsuccessful color change: ch1 is " + ch1.color.string() + ", ch2 is " + ch2.color.string());
	}
}

def main() {
	/* throw exception if numChameneos or numMeetings < 0, or if numChameneos < 2 */
	const forest : MeetingPlace = new MeetingPlace();

	const blue : Color = new Color(0);
	const red : Color = new Color(1);
	const yellow : Color = new Color(2);

	printColorChange(forest, blue, blue);
	printColorChange(forest, blue, red);
	printColorChange(forest, blue, yellow);
	printColorChange(forest, red, blue);
	printColorChange(forest, red, red);
	printColorChange(forest, red, yellow);
	printColorChange(forest, yellow, blue);
	printColorChange(forest, yellow, red);
	printColorChange(forest, yellow, yellow);
	writeln();

	/* first run with population size of 3 */
	/* makepopulation sizes config, if user wants to change size, possible, but have default 3 and 10
	   [0..n] repetitive, use domain instead e.g. const D = [0..2]
   	   -- chameneos should be made as consts, not colors
	   -- move bulk inside function, instantiate arrays in main
	   -- why is forest passed into Chameneos class?  move outside, and pass into start instead
	   -- totalMeetings = + reduce population.meetings
	   -- make enum for digits and their spelling */
	const colors1 : [0..2] Color = (blue, red, yellow);
	const population1 : [0..2] Chameneos;
	for i in [0..2] {
		population1(i) = new Chameneos(i, forest, colors1(i));
		write(" " + population1(i).color.string());
	}
	writeln();
	forest.fill(N*2);
	coforall chameneos in population1 {
		chameneos.start();
	}
	for chameneos in population1 {
		writeln(chameneos.meetings + " " + chameneos.meetingsWithSelf);
	}
	writeln();

	/* second run with population size of 10 */
	const colors2 : [0..9] Color = (blue, red, yellow, red, yellow,
					blue, red, yellow, red, blue);
	const population2: [0..9] Chameneos;
	for i in [0..9] {
		population2(i) = new Chameneos(i, forest, colors2(i));
		write(" " + population2(i).color.string());
	}
	writeln();
	forest.fill(N*2);
	coforall chameneos in population2 {
		chameneos.start();
	}
	for chameneos in population2 {
		writeln(chameneos.meetings + " " + chameneos.meetingsWithSelf);
	}

}

/* 	chameneos.chpl

	- description of benchmark: http://shootout.alioth.debian.org/u32q/benchmark.php?test=chameneosredux&lang=all
	- written by Hannah Hemmaplardh
	- functionality: fill me in later .. */

config const numChameneos : int = 3;
config const numMeetings : int = 2;

class MeetingPlace {
	var color1$, color2$: sync Color;
	var id1$, id2$: sync int;
	var numPresent$ : sync int = 0;
	var totalMeetings: int;

	/* if called by chameneos who arrives 1st,
	   returns color of chameneos who arrives 2nd
	   otherwise returns color of chameneos who arrives 1st
           (denies meetings of 3+ chameneos) */
	def meet(chameneos : Chameneos) {
		var result : Color;

		while (numPresent$.readFF() == 2) {
			//spin?
		}

		if (numPresent$ == 0) {
			numPresent$ = 1;
			color1$ = chameneos.color;
			id1$ = chameneos.id;
			result = color2$;
			//writeln("***** id = " + chameneos.id + ", other id = " + id2$.readFF());
			if (id1$ == id2$) {
				chameneos.meetingsWithSelf += 1;
			}
			totalMeetings += 1;
			numPresent$.writeFF(0);
		} else {
			numPresent$ = 2;
			result = color1$;
			//writeln("***** id = " + chameneos.id + ", other id = " + id1$.readFF());
			id2$ = chameneos.id;
			color2$ = chameneos.color;
		} /* else {
			result = chameneos.color;
			//writeln("unexpected value for numPresent$: " + numPresent$.readFF());
		} */
		chameneos.meetings += 1;
		return result;
	}
}

class Color {
	var value: int;

	/* returns the compliment of this and another color:
	   if this and the other color are of the same value, return own value
  	   otherwise return the color that is neither this or the other color */
	def getComplement(otherColor: Color) {
		var result : Color;
		if (value == otherColor.value) {
			result = new Color(value);
		} else {
			result = new Color(3 - value - otherColor.value);
		}
		return result;
	}

	/* returns string representation of this color */
	def string() {
		select value {
			when 0 do return "blue";
			when 1 do return "red";
			when 2 do return "yellow";
			otherwise return "unexpected color value: " + value;
		}
	}

}

class Chameneos {
	var id: int;
	var meetingPlace: MeetingPlace;
	var color, otherColor: Color;
	var meetings: int;
	var meetingsWithSelf: int;

	def start() {
		//writeln("***** id = " + id + ", initial color = " + color.string());
		otherColor = meetingPlace.meet(this);		// meet at meeting place
		//writeln("***** id = " + id + ", otherColor = " + otherColor.string());
		color = color.getComplement(otherColor);	// change color
		//writeln("***** id = " + id + ", final color = " + color.string());
	}
}

def printColorChange(meetingPlace : MeetingPlace, color1 : Color,  color2 : Color) {
	/* use enum for colors instead of string (clumsy).. ?*/
	var blueValue : int = 0;
	var redValue : int = 1;
	var yellowValue : int = 2;

	var ch1 : Chameneos = new Chameneos(0, meetingPlace, color1);
	var ch2 : Chameneos = new Chameneos(1, meetingPlace, color2);

	write(ch1.color.string() + " + " + ch2.color.string() + " -> ");

	cobegin {
		ch1.start();
		ch2.start();
	}

	if (ch1.color.value == ch2.color.value) {
		writeln(ch1.color.string());
	}
}

def main() {
	/* throw exception if numChameneos or numMeetings < 0, or if numChameneos < 2 */
	const forest : MeetingPlace = new MeetingPlace();

	const blue : Color = new Color(0);
	const red : Color = new Color(1);
	const yellow : Color = new Color(2);

	printColorChange(forest, blue, blue);
	printColorChange(forest, blue, red);
	printColorChange(forest, blue, yellow);
	printColorChange(forest, red, blue);
	printColorChange(forest, red, red);
	printColorChange(forest, red, yellow);
	printColorChange(forest, yellow, blue);
	printColorChange(forest, yellow, red);
	printColorChange(forest, yellow, yellow);
	writeln();

	var population: [0..numChameneos-1] Chameneos;
	for i in [0..numChameneos-1] {
		var myColor: Color = new Color(i % 3);
		population(i) = new Chameneos(i, forest, myColor);
		write(" " + population(i).color.string());
	}
	writeln();

	coforall i in [0..(numMeetings*2 - 1)] {
		population(i % numChameneos).start();
	}
	for chameneos in population {
		writeln(chameneos.meetings + " " + chameneos.meetingsWithSelf);
	}
}


Added dummy field to Tuple class to keep it from being used for some
other purposes.  Why is this necessary?, I wonder.  This fixes the new
regression of test_typevar_record3.chpl.

git-svn-id: 88467cb1fb04b8a755be7e1ee1026be4190196ef@3406 3a8e244f-b0f2-452b-bcba-4c88e055c3ca

class pragma "codegen data" _data { -- a c array, basically
  type t;
  var x : t; -- dummy
  pragma "rename _data_this" function this(i : integer) : t {
    return __primitive("array_index", t, i);
  }
  pragma "rename _data_set" function =this(i : integer, val : t) : t {
    return __primitive("array_set", this, i, val);
  }
  pragma "rename _data_alloc" function alloc(size, description) {  }
}

-- I/O

pragma "rename _chpl_write_boolean" function write(x : boolean) : void {
         __primitive("write", x);
}
pragma "rename _chpl_write_integer" function write(x : integer) : void {
         __primitive("write", x);
}
pragma "rename _chpl_write_float" function write(x : float) : void {
         __primitive("write", x);
}
pragma "rename _chpl_write_complex" function write(x : complex) : void {
                __primitive("write", x);
}
pragma "rename _chpl_write_string" function write(x : string) : void {
         __primitive("write", x);
}
pragma "rename _chpl_write_nil" function write(x : _nilType) : void {
         __primitive("write", x);
}
pragma "rename _chpl_write_linefeed" function writeln() : void {
         __primitive("writeln");
}
pragma "rename _chpl_read_boolean" function read(inout x : boolean) : void {
         __primitive("read", x);
}
pragma "rename _chpl_read_integer" function read(inout x : integer) : void {
         __primitive("read", x);
}
pragma "rename _chpl_read_float" function read(inout x : float) : void {
         __primitive("read", x);
}
pragma "rename _chpl_read_complex" function read(inout x : complex) : void {
         __primitive("read", x);
}
pragma "rename _chpl_read_string" function read(inout x : string) : void {
         __primitive("read", x);
}

pragma "rename _chpl_tostring_boolean"
function _tostring(x : boolean, format : string) : string {
         return __primitive("coerce", string, x);
}

pragma "rename _chpl_tostring_integer"
function _tostring(x : integer, format : string) : string {
         return __primitive("coerce", string, x);
}

pragma "rename _chpl_tostring_float"
function _tostring(x : float, format : string) : string {
         return __primitive("coerce", string, x);
}

pragma "rename _chpl_tostring_complex"
function _tostring(x : complex, format : string) : string {
         return __primitive("coerce", string, x);
}

-- intrinsic type values

const false: boolean = 0;
const true: boolean = 1;

-- math

function sqrt(x: float): float {}
function abs(x: ?t): float {}  -- BLC: should be ": t"

-- boundary classes/functions

function wrap() {}

-- reductions

class reduction {
}

class sum {
}

class max {
}

class min {
}

class maxloc {
}

class minloc {
}

-- timers

class timer {
  function start();
  function stop();
  function read(): float;
}

-- exits

pragma "rename _chpl_exit" function exit(status : integer);

function halt() {
  __primitive("halt");
}

function assert() {
  __primitive("assert");
}

-- memory tests (These tests will be moved to a module, once we have modules.)

function _chpl_memtest_printMemTable();
function _chpl_memtest_printMemStat();
function _chpl_memtest_resetMemStat();
function _chpl_memtest_allocAndFree();
function _chpl_memtest_freedMalloc();
function _chpl_memtest_freedWithoutMalloc();
function _chpl_memtest_reallocWithoutMalloc();
function _chpl_memtest_reallocZeroSize();
function _chpl_memtest_mallocOutOfMemory();
function _chpl_memtest_reallocOutOfMemory();

function _complex_read_hack(inout x) {
  __primitive("read", x);
}

function _complex_tostring_hack(x, format : string) : string {
  return __primitive("coerce", string, x);
}

-- FROM INTERNAL PRELUDE

record _methodTokenType {
  var _methodTokenTypeFieldDummy : integer;
}

var _methodToken : _methodTokenType;

class _seq { -- this is no longer necessary
}

class Index {
}

pragma "omit for noanalysis" class Array {
  pragma "omit for noanalysis" function this(i) {
    return __primitive("array_index", this, i);
  }
  pragma "omit for noanalysis" function this(i, j) {
    return __primitive("array_index", this, i, j);
  }
  pragma "omit for noanalysis" function this(i, j, k) {
    return __primitive("array_index", this, i, j, k);
  }
  pragma "omit for noanalysis" function =this(i, x) {
    return __primitive("array_set", this, i, x);
  }
  pragma "omit for noanalysis" function =this(i, j, x) {
    return __primitive("array_set", this, i, j, x);
  }
  pragma "omit for noanalysis" function =this(i, j, k, x) {
    return __primitive("array_set", this, i, j, k, x);
  }
}

class Domain {
}

record Tuple {
  var dummyTuple : integer;
  function this(pragma "clone_for_constants" i) {
    return __primitive("index_object", this, i);
  }
  function =this(pragma "clone_for_constants" i, x) {
    return __primitive("set_index_object", this, i, x);
  }
}

pragma "builtin" function +(a : Array, b : Array) { return __primitive("array_pointwise_op", a, b); }
pragma "builtin" function -(a : Array, b : Array) { return __primitive("array_pointwise_op", a, b); }
pragma "builtin" function *(a : Array, b : Array) { return __primitive("array_pointwise_op", a, b); }
pragma "builtin" function /(a : Array, b : Array) { return __primitive("array_pointwise_op", a, b); }
pragma "builtin" function &(a : Array, b : Array) { return __primitive("array_pointwise_op", a, b); }
pragma "builtin" function |(a : Array, b : Array) { return __primitive("array_pointwise_op", a, b); }
pragma "builtin" function ^(a : Array, b : Array) { return __primitive("array_pointwise_op", a, b); }
pragma "builtin" function ==(a : Array, b : Array) { return __primitive("array_pointwise_op", a, b); }
pragma "builtin" function !=(a : Array, b : Array) { return __primitive("array_pointwise_op", a, b); }
pragma "builtin" function <=(a : Array, b : Array) { return __primitive("array_pointwise_op", a, b); }
pragma "builtin" function >=(a : Array, b : Array) { return __primitive("array_pointwise_op", a, b); }
pragma "builtin" function <(a : Array, b : Array) { return __primitive("array_pointwise_op", a, b); }
pragma "builtin" function >(a : Array, b : Array) { return __primitive("array_pointwise_op", a, b); }
pragma "builtin" function and(a : Array, b : Array) { return __primitive("array_pointwise_op", a, b); }
pragma "builtin" function or(a : Array, b : Array) { return __primitive("array_pointwise_op", a, b); }
pragma "builtin" function **(a : Array, b : Array) { return __primitive("array_pointwise_op", a, b); }

pragma "builtin" function +(a : numeric, b : numeric) { return __primitive(a, "+", b); }
pragma "builtin" function -(a : numeric, b : numeric) { return __primitive(a, "-", b); }
pragma "builtin" function *(a : numeric, b : numeric) { return __primitive(a, "*", b); }
pragma "builtin" function /(a : numeric, b : numeric) { return __primitive(a, "/", b); }
pragma "builtin" function mod(a : numeric, b : numeric) { return __primitive(a, "%", b); }
pragma "builtin" function ==(a : numeric, b : numeric) { return __primitive(a, "==", b); }
pragma "builtin" function !=(a : numeric, b : numeric) { return __primitive(a, "!=", b); }
pragma "builtin" function <=(a : numeric, b : numeric) { return __primitive(a, "<=", b); }
pragma "builtin" function >=(a : numeric, b : numeric) { return __primitive(a, ">=", b); }
pragma "builtin" function <(a : numeric, b : numeric) { return __primitive(a, "<", b); }
pragma "builtin" function >(a : numeric, b : numeric) { return __primitive(a, ">", b); }
pragma "builtin" function &(a : numeric, b : numeric) { return __primitive(a, "&", b); }
pragma "builtin" function |(a : numeric, b : numeric) { return __primitive(a, "|", b); }
pragma "builtin" function ^(a : numeric, b : numeric) { return __primitive(a, "^", b); }
pragma "builtin" function and(a : numeric, b : numeric) { return __primitive(a, "&&", b); }
pragma "builtin" function or(a : numeric, b : numeric) { return __primitive(a, "||", b); }
pragma "builtin" function **(a : numeric, b : numeric) { return __primitive(a, "**", b); }
pragma "builtin" function by(a : numeric, b : numeric) { return __primitive(a, "by", b); }
pragma "builtin" function ==(a : object, b : object) { return __primitive("ptr_eq", a, b); }
pragma "builtin" function !=(a : object, b : object) { return __primitive("ptr_neq", a, b); }

pragma "builtin" function Index.=(b : integer) { return __primitive("indextype_set", this, b); }
pragma "builtin" function integer.=(b : Index) { return __primitive("indextype_get", b); }
pragma "builtin" function any.=(b : any) { return b; }

pragma "builtin" function =(a : Index, b : integer) { return __primitive("indextype_set", this, b); }
pragma "builtin" function =(a : integer, b : Index) { return __primitive("indextype_get", b); }
pragma "builtin" function =(a : any, b : any) { return b; }

pragma "rename _chpl_string_concat"
function +(a : string, b : string) : string {
  return __primitive("string_op", a, b);
}

function _chpl_malloc(number, size, description: string);
function _chpl_calloc(number, size, description: string);
function _chpl_free(memory);
function _chpl_realloc(memory, number, size, description: string);

function _init_string() { return ""; }

function _UNION_CHECK(u, tag, filename, lineno);
function _UNION_SET(u, tag);
function _UNION_CHECK_QUIET(u, tag): boolean;

function _INIT_CONFIG(inout v, v_type, chapel_name, module_name);
function _INIT_ARRAY(rank, arr, dom, elt_type);
function _INIT_DOMAIN_DIM(dom, dim, lo, hi, str);

function _UnionWriteStopgap(x) { }
function _ArrayWriteStopgap(x) { }
function _EnumWriteStopgap(x) { }
function _EnumReadStopgap(x) { }
function _DomainWriteStopgap(x) { }

-- END FROM INTERNAL PRELUDE

class pragma "codegen data" _data { -- a c array, basically
  type t;
  var x : t; -- dummy
  pragma "rename _data_this" function this(i : integer) : t {
    return __primitive("array_index", t, i);
  }
  pragma "rename _data_set" function =this(i : integer, val : t) : t {
    return __primitive("array_set", this, i, val);
  }
  pragma "rename _data_alloc" function alloc(size, description) {  }
}

-- I/O

pragma "rename _chpl_write_boolean" function write(x : boolean) : void {
         __primitive("write", x);
}
pragma "rename _chpl_write_integer" function write(x : integer) : void {
         __primitive("write", x);
}
pragma "rename _chpl_write_float" function write(x : float) : void {
         __primitive("write", x);
}
pragma "rename _chpl_write_complex" function write(x : complex) : void {
                __primitive("write", x);
}
pragma "rename _chpl_write_string" function write(x : string) : void {
         __primitive("write", x);
}
pragma "rename _chpl_write_nil" function write(x : _nilType) : void {
         __primitive("write", x);
}
pragma "rename _chpl_write_linefeed" function writeln() : void {
         __primitive("writeln");
}
pragma "rename _chpl_read_boolean" function read(inout x : boolean) : void {
         __primitive("read", x);
}
pragma "rename _chpl_read_integer" function read(inout x : integer) : void {
         __primitive("read", x);
}
pragma "rename _chpl_read_float" function read(inout x : float) : void {
         __primitive("read", x);
}
pragma "rename _chpl_read_complex" function read(inout x : complex) : void {
         __primitive("read", x);
}
pragma "rename _chpl_read_string" function read(inout x : string) : void {
         __primitive("read", x);
}

pragma "rename _chpl_tostring_boolean"
function _tostring(x : boolean, format : string) : string {
         return __primitive("coerce", string, x);
}

pragma "rename _chpl_tostring_integer"
function _tostring(x : integer, format : string) : string {
         return __primitive("coerce", string, x);
}

pragma "rename _chpl_tostring_float"
function _tostring(x : float, format : string) : string {
         return __primitive("coerce", string, x);
}

pragma "rename _chpl_tostring_complex"
function _tostring(x : complex, format : string) : string {
         return __primitive("coerce", string, x);
}

-- intrinsic type values

const false: boolean = 0;
const true: boolean = 1;

-- math

function sqrt(x: float): float {}
function abs(x: ?t): float {}  -- BLC: should be ": t"

-- boundary classes/functions

function wrap() {}

-- reductions

class reduction {
}

class sum {
}

class max {
}

class min {
}

class maxloc {
}

class minloc {
}

-- timers

class timer {
  function start();
  function stop();
  function read(): float;
}

-- exits

pragma "rename _chpl_exit" function exit(status : integer);

function halt() {
  __primitive("halt");
}

function assert() {
  __primitive("assert");
}

-- memory tests (These tests will be moved to a module, once we have modules.)

function _chpl_memtest_printMemTable();
function _chpl_memtest_printMemStat();
function _chpl_memtest_resetMemStat();
function _chpl_memtest_allocAndFree();
function _chpl_memtest_freedMalloc();
function _chpl_memtest_freedWithoutMalloc();
function _chpl_memtest_reallocWithoutMalloc();
function _chpl_memtest_reallocZeroSize();
function _chpl_memtest_mallocOutOfMemory();
function _chpl_memtest_reallocOutOfMemory();

function _complex_read_hack(inout x) {
  __primitive("read", x);
}

function _complex_tostring_hack(x, format : string) : string {
  return __primitive("coerce", string, x);
}

-- FROM INTERNAL PRELUDE

record _methodTokenType {
  var _methodTokenTypeFieldDummy : integer;
}

var _methodToken : _methodTokenType;

class _seq { -- this is no longer necessary
}

class Index {
}

pragma "omit for noanalysis" class Array {
  pragma "omit for noanalysis" function this(i) {
    return __primitive("array_index", this, i);
  }
  pragma "omit for noanalysis" function this(i, j) {
    return __primitive("array_index", this, i, j);
  }
  pragma "omit for noanalysis" function this(i, j, k) {
    return __primitive("array_index", this, i, j, k);
  }
  pragma "omit for noanalysis" function =this(i, x) {
    return __primitive("array_set", this, i, x);
  }
  pragma "omit for noanalysis" function =this(i, j, x) {
    return __primitive("array_set", this, i, j, x);
  }
  pragma "omit for noanalysis" function =this(i, j, k, x) {
    return __primitive("array_set", this, i, j, k, x);
  }
}

class Domain {
}

record Tuple {
  function this(pragma "clone_for_constants" i) {
    return __primitive("index_object", this, i);
  }
  function =this(pragma "clone_for_constants" i, x) {
    return __primitive("set_index_object", this, i, x);
  }
}

pragma "builtin" function +(a : Array, b : Array) { return __primitive("array_pointwise_op", a, b); }
pragma "builtin" function -(a : Array, b : Array) { return __primitive("array_pointwise_op", a, b); }
pragma "builtin" function *(a : Array, b : Array) { return __primitive("array_pointwise_op", a, b); }
pragma "builtin" function /(a : Array, b : Array) { return __primitive("array_pointwise_op", a, b); }
pragma "builtin" function &(a : Array, b : Array) { return __primitive("array_pointwise_op", a, b); }
pragma "builtin" function |(a : Array, b : Array) { return __primitive("array_pointwise_op", a, b); }
pragma "builtin" function ^(a : Array, b : Array) { return __primitive("array_pointwise_op", a, b); }
pragma "builtin" function ==(a : Array, b : Array) { return __primitive("array_pointwise_op", a, b); }
pragma "builtin" function !=(a : Array, b : Array) { return __primitive("array_pointwise_op", a, b); }
pragma "builtin" function <=(a : Array, b : Array) { return __primitive("array_pointwise_op", a, b); }
pragma "builtin" function >=(a : Array, b : Array) { return __primitive("array_pointwise_op", a, b); }
pragma "builtin" function <(a : Array, b : Array) { return __primitive("array_pointwise_op", a, b); }
pragma "builtin" function >(a : Array, b : Array) { return __primitive("array_pointwise_op", a, b); }
pragma "builtin" function and(a : Array, b : Array) { return __primitive("array_pointwise_op", a, b); }
pragma "builtin" function or(a : Array, b : Array) { return __primitive("array_pointwise_op", a, b); }
pragma "builtin" function **(a : Array, b : Array) { return __primitive("array_pointwise_op", a, b); }

pragma "builtin" function +(a : numeric, b : numeric) { return __primitive(a, "+", b); }
pragma "builtin" function -(a : numeric, b : numeric) { return __primitive(a, "-", b); }
pragma "builtin" function *(a : numeric, b : numeric) { return __primitive(a, "*", b); }
pragma "builtin" function /(a : numeric, b : numeric) { return __primitive(a, "/", b); }
pragma "builtin" function mod(a : numeric, b : numeric) { return __primitive(a, "%", b); }
pragma "builtin" function ==(a : numeric, b : numeric) { return __primitive(a, "==", b); }
pragma "builtin" function !=(a : numeric, b : numeric) { return __primitive(a, "!=", b); }
pragma "builtin" function <=(a : numeric, b : numeric) { return __primitive(a, "<=", b); }
pragma "builtin" function >=(a : numeric, b : numeric) { return __primitive(a, ">=", b); }
pragma "builtin" function <(a : numeric, b : numeric) { return __primitive(a, "<", b); }
pragma "builtin" function >(a : numeric, b : numeric) { return __primitive(a, ">", b); }
pragma "builtin" function &(a : numeric, b : numeric) { return __primitive(a, "&", b); }
pragma "builtin" function |(a : numeric, b : numeric) { return __primitive(a, "|", b); }
pragma "builtin" function ^(a : numeric, b : numeric) { return __primitive(a, "^", b); }
pragma "builtin" function and(a : numeric, b : numeric) { return __primitive(a, "&&", b); }
pragma "builtin" function or(a : numeric, b : numeric) { return __primitive(a, "||", b); }
pragma "builtin" function **(a : numeric, b : numeric) { return __primitive(a, "**", b); }
pragma "builtin" function by(a : numeric, b : numeric) { return __primitive(a, "by", b); }
pragma "builtin" function ==(a : object, b : object) { return __primitive("ptr_eq", a, b); }
pragma "builtin" function !=(a : object, b : object) { return __primitive("ptr_neq", a, b); }

pragma "builtin" function Index.=(b : integer) { return __primitive("indextype_set", this, b); }
pragma "builtin" function integer.=(b : Index) { return __primitive("indextype_get", b); }
pragma "builtin" function any.=(b : any) { return b; }

pragma "builtin" function =(a : Index, b : integer) { return __primitive("indextype_set", this, b); }
pragma "builtin" function =(a : integer, b : Index) { return __primitive("indextype_get", b); }
pragma "builtin" function =(a : any, b : any) { return b; }

pragma "rename _chpl_string_concat"
function +(a : string, b : string) : string {
  return __primitive("string_op", a, b);
}

function _chpl_malloc(number, size, description: string);
function _chpl_calloc(number, size, description: string);
function _chpl_free(memory);
function _chpl_realloc(memory, number, size, description: string);

function _init_string() { return ""; }

function _UNION_CHECK(u, tag, filename, lineno);
function _UNION_SET(u, tag);
function _UNION_CHECK_QUIET(u, tag): boolean;

function _INIT_CONFIG(inout v, v_type, chapel_name, module_name);
function _INIT_ARRAY(rank, arr, dom, elt_type);
function _INIT_DOMAIN_DIM(dom, dim, lo, hi, str);

function _UnionWriteStopgap(x) { }
function _ArrayWriteStopgap(x) { }
function _EnumWriteStopgap(x) { }
function _EnumReadStopgap(x) { }
function _DomainWriteStopgap(x) { }

-- END FROM INTERNAL PRELUDE


Clean-up and update comments for release.

git-svn-id: 88467cb1fb04b8a755be7e1ee1026be4190196ef@19884 3a8e244f-b0f2-452b-bcba-4c88e055c3ca

module SSCA2_kernels

//  +==========================================================================+
//  |  Polymorphic Implementation of SSCA #2, Kernels 2-4                      |
//  |                                                                          |
//  |  Each kernel takes a graph argument which provides for each vertex       |
//  |  1.  an iterator for its set of neighbors                                |
//  |  2.  a parallel integer array of edge weights, which can be zipper       |
//  |      iterated with the set of neighbors                                  |
//  |  3.  the number of neighbors                                             |
//  |                                                                          |
//  |  These are the only requirements on the representation of the graph.     |
//  |                                                                          |
//  |  Filtering in Kernel 4 is turned on or off by a compilation time param.  |
//  +==========================================================================+

{
  use SSCA2_compilation_config_params, Time;

  var stopwatch : Timer;

  // ========================================================
  //                           KERNEL 2:
  // ========================================================
  // Find the edges with the largest edges.  Return a list of
  // edges, all of which have the largest weight.
  // ========================================================

  proc largest_edges ( G, heavy_edge_list :domain )

    // edge_weights can be either an array over an associative
    // domain or over a sparse domain.  the output  heavy_edge_list
    // can either kind of domain or something else purpose-built
    // for this task.
    {
      if PRINT_TIMING_STATISTICS then stopwatch.start ();
      var heaviest_edge_weight$ : sync int = 0;

      // ---------------------------------------------------------
      // find heaviest edge weight in a single pass over all edges
      // ---------------------------------------------------------

      // TODO: replace with a proper reduction

      forall s in G.vertices do
        forall w in G.edge_weight (s) do
	  heaviest_edge_weight$ = max ( w, heaviest_edge_weight$ );

      // ---------------------------------------------
      // in a second pass over all edges, extract list
      // of all edges  matching the heaviest weight
      // ---------------------------------------------

      forall s in G.vertices do
        forall (t, w) in ( G.Neighbors (s), G.edge_weight (s) ) do

	  if w == heaviest_edge_weight$.readXX () then {
	    heavy_edge_list.add ( (s,t) );
	  };

      if PRINT_TIMING_STATISTICS then {
	stopwatch.stop ();
	writeln ( "Elapsed time for Kernel 2: ", stopwatch.elapsed (),
		  " seconds");
	stopwatch.clear ();
      }

      // ------------------------------------------------
      // should be able to write a user-defined "maxlocs"
      // reduction more efficiently than this scheme
      // ------------------------------------------------

      if DEBUG_KERNEL2 then {
	writeln ();
	writeln ( "Heaviest weight      : ",
		  heaviest_edge_weight$ . readFF ());
	writeln ( "Number of heavy edges:", heavy_edge_list.numIndices );
	writeln ();
	writeln ( "Edges with largest weight and other neighbors:" );
	for (s,t) in heavy_edge_list do {
	  writeln ("edge   ", (s,t));
	  for (v,w) in (G.Neighbors (s), G.edge_weight (s) ) do
	    writeln ("      ", v, " ", w);}
      }
    };

  // ===================================================================
  //                              KERNEL 3:
  // ===================================================================
  // For each root (heavy) edge, find the subgraph (vertices and edges)
  // defined by directed paths of length no greater than max_path_length
  // in which the first edge traversed is the root edge
  // ===================================================================

  proc rooted_heavy_subgraphs ( G,
                                Heavy_Edge_List     : domain,
                                Heavy_Edge_Subgraph : [],
                                in max_path_length  : int )

    // -------------------------------------------------------------------------
    // there is a classic space versus time tradeoff.  if the subgraphs expanded
    // by breadth first search are small, it would make sense to use a hash
    // table or an associative domain to represent the search.  If the subgraphs
    // are large, using a full length vector to represent the search is more
    // appropriate.  We expect small diameters for power law graphs, so we
    // expect large subgraphs.
    // -------------------------------------------------------------------------

    {
      if PRINT_TIMING_STATISTICS then stopwatch.start ();

      const vertex_domain = G.vertices;

      forall ( x, y ) in Heavy_Edge_List do {
	var Active_Level, Next_Level : domain ( index (vertex_domain) );
	var min_distance             : [vertex_domain] atomic int;
        forall m in min_distance do m.write(-1);

	if DEBUG_KERNEL3 then
	  writeln ( " Building heavy edge subgraph from pair:", (x,y) );
	Active_Level.add ( y );
	Next_Level.clear ();
	Heavy_Edge_Subgraph ( (x, y) ).nodes.clear ();
	Heavy_Edge_Subgraph ( (x, y) ).edges.clear ();
	min_distance ( y ).write(0);

	Heavy_Edge_Subgraph ( (x, y) ).edges.add ( (x, y) );
	Heavy_Edge_Subgraph ( (x, y) ).nodes.add ( x );
	Heavy_Edge_Subgraph ( (x, y) ).nodes.add ( y );

	for path_length in 1 .. max_path_length do {

	  forall v in Active_Level do {

	    forall w in G.Neighbors (v) do {

              if min_distance(w).compareExchangeStrong(-1, path_length) then {
                Next_Level.add (w);
                Heavy_Edge_Subgraph ( (x, y) ).nodes.add (w);
	      }

	      if min_distance(w).read() == path_length then {
		Heavy_Edge_Subgraph ( (x, y) ).edges.add ( (v, w) );
	      }
	    }
	  }

	  if path_length < max_path_length then {
	    Active_Level = Next_Level;
	    Next_Level.clear ();
	  }
	}
      }

      if PRINT_TIMING_STATISTICS then {
	stopwatch.stop ();
	writeln ( "Elapsed time for Kernel 3: ", stopwatch.elapsed (),
		  " seconds");
	stopwatch.clear ();
      }
    } // end of rooted_heavy_subgraphs

  use BlockDist;
  // Would be nice to use PriavteDist, but aliasing is not supported (yet)
  const PrivateSpace = [LocaleSpace] dmapped Block(boundingBox=[LocaleSpace]);

  // ==================================================================
  //                              KERNEL 4
  // ==================================================================
  // Calculate Betweenness Centrality for simple unweighted directed or
  // undirected graphs, using Madduri, et.al.'s modification of
  // Brandes's 2001 algorithm
  // ==================================================================

  proc approximate_betweenness_centrality ( G, starting_vertices,
                                            Between_Cent : [] real,
                                            out Sum_Min_Dist : real )

    // -----------------------------------------------------------------------
    // The betweenness centrality metric for a given node  v  is defined
    // as the double sum over s not equal to v and  t not equal to
    // either s or v of the ratio of the number of shortest paths from s to t
    // passing through v to the number of shortest paths from s to t.
    //
    // Brandes's algorithm decomposes the computation of this metric into,
    // first, separate sums for each vertex s, which can be computed
    // independently in parallel, and
    // two, a recursive, tree-based, calculation of the path counts for
    // any particular s.
    // The complexity of this algorithm is O ( |V||E| ) time for an unweighted
    // graph.  The algorithm requires O ( |V| ) temporary space for each
    // process that executes instances of the outermost loop.
    // -----------------------------------------------------------------------
    {
      const vertex_domain = G.vertices;

      // Considering using a dense 1-d array instead.  This would
      // complicate the Level_Set implementation a little, but would
      // probably be more efficient.
      type Sparse_Vertex_List = domain(index(vertex_domain));

      var Between_Cent$ : [vertex_domain] sync real = 0.0;
      var Sum_Min_Dist$ : sync real = 0.0;

      //
      // Throughout kernel 4, we use distributed arrays that are
      // private to each iteration of the outer loop.  Because set-up
      // and clean-up of such variables is very expensive, it is
      // desirable to do it at most only once per task versus once
      // per iteration, as a task executes multiple iterations of a
      // forall loop.
      //
      // To avoid this per-iteration overhead, we have implemented
      // an optimization that make certain variables private to each
      // task.  These variables are reinitialized each iteration of
      // the loop, but not reallocated, reprivatized, etc.
      //
      // Note that the Chapel group and collaborators are currently in
      // the process of bringing the idea of task private variable to
      // the language.
      //

      // Initialize task private data
      var localePrivate: [PrivateSpace] localePrivateData(vertex_domain.type);
      forall l in localePrivate do {
        l = new localePrivateData(vertex_domain);
        for t in l.temps { // this might be bad for first-touch
          t = new taskPrivateData(domain(index(vertex_domain)), vertex_domain);
          forall v in vertex_domain do
            t.children_list[v].nd = [1..G.n_Neighbors[v]];
          for loc in Locales do on loc {
              t.Active_Level[here.id] = new Level_Set (Sparse_Vertex_List);
              t.Active_Level[here.id].previous = nil;
              t.Active_Level[here.id].next = new Level_Set (Sparse_Vertex_List);;
              t.Active_Level[here.id].next.previous = t.Active_Level[here.id];
              t.Active_Level[here.id].next.next = nil;
          }
        }
      }

      // ------------------------------------------------------
      // Each iteration of the outer loop of Brandes's algorithm
      // computes the contribution (the "dependency" metric) for
      // one particular vertex  (s)  independently.
      // ------------------------------------------------------

      if PRINT_TIMING_STATISTICS then stopwatch.start ();

      forall s in starting_vertices do {

	if DEBUG_KERNEL4 then writeln ( "expanding from starting node ", s );

        // Initialize task private variables
        const lp = localePrivate[here.id];
        const tid = lp.get_tid();
        var depend => lp.get_depend(tid);
        var min_distance  => lp.get_min_distance(tid);
        var path_count$   => lp.get_path_count(tid);
        var children_list => lp.get_children_list(tid);
        forall v in vertex_domain do {
          depend[v] = 0.0;
          min_distance[v].write(-1);
          path_count$[v].writeXF(0.0);
          children_list[v].child_count.write(0);
        }
	var Lcl_Sum_Min_Dist: sync real = 0.0;

	// The structure of the algorithm depends on a breadth-first
	// traversal. Each vertex will be marked by the length of
	// the shortest path (min_distance) from s to it. The array
	// path_count$ will hold a count of the number of shortest
	// paths from s to this node.  The number of paths in moderate
	// sized tori exceeds 2**64.

        //
        // Used to check termination of the forward pass
        //
        // We could use a task-private reduction variable here.  This
        // is yet another concept that the Chapel group is planning to
        // implement.
        //
        var Active_Remaining => lp.get_Active_Remaining(tid);
        Active_Remaining = true;
        var remaining = true;

        //
        // Each locale will have its own level sets.  A locale's level set
        // will only contain nodes that are physically allocated on that
        // particular locale.
        //
        var Active_Level => lp.get_Active_Level(tid);
        coforall loc in Locales do on loc {
          Active_Level[here.id].Members.clear();
          Active_Level[here.id].next.Members.clear();
          if vertex_domain.dist.idxToLocale(s) == here {
            // Establish the initial level sets for the breadth-first
            // traversal from s
            Active_Level[here.id].Members.add(s);
            min_distance[s].write(0);
            path_count$[s].writeXF(1);
          }
        }

	var current_distance : int = 0;

	while remaining do {
	    // ------------------------------------------------
	    // expand the neighbor sets for all vertices at the
	    // current distance from the starting vertex  s
	    // ------------------------------------------------

	    current_distance += 1;

            var barrier = new Barrier(numLocales);

            // The Chapel compiler is still a bit conservative when it
            // comes to forwarding read-only variables to remote
            // locales, so we make a const copy here to insure it is
            // forwarded to the remote locale in the following
            // coforall loop.
            const current_distance_c = current_distance;
            coforall loc in Locales do on loc {
             forall u in Active_Level[here.id].Members do {

               forall (v, w) in ( G.Neighbors (u), G.edge_weight (u) ) do
                 on vertex_domain.dist.idxToLocale(v) {
		// --------------------------------------------
		// add any unmarked neighbors to the next level
		// --------------------------------------------

		if  ( FILTERING &&  w % 8 != 0 ) || !FILTERING then
		  if  min_distance[v].compareExchangeStrong(-1, current_distance_c) {
                    Active_Level[here.id].next.Members.add (v);
                    if VALIDATE_BC then
                      Lcl_Sum_Min_Dist += current_distance_c;
                  }

		// ------------------------------------------------
		// only neighbors of  u  that are in the next level
		// are on shortest paths from s through v.  Some
		// task will have set  min_distance (v) by the
		// time this code is reached, whether  v  lies in
		// the previous, the current or the next level.
		// ------------------------------------------------

		if min_distance[v].read() == current_distance_c {
                  path_count$[v] += path_count$[u].readFF();
                  children_list(u).add_child (v);
                }

	      }
	    };

            // This barrier is needed to insure all updates to the next
            // level are completed before updating to use the next level
            barrier.notify();
            // do some work while we wait
            if Active_Level[here.id].next.next == nil {
              Active_Level[here.id].next.next = new Level_Set (Sparse_Vertex_List);
              Active_Level[here.id].next.next.previous = Active_Level[here.id].next;
              Active_Level[here.id].next.next.next = nil;
            } else {
              Active_Level[here.id].next.next.Members.clear();
            }
            barrier.wait();

            Active_Level[here.id] = Active_Level[here.id].next;
            Active_Remaining[here.id] =
              Active_Level[here.id].Members.numIndices:bool;

          }

          remaining = || reduce Active_Remaining;

	};  // end forward pass

	if VALIDATE_BC then
	  Sum_Min_Dist$ += Lcl_Sum_Min_Dist;

	// -------------------------------------------------------------
	// compute the dependencies recursively, traversing the vertices
	// of the graph in non-increasing order of distance (reverse
	// ordering from the initial traversal)
	// -------------------------------------------------------------

	var graph_diameter = current_distance - 1;

	if DEBUG_KERNEL4 then
	  writeln ( " graph diameter from starting node ", s,
		    "  is ", graph_diameter );

        // Use multiple barriers to simplify synchronization between
        // the barriers in each iteration of the outer for loop
        var barrier: [2..graph_diameter] Barrier;
        [2..graph_diameter] barrier.reset(numLocales);

        coforall loc in Locales do on loc {
          // back up to last level
          var curr_Level =  Active_Level[here.id].previous;

          for current_distance in 2 .. graph_diameter by -1 {
            curr_Level = curr_Level.previous;

            for u in curr_Level.Members do on vertex_domain.dist.idxToLocale(u) {
              depend (u) = + reduce [v in children_list(u).Row_Children[1..children_list(u).child_count.read()]]
                ( path_count$[u].readFF() /
                  path_count$[v].readFF() )      *
                ( 1.0 + depend (v) );
              Between_Cent$ (u) += depend (u);
            }

            // This barrier is needed to insure all updates to depend are
            // complete before the next pass.
            barrier[current_distance].barrier();
          }
        }

      }; // closure of outer embarassingly parallel forall

      if PRINT_TIMING_STATISTICS then {
	stopwatch.stop ();
	var K4_time = stopwatch.elapsed ();
	stopwatch.clear ();
	writeln ( "Elapsed time for Kernel 4: ", K4_time, " seconds");

	var n0            = + reduce [v in vertex_domain] (G.n_Neighbors (v)== 0);
	var n_edges       = + reduce [v in vertex_domain] G.n_Neighbors (v);
	var N_VERTICES    = vertex_domain.numIndices;
	var TEPS          = 7.0 * N_VERTICES * (N_VERTICES - n0) / K4_time;
	var Adjusted_TEPS = n_edges * (N_VERTICES - n0) / K4_time;

	writeln ( "                     TEPS: ", TEPS );
	writeln ( " edge count adjusted TEPS: ", Adjusted_TEPS );
      }

      if VALIDATE_BC then
	Sum_Min_Dist = Sum_Min_Dist$;

      Between_Cent = Between_Cent$;

      forall l in localePrivate do on l {
          for i in l.r {
            var al  => l.temps[i].Active_Level;
            coforall loc in Locales do on loc {
                var level = al[here.id];
                while level != nil {
                    var l2 = level.next;
                    delete level;
                    level = l2;
                }
            }
            delete l.temps[i];
          }
          delete l;
      }

    } // end of Brandes' betweenness centrality calculation

  //
  // Addition support data structures for kernel 4
  //

  // ------------------------------------------------------------
  // The set of vertices at a particular distance from s form a
  // level set.  The class allows the full set of vertices to be
  // partitioned into a linked list of level sets.  Each instance
  // of the outer loop in kernel 4 creates such a partitioning.
  // ============================================================

  class Level_Set {
    type Sparse_Vertex_List;
    var Members  : Sparse_Vertex_List;
    var previous : Level_Set (Sparse_Vertex_List);
    var next : Level_Set (Sparse_Vertex_List);
  }

  //
  // Data structure to save Children lists between the forward
  //  and backwards passes
  //
  record child_struct {
    type vertex;
    var nd: domain(1);
    var Row_Children: [nd] vertex;
    var child_count: atomic int;

    // This function should only be called using unique vertices
    proc add_child ( new_child: vertex ) {
      var c = child_count.fetchAdd(1)+1;
      Row_Children[c] = new_child;
    }
  }

  //
  // Implementation of task-private variables for kernel 4
  //
  class taskPrivateData {
    type Sparse_Vertex_List;
    const vertex_domain;
    // It would be nice to use an atomic for the tid, but
    // chpl_taskID_t is an opaque type.  Might be able to make some
    // assumptions about it.
    var tid$           : sync chpl_taskID_t = chpl_nullTaskID;
    var min_distance   : [vertex_domain] atomic int;
    var path_count$    : [vertex_domain] sync real(64);
    var depend         : [vertex_domain] real;
    var children_list  : [vertex_domain] child_struct(index(vertex_domain));
    var Active_Remaining: [PrivateSpace] bool;
    var Active_Level   : [PrivateSpace] Level_Set (Sparse_Vertex_List);
  };
  inline proc =(a: chpl_taskID_t, b: chpl_taskID_t) return b;
  inline proc !=(a: chpl_taskID_t, b: chpl_taskID_t) return __primitive("!=", a, b);
  class localePrivateData {
    const vertex_domain;
    const numTasks = if dataParTasksPerLocale==0 then here.numCores
      else dataParTasksPerLocale;
    var r = [0..#numTasks];
    var temps: [r] taskPrivateData(domain(index(vertex_domain)),
                                   vertex_domain.type);
    proc get_tid() {
      // This code assumes that chpl_taskID_t is an integral type
      extern proc chpl_task_getId(): chpl_taskID_t;
      var mytid = chpl_task_getId();
      var slot = (mytid:uint % (numTasks:uint)):int;
      var tid: chpl_taskID_t = temps[slot].tid$; // lock
      while ((tid != chpl_nullTaskID) && (tid != mytid)) {
        temps[slot].tid$ = tid;                  // unlock
        slot = (slot+1)%numTasks;
        tid = temps[slot].tid$;                  // lock
      }
      temps[slot].tid$ = mytid;                  // unlock
      return slot;
    }
    inline proc get_min_distance(tid=get_tid()) return temps[tid].min_distance;
    inline proc get_path_count(tid=get_tid()) return temps[tid].path_count$;
    inline proc get_depend(tid=get_tid()) return temps[tid].depend;
    inline proc get_children_list(tid=get_tid()) return temps[tid].children_list;
    inline proc get_Active_Remaining(tid=get_tid()) return temps[tid].Active_Remaining;
    inline proc get_Active_Level(tid=get_tid()) return temps[tid].Active_Level;
  }

  //
  // simple barrier implementation
  //
  extern proc chpl_task_yield();
  record Barrier {
    var count: atomic int;
    var done: atomic bool;

    proc Barrier(n: int) {
      reset(n);
    }

    inline proc reset(n: int) {
      on this {
        count.write(n);
        done.write(false);
      }
    }

    inline proc barrier() {
      on this {
        const myc = count.fetchSub(1);
        if myc<=1 {
          if done.testAndSet() then
            halt("Too many callers to barrier()");
        } else {
          wait();
        }
      }
    }

    inline proc notify() {
      on this {
        const myc = count.fetchSub(1);
        if myc<=1 {
          if done.testAndSet() then
            halt("Too many callers to barrier_notify()");
        }
      }
    }

    inline proc wait() {
      on this do
        while !done.read() do chpl_task_yield();
    }

    inline proc try() {
      return done.read();
    }
  }

}

module SSCA2_kernels

//  +==========================================================================+
//  |  Polymorphic Implementation of SSCA #2, Kernels 2-4                      |
//  |                                                                          |
//  |  Each kernel takes a graph argument which provides for each vertex       |
//  |  1.  an iterator for its set of neighbors                                |
//  |  2.  a parallel integer array of edge weights, which can be zipper       |
//  |      iterated with the set of neighbors                                  |
//  |  3.  the number of neighbors                                             |
//  |                                                                          |
//  |  These are the only requirements on the representation of the graph.     |
//  |                                                                          |
//  |  Filtering in Kernel 4 is turned on or off by a compilation time param.  |
//  +==========================================================================+

{
  use SSCA2_compilation_config_params, Time;

  var stopwatch : Timer;

  // ========================================================
  //                           KERNEL 2:
  // ========================================================
  // Find the edges with the largest edges.  Return a list of
  // edges, all of which have the largest weight.
  // ========================================================

  proc largest_edges ( G, heavy_edge_list :domain )

    // edge_weights can be either an array over an associative
    // domain or over a sparse domain.  the output  heavy_edge_list
    // can either kind of domain or something else purpose-built
    // for this task.
    {
      if PRINT_TIMING_STATISTICS then stopwatch.start ();
      var heaviest_edge_weight$ : sync int = 0;

      // ---------------------------------------------------------
      // find heaviest edge weight in a single pass over all edges
      // ---------------------------------------------------------

      //       heaviest_edge_weight = max reduce [ s in G.vertices ]
      //        	                         [ w in G.edge_weight (s) ] w;

      forall s in G.vertices do
        forall w in G.edge_weight (s) do
	  heaviest_edge_weight$ = max ( w, heaviest_edge_weight$ );

      // ---------------------------------------------
      // in a second pass over all edges, extract list
      // of all edges  matching the heaviest weight
      // ---------------------------------------------

      forall s in G.vertices do
        forall (t, w) in ( G.Neighbors (s), G.edge_weight (s) ) do

	  // should be forall, requires a custom parallel iterator in the
	  // random graph case and zippering for associative domains may
	  // also present a problem

	  if w == heaviest_edge_weight$.readXX () then {
	    heavy_edge_list.add ( (s,t) );
	  };

      if PRINT_TIMING_STATISTICS then {
	stopwatch.stop ();
	writeln ( "Elapsed time for Kernel 2: ", stopwatch.elapsed (),
		  " seconds");
	stopwatch.clear ();
      }

      // ------------------------------------------------
      // should be able to write a user-defined "maxlocs"
      // reduction more efficiently than this scheme
      // ------------------------------------------------

      if DEBUG_KERNEL2 then {
	writeln ();
	writeln ( "Heaviest weight      : ",
		  heaviest_edge_weight$ . readFF ());
	writeln ( "Number of heavy edges:", heavy_edge_list.numIndices );
	writeln ();
	writeln ( "Edges with largest weight and other neighbors:" );
	for (s,t) in heavy_edge_list do {
	  writeln ("edge   ", (s,t));
	  for (v,w) in (G.Neighbors (s), G.edge_weight (s) ) do
	    writeln ("      ", v, " ", w);}
      }
    };

  // ===================================================================
  //                              KERNEL 3:
  // ===================================================================
  // For each root (heavy) edge, find the subgraph (vertices and edges)
  // defined by directed paths of length no greater than max_path_length
  // in which the first edge traversed is the root edge
  // ===================================================================

  proc rooted_heavy_subgraphs ( G,
                                Heavy_Edge_List     : domain,
                                Heavy_Edge_Subgraph : [],
                                in max_path_length  : int )

    // -------------------------------------------------------------------------
    // there is a classic space versus time tradeoff.  if the subgraphs expanded
    // by breadth first search are small, it would make sense to use a hash
    // table or an associative domain to represent the search.  If the subgraphs
    // are large, using a full length vector to represent the search is more
    // appropriate.  We expect small diameters for power law graphs, so we
    // expect large subgraphs.
    // -------------------------------------------------------------------------

    {
      if PRINT_TIMING_STATISTICS then stopwatch.start ();

      const vertex_domain = G.vertices;

      forall ( x, y ) in Heavy_Edge_List do {
	var Active_Level, Next_Level : domain ( index (vertex_domain) );
	var min_distance             : [vertex_domain] atomic int;
        forall m in min_distance do m.write(-1);

	if DEBUG_KERNEL3 then
	  writeln ( " Building heavy edge subgraph from pair:", (x,y) );
	Active_Level.add ( y );
	Next_Level.clear ();
	Heavy_Edge_Subgraph ( (x, y) ).nodes.clear ();
	Heavy_Edge_Subgraph ( (x, y) ).edges.clear ();
	min_distance ( y ).write(0);

	Heavy_Edge_Subgraph ( (x, y) ).edges.add ( (x, y) );
	Heavy_Edge_Subgraph ( (x, y) ).nodes.add ( x );
	Heavy_Edge_Subgraph ( (x, y) ).nodes.add ( y );

	for path_length in 1 .. max_path_length do {

	  forall v in Active_Level do {

	    forall w in G.Neighbors (v) do { // eventually, will be forall

              if min_distance(w).compareExchangeStrong(-1, path_length) then {
                Next_Level.add (w);
                Heavy_Edge_Subgraph ( (x, y) ).nodes.add (w);
	      }

	      // min_distance must have been set by some thread by now

	      if min_distance(w).read() == path_length then {
		Heavy_Edge_Subgraph ( (x, y) ).edges.add ( (v, w) );
	      }
	    }
	  }

	  if path_length < max_path_length then {
	    Active_Level = Next_Level;
	    Next_Level.clear ();
	  }
	}
      }

      if PRINT_TIMING_STATISTICS then {
	stopwatch.stop ();
	writeln ( "Elapsed time for Kernel 3: ", stopwatch.elapsed (),
		  " seconds");
	stopwatch.clear ();
      }
    } // end of rooted_heavy_subgraphs

  use BlockDist;
  // Would be nice to use PriavteSpace, but aliasing is not supported
  const PrivateSpace = [LocaleSpace] dmapped Block(boundingBox=[LocaleSpace]);

  // ==================================================================
  //                              KERNEL 4
  // ==================================================================
  // Calculate Betweenness Centrality for simple unweighted directed or
  // undirected graphs, using Madduri, et.al.'s modification of
  // Brandes's 2001 algorithm
  // ==================================================================

  proc approximate_betweenness_centrality ( G, starting_vertices,
                                            Between_Cent : [] real,
                                            out Sum_Min_Dist : real )

    // -----------------------------------------------------------------------
    // The betweenness centrality metric for a given node  v  is defined
    // as the double sum over s not equal to v and  t not equal to
    // either s or v of the ratio of the number of shortest paths from s to t
    // passing through v to the number of shortest paths from s to t.
    //
    // Brandes's algorithm decomposes the computation of this metric into,
    // first, separate sums for each vertex s, which can be computed
    // independently in parallel, and
    // two, a recursive, tree-based, calculation of the path counts for
    // any particular s.
    // The complexity of this algorithm is O ( |V||E| ) time for an unweighted
    // graph.  The algorithm requires O ( |V| ) temporary space for each
    // process that executes instances of the outermost loop.
    // -----------------------------------------------------------------------
    {
      const vertex_domain = G.vertices;

      // Had to change declaration below
      //    type Sparse_Vertex_List = sparse subdomain ( G.vertices );
      // to accommodate block distribution of G.vertices

      type Sparse_Vertex_List = domain(index(vertex_domain));

      var Between_Cent$ : [vertex_domain] sync real = 0.0;
      var Sum_Min_Dist$ : sync real = 0.0;

      // Initialize task private data
      var localePrivate: [PrivateSpace] localePrivateData(vertex_domain.type);
      forall l in localePrivate do {
        l = new localePrivateData(vertex_domain);
        for t in l.temps { // this might be bad for first-touch
          t = new taskPrivateData(domain(index(vertex_domain)), vertex_domain);
          forall v in vertex_domain do
            t.children_list[v].nd = [1..G.n_Neighbors[v]];
          for loc in Locales do on loc {
              t.Active_Level[here.id] = new Level_Set (Sparse_Vertex_List);
              t.Active_Level[here.id].previous = nil;
              t.Active_Level[here.id].next = new Level_Set (Sparse_Vertex_List);;
              t.Active_Level[here.id].next.previous = t.Active_Level[here.id];
              t.Active_Level[here.id].next.next = nil;
          }
        }
      }

      // ------------------------------------------------------
      // Each iteration of the outer loop of Brandes's algorithm
      // computes the contribution (the "dependency" metric) for
      // one particular vertex  (s)  independently.
      // ------------------------------------------------------

      if PRINT_TIMING_STATISTICS then stopwatch.start ();

      forall s in starting_vertices do {

	if DEBUG_KERNEL4 then writeln ( "expanding from starting node ", s );

        // Initialize task private variables
        const lp = localePrivate[here.id];
        const tid = lp.get_tid();
        var depend => lp.get_depend(tid);
        var min_distance  => lp.get_min_distance(tid);
        var path_count$   => lp.get_path_count(tid);
        var children_list => lp.get_children_list(tid);
        forall v in vertex_domain do {
          depend[v] = 0.0;
          min_distance[v].write(-1);
          path_count$[v].writeXF(0.0);
          children_list[v].child_count.write(0);
        }
	var Lcl_Sum_Min_Dist: sync real = 0.0;

	// The structure of the algorithm depends on a breadth-first
	// traversal. Each vertex will be marked by the length of
	// the shortest path (min_distance) from s to it. The array
	// path_count$ will hold a count of the number of shortest
	// paths from s to this node.  The number of paths in moderate
	// sized tori exceeds 2**64.

        //
        // Used to check termination of the forward pass
        //
        // We could use a task-private reduction variable, if
        //  such a thing existed
        //
        var Active_Remaining => lp.get_Active_Remaining(tid);
        Active_Remaining = true;
        var remaining = true;

        // Replicated level sets
        //
        // sungeun: 8/2011
        // Added replicated level sets
        //
        // Each locale will have its own level sets.  A locale's level set
        // will only contain nodes that are physically allocated on that
        // particular locale.
        var Active_Level => lp.get_Active_Level(tid);
        coforall loc in Locales do on loc {
          Active_Level[here.id].Members.clear();
          Active_Level[here.id].next.Members.clear();
          if vertex_domain.dist.idxToLocale(s) == here {
            Active_Level[here.id].Members.add(s);
            min_distance[s].write(0);
            path_count$[s].writeXF(1);
          }
        }

	var current_distance : int = 0;

	// establish the initial level sets for the
	// breadth-first traversal from s

	while remaining do {
	    // ------------------------------------------------
	    // expand the neighbor sets for all vertices at the
	    // current distance from the starting vertex  s
	    // ------------------------------------------------

	    current_distance += 1;

            var barrier = new Barrier(numLocales);

            // sungeun: 8/2011
            // Copy this value to a constant to enable remote value
            // forwarding optimization.
            const current_distance_c = current_distance;
            coforall loc in Locales do on loc {
             forall u in Active_Level[here.id].Members do { // sparse

               forall (v, w) in ( G.Neighbors (u), G.edge_weight (u) ) do on vertex_domain.dist.idxToLocale(v) {
		// --------------------------------------------
		// add any unmarked neighbors to the next level
		// --------------------------------------------

		if  ( FILTERING &&  w % 8 != 0 ) || !FILTERING then
		  if  min_distance[v].compareExchangeStrong(-1, current_distance_c) {
                    Active_Level[here.id].next.Members.add (v);
                    if VALIDATE_BC then
                      Lcl_Sum_Min_Dist += current_distance_c;
                  }

		// ------------------------------------------------
		// only neighbors of  u  that are in the next level
		// are on shortest paths from s through v.  Some
		// thread will have set  min_distance$ (v) by the
		// time this code is reached, whether  v  lies in
		// the previous, the current or the next level.
		// ------------------------------------------------

		if min_distance[v].read() == current_distance_c {
                  path_count$[v] += path_count$[u].readFF();
                  children_list(u).add_child (v);
                }

	      }
	    };

            // sungeun: 8/2011
            // This barrier is needed to insure all updates to the next
            // level are completed before updating to use the next level
            barrier.notify();
            // do some work while we wait
            if Active_Level[here.id].next.next == nil {
              Active_Level[here.id].next.next = new Level_Set (Sparse_Vertex_List);
              Active_Level[here.id].next.next.previous = Active_Level[here.id].next;
              Active_Level[here.id].next.next.next = nil;
            } else {
              Active_Level[here.id].next.next.Members.clear();
            }
            barrier.wait();

            Active_Level[here.id] = Active_Level[here.id].next;
            Active_Remaining[here.id] =
              Active_Level[here.id].Members.numIndices:bool;

          }

          remaining = || reduce Active_Remaining;

	};  // end forward pass

	if VALIDATE_BC then
	  Sum_Min_Dist$ += Lcl_Sum_Min_Dist;

	// -------------------------------------------------------------
	// compute the dependencies recursively, traversing the vertices
	// of the graph in non-increasing order of distance (reverse
	// ordering from the initial traversal)
	// -------------------------------------------------------------

	var graph_diameter = current_distance - 1;

	if DEBUG_KERNEL4 then
	  writeln ( " graph diameter from starting node ", s,
		    "  is ", graph_diameter );

        // to simplify synchronization between multiple barriers
        var barrier: [2..graph_diameter] Barrier;
        [2..graph_diameter] barrier.reset(numLocales);

        coforall loc in Locales do on loc {
          // back up to last level
          var curr_Level =  Active_Level[here.id].previous;

          for current_distance in 2 .. graph_diameter by -1 {
            curr_Level = curr_Level.previous;

            for u in curr_Level.Members do on vertex_domain.dist.idxToLocale(u) {
              depend (u) = + reduce [v in children_list(u).Row_Children[1..children_list(u).child_count.read()]]
                ( path_count$[u].readFF() /
                  path_count$[v].readFF() )      *
                ( 1.0 + depend (v) );
              Between_Cent$ (u) += depend (u);
            }
            // sungeun: 8/2011
            // This barrier is needed to insure all updates to depend are
            // complete before the next pass.
            barrier[current_distance].barrier();
          }
        }

      }; // closure of outer embarassingly parallel forall

      if PRINT_TIMING_STATISTICS then {
	stopwatch.stop ();
	var K4_time = stopwatch.elapsed ();
	stopwatch.clear ();
	writeln ( "Elapsed time for Kernel 4: ", K4_time, " seconds");

	var n0            = + reduce [v in vertex_domain] (G.n_Neighbors (v)== 0);
	var n_edges       = + reduce [v in vertex_domain] G.n_Neighbors (v);
	var N_VERTICES    = vertex_domain.numIndices;
	var TEPS          = 7.0 * N_VERTICES * (N_VERTICES - n0) / K4_time;
	var Adjusted_TEPS = n_edges * (N_VERTICES - n0) / K4_time;

	writeln ( "                     TEPS: ", TEPS );
	writeln ( " edge count adjusted TEPS: ", Adjusted_TEPS );
      }

      if VALIDATE_BC then
	Sum_Min_Dist = Sum_Min_Dist$;

      Between_Cent = Between_Cent$;

      forall l in localePrivate do on l {
          for i in l.r {
            var al  => l.temps[i].Active_Level;
            coforall loc in Locales do on loc {
                var level = al[here.id];
                while level != nil {
                    var l2 = level.next;
                    delete level;
                    level = l2;
                }
            }
            delete l.temps[i];
          }
          delete l;
      }

    } // end of Brandes' betweenness centrality calculation

  //
  // Addition support data structures for kernel 4
  //

  // ============================================================
  // generic class structure must be defined outside of
  // generic procedure.  used by Betweenness Centrality kernel 4.
  // ------------------------------------------------------------
  // The set of vertices at a particular distance from s form a
  // level set.  The class allows the full set of vertices to be
  // partitioned into a linked list of level sets.  Each instance
  // of the outer loop in kernel 4 creates such a partitioning.
  // ============================================================

  class Level_Set {
    type Sparse_Vertex_List;
    var Members  : Sparse_Vertex_List;
    var previous : Level_Set (Sparse_Vertex_List);
    var next : Level_Set (Sparse_Vertex_List);
  }

  //
  // Data structure to save Children lists between the forward
  //  and backwards pass
  //
  record child_struct {
    type vertex;
    var nd: domain(1);
    var Row_Children: [nd] vertex;
    var child_count: atomic int;

    // This function should only be called using unique vertices
    proc add_child ( new_child: vertex ) {
      var c = child_count.fetchAdd(1)+1;
      Row_Children[c] = new_child;
    }
  }

  //
  // Implementation of task-private variables for kernel 4
  //
  class taskPrivateData {
    type Sparse_Vertex_List;
    const vertex_domain;
    var tid$           : sync chpl_taskID_t = chpl_nullTaskID;
    var min_distance   : [vertex_domain] atomic int;
    var path_count$    : [vertex_domain] sync real(64);
    var depend         : [vertex_domain] real;
    var children_list  : [vertex_domain] child_struct(index(vertex_domain));
    var Active_Remaining: [PrivateSpace] bool;
    var Active_Level   : [PrivateSpace] Level_Set (Sparse_Vertex_List);
  };
  inline proc =(a: chpl_taskID_t, b: chpl_taskID_t) return b;
  inline proc !=(a: chpl_taskID_t, b: chpl_taskID_t) return __primitive("!=", a, b);
  class localePrivateData {
    const vertex_domain;
    const numTasks = if dataParTasksPerLocale==0 then here.numCores
      else dataParTasksPerLocale;
    var r = [0..#numTasks];
    var temps: [r] taskPrivateData(domain(index(vertex_domain)),
                                   vertex_domain.type);
    proc get_tid() {
      // This code assumes that chpl_taskID_t is an integral type
      extern proc chpl_task_getId(): chpl_taskID_t;
      var mytid = chpl_task_getId();
      var slot = (mytid:uint % (numTasks:uint)):int;
      // Would be nice to have CAS
      var tid: chpl_taskID_t = temps[slot].tid$; // lock
      while ((tid != chpl_nullTaskID) && (tid != mytid)) {
        temps[slot].tid$ = tid;                  // unlock
        slot = (slot+1)%numTasks;
        tid = temps[slot].tid$;                  // lock
      }
      temps[slot].tid$ = mytid;                  // unlock
      return slot;
    }
    inline proc get_min_distance(tid=get_tid()) return temps[tid].min_distance;
    inline proc get_path_count(tid=get_tid()) return temps[tid].path_count$;
    inline proc get_depend(tid=get_tid()) return temps[tid].depend;
    inline proc get_children_list(tid=get_tid()) return temps[tid].children_list;
    inline proc get_Active_Remaining(tid=get_tid()) return temps[tid].Active_Remaining;
    inline proc get_Active_Level(tid=get_tid()) return temps[tid].Active_Level;
  }

  //
  // simple barrier implementation
  //
  extern proc chpl_task_yield();
  record Barrier {
    var count: atomic int;
    var done: atomic bool;

    proc Barrier(n: int) {
      reset(n);
    }

    inline proc reset(n: int) {
      on this {
        count.write(n);
        done.write(false);
      }
    }

    inline proc barrier() {
      on this {
        const myc = count.fetchSub(1);
        if myc<=1 {
          if done.testAndSet() then
            halt("Too many callers to barrier()");
        } else {
          wait();
        }
      }
    }

    inline proc notify() {
      on this {
        const myc = count.fetchSub(1);
        if myc<=1 {
          if done.testAndSet() then
            halt("Too many callers to barrier_notify()");
        }
      }
    }

    inline proc wait() {
      on this do
        while !done.read() do chpl_task_yield();
    }

    inline proc try() {
      return done.read();
    }
  }

}