Renamed 'recur' to 'recursive'

Renamed 'recur' to 'recursive'

/*
 * Copyright 2004-2014 Cray Inc.
 * Other additional copyright holders may be indicated within.
 *
 * The entirety of this work is licensed under the Apache License,
 * Version 2.0 (the "License"); you may not use this file except
 * in compliance with the License.
 *
 * You may obtain a copy of the License at
 *
 *     http://www.apache.org/licenses/LICENSE-2.0
 *
 * Unless required by applicable law or agreed to in writing, software
 * distributed under the License is distributed on an "AS IS" BASIS,
 * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
 * See the License for the specific language governing permissions and
 * limitations under the License.
 */

use Sort;

//
// This module defines several iterators that are designed to help
// support reasoning about directory and file contents.  At present,
// all are serial.
//

/* iter listdir(path: string, dotfiles=false, dirs=true, files=true,
                listlinks=true): string

    listdir() lists the contents of a directory, similar to 'ls'
      * path: the directory whose contents should be listed
      * dotfiles: should files/directories that start with '.' be listed?
      * dirs: should dirs be listed?
      * files: should files be listed?
      * listlinks: should symbolic links be listed?

   By default this routine lists all files and directories in the
   current directory, including symbolic links, as long as they don't
   start with '.'
*/

iter listdir(path: string, dotfiles=false, dirs=true, files=true,
             listlinks=true): string {
  extern type DIRptr;
  extern type direntptr;
  extern proc opendir(name: c_string): DIRptr;
  extern proc readdir(dirp: DIRptr): direntptr;
  extern proc closedir(dirp: DIRptr): c_int;
  extern proc chpl_rt_isDir(pathname: c_string, followLinks: bool): c_int;

  proc direntptr.d_name(): c_string {
    extern proc chpl_rt_direntptr_getname(d: direntptr): c_string;

    return chpl_rt_direntptr_getname(this);
  }

  var dir: DIRptr;
  var ent: direntptr;
  dir = opendir(path:c_string);
  if (!is_c_nil(dir)) {
    ent = readdir(dir);
    while (!is_c_nil(ent)) {
      const filename = ent.d_name();
      if (dotfiles || filename.substring(1) != '.') {
        if (filename != "." && filename != "..") {
          const fullpath = path + "/" + filename;
          //
          // chpl_rt_isDir() returns 'true' if 'fullpath' is a
          // directory.  If we are listing symbolic links
          // (listlinks==true), it will also return symbolic links to
          // directories.
          //
          if (chpl_rt_isDir(fullpath:c_string, listlinks)) {
            if (dirs) then
              yield filename;
          } else {
            if (files) then
              yield filename;
          }
        }
      }
      ent = readdir(dir);
    }
    closedir(dir);
  } else {
    extern proc perror(s: c_string);
    perror("error in listdir(): ");
  }
}

/* iter walkdirs(path: string=".", topdown=true, depth=max(int),
                 dotfiles=false, followlinks=false, sort=false): string

   walkdirs() recursively walks a directory structure, yielding
   directory names.  The strings that are generated will be rooted
   from 'path'.
     * path: the directory to start from
     * topdown: indicates whether to yield the directories using a
       preorder (vs. postorder) traversal
     * depth: indicates the maximal depth of recursion to use
     * dotfiles: indicates whether to enter directories with dotfile names
     * followlinks: indicates whether to follow symbolic links or not
     * sort: indicates whether to consider subdirectories in sorted
       order or not

   by default, walkdirs() will start in the current directory, process
   directories in preorder; recursively traverse subdirectories; and
   neither follow dotfile directories nor symbolic links.  It will not
   sort the directories by default.
*/

iter walkdirs(path: string=".", topdown=true, depth=max(int), dotfiles=false,
              followlinks=false, sort=false): string {

  if (topdown) then
    yield path;

  if (depth) {
    var subdirs = listdir(path, dotfiles=dotfiles, files=false, listlinks=followlinks);
    if (sort) then
      QuickSort(subdirs);
    for subdir in subdirs {
      const fullpath = path + "/" + subdir;
      for subdir in walkdirs(fullpath, topdown, depth-1, dotfiles,
                             followlinks, sort) do
        yield subdir;
    }
  }

  if (!topdown) then
    yield path;
}

/* iter wordexp(pattern="*")

   wordexp() gives a glob-like capability, implemented with C's wordexp()
   (which is, itself a routine that provides a glob-like capability :)
     * pattern: the glob pattern to match against

   By default, it will list all files/directories in the current directory
*/

iter wordexp(pattern="*") {
  extern type wordexp_t;
  extern proc wordexp(pattern:c_string, ref ret_glob: wordexp_t,
                      flags_c_int): c_int;
  extern proc chpl_wordexp_num(x:wordexp_t): size_t;
  extern proc chpl_wordexp_index(x:wordexp_t, idx:size_t): c_string;
  extern proc wordfree(ref glb:wordexp_t);

  var glb : wordexp_t;

  const err = wordexp(pattern:c_string, glb, 0);

  for i in 0..chpl_wordexp_num(glb)-1 {
    yield chpl_wordexp_index(glb, i): string;
  }

  wordfree(glb);
}

/* iter glob(pattern="*")

   glob() gives glob() capabilities and is implemented using C's glob()
     * pattern: the glob pattern to match against

   By default, it will list all files/directories in the current directory
*/

iter glob(pattern="*") {
  extern type glob_t;
  extern proc glob(pattern:c_string, flags: c_int, errfunc:c_void_ptr,
                   ref ret_glob:glob_t):c_int;
  extern proc chpl_glob_num(x:glob_t): size_t;
  extern proc chpl_glob_index(x:glob_t, idx:size_t): c_string;
  extern proc globfree(ref glb:glob_t);

  var glb : glob_t;

  const err = glob(pattern:c_string, 0, c_nil, glb);

  for i in 0..chpl_glob_num(glb)-1 do
    yield chpl_glob_index(glb, i): string;

  globfree(glb);
}

/* iter findfiles(startdir = ".", recursive=false, dotfiles=false)

   findfiles() is a simple find-like utility implemented using the
   above routines
     * startdir: where to start when looking for files
     * recursive: tells whether or not to descend recurisvely
     * dotfiles: tells whether or not to yield dotfiles
*/

iter findfiles(startdir = ".", recursive=false, dotfiles=false) {
  if (recursive) then
    for subdir in walkdirs(startdir, dotfiles=dotfiles) do
      for file in listdir(subdir, dotfiles=dotfiles, dirs=false, files=true, listlinks=true) do
        yield subdir+"/"+file;
  else
    for file in listdir(startdir, dotfiles=dotfiles, dirs=false, files=true, listlinks=false) do
      yield startdir+"/"+file;
}

/*
 * Copyright 2004-2014 Cray Inc.
 * Other additional copyright holders may be indicated within.
 *
 * The entirety of this work is licensed under the Apache License,
 * Version 2.0 (the "License"); you may not use this file except
 * in compliance with the License.
 *
 * You may obtain a copy of the License at
 *
 *     http://www.apache.org/licenses/LICENSE-2.0
 *
 * Unless required by applicable law or agreed to in writing, software
 * distributed under the License is distributed on an "AS IS" BASIS,
 * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
 * See the License for the specific language governing permissions and
 * limitations under the License.
 */

use Sort;

//
// This module defines several iterators that are designed to help
// support reasoning about directory and file contents.  At present,
// all are serial.
//

/* iter listdir(path: string, dotfiles=false, dirs=true, files=true,
                listlinks=true): string

    listdir() lists the contents of a directory, similar to 'ls'
      * path: the directory whose contents should be listed
      * dotfiles: should files/directories that start with '.' be listed?
      * dirs: should dirs be listed?
      * files: should files be listed?
      * listlinks: should symbolic links be listed?

   By default this routine lists all files and directories in the
   current directory, including symbolic links, as long as they don't
   start with '.'
*/

iter listdir(path: string, dotfiles=false, dirs=true, files=true,
             listlinks=true): string {
  extern type DIRptr;
  extern type direntptr;
  extern proc opendir(name: c_string): DIRptr;
  extern proc readdir(dirp: DIRptr): direntptr;
  extern proc closedir(dirp: DIRptr): c_int;
  extern proc chpl_rt_isDir(pathname: c_string, followLinks: bool): c_int;

  proc direntptr.d_name(): c_string {
    extern proc chpl_rt_direntptr_getname(d: direntptr): c_string;

    return chpl_rt_direntptr_getname(this);
  }

  var dir: DIRptr;
  var ent: direntptr;
  dir = opendir(path:c_string);
  if (!is_c_nil(dir)) {
    ent = readdir(dir);
    while (!is_c_nil(ent)) {
      const filename = ent.d_name();
      if (dotfiles || filename.substring(1) != '.') {
        if (filename != "." && filename != "..") {
          const fullpath = path + "/" + filename;
          //
          // chpl_rt_isDir() returns 'true' if 'fullpath' is a
          // directory.  If we are listing symbolic links
          // (listlinks==true), it will also return symbolic links to
          // directories.
          //
          if (chpl_rt_isDir(fullpath:c_string, listlinks)) {
            if (dirs) then
              yield filename;
          } else {
            if (files) then
              yield filename;
          }
        }
      }
      ent = readdir(dir);
    }
    closedir(dir);
  } else {
    extern proc perror(s: c_string);
    perror("error in listdir(): ");
  }
}

/* iter walkdirs(path: string=".", topdown=true, depth=max(int),
                 dotfiles=false, followlinks=false, sort=false): string

   walkdirs() recursively walks a directory structure, yielding
   directory names.  The strings that are generated will be rooted
   from 'path'.
     * path: the directory to start from
     * topdown: indicates whether to yield the directories using a
       preorder (vs. postorder) traversal
     * depth: indicates the maximal depth of recursion to use
     * dotfiles: indicates whether to enter directories with dotfile names
     * followlinks: indicates whether to follow symbolic links or not
     * sort: indicates whether to consider subdirectories in sorted
       order or not

   by default, walkdirs() will start in the current directory, process
   directories in preorder; recursively traverse subdirectories; and
   neither follow dotfile directories nor symbolic links.  It will not
   sort the directories by default.
*/

iter walkdirs(path: string=".", topdown=true, depth=max(int), dotfiles=false,
              followlinks=false, sort=false): string {

  if (topdown) then
    yield path;

  if (depth) {
    var subdirs = listdir(path, dotfiles=dotfiles, files=false, listlinks=followlinks);
    if (sort) then
      QuickSort(subdirs);
    for subdir in subdirs {
      const fullpath = path + "/" + subdir;
      for subdir in walkdirs(fullpath, topdown, depth-1, dotfiles,
                             followlinks, sort) do
        yield subdir;
    }
  }

  if (!topdown) then
    yield path;
}

/* iter wordexp(pattern="*")

   wordexp() gives a glob-like capability, implemented with C's wordexp()
   (which is, itself a routine that provides a glob-like capability :)
     * pattern: the glob pattern to match against

   By default, it will list all files/directories in the current directory
*/

iter wordexp(pattern="*") {
  extern type wordexp_t;
  extern proc wordexp(pattern:c_string, ref ret_glob: wordexp_t,
                      flags_c_int): c_int;
  extern proc chpl_wordexp_num(x:wordexp_t): size_t;
  extern proc chpl_wordexp_index(x:wordexp_t, idx:size_t): c_string;
  extern proc wordfree(ref glb:wordexp_t);

  var glb : wordexp_t;

  const err = wordexp(pattern:c_string, glb, 0);

  for i in 0..chpl_wordexp_num(glb)-1 {
    yield chpl_wordexp_index(glb, i): string;
  }

  wordfree(glb);
}

/* iter glob(pattern="*")

   glob() gives glob() capabilities and is implemented using C's glob()
     * pattern: the glob pattern to match against

   By default, it will list all files/directories in the current directory
*/

iter glob(pattern="*") {
  extern type glob_t;
  extern proc glob(pattern:c_string, flags: c_int, errfunc:c_void_ptr,
                   ref ret_glob:glob_t):c_int;
  extern proc chpl_glob_num(x:glob_t): size_t;
  extern proc chpl_glob_index(x:glob_t, idx:size_t): c_string;
  extern proc globfree(ref glb:glob_t);

  var glb : glob_t;

  const err = glob(pattern:c_string, 0, c_nil, glb);

  for i in 0..chpl_glob_num(glb)-1 do
    yield chpl_glob_index(glb, i): string;

  globfree(glb);
}

/* iter findfiles(startdir = ".", recur=false, dotfiles=false)

   findfiles() is a simple find-like utility implemented using the
   above routines
     * startdir: where to start when looking for files
     * recur: tells whether or not to descend recurisvely
     * dotfiles: tells whether or not to yield dotfiles
*/

iter findfiles(startdir = ".", recur=false, dotfiles=false) {
  if (recur) then
    for subdir in walkdirs(startdir, dotfiles=dotfiles) do
      for file in listdir(subdir, dotfiles=dotfiles, dirs=false, files=true, listlinks=true) do
        yield subdir+"/"+file;
  else
    for file in listdir(startdir, dotfiles=dotfiles, dirs=false, files=true, listlinks=false) do
      yield startdir+"/"+file;
}


Undo last checkin, removed dummy variable from tuple.  I'll have to
fix this another way.

git-svn-id: 88467cb1fb04b8a755be7e1ee1026be4190196ef@3408 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 {
  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 {
  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


Improved locality in edge generation in the release version of SSCA2.

[reviewed by Sung]

r20857 allowed me to be more aggressive in using 'local' blocks,
so I added one and extended the scope of another.

I still have to create a const copy of the 'bit' variable,
because 'bit' itself does vary and the remote value forwarding
is too conservative in this case to pass it by value.

The second 'local' I added, before

  w = floor (1 + rnd * MAX_EDGE_WEIGHT) : int

- should not affect performance. I like it to document my expectations
that the variables inside it do not need communication.

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

module SSCA2_RMAT_graph_generator

{
  // +=========================================================================+
  // |             RMAT approximate power law graph generator                  |
  // |                                 and                                     |
  // |                           SSCA #2 Kernel 1                              |
  // |                                                                         |
  // |  Generate approximate power law graph                                   |
  // |                                                                         |
  // |  This procedure accepts a generic graph representation which must       |
  // |  provide only the capabilities to:                                      |
  // |    1. add a vertex to a neighbor list for some other vertex             |
  // |    2. assign an integer weight to an entry in an associated weight list |
  // |                                                                         |
  // |  The RMAT procedure implicitly assumes that vertices are integers       |
  // |  in the range [0, 2^SCALE].  So vertices are integers in this           |
  // |  procedure and edges are pairs of integers.                             |
  // |                                                                         |
  // |  This implementation first generates the RMAT graph as a list of        |
  // |  triples, using an array of edges and an associated array of weights.   |
  // |  These are transformed into the Chapel graph representation using       |
  // |  native Chapel syntax for associative and sparse domains and arrays.    |
  // |  That transformation is Kernel 1 of the SSCA #2 benchmark.              |
  // |                                                                         |
  // |  The code uses two auxiliary procedures for clarity and to help the     |
  // |  compiler use more abstract, higher level, code.                        |
  // +=========================================================================+

  use SSCA2_compilation_config_params, Time, BlockDist;

  // File names to dump the edge list and the constructed graph, resp.
  // By default, printouts, if requested, are traditional.
  config const rmatEdgeGenFile = "";
  config const rmatGraphConFile = "";

  // These control which variations of the code to run.
  config const newEG = true;      // do new-style edge generation?
  config const parEG = true;      // do newEG permutations in parallel?
  config const numDepths = -1;    // number of edge tweaks; -1 for baseline
  config const edgeChecks = true; // run edge consistency checks?
  config const parGC = true;      // do Graph Generation in parallel?
  // Set to false for parallel computation (=> faster but not reproducible).
  config param SERIAL_GRAPH_GEN = REPRODUCIBLE_PROBLEMS;

  var stopwatch : Timer;

  record directed_vertex_pair {
    var start = 1: int;
    var end   = 1: int;
  }

  // ============================
  // Quadrant selection algorithm
  // ============================

  inline proc directed_vertex_pair.assign_quadrant
    (u: real, a: real, b: real, c: real, d: real, bit: int)
    {
      // ---------------------------------------------------------------------
      // The heart of the RMAT random graph generator is a procedure that
      // assigns a single bit of the edge starting and ending vertex by
      // assigning the edge with specified probability to one of the four
      // quadrants of a 2 x 2 grid.
      //
      // Chapel is able to promote this conditional-based scalar procedure to
      // array operations where it is not able to promote conditional code
      // directly.
      //
      // Determine randomly in which quadrant of the grid a point lies,
      // based on the following picture:
      //
      //     +---------------------------+
      //     | u < a         | u < a+b   |
      //     |-------------+-------------|
      //     | u < a + b + c | otherwise |
      //     +---------------------------+
      //
      // The probability of the edge falling in the upper left quadrant is  a,
      // in the upper right quadrant, b, the lower left quadrant  c
      // and the lower right quadrant  d, where the probabilities are
      // normalized to sum to one.
      // ---------------------------------------------------------------------

      var start_inc = 0;
      var end_inc   = 0;

      if u <= a then
	{}
      else if u <= a + b then
	{ end_inc = 1;}
      else if u <= a + b + c then
	{ start_inc = 1;}
      else
	{ start_inc = 1; end_inc = 1;};

      this.start += bit * start_inc;
      this.end   += bit * end_inc;
    }

  // ====================================
  // Main RMAT Graph Generation Procedure
  // ====================================~

  proc Gen_RMAT_graph ( a : real,
		       b : real,
		       c : real,
		       d : real,
                       vertex_domain,
		       SCALE :int,
		       N_VERTICES : int,
		       n_raw_edges : int,
		       MAX_EDGE_WEIGHT :int,
		       G )

    { use Random;
      use analyze_RMAT_graph_associative_array;

      if PRINT_TIMING_STATISTICS then stopwatch.start ();

      const vertex_range = 1..N_VERTICES,
	    edge_range   = 1..n_raw_edges;

      const edge_domain =
        if DISTRIBUTION_TYPE == "BLOCK" then
          {edge_range} dmapped Block ( {edge_range} )
        else
          {edge_range} ;

      var Edges       : [edge_domain] directed_vertex_pair;
      // TODO: fold edge weight into directed_vertex_pair
      var Edge_Weight : [edge_domain] int;
      var permutation : [vertex_domain] int = vertex_range;

       // ---------------------------------------------------------------
      // The RMAT algorithm is based on recursively sub-dividing a grid.
      // In this case, the grid is square of order 2^SCALE by 2^SCALE.
      // So exactly "SCALE" steps of recursion will be required and the
      // recursion can be implemented directly by iteration.
      // ---------------------------------------------------------------

      // -----------------------------------------------------------------
      // Note on random number generators -- the RMAT generator creates
      // 5*SCALE vectors of length 2**SCALE.  The dependence on powers
      // of two provides an opportunity to expose statistical correlations
      // in the pseudo-random numbers.  This certainly occurs with the
      // current Chapel Random module.  The "skips" in the random number
      // sequence dramatically change the results.  Without them, the
      // Chapel RMAT matrices are inconsistent with what is seen in
      // other implementations.
      // -----------------------------------------------------------------

      writeln ("Random graph generated by stride of 1 in one random stream",
	       " with skips" );
      if newEG then
        writeln("Using the new edge generation scheme, ",
                if parEG then "in parallel" else "serially");
      if SERIAL_GRAPH_GEN then
        writeln("Serializing certain parallel loops");

      const numDep = if numDepths == -1 then SCALE else numDepths;
      if numDep != SCALE then
        writeln("randomizing with ", numDep, " depths instead of ",
                SCALE, " depths");

    if newEG {
      // new edge generation

      var rndPos = 1;
      const seed = if REPRODUCIBLE_PROBLEMS then 0556707007
                                            else SeedGenerator.currentTime;

      const delta = n_raw_edges + 1; // 1 corresponds to 'skip' in "old" code
      rndPos += 1;                   // start with a skip
      var bit = 1 << numDep;

      for depth in 1..numDep {
        bit >>= 1;
        const bitCst = bit;

        forall (e, r1, r2, r3, r4, r5) in zip(Edges,
 // RandomPrivate_iterate() generates a random number per elem of edge_domain
 // starting at 'start'-th point in the random number stream for 'seed'.
 RandomPrivate_iterate(real, edge_domain, seed, start=rndPos+0*delta),
 RandomPrivate_iterate(real, edge_domain, seed, start=rndPos+1*delta),
 RandomPrivate_iterate(real, edge_domain, seed, start=rndPos+2*delta),
 RandomPrivate_iterate(real, edge_domain, seed, start=rndPos+3*delta),
 RandomPrivate_iterate(real, edge_domain, seed, start=rndPos+4*delta)) {
         local {

          var Noisy_a = a * (0.95 + 0.1 * r1);
          var Noisy_b = b * (0.95 + 0.1 * r2);
          var Noisy_c = c * (0.95 + 0.1 * r3);
          var Noisy_d = d * (0.95 + 0.1 * r4);

	  var norm     = 1.0 / (Noisy_a + Noisy_b + Noisy_c + Noisy_d);
	  Noisy_a *= norm;
	  Noisy_b *= norm;
	  Noisy_c *= norm;
	  Noisy_d *= norm;

          e.assign_quadrant(r5, Noisy_a, Noisy_b, Noisy_c, Noisy_d, bitCst);

         }  // local
        }  // forall

        rndPos += delta * 5;

      }  // for depth

      forall (w, rnd) in zip(Edge_Weight,
        RandomPrivate_iterate(real, edge_domain, seed, start=rndPos-1))
      do
       local
        w = floor (1 + rnd * MAX_EDGE_WEIGHT) : int;
      rndPos += n_raw_edges;

      if parEG {
        var permutation$ : [vertex_domain] sync int = vertex_range;

        serial(SERIAL_GRAPH_GEN) {
          forall (v, rnd) in zip(vertex_domain,
            RandomPrivate_iterate(real, edge_domain, seed, start=rndPos-1))
          {
            const u = floor (1 + rnd * N_VERTICES) : int;
            if u != v {
              // All this does is permutation$(u) <=> permutation$(v).
              // Implementation notes:
              // * Lock the smaller index first, to ensure progress.
              // * Access each of the two sync vars on its locale.
              // * Factors out the 'on's that are implicit in
              //   the accesses to the sync variables into explicit 'on's.
              // * Factors out indexing into permutation$ using
              //   by-reference argument passing.

              const (ix1, ix2) = if v <= u then (v, u) else (u, v);
              swapTwo(permutation$(ix1), permutation$(ix2));

              proc swapTwo(p1$: sync int, p2$: sync int): void {
                on p1$ {
                  const label1 = p1$;
                  var label2: int;
                  on p2$ {
                    label2 = p2$;
                    p2$ = label1;
                  }
                  p1$ = label2;
                }
              }  // proc swapTwo
            }
          }  // forall
        }
        rndPos += N_VERTICES;

        forall (pm, pm$) in zip(permutation, permutation$) {
          pm = pm$.readXX();
        }

      } else {  // !parEG
        for (v, rnd) in zip(vertex_domain,
          RandomPrivate_iterate(real, vertex_domain, seed, start=rndPos-1))
        {
          const new_id = floor (1 + rnd * N_VERTICES) : int;
          permutation (v) <=> permutation (new_id);
        }
        rndPos += N_VERTICES;

      } // if parEG

    } else {  // !newEG

      // Random Numbers return in the range [0.0, 1.0)

      var Rand_Gen = if REPRODUCIBLE_PROBLEMS then
	               new RandomStream (seed = 0556707007)
		     else
		       new RandomStream ();

      var   Noisy_a     : [edge_domain] real,
            Noisy_b     : [edge_domain] real,
            Noisy_c     : [edge_domain] real,
            Noisy_d     : [edge_domain] real,
            norm        : [edge_domain] real,
            Unif_Random : [edge_domain] real;

      var bit = 1 << numDep;
      var   skip : real;

      for depth in 1..numDep do {
	  bit >>= 1;

	  // randomize the coefficients, tweaking them by numbers in [-.05, .05)

	  skip = Rand_Gen.getNext ();
	  Rand_Gen.fillRandom (Unif_Random);
	  Noisy_a = a * (0.95 + 0.1 * Unif_Random);

	  skip = Rand_Gen.getNext ();
	  Rand_Gen.fillRandom (Unif_Random);
	  Noisy_b = b * (0.95 + 0.1 * Unif_Random);

	  skip = Rand_Gen.getNext ();
	  Rand_Gen.fillRandom (Unif_Random);
	  Noisy_c = c * (0.95 + 0.1 * Unif_Random);

	  skip = Rand_Gen.getNext ();
	  Rand_Gen.fillRandom (Unif_Random);
	  Noisy_d = d * (0.95 + 0.1 * Unif_Random);

	  norm     = 1.0 / (Noisy_a + Noisy_b + Noisy_c + Noisy_d);
	  Noisy_a *= norm;
	  Noisy_b *= norm;
	  Noisy_c *= norm;
	  Noisy_d *= norm;

	  skip = Rand_Gen.getNext ();
	  Rand_Gen.fillRandom (Unif_Random);

	  Edges.assign_quadrant ( Unif_Random, Noisy_a, Noisy_b,
				     Noisy_c, Noisy_d, bit );
	};

      // ---------------------------------------------------------------------
      // Assign weights to edges randomly, then randomly relabel the vertices
      // to avoid locality from the obvious imbalance that will arise when
      // one of the coefficients is clearly larger than the others
      // ---------------------------------------------------------------------

      Rand_Gen.fillRandom ( Unif_Random  );
      Edge_Weight = floor (1 + Unif_Random * MAX_EDGE_WEIGHT) : int;

      Rand_Gen.fillRandom ( Unif_Random (vertex_range) );

      for v in vertex_range do
	{ var new_id : int;
	  new_id = floor (1 + Unif_Random (v) * N_VERTICES) : int;
	  permutation (v) <=> permutation (new_id);
	};

    } // if newEG

      forall e in Edges do {
        e.start = permutation(e.start);
        e.end   = permutation(e.end);
      }

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

      if DEBUG_WEIGHT_GENERATOR then {
	writeln ();
       if rmatEdgeGenFile != "" {
        writeln("writing edges to ", rmatEdgeGenFile);
        const fl = open(rmatEdgeGenFile, iomode.cw);
        const ch = fl.writer();
	for (ed, w) in zip(Edges, Edge_Weight) do
          ch.writeln (ed.start, " ", ed.end, " ", w);
        ch.close();
        fl.close();
       } else
	for e in edge_range do
	  writeln ("edge (", e, ") : (", Edges(e), ", ",
		   Edge_Weight (e), ")" );
      }

      // --------------------------
      // Graph consistency checking
      // --------------------------

      if edgeChecks {
        // Check that 'permutation' was a permutation.
        var permuteCounts : [vertex_domain] atomic int;
        forall p in permutation do
          permuteCounts[p].add(1);
        forall (pc, ix) in zip(permuteCounts, vertex_domain) do
          if !(pc.read() == 1) then halt(
               "'permutation' is not a permutation: vertex ", ix,
               " is mentioned ", pc.read(), " times");

        // Sanity checks on edges and weights.
        forall (e, w) in zip(Edges, Edge_Weight) {

          if !(e.start > 0) then halt(
	       "edge start vertices out of low end of range");

          if !(e.end > 0) then halt(
	       "edge end vertices out of low end of range");

          if !(e.start <= 2**SCALE) then halt(
	       "edge start vertices out of high end of range");

          if !(e.end <= 2**SCALE) then halt(
	       "edge end vertices out of high end of range");

          if !(w > 0) then halt(
	       "edge weightd out of low end of range");

          if !(w <= MAX_EDGE_WEIGHT) then halt(
	       "edge weightd out of high end of range");
        }
        // exit the scope to enable memory deallocation, if any
      }

      writeln (); writeln ("Vertex Set in G:", G.vertices);

      // ----------------------------------------------------------
      // Kernel 1: assemble graph from list of triples.
      // Include only non-self incident edges.
      // In case of (start, end) duplicates, the first triple wins.
      // Alternatively, could skip the member(v) check (so the last triple
      // wins) or also use += instead of = (to sum duplicates' weights).
      // ----------------------------------------------------------

      var firstAvailNeighbor$: [vertex_domain] sync int = initialFirstAvail;

      writeln("Starting Graph Generation ",
              if parGC then "in parallel" else "serially");
      if PRINT_TIMING_STATISTICS then stopwatch.start ();

      var collisions = 0, self_edges = 0;

    if parGC {

      var self_edges$: atomic int;
      serial(SERIAL_GRAPH_GEN) {
        forall (e, w) in zip(Edges, Edge_Weight) do {
          const u = e.start;
          const v = e.end;

          if ( v == u ) then {
            // self-edge, ignore
            self_edges$.add(1);
          } else {
            // Both the vertex and firstAvail must be passed by reference.
            // TODO: possibly compute how many neighbors the vertex has, first.
            // Then allocate that big of a neighbor list right away.
            // That way there will be no need for a sync, just an atomic.
            G.Row[u].addEdgeOnVertex(u, v, w, firstAvailNeighbor$[u]);
          }
        }
      }

      self_edges = self_edges$.read();

    } else {  // !parGC

      for e in edge_range do {
	const u = Edges (e).start;
	const v = Edges (e).end  ;

	if ( v == u ) then {
          // self-edge, ignore
          self_edges += 1;
        } else {
          const w = Edge_Weight(e);
          // Both the vertex and firstAvail must be passed by reference.
          // TODO: skip locking in this serial version.
          G.Row[u].addEdgeOnVertex(u, v, w, firstAvailNeighbor$[u]);
	}
      }

    } // if parGC

      forall (vx, firstAvail$) in zip(G.Row, firstAvailNeighbor$) do
        vx.tidyNeighbors(firstAvail$);

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

      G.num_edges = + reduce [v in G.vertices] G.n_Neighbors (v);

      writeln ( "# of raw edges generated  ", n_raw_edges );
      writeln ( "# of duplicate edges      ", "not counted" /*collisions*/ );
      writeln ( "# of self edges           ", self_edges );
      writeln ( "# of edges in final graph ", G.num_edges );

      if DEBUG_GRAPH_GENERATOR then {
       writeln ();
       if rmatGraphConFile != "" {
        writeln("writing neighbor lists to ", rmatGraphConFile);
        const fl = open(rmatGraphConFile, iomode.cw);
        const ch = fl.writer();
        for (u, vx) in zip(G.vertices, G.Row) do
          for (v, w) in vx.neighborList do
            ch.writeln(u, " ", v, " ", w);
        ch.close();
        fl.close();
       } else {
	writeln ("tuples denote (edge, weight)");
	writeln ();
	for u in G.vertices do {
	  write ( "row ", u, ": [", G.n_Neighbors (u), "] " );
	  for (v,w) in G .NeighborPairs (u) do
	    write ( (v, w) );
	  writeln ();
	}
       }
      }

      var max_edges = max reduce [v in vertex_range] G.n_Neighbors (v);
      writeln ("max number of outgoing edges ", max_edges);
      if !DEBUG_NEIGHBOR_HISTOGRAM {
        var zero_edge_vs = + reduce [v in G.Row] (v.numNeighbors() == 0):int;
        writeln("number of disconnected vertices ", zero_edge_vs);
      }

     if DEBUG_NEIGHBOR_HISTOGRAM {
      var edge_count : [0..max_edges] int = 0;

      for v in G.vertices do
	edge_count (G.n_Neighbors (v)) += 1;

      writeln ("histograph of node distributions by number of outgoing edges");
      writeln ( "# edges  # nodes");
      for count in 0..max_edges do
	writeln ( count, "  ", edge_count (count) );
     }

      writeln ();

    }
}

module SSCA2_RMAT_graph_generator

{
  // +=========================================================================+
  // |             RMAT approximate power law graph generator                  |
  // |                                 and                                     |
  // |                           SSCA #2 Kernel 1                              |
  // |                                                                         |
  // |  Generate approximate power law graph                                   |
  // |                                                                         |
  // |  This procedure accepts a generic graph representation which must       |
  // |  provide only the capabilities to:                                      |
  // |    1. add a vertex to a neighbor list for some other vertex             |
  // |    2. assign an integer weight to an entry in an associated weight list |
  // |                                                                         |
  // |  The RMAT procedure implicitly assumes that vertices are integers       |
  // |  in the range [0, 2^SCALE].  So vertices are integers in this           |
  // |  procedure and edges are pairs of integers.                             |
  // |                                                                         |
  // |  This implementation first generates the RMAT graph as a list of        |
  // |  triples, using an array of edges and an associated array of weights.   |
  // |  These are transformed into the Chapel graph representation using       |
  // |  native Chapel syntax for associative and sparse domains and arrays.    |
  // |  That transformation is Kernel 1 of the SSCA #2 benchmark.              |
  // |                                                                         |
  // |  The code uses two auxiliary procedures for clarity and to help the     |
  // |  compiler use more abstract, higher level, code.                        |
  // +=========================================================================+

  use SSCA2_compilation_config_params, Time, BlockDist;

  // File names to dump the edge list and the constructed graph, resp.
  // By default, printouts, if requested, are traditional.
  config const rmatEdgeGenFile = "";
  config const rmatGraphConFile = "";

  // These control which variations of the code to run.
  config const newEG = true;      // do new-style edge generation?
  config const parEG = true;      // do newEG permutations in parallel?
  config const numDepths = -1;    // number of edge tweaks; -1 for baseline
  config const edgeChecks = true; // run edge consistency checks?
  config const parGC = true;      // do Graph Generation in parallel?
  // Set to false for parallel computation (=> faster but not reproducible).
  config param SERIAL_GRAPH_GEN = REPRODUCIBLE_PROBLEMS;

  var stopwatch : Timer;

  record directed_vertex_pair {
    var start = 1: int;
    var end   = 1: int;
  }

  // ============================
  // Quadrant selection algorithm
  // ============================

  inline proc directed_vertex_pair.assign_quadrant
    (u: real, a: real, b: real, c: real, d: real, bit: int)
    {
      // ---------------------------------------------------------------------
      // The heart of the RMAT random graph generator is a procedure that
      // assigns a single bit of the edge starting and ending vertex by
      // assigning the edge with specified probability to one of the four
      // quadrants of a 2 x 2 grid.
      //
      // Chapel is able to promote this conditional-based scalar procedure to
      // array operations where it is not able to promote conditional code
      // directly.
      //
      // Determine randomly in which quadrant of the grid a point lies,
      // based on the following picture:
      //
      //     +---------------------------+
      //     | u < a         | u < a+b   |
      //     |-------------+-------------|
      //     | u < a + b + c | otherwise |
      //     +---------------------------+
      //
      // The probability of the edge falling in the upper left quadrant is  a,
      // in the upper right quadrant, b, the lower left quadrant  c
      // and the lower right quadrant  d, where the probabilities are
      // normalized to sum to one.
      // ---------------------------------------------------------------------

      var start_inc = 0;
      var end_inc   = 0;

      if u <= a then
	{}
      else if u <= a + b then
	{ end_inc = 1;}
      else if u <= a + b + c then
	{ start_inc = 1;}
      else
	{ start_inc = 1; end_inc = 1;};

      this.start += bit * start_inc;
      this.end   += bit * end_inc;
    }

  // ====================================
  // Main RMAT Graph Generation Procedure
  // ====================================~

  proc Gen_RMAT_graph ( a : real,
		       b : real,
		       c : real,
		       d : real,
                       vertex_domain,
		       SCALE :int,
		       N_VERTICES : int,
		       n_raw_edges : int,
		       MAX_EDGE_WEIGHT :int,
		       G )

    { use Random;
      use analyze_RMAT_graph_associative_array;

      if PRINT_TIMING_STATISTICS then stopwatch.start ();

      const vertex_range = 1..N_VERTICES,
	    edge_range   = 1..n_raw_edges;

      const edge_domain =
        if DISTRIBUTION_TYPE == "BLOCK" then
          {edge_range} dmapped Block ( {edge_range} )
        else
          {edge_range} ;

      var Edges       : [edge_domain] directed_vertex_pair;
      // TODO: fold edge weight into directed_vertex_pair
      var Edge_Weight : [edge_domain] int;
      var permutation : [vertex_domain] int = vertex_range;

       // ---------------------------------------------------------------
      // The RMAT algorithm is based on recursively sub-dividing a grid.
      // In this case, the grid is square of order 2^SCALE by 2^SCALE.
      // So exactly "SCALE" steps of recursion will be required and the
      // recursion can be implemented directly by iteration.
      // ---------------------------------------------------------------

      // -----------------------------------------------------------------
      // Note on random number generators -- the RMAT generator creates
      // 5*SCALE vectors of length 2**SCALE.  The dependence on powers
      // of two provides an opportunity to expose statistical correlations
      // in the pseudo-random numbers.  This certainly occurs with the
      // current Chapel Random module.  The "skips" in the random number
      // sequence dramatically change the results.  Without them, the
      // Chapel RMAT matrices are inconsistent with what is seen in
      // other implementations.
      // -----------------------------------------------------------------

      writeln ("Random graph generated by stride of 1 in one random stream",
	       " with skips" );
      if newEG then
        writeln("Using the new edge generation scheme, ",
                if parEG then "in parallel" else "serially");
      if SERIAL_GRAPH_GEN then
        writeln("Serializing certain parallel loops");

      const numDep = if numDepths == -1 then SCALE else numDepths;
      if numDep != SCALE then
        writeln("randomizing with ", numDep, " depths instead of ",
                SCALE, " depths");

    if newEG {
      // new edge generation

      var rndPos = 1;
      const seed = if REPRODUCIBLE_PROBLEMS then 0556707007
                                            else SeedGenerator.currentTime;

      const delta = n_raw_edges + 1; // 1 corresponds to 'skip' in "old" code
      rndPos += 1;                   // start with a skip
      var bit = 1 << numDep;

      for depth in 1..numDep {
        bit >>= 1;

        forall (e, r1, r2, r3, r4, r5) in zip(Edges,
 // RandomPrivate_iterate() generates a random number per elem of edge_domain
 // starting at 'start'-th point in the random number stream for 'seed'.
 RandomPrivate_iterate(real, edge_domain, seed, start=rndPos+0*delta),
 RandomPrivate_iterate(real, edge_domain, seed, start=rndPos+1*delta),
 RandomPrivate_iterate(real, edge_domain, seed, start=rndPos+2*delta),
 RandomPrivate_iterate(real, edge_domain, seed, start=rndPos+3*delta),
 RandomPrivate_iterate(real, edge_domain, seed, start=rndPos+4*delta)) {

          var Noisy_a = a * (0.95 + 0.1 * r1);
          var Noisy_b = b * (0.95 + 0.1 * r2);
          var Noisy_c = c * (0.95 + 0.1 * r3);
          var Noisy_d = d * (0.95 + 0.1 * r4);

	  var norm     = 1.0 / (Noisy_a + Noisy_b + Noisy_c + Noisy_d);
	  Noisy_a *= norm;
	  Noisy_b *= norm;
	  Noisy_c *= norm;
	  Noisy_d *= norm;

          const _bit= bit;
          local
            e.assign_quadrant(r5, Noisy_a, Noisy_b, Noisy_c, Noisy_d, _bit);

        }  // forall

        rndPos += delta * 5;

      }  // for depth

      forall (w, rnd) in zip(Edge_Weight,
        RandomPrivate_iterate(real, edge_domain, seed, start=rndPos-1))
      do
        w = floor (1 + rnd * MAX_EDGE_WEIGHT) : int;
      rndPos += n_raw_edges;

      if parEG {
        var permutation$ : [vertex_domain] sync int = vertex_range;

        serial(SERIAL_GRAPH_GEN) {
          forall (v, rnd) in zip(vertex_domain,
            RandomPrivate_iterate(real, edge_domain, seed, start=rndPos-1))
          {
            const u = floor (1 + rnd * N_VERTICES) : int;
            if u != v {
              // All this does is permutation$(u) <=> permutation$(v).
              // Implementation notes:
              // * Lock the smaller index first, to ensure progress.
              // * Access each of the two sync vars on its locale.
              // * Factors out the 'on's that are implicit in
              //   the accesses to the sync variables into explicit 'on's.
              // * Factors out indexing into permutation$ using
              //   by-reference argument passing.

              const (ix1, ix2) = if v <= u then (v, u) else (u, v);
              swapTwo(permutation$(ix1), permutation$(ix2));

              proc swapTwo(p1$: sync int, p2$: sync int): void {
                on p1$ {
                  const label1 = p1$;
                  var label2: int;
                  on p2$ {
                    label2 = p2$;
                    p2$ = label1;
                  }
                  p1$ = label2;
                }
              }  // proc swapTwo
            }
          }  // forall
        }
        rndPos += N_VERTICES;

        forall (pm, pm$) in zip(permutation, permutation$) {
          pm = pm$.readXX();
        }

      } else {  // !parEG
        for (v, rnd) in zip(vertex_domain,
          RandomPrivate_iterate(real, vertex_domain, seed, start=rndPos-1))
        {
          const new_id = floor (1 + rnd * N_VERTICES) : int;
          permutation (v) <=> permutation (new_id);
        }
        rndPos += N_VERTICES;

      } // if parEG

    } else {  // !newEG

      // Random Numbers return in the range [0.0, 1.0)

      var Rand_Gen = if REPRODUCIBLE_PROBLEMS then
	               new RandomStream (seed = 0556707007)
		     else
		       new RandomStream ();

      var   Noisy_a     : [edge_domain] real,
            Noisy_b     : [edge_domain] real,
            Noisy_c     : [edge_domain] real,
            Noisy_d     : [edge_domain] real,
            norm        : [edge_domain] real,
            Unif_Random : [edge_domain] real;

      var bit = 1 << numDep;
      var   skip : real;

      for depth in 1..numDep do {
	  bit >>= 1;

	  // randomize the coefficients, tweaking them by numbers in [-.05, .05)

	  skip = Rand_Gen.getNext ();
	  Rand_Gen.fillRandom (Unif_Random);
	  Noisy_a = a * (0.95 + 0.1 * Unif_Random);

	  skip = Rand_Gen.getNext ();
	  Rand_Gen.fillRandom (Unif_Random);
	  Noisy_b = b * (0.95 + 0.1 * Unif_Random);

	  skip = Rand_Gen.getNext ();
	  Rand_Gen.fillRandom (Unif_Random);
	  Noisy_c = c * (0.95 + 0.1 * Unif_Random);

	  skip = Rand_Gen.getNext ();
	  Rand_Gen.fillRandom (Unif_Random);
	  Noisy_d = d * (0.95 + 0.1 * Unif_Random);

	  norm     = 1.0 / (Noisy_a + Noisy_b + Noisy_c + Noisy_d);
	  Noisy_a *= norm;
	  Noisy_b *= norm;
	  Noisy_c *= norm;
	  Noisy_d *= norm;

	  skip = Rand_Gen.getNext ();
	  Rand_Gen.fillRandom (Unif_Random);

	  Edges.assign_quadrant ( Unif_Random, Noisy_a, Noisy_b,
				     Noisy_c, Noisy_d, bit );
	};

      // ---------------------------------------------------------------------
      // Assign weights to edges randomly, then randomly relabel the vertices
      // to avoid locality from the obvious imbalance that will arise when
      // one of the coefficients is clearly larger than the others
      // ---------------------------------------------------------------------

      Rand_Gen.fillRandom ( Unif_Random  );
      Edge_Weight = floor (1 + Unif_Random * MAX_EDGE_WEIGHT) : int;

      Rand_Gen.fillRandom ( Unif_Random (vertex_range) );

      for v in vertex_range do
	{ var new_id : int;
	  new_id = floor (1 + Unif_Random (v) * N_VERTICES) : int;
	  permutation (v) <=> permutation (new_id);
	};

    } // if newEG

      forall e in Edges do {
        e.start = permutation(e.start);
        e.end   = permutation(e.end);
      }

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

      if DEBUG_WEIGHT_GENERATOR then {
	writeln ();
       if rmatEdgeGenFile != "" {
        writeln("writing edges to ", rmatEdgeGenFile);
        const fl = open(rmatEdgeGenFile, iomode.cw);
        const ch = fl.writer();
	for (ed, w) in zip(Edges, Edge_Weight) do
          ch.writeln (ed.start, " ", ed.end, " ", w);
        ch.close();
        fl.close();
       } else
	for e in edge_range do
	  writeln ("edge (", e, ") : (", Edges(e), ", ",
		   Edge_Weight (e), ")" );
      }

      // --------------------------
      // Graph consistency checking
      // --------------------------

      if edgeChecks {
        // Check that 'permutation' was a permutation.
        var permuteCounts : [vertex_domain] atomic int;
        forall p in permutation do
          permuteCounts[p].add(1);
        forall (pc, ix) in zip(permuteCounts, vertex_domain) do
          if !(pc.read() == 1) then halt(
               "'permutation' is not a permutation: vertex ", ix,
               " is mentioned ", pc.read(), " times");

        // Sanity checks on edges and weights.
        forall (e, w) in zip(Edges, Edge_Weight) {

          if !(e.start > 0) then halt(
	       "edge start vertices out of low end of range");

          if !(e.end > 0) then halt(
	       "edge end vertices out of low end of range");

          if !(e.start <= 2**SCALE) then halt(
	       "edge start vertices out of high end of range");

          if !(e.end <= 2**SCALE) then halt(
	       "edge end vertices out of high end of range");

          if !(w > 0) then halt(
	       "edge weightd out of low end of range");

          if !(w <= MAX_EDGE_WEIGHT) then halt(
	       "edge weightd out of high end of range");
        }
        // exit the scope to enable memory deallocation, if any
      }

      writeln (); writeln ("Vertex Set in G:", G.vertices);

      // ----------------------------------------------------------
      // Kernel 1: assemble graph from list of triples.
      // Include only non-self incident edges.
      // In case of (start, end) duplicates, the first triple wins.
      // Alternatively, could skip the member(v) check (so the last triple
      // wins) or also use += instead of = (to sum duplicates' weights).
      // ----------------------------------------------------------

      var firstAvailNeighbor$: [vertex_domain] sync int = initialFirstAvail;

      writeln("Starting Graph Generation ",
              if parGC then "in parallel" else "serially");
      if PRINT_TIMING_STATISTICS then stopwatch.start ();

      var collisions = 0, self_edges = 0;

    if parGC {

      var self_edges$: atomic int;
      serial(SERIAL_GRAPH_GEN) {
        forall (e, w) in zip(Edges, Edge_Weight) do {
          const u = e.start;
          const v = e.end;

          if ( v == u ) then {
            // self-edge, ignore
            self_edges$.add(1);
          } else {
            // Both the vertex and firstAvail must be passed by reference.
            // TODO: possibly compute how many neighbors the vertex has, first.
            // Then allocate that big of a neighbor list right away.
            // That way there will be no need for a sync, just an atomic.
            G.Row[u].addEdgeOnVertex(u, v, w, firstAvailNeighbor$[u]);
          }
        }
      }

      self_edges = self_edges$.read();

    } else {  // !parGC

      for e in edge_range do {
	const u = Edges (e).start;
	const v = Edges (e).end  ;

	if ( v == u ) then {
          // self-edge, ignore
          self_edges += 1;
        } else {
          const w = Edge_Weight(e);
          // Both the vertex and firstAvail must be passed by reference.
          // TODO: skip locking in this serial version.
          G.Row[u].addEdgeOnVertex(u, v, w, firstAvailNeighbor$[u]);
	}
      }

    } // if parGC

      forall (vx, firstAvail$) in zip(G.Row, firstAvailNeighbor$) do
        vx.tidyNeighbors(firstAvail$);

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

      G.num_edges = + reduce [v in G.vertices] G.n_Neighbors (v);

      writeln ( "# of raw edges generated  ", n_raw_edges );
      writeln ( "# of duplicate edges      ", "not counted" /*collisions*/ );
      writeln ( "# of self edges           ", self_edges );
      writeln ( "# of edges in final graph ", G.num_edges );

      if DEBUG_GRAPH_GENERATOR then {
       writeln ();
       if rmatGraphConFile != "" {
        writeln("writing neighbor lists to ", rmatGraphConFile);
        const fl = open(rmatGraphConFile, iomode.cw);
        const ch = fl.writer();
        for (u, vx) in zip(G.vertices, G.Row) do
          for (v, w) in vx.neighborList do
            ch.writeln(u, " ", v, " ", w);
        ch.close();
        fl.close();
       } else {
	writeln ("tuples denote (edge, weight)");
	writeln ();
	for u in G.vertices do {
	  write ( "row ", u, ": [", G.n_Neighbors (u), "] " );
	  for (v,w) in G .NeighborPairs (u) do
	    write ( (v, w) );
	  writeln ();
	}
       }
      }

      var max_edges = max reduce [v in vertex_range] G.n_Neighbors (v);
      writeln ("max number of outgoing edges ", max_edges);
      if !DEBUG_NEIGHBOR_HISTOGRAM {
        var zero_edge_vs = + reduce [v in G.Row] (v.numNeighbors() == 0):int;
        writeln("number of disconnected vertices ", zero_edge_vs);
      }

     if DEBUG_NEIGHBOR_HISTOGRAM {
      var edge_count : [0..max_edges] int = 0;

      for v in G.vertices do
	edge_count (G.n_Neighbors (v)) += 1;

      writeln ("histograph of node distributions by number of outgoing edges");
      writeln ( "# edges  # nodes");
      for count in 0..max_edges do
	writeln ( count, "  ", edge_count (count) );
     }

      writeln ();

    }
}


Changes resulting from review.

Changes resulting from review.

- Restore the 'pragma "no use ChapelStandard"' I removed in my first
  commit.  Based on testing it was safe to do this, but it is a code
  change and as such, at this point in the release cycle is not allowed.
  I've left a note to myself and will re-apply this part after the
  release.
- Clear up phrasing in the module-level comment.
- Fix 'turn-of' typo, should be 'turn-on'.
- Move description of reporting output to the module comment from the
  startVerboseComm{Here}() proc comments.
- Remove mention of the runtime in the record type description.
- Use 'on this locale' in all cases for the *Here() procs, vs. 'on the
  calling locale' in some cases.
- Use 'on-the-fly' to describe the verbose comm reporting,
  vs. 'real-time' in some cases.

/*
 * Copyright 2004-2015 Cray Inc.
 * Other additional copyright holders may be indicated within.
 *
 * The entirety of this work is licensed under the Apache License,
 * Version 2.0 (the "License"); you may not use this file except
 * in compliance with the License.
 *
 * You may obtain a copy of the License at
 *
 *     http://www.apache.org/licenses/LICENSE-2.0
 *
 * Unless required by applicable law or agreed to in writing, software
 * distributed under the License is distributed on an "AS IS" BASIS,
 * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
 * See the License for the specific language governing permissions and
 * limitations under the License.
 */

pragma "no use ChapelStandard"

/* This module provides support for reporting and counting communication
   operations between network-connected locales.  The operations include
   various kinds of remote reads (GETs), remote writes (PUTs), and
   remote forks.  Callers can request on-the-fly output each time a
   remote operation occurs, or count such operations as they occur and
   retrieve the counts later.  The former gives more detailed
   information but has much more overhead.  The latter has much less
   overhead but only provides aggregate information.

   All forms of communication reporting and counting are done between
   pairs of function calls that turn it on and off.  On-the-fly
   reporting across all locales is done like this::

     startVerboseComm();
     // between start/stop calls, report comm ops initiated on any locale
     stopVerboseComm();

   On-the-fly reporting for a single locale is done like this::

     startVerboseCommHere();
     // between start/stop calls, report comm ops initiated on this locale
     stopVerboseCommHere();

   In either case, the output produced consists of a line written to
   ``stdout`` for each communication operation.  (Here ``stdout`` means
   the file associated with the process, not the Chapel channel with the
   same name.)

   Counting communication operations requires a few more calls then just
   reporting them does.  In particular, the counts have to be retrieved
   after they are collected and, if they have been used previously, the
   internal counters have to be reset before counting is turned on.
   Counting across all locales is done like this::

     // (optional) if we counted previously, reset the counters to zero
     resetCommDiagnostics();
     startCommDiagnostics();
     // between start/stop calls, count comm ops initiated on any locale
     stopCommDiagnostics();
     // retrieve the counts and report the results
     writeln(getCommDiagnostics());

   Counting on just the calling locale is similar.  Only the procedure
   names change::

     // (optional) if we counted previously, reset the counters to zero
     resetCommDiagnosticsHere();
     startCommDiagnosticsHere();
     // between start/stop calls, count comm ops initiated on this locale
     stopCommDiagnosticsHere();
     // retrieve the counts and report the results
     writeln(getCommDiagnosticsHere());

   The optional call to reset the counters is only needed when a program
   collects counts more than once.  In this case, the counters have to
   be set back to zero before starting the second and succeeding
   counting periods.  By far the most common situation is that programs
   only collect communication counts once per run, in which case this
   step is not needed.

   Note that the same internal mechanisms and counters are used for
   counting on all locales and counting on just the calling locale, so
   trying to do both at once may lead to surprising turn-on/turn-off
   behavior and/or incorrect results.
 */
module CommDiagnostics
{
  //
  // multi-locale diagnostics/debugging support
  //

  // There should be a type like this declared in chpl-comm.h with a single
  // function that returns the C struct.  We're not doing it that way yet
  // due to some shortcomings in our extern records implementation.
  // Once that gets sorted out, we can turn this into an extern record,
  // and remove the 8 or so individual functions below that return the
  // various counters.

  /* Aggregated communication operation counts.  This record type is
     defined in the same way by both the underlying comm layer(s) and
     this module, because we don't have a good way to inherit types back
     and forth between the two.  This first definition duplicates the
     one in the comm layer(s).
   */
  extern record chpl_commDiagnostics {
    /*
      blocking GETs, in which initiator waits for completion
     */
    var get: uint(64);
    /*
      non-blocking GETs
     */
    var get_nb: uint(64);
    /*
      blocking PUTs, in which initiator waits for completion
     */
    var put: uint(64);
    /*
      non-blocking PUTs
     */
    var put_nb: uint(64);
    /*
      tests for non-blocking GET/PUT completions
     */
    var test_nb: uint(64);
    /*
      blocking waits for non-blocking GET/PUT completions
     */
    var wait_nb: uint(64);
    /*
      non-blocking waits for non-blocking GET/PUT completions
     */
    var try_nb: uint(64);
    /*
      blocking remote executions, in which initiator waits for completion
     */
    var fork: uint(64);
    /*
      blocking remote executions performed by the target locale's
      Active Message handler
     */
    var fork_fast: uint(64);
    /*
      non-blocking remote executions
     */
    var fork_nb: uint(64);
  };

  /*
    The Chapel record type inherits the comm layer definition of it.
   */
  type commDiagnostics = chpl_commDiagnostics;

  pragma "no doc"
  extern proc chpl_startVerboseComm();

  pragma "no doc"
  extern proc chpl_stopVerboseComm();

  pragma "no doc"
  extern proc chpl_startVerboseCommHere();

  pragma "no doc"
  extern proc chpl_stopVerboseCommHere();

  pragma "no doc"
  extern proc chpl_gen_startCommDiagnostics();

  pragma "no doc"
  extern proc chpl_gen_stopCommDiagnostics();

  pragma "no doc"
  extern proc chpl_gen_startCommDiagnosticsHere();

  pragma "no doc"
  extern proc chpl_gen_stopCommDiagnosticsHere();

  pragma "no doc"
  extern proc chpl_resetCommDiagnosticsHere();

  pragma "no doc"
  extern proc chpl_getCommDiagnosticsHere(out cd: commDiagnostics);

  /*
    Start on-the-fly reporting of communication initiated on any locale.
   */
  proc startVerboseComm() { chpl_startVerboseComm(); }

  /*
    Stop on-the-fly reporting of communication initiated on any locale.
   */
  proc stopVerboseComm() { chpl_stopVerboseComm(); }

  /*
    Start on-the-fly reporting of communication initiated on this locale.
   */
  proc startVerboseCommHere() { chpl_startVerboseCommHere(); }

  /*
    Stop on-the-fly reporting of communication initiated on this locale.
   */
  proc stopVerboseCommHere() { chpl_stopVerboseCommHere(); }

  /*
    Start counting communication operations across the whole program.
   */
  proc startCommDiagnostics() {
    chpl_gen_startCommDiagnostics();
  }

  /*
    Stop counting communication operations across the whole program.
   */
  proc stopCommDiagnostics() {
    chpl_gen_stopCommDiagnostics();
  }

  /*
    Start counting communication operations initiated on this locale.
   */
  proc startCommDiagnosticsHere() {
    chpl_gen_startCommDiagnosticsHere();
  }

  /*
    Stop counting communication operations initiated on this locale.
   */
  proc stopCommDiagnosticsHere() {
    chpl_gen_stopCommDiagnosticsHere();
  }

  /*
    Reset aggregate communication counts across the whole program.
   */
  proc resetCommDiagnostics() {
    for loc in Locales do on loc do
      resetCommDiagnosticsHere();
  }

  /*
    Reset aggregate communication counts on the calling locale.
   */
  inline proc resetCommDiagnosticsHere() {
    chpl_resetCommDiagnosticsHere();
  }

  // See note above regarding extern records
  pragma "no doc"
  extern proc chpl_numCommGets(): uint(64);

  pragma "no doc"
  extern proc chpl_numCommNBGets(): uint(64);

  pragma "no doc"
  extern proc chpl_numCommPuts(): uint(64);

  pragma "no doc"
  extern proc chpl_numCommNBPuts(): uint(64);

  pragma "no doc"
  extern proc chpl_numCommTestNB(): uint(64);

  pragma "no doc"
  extern proc chpl_numCommWaitNB(): uint(64);

  pragma "no doc"
  extern proc chpl_numCommTryNB(): uint(64);

  pragma "no doc"
  extern proc chpl_numCommForks(): uint(64);

  pragma "no doc"
  extern proc chpl_numCommFastForks(): uint(64);

  pragma "no doc"
  extern proc chpl_numCommNBForks(): uint(64);

  /*
    Retrieve aggregate communication counts for the whole program.

    :returns: array of counts of comm ops initiated on each locale
    :rtype: `[LocaleSpace] commDiagnostics`
   */
  proc getCommDiagnostics() {
    var D: [LocaleSpace] commDiagnostics;
    for loc in Locales do on loc {
      // See note above regarding extern records
      D(loc.id).get = chpl_numCommGets();
      D(loc.id).get_nb = chpl_numCommNBGets();
      D(loc.id).put = chpl_numCommPuts();
      D(loc.id).put_nb = chpl_numCommNBPuts();
      D(loc.id).test_nb = chpl_numCommTestNB();
      D(loc.id).wait_nb = chpl_numCommWaitNB();
      D(loc.id).try_nb = chpl_numCommTryNB();
      D(loc.id).fork = chpl_numCommForks();
      D(loc.id).fork_fast = chpl_numCommFastForks();
      D(loc.id).fork_nb = chpl_numCommNBForks();
    }
    return D;
  }

  /*
    Retrieve aggregate communication counts for this locale.

    :returns: counts of comm ops initiated on this locale
    :rtype: `commDiagnostics`
   */
  proc getCommDiagnosticsHere() {
    var cd: commDiagnostics;
    cd.get = chpl_numCommGets();
    cd.get_nb = chpl_numCommNBGets();
    cd.put = chpl_numCommPuts();
    cd.put_nb = chpl_numCommNBPuts();
    cd.test_nb = chpl_numCommTestNB();
    cd.wait_nb = chpl_numCommWaitNB();
    cd.try_nb = chpl_numCommTryNB();
    cd.fork = chpl_numCommForks();
    cd.fork_fast = chpl_numCommFastForks();
    cd.fork_nb = chpl_numCommNBForks();
    return cd;
  }

}

/*
 * Copyright 2004-2015 Cray Inc.
 * Other additional copyright holders may be indicated within.
 *
 * The entirety of this work is licensed under the Apache License,
 * Version 2.0 (the "License"); you may not use this file except
 * in compliance with the License.
 *
 * You may obtain a copy of the License at
 *
 *     http://www.apache.org/licenses/LICENSE-2.0
 *
 * Unless required by applicable law or agreed to in writing, software
 * distributed under the License is distributed on an "AS IS" BASIS,
 * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
 * See the License for the specific language governing permissions and
 * limitations under the License.
 */

/* This module provides for collecting and reporting statistics about
   communication operations between network-connected locales.  The
   operations include various kinds of remote reads (GETs), remote
   writes (PUTs), and remote forks.  Callers can request on-the-fly
   output each time a remote operation occurs, or aggregate counting of
   the operations for later retrieval.  The former gives more detailed
   information but has much more overhead.  The latter has much less
   overhead but only provides aggregate information.

   All forms of statistics collection are done between pairs of function
   calls that turn it on and off.  On-the-fly reporting across all
   locales is done like this::

     startVerboseComm();
     // between start/stop calls, report comm ops initiated on any locale
     stopVerboseComm();

   On-the-fly reporting for a single locale is done like this::

     startVerboseCommHere();
     // between start/stop calls, report comm ops initiated on this locale
     stopVerboseCommHere();

   Aggregate statistics collection requires a few more calls.  One has
   to retrieve the statistics after they are collected and, if they are
   to be used again, reset the internal counters afterward.  Collecting
   statistics across all locales is done like this::

     // (optional) if we counted previously, reset the counters to zero
     resetCommDiagnostics();
     startCommDiagnostics();
     // between start/stop calls, count comm ops initiated on any locale
     stopCommDiagnostics();
     // retrieve the counts and report the results
     writeln(getCommDiagnostics());

   Collecting statistics on just the calling locale is much the same.
   Only the procedure names change::

     // (optional) if we counted previously, reset the counters to zero
     resetCommDiagnosticsHere();
     startCommDiagnosticsHere();
     // between start/stop calls, count comm ops initiated on this locale
     stopCommDiagnosticsHere();
     // retrieve the counts and report the results
     writeln(getCommDiagnosticsHere());

   The optional call to reset the counters is only needed when a program
   collects communication statistics more than once.  In this case, the
   counters have to be set back to zero before starting the second and
   succeeding collection periods.  By far the most common situation is
   that programs only collect the communication counters once per run,
   in which case this step is not needed.

   Note that the same internal mechanisms and counters are used for
   counting on all locales and counting on just the calling locale, so
   trying to do both at once may lead to surprising turn-of/turn-off
   behavior and/or incorrect results.
 */
module CommDiagnostics
{
  //
  // multi-locale diagnostics/debugging support
  //

  // There should be a type like this declared in chpl-comm.h with a single
  // function that returns the C struct.  We're not doing it that way yet
  // due to some shortcomings in our extern records implementation.
  // Once that gets sorted out, we can turn this into an extern record,
  // and remove the 8 or so individual functions below that return the
  // various counters.

  /* Aggregated communication operation counts.  This record type is
     defined in the same way by both the runtime and this module,
     because we don't have a good way to inherit types back and forth
     between the two.  This first definition duplicates the one in the
     runtime.
   */
  extern record chpl_commDiagnostics {
    /*
      blocking GETs, in which initiator waits for completion
     */
    var get: uint(64);
    /*
      non-blocking GETs
     */
    var get_nb: uint(64);
    /*
      blocking PUTs, in which initiator waits for completion
     */
    var put: uint(64);
    /*
      non-blocking PUTs
     */
    var put_nb: uint(64);
    /*
      tests for non-blocking GET/PUT completions
     */
    var test_nb: uint(64);
    /*
      blocking waits for non-blocking GET/PUT completions
     */
    var wait_nb: uint(64);
    /*
      non-blocking waits for non-blocking GET/PUT completions
     */
    var try_nb: uint(64);
    /*
      blocking remote executions, in which initiator waits for completion
     */
    var fork: uint(64);
    /*
      blocking remote executions performed by the target locale's
      Active Message handler
     */
    var fork_fast: uint(64);
    /*
      non-blocking remote executions
     */
    var fork_nb: uint(64);
  };

  /*
    The Chapel record type inherits the runtime's definition of it.
   */
  type commDiagnostics = chpl_commDiagnostics;

  pragma "no doc"
  extern proc chpl_startVerboseComm();

  pragma "no doc"
  extern proc chpl_stopVerboseComm();

  pragma "no doc"
  extern proc chpl_startVerboseCommHere();

  pragma "no doc"
  extern proc chpl_stopVerboseCommHere();

  pragma "no doc"
  extern proc chpl_gen_startCommDiagnostics();

  pragma "no doc"
  extern proc chpl_gen_stopCommDiagnostics();

  pragma "no doc"
  extern proc chpl_gen_startCommDiagnosticsHere();

  pragma "no doc"
  extern proc chpl_gen_stopCommDiagnosticsHere();

  pragma "no doc"
  extern proc chpl_resetCommDiagnosticsHere();

  pragma "no doc"
  extern proc chpl_getCommDiagnosticsHere(out cd: commDiagnostics);

  /*
    Start real-time reporting of communication initiated on any locale.
    The output consists of a line written to ``stdout`` for each
    communication operation.  (Here ``stdout`` means the file associated
    with the process, not the Chapel channel with the same name.)
   */
  proc startVerboseComm() { chpl_startVerboseComm(); }

  /*
    Stop real-time reporting of communication initiated on any locale.
   */
  proc stopVerboseComm() { chpl_stopVerboseComm(); }

  /*
    Start real-time reporting of communication initiated on this locale.
    The output consists of a line written to ``stdout`` for each
    communication operation.  (Here ``stdout`` means the file associated
    with the process, not the Chapel channel with the same name.)
   */
  proc startVerboseCommHere() { chpl_startVerboseCommHere(); }

  /*
    Stop real-time reporting of communication initiated on this locale.
   */
  proc stopVerboseCommHere() { chpl_stopVerboseCommHere(); }

  /*
    Start counting communication operations across the whole program.
   */
  proc startCommDiagnostics() {
    chpl_gen_startCommDiagnostics();
  }

  /*
    Stop counting communication operations across the whole program.
   */
  proc stopCommDiagnostics() {
    chpl_gen_stopCommDiagnostics();
  }

  /*
    Start counting communication operations initiated on the calling locale.
   */
  proc startCommDiagnosticsHere() {
    chpl_gen_startCommDiagnosticsHere();
  }

  /*
    Stop counting communication operations initiated on the calling locale.
   */
  proc stopCommDiagnosticsHere() {
    chpl_gen_stopCommDiagnosticsHere();
  }

  /*
    Reset aggregate communication counts across the whole program.
   */
  proc resetCommDiagnostics() {
    for loc in Locales do on loc do
      resetCommDiagnosticsHere();
  }

  /*
    Reset aggregate communication counts on the calling locale.
   */
  inline proc resetCommDiagnosticsHere() {
    chpl_resetCommDiagnosticsHere();
  }

  // See note above regarding extern records
  pragma "no doc"
  extern proc chpl_numCommGets(): uint(64);

  pragma "no doc"
  extern proc chpl_numCommNBGets(): uint(64);

  pragma "no doc"
  extern proc chpl_numCommPuts(): uint(64);

  pragma "no doc"
  extern proc chpl_numCommNBPuts(): uint(64);

  pragma "no doc"
  extern proc chpl_numCommTestNB(): uint(64);

  pragma "no doc"
  extern proc chpl_numCommWaitNB(): uint(64);

  pragma "no doc"
  extern proc chpl_numCommTryNB(): uint(64);

  pragma "no doc"
  extern proc chpl_numCommForks(): uint(64);

  pragma "no doc"
  extern proc chpl_numCommFastForks(): uint(64);

  pragma "no doc"
  extern proc chpl_numCommNBForks(): uint(64);

  /*
    Retrieve aggregate communication counts for the whole program.

    :returns: array of counts of comm ops initiated on each locale
    :rtype: `[LocaleSpace] commDiagnostics`
   */
  proc getCommDiagnostics() {
    var D: [LocaleSpace] commDiagnostics;
    for loc in Locales do on loc {
      // See note above regarding extern records
      D(loc.id).get = chpl_numCommGets();
      D(loc.id).get_nb = chpl_numCommNBGets();
      D(loc.id).put = chpl_numCommPuts();
      D(loc.id).put_nb = chpl_numCommNBPuts();
      D(loc.id).test_nb = chpl_numCommTestNB();
      D(loc.id).wait_nb = chpl_numCommWaitNB();
      D(loc.id).try_nb = chpl_numCommTryNB();
      D(loc.id).fork = chpl_numCommForks();
      D(loc.id).fork_fast = chpl_numCommFastForks();
      D(loc.id).fork_nb = chpl_numCommNBForks();
    }
    return D;
  }

  /*
    Retrieve aggregate communication counts for this locale.

    :returns: counts of comm ops initiated on the calling locale
    :rtype: `commDiagnostics`
   */
  proc getCommDiagnosticsHere() {
    var cd: commDiagnostics;
    cd.get = chpl_numCommGets();
    cd.get_nb = chpl_numCommNBGets();
    cd.put = chpl_numCommPuts();
    cd.put_nb = chpl_numCommNBPuts();
    cd.test_nb = chpl_numCommTestNB();
    cd.wait_nb = chpl_numCommWaitNB();
    cd.try_nb = chpl_numCommTryNB();
    cd.fork = chpl_numCommForks();
    cd.fork_fast = chpl_numCommFastForks();
    cd.fork_nb = chpl_numCommNBForks();
    return cd;
  }

}