Small mods to chpl_executeOn* functions in the numa locale model

[reviewed by Greg]

- Do not change sublocales if the requested sublocale is c_sublocid_any
- Use a config var to disable use of begin+chpl_ftable_call()

FYI, I was trying to replace the call to the chpl_comm_fork_nb() with
begin+chpl_ftable_call(), but it appears to still not work despite an
earlier fix (r21912) that made the use of begins in modules work
better.

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

// LocaleModel.chpl
//
// This provides a flat locale model architectural description.  The
// locales contain memory and a multi-core processor with homogeneous
// cores, and we ignore any affinity (NUMA effects) between the
// processor cores and the memory.  This architectural description is
// backward compatible with the architecture implicitly provided by
// releases 1.6 and preceding.
//
pragma "no use ChapelStandard"
module LocaleModel {

  // This should eventually be unified with
  // CHPL_LOCALE_MODEL_NUM_SUBLOCALES which is currently defined in the
  // runtime for any locale model that doesn't use sub locales
  param localeModelHasSublocales = true;

  use ChapelLocale;
  use DefaultRectangular;
  use ChapelNumLocales;
  use Sys;

  extern proc chpl_task_getRequestedSubloc(): int(32);

  config param debugLocaleModel = false;

  // We would really like a class-static storage class.(C++ nomenclature)
  var doneCreatingLocales: bool = false;

  // The chpl_localeID_t type is used internally.  It should not be exposed to
  // the user.  The runtime defines the actual type, as well as a functional
  // interface for assembling and disassembling chpl_localeID_t values.  This
  // module then provides the interface the compiler-emitted code uses to do
  // the same.

  type chpl_nodeID_t = int(32);
  type chpl_sublocID_t = int(32);

  extern record chpl_localeID_t {
    // We need to know that this is a record type in order to pass it to and
    // return it from runtime functions properly, but we don't need or want
    // to see its contents.
  };

  // We need an explicit copy constructor because the compiler cannot create
  // a correct one for a record type whose members are not known to it.
  pragma "init copy fn"
  extern chpl__initCopy_chpl_rt_localeID_t
  proc chpl__initCopy(initial: chpl_localeID_t): chpl_localeID_t;

  extern var chpl_nodeID: chpl_nodeID_t;

  // Runtime interface for manipulating global locale IDs.
  extern
    proc chpl_rt_buildLocaleID(node: chpl_nodeID_t,
                               subloc: chpl_sublocID_t): chpl_localeID_t;

  extern
    proc chpl_rt_nodeFromLocaleID(loc: chpl_localeID_t): chpl_nodeID_t;

  extern
    proc chpl_rt_sublocFromLocaleID(loc: chpl_localeID_t): chpl_sublocID_t;

  // Compiler (and module code) interface for manipulating global locale IDs..
  pragma "insert line file info"
  proc chpl_buildLocaleID(node: chpl_nodeID_t, subloc: chpl_sublocID_t)
    return chpl_rt_buildLocaleID(node, subloc);

  pragma "insert line file info"
  proc chpl_nodeFromLocaleID(loc: chpl_localeID_t)
    return chpl_rt_nodeFromLocaleID(loc);

  pragma "insert line file info"
  proc chpl_sublocFromLocaleID(loc: chpl_localeID_t)
    return chpl_rt_sublocFromLocaleID(loc);

  //
  // The NUMA sublocale model
  //
  class NumaDomain : AbstractLocaleModel {
    const sid: chpl_sublocID_t;
    const name: string;

    proc chpl_id() return (parent:LocaleModel)._node_id; // top-level node id
    proc chpl_localeid() {
      return chpl_buildLocaleID((parent:LocaleModel)._node_id:chpl_nodeID_t,
                                sid);
    }
    proc chpl_name() return name;

    proc NumaDomain() {
    }

    proc NumaDomain(_sid, _parent) {
      sid = _sid;
      name = "ND"+sid;
      parent = _parent;
    }

    proc readWriteThis(f) {
      parent.readWriteThis(f);
      f <~> '.'+name;
    }

    proc getChildCount(): int { return 0; }
    iter getChildIndices() : int {
      halt("No children to iterate over.");
      yield -1;
    }
    proc addChild(loc:locale) { halt("Cannot add children to this locale type."); }
    proc getChild(idx:int) : locale { return nil; }

    // This is commented out b/c it leads to an internal error during
    // the resolveIntents pass.  See
    // test/functions/iterators/sungeun/iterInClass.future
    //
    // iter getChildren() : locale {
    //  halt("No children to iterate over.");
    //  yield nil;
    // }
  }

  //
  // The node model
  //
  class LocaleModel : AbstractLocaleModel {
    const callStackSize: int;
    const _node_id : int;
    const local_name : string;

    const numSublocales: int;
    var childSpace: domain(1);
    var childLocales: [childSpace] NumaDomain;

    // This constructor must be invoked "on" the node
    // that it is intended to represent.  This trick is used
    // to establish the equivalence the "locale" field of the locale object
    // and the node ID portion of any wide pointer referring to it.
    proc LocaleModel() {
      if doneCreatingLocales {
        halt("Cannot create additional LocaleModel instances");
      }
      init();
    }

    proc LocaleModel(parent_loc : locale) {
      if doneCreatingLocales {
        halt("Cannot create additional LocaleModel instances");
      }
      parent = parent_loc;
      init();
    }

    proc chpl_id() return _node_id;     // top-level locale (node) number
    proc chpl_localeid() {
      extern const c_sublocid_any: chpl_sublocID_t;
      return chpl_buildLocaleID(_node_id:chpl_nodeID_t, c_sublocid_any);
    }
    proc chpl_name() return local_name;

    proc readWriteThis(f) {
      // Most classes will define it like this:
//      f <~> name;
      // but here it is defined thus for backward compatibility.
      f <~> new ioLiteral("LOCALE") <~> _node_id;
    }

    proc getChildSpace() return childSpace;

    proc getChildCount() return numSublocales;

    iter getChildIndices() : int {
      for idx in childSpace do
        yield idx;
    }

    proc getChild(idx:int) : locale {
      if boundsChecking then
        if (idx < 0) || (idx >= numSublocales) then
          halt("sublocale child index out of bounds (",idx,")");
      return childLocales[idx];
    }

    iter getChildren() : locale  {
      for loc in childLocales do
        yield loc;
    }

    proc getChildArray() {
      return childLocales;
    }

    //------------------------------------------------------------------------{
    //- Implementation (private)
    //-
    proc init() {
      _node_id = chpl_nodeID: int;

      // chpl_nodeName is defined in chplsys.c.
      // It supplies a node name obtained by running uname(3) on the
      // current node.  For this reason (as well), the constructor (or
      // at least this init method) must be run on the node it is
      // intended to describe.
      var comm, spawnfn : string;
      extern proc chpl_nodeName() : string;
      // sys_getenv returns zero on success.
      if sys_getenv("CHPL_COMM", comm) == 0 && comm == "gasnet" &&
        sys_getenv("GASNET_SPAWNFN", spawnfn) == 0 && spawnfn == "L"
      then local_name = chpl_nodeName() + "-" + _node_id : string;
      else local_name = chpl_nodeName();

      extern proc chpl_task_getCallStackSize(): int;
      callStackSize = chpl_task_getCallStackSize();

      extern proc chpl_numCoresOnThisLocale(): int;
      numCores = chpl_numCoresOnThisLocale();

      extern proc chpl_task_getNumSublocales(): int(32);
      numSublocales = chpl_task_getNumSublocales();

      if numSublocales >= 1 {
        childSpace = {0..#numSublocales};
        const numCoresPerNumaDomain = numCores/numSublocales;
        const origSubloc = chpl_task_getRequestedSubloc(); // this should be any
        for i in childSpace {
          // allocate the structure on the domain?
          // MUST CHANGE SUBLOC HERE (prolly by primitive)
          chpl_task_setSubloc(i:chpl_sublocID_t);
          childLocales[i] = new NumaDomain(i:chpl_sublocID_t, this);
          childLocales[i].numCores = numCoresPerNumaDomain;
        }
        chpl_task_setSubloc(origSubloc);
      }
    }
    //------------------------------------------------------------------------}

    inline proc subloc return c_sublocid_any;
 }

  //
  // An instance of this class is the default contents 'rootLocale'.
  //
  // In the current implementation a platform-specific architectural description
  // may overwrite this instance or any of its children to establish a more customized
  // representation of the system resources.
  //
  class RootLocale : AbstractRootLocale {

    // Would like to make myLocaleSpace distributed with one index per node.
    const myLocaleSpace: domain(1) = {0..numLocales-1};
    const myLocales: [myLocaleSpace] locale;

    proc RootLocale() {
      parent = nil;
      numCores = 0;
    }

    // The init() function must use initOnLocales() to iterate (in
    // parallel) over the locales to set up the LocaleModel object.
    // In addition, the initial 'here' must be set.
    proc init() {
      forall locIdx in initOnLocales() {
        chpl_task_setSubloc(c_sublocid_any);
        const node = new LocaleModel(this);
        myLocales[locIdx] = node;
        numCores += node.numCores;
      }
    }

    // Has to be globally unique and not equal to a node ID.
    // We return numLocales for now, since we expect nodes to be
    // numbered less than this.
    // -1 is used in the abstract locale class to specify an invalid node ID.
    proc chpl_id() return numLocales;
    proc chpl_localeid() {
      extern const c_sublocid_any: chpl_sublocID_t;
      return chpl_buildLocaleID(numLocales:chpl_nodeID_t, c_sublocid_any);
    }
    proc chpl_name() return local_name();
    proc local_name() return "rootLocale";

    proc readWriteThis(f) {
      f <~> name;
    }

    proc getChildCount() return this.myLocaleSpace.numIndices;

    proc getChildSpace() return this.myLocaleSpace;

    iter getChildIndices() : int {
      for idx in this.myLocaleSpace do
        yield idx;
    }

    proc getChild(idx:int) return this.myLocales[idx];

    iter getChlidren() : locale  {
      for loc in this.myLocales do
        yield loc;
    }

    proc getDefaultLocaleSpace() return this.myLocaleSpace;
    proc getDefaultLocaleArray() return myLocales;

    proc localeIDtoLocale(id : chpl_localeID_t) {
      const dnode = chpl_nodeFromLocaleID(id);
      const dsubloc = chpl_sublocFromLocaleID(id);
      if (dsubloc == c_sublocid_curr) || (dsubloc == c_sublocid_any) then
        return (myLocales[dnode:int]):locale;
      else
        return (myLocales[dnode:int].getChild(dsubloc:int)):locale;
    }
  }

  //////////////////////////////////////////
  //
  // support for memory management
  //

  // The allocator pragma is used by scalar replacement.
  pragma "allocator"
  pragma "no sync demotion"
  pragma "locale model alloc"
  proc chpl_here_alloc(size:int, md:int(16)) {
    pragma "insert line file info"
      extern proc chpl_mem_alloc(size:int, md:int(16)) : opaque;
    return chpl_mem_alloc(size, md + chpl_memhook_md_num());
  }

  pragma "allocator"
  pragma "no sync demotion"
  proc chpl_here_calloc(size:int, number:int, md:int(16)) {
    pragma "insert line file info"
      extern proc chpl_mem_calloc(number:int, size:int, md:int(16)) : opaque;
    return chpl_mem_calloc(number, size, md + chpl_memhook_md_num());
  }

  pragma "allocator"
  pragma "no sync demotion"
  proc chpl_here_realloc(ptr:opaque, size:int, md:int(16)) {
    pragma "insert line file info"
      extern proc chpl_mem_realloc(ptr:opaque, size:int, md:int(16)) : opaque;
    return chpl_mem_realloc(ptr, size, md + chpl_memhook_md_num());
  }

  pragma "no sync demotion"
  pragma "locale model free"
  proc chpl_here_free(ptr:opaque) {
    pragma "insert line file info"
      extern proc chpl_mem_free(ptr:opaque): void;
    chpl_mem_free(ptr);
  }

  //////////////////////////////////////////
  //
  // support for "on" statements
  //

  //
  // runtime interface
  //
  extern proc chpl_comm_fork(loc_id: int, subloc_id: int,
                             fn: int, args: c_void_ptr, arg_size: int(32));
  extern proc chpl_comm_fork_fast(loc_id: int, subloc_id: int,
                                  fn: int, args: c_void_ptr, args_size: int(32));
  extern proc chpl_comm_fork_nb(loc_id: int, subloc_id: int,
                                fn: int, args: c_void_ptr, args_size: int(32));
  extern proc chpl_ftable_call(fn: int, args: c_void_ptr): void;
  extern proc chpl_task_setSubloc(subloc: int(32));
  extern const c_sublocid_any: chpl_sublocID_t;
  extern const c_sublocid_curr: chpl_sublocID_t;

  //
  // regular "on"
  //
  pragma "insert line file info"
  export
  proc chpl_executeOn(loc: chpl_localeID_t, // target locale
                      fn: int,              // on-body function idx
                      args: c_void_ptr,     // function args
                      args_size: int(32)    // args size
                     ) {
    const dnode =  chpl_nodeFromLocaleID(loc);
    const dsubloc =  chpl_sublocFromLocaleID(loc);
    if dnode != chpl_nodeID {
      chpl_comm_fork(dnode, dsubloc, fn, args, args_size);
    } else {
      // run directly on this node
      var origSubloc = chpl_task_getRequestedSubloc();
      if (dsubloc==c_sublocid_any || dsubloc==origSubloc) {
        chpl_ftable_call(fn, args);
      } else {
        // move to a different sublocale
        chpl_task_setSubloc(dsubloc);
        chpl_ftable_call(fn, args);
        chpl_task_setSubloc(origSubloc);
      }
    }
  }

  //
  // fast "on" (doesn't do anything that could deadlock a comm layer,
  // in the Active Messages sense)
  //
  pragma "insert line file info"
  export
  proc chpl_executeOnFast(loc: chpl_localeID_t, // target locale
                          fn: int,              // on-body function idx
                          args: c_void_ptr,     // function args
                          args_size: int(32)    // args size
                         ) {
    const dnode =  chpl_nodeFromLocaleID(loc);
    const dsubloc =  chpl_sublocFromLocaleID(loc);
    if dnode != chpl_nodeID {
      chpl_comm_fork_fast(dnode, dsubloc, fn, args, args_size);
    } else {
      var origSubloc = chpl_task_getRequestedSubloc();
      if (dsubloc==c_sublocid_any || dsubloc==origSubloc) {
        chpl_ftable_call(fn, args);
      } else {
        // move to a different sublocale
        chpl_task_setSubloc(dsubloc);
        chpl_ftable_call(fn, args);
        chpl_task_setSubloc(origSubloc);
      }
    }
  }

  // Unused for now due to bug in non-developer mode when using 'begin'
  inline proc chpl_executeOnNBAux(fn: int,         // on-body function idx
                                  args: c_void_ptr // function args
                                  ) {
    if __primitive("task_get_serial") then
      chpl_ftable_call(fn, args);
    else
      begin chpl_ftable_call(fn, args);
  }
  //
  // nonblocking "on" (doesn't wait for completion)
  //
  param useBegin = false;
  pragma "insert line file info"
  export
  proc chpl_executeOnNB(loc: chpl_localeID_t, // target locale
                        fn: int,              // on-body function idx
                        args: c_void_ptr,     // function args
                        args_size: int(32)    // args size
                       ) {
    //
    // If we're in serial mode, we should use blocking rather than
    // non-blocking "on" in order to serialize the forks.
    //
    const dnode =  chpl_nodeFromLocaleID(loc);
    const dsubloc =  chpl_sublocFromLocaleID(loc);
    if dnode != chpl_nodeID {
      if __primitive("task_get_serial") then
        chpl_comm_fork(dnode, dsubloc, fn, args, args_size);
      else
        chpl_comm_fork_nb(dnode, dsubloc, fn, args, args_size);
    } else {
      var origSubloc = chpl_task_getRequestedSubloc();
      // We'd like to call chpl_executeOnNBaux() here, but the begin
      //  statement seems to cause a problem
      if (dsubloc==c_sublocid_any || dsubloc==origSubloc) {
        // run on this sublocale
        if useBegin {
          chpl_executeOnNBAux(fn, args);
        } else {
          if __primitive("task_get_serial") then
            chpl_ftable_call(fn, args);
          else
            // begin chpl_ftable_call(fn, args);
            chpl_comm_fork_nb(dnode, dsubloc, fn, args, args_size);
        }
      } else {
        // move to a different sublocale
        chpl_task_setSubloc(dsubloc);
        if useBegin {
          chpl_executeOnNBAux(fn, args);
        } else {
          if __primitive("task_get_serial") then
            chpl_ftable_call(fn, args);
          else
            // begin chpl_ftable_call(fn, args);
            chpl_comm_fork_nb(dnode, dsubloc, fn, args, args_size);
        }
        chpl_task_setSubloc(origSubloc);
      }
    }
  }

  //////////////////////////////////////////
  //
  // support for tasking statements: begin, cobegin, coforall
  //

  //
  // runtime interface
  //
  pragma "insert line file info"
  extern proc chpl_task_addToTaskList(fn: int, args: c_void_ptr, subloc_id: int,
                                      ref tlist: _task_list, tlist_node_id: int,
                                      is_begin: bool);
  extern proc chpl_task_processTaskList(tlist: _task_list);
  extern proc chpl_task_executeTasksInList(tlist: _task_list);
  extern proc chpl_task_freeTaskList(tlist: _task_list);

  //
  // add a task to a list of tasks being built for a begin statement
  //
  pragma "insert line file info"
  export
  proc chpl_taskListAddBegin(subloc_id: int,        // target sublocale
                             fn: int,               // task body function idx
                             args: c_void_ptr,      // function args
                             ref tlist: _task_list, // task list
                             tlist_node_id: int     // task list owner node
                            ) {
    chpl_task_addToTaskList(fn, args, subloc_id, tlist, tlist_node_id, true);
  }

  //
  // add a task to a list of tasks being built for a cobegin or coforall
  // statement
  //
  pragma "insert line file info"
  export
  proc chpl_taskListAddCoStmt(subloc_id: int,        // target sublocale
                              fn: int,               // task body function idx
                              args: c_void_ptr,      // function args
                              ref tlist: _task_list, // task list
                              tlist_node_id: int     // task list owner node
                             ) {
    chpl_task_addToTaskList(fn, args, subloc_id, tlist, tlist_node_id, false);
  }

  //
  // make sure all tasks in a list are known to the tasking layer
  //
  pragma "insert line file info"
  export
  proc chpl_taskListProcess(task_list: _task_list) {
    chpl_task_processTaskList(task_list);
  }

  //
  // make sure all tasks in a list have an opportunity to run
  //
  pragma "insert line file info"
  export
  proc chpl_taskListExecute(task_list: _task_list) {
    chpl_task_executeTasksInList(task_list);
  }

  //
  // do final cleanup for a task list
  //
  pragma "insert line file info"
  export
  proc chpl_taskListFree(task_list: _task_list) {
    chpl_task_freeTaskList(task_list);
  }
}

// LocaleModel.chpl
//
// This provides a flat locale model architectural description.  The
// locales contain memory and a multi-core processor with homogeneous
// cores, and we ignore any affinity (NUMA effects) between the
// processor cores and the memory.  This architectural description is
// backward compatible with the architecture implicitly provided by
// releases 1.6 and preceding.
//
pragma "no use ChapelStandard"
module LocaleModel {

  // This should eventually be unified with
  // CHPL_LOCALE_MODEL_NUM_SUBLOCALES which is currently defined in the
  // runtime for any locale model that doesn't use sub locales
  param localeModelHasSublocales = true;

  use ChapelLocale;
  use DefaultRectangular;
  use ChapelNumLocales;
  use Sys;

  extern proc chpl_task_getRequestedSubloc(): int(32);

  config param debugLocaleModel = false;

  // We would really like a class-static storage class.(C++ nomenclature)
  var doneCreatingLocales: bool = false;

  // The chpl_localeID_t type is used internally.  It should not be exposed to
  // the user.  The runtime defines the actual type, as well as a functional
  // interface for assembling and disassembling chpl_localeID_t values.  This
  // module then provides the interface the compiler-emitted code uses to do
  // the same.

  type chpl_nodeID_t = int(32);
  type chpl_sublocID_t = int(32);

  extern record chpl_localeID_t {
    // We need to know that this is a record type in order to pass it to and
    // return it from runtime functions properly, but we don't need or want
    // to see its contents.
  };

  // We need an explicit copy constructor because the compiler cannot create
  // a correct one for a record type whose members are not known to it.
  pragma "init copy fn"
  extern chpl__initCopy_chpl_rt_localeID_t
  proc chpl__initCopy(initial: chpl_localeID_t): chpl_localeID_t;

  extern var chpl_nodeID: chpl_nodeID_t;

  // Runtime interface for manipulating global locale IDs.
  extern
    proc chpl_rt_buildLocaleID(node: chpl_nodeID_t,
                               subloc: chpl_sublocID_t): chpl_localeID_t;

  extern
    proc chpl_rt_nodeFromLocaleID(loc: chpl_localeID_t): chpl_nodeID_t;

  extern
    proc chpl_rt_sublocFromLocaleID(loc: chpl_localeID_t): chpl_sublocID_t;

  // Compiler (and module code) interface for manipulating global locale IDs..
  pragma "insert line file info"
  proc chpl_buildLocaleID(node: chpl_nodeID_t, subloc: chpl_sublocID_t)
    return chpl_rt_buildLocaleID(node, subloc);

  pragma "insert line file info"
  proc chpl_nodeFromLocaleID(loc: chpl_localeID_t)
    return chpl_rt_nodeFromLocaleID(loc);

  pragma "insert line file info"
  proc chpl_sublocFromLocaleID(loc: chpl_localeID_t)
    return chpl_rt_sublocFromLocaleID(loc);

  //
  // The NUMA sublocale model
  //
  class NumaDomain : AbstractLocaleModel {
    const sid: chpl_sublocID_t;
    const name: string;

    proc chpl_id() return (parent:LocaleModel)._node_id; // top-level node id
    proc chpl_localeid() {
      return chpl_buildLocaleID((parent:LocaleModel)._node_id:chpl_nodeID_t,
                                sid);
    }
    proc chpl_name() return name;

    proc NumaDomain() {
    }

    proc NumaDomain(_sid, _parent) {
      sid = _sid;
      name = "ND"+sid;
      parent = _parent;
    }

    proc readWriteThis(f) {
      parent.readWriteThis(f);
      f <~> '.'+name;
    }

    proc getChildCount(): int { return 0; }
    iter getChildIndices() : int {
      halt("No children to iterate over.");
      yield -1;
    }
    proc addChild(loc:locale) { halt("Cannot add children to this locale type."); }
    proc getChild(idx:int) : locale { return nil; }

    // This is commented out b/c it leads to an internal error during
    // the resolveIntents pass.  See
    // test/functions/iterators/sungeun/iterInClass.future
    //
    // iter getChildren() : locale {
    //  halt("No children to iterate over.");
    //  yield nil;
    // }
  }

  //
  // The node model
  //
  class LocaleModel : AbstractLocaleModel {
    const callStackSize: int;
    const _node_id : int;
    const local_name : string;

    const numSublocales: int;
    var childSpace: domain(1);
    var childLocales: [childSpace] NumaDomain;

    // This constructor must be invoked "on" the node
    // that it is intended to represent.  This trick is used
    // to establish the equivalence the "locale" field of the locale object
    // and the node ID portion of any wide pointer referring to it.
    proc LocaleModel() {
      if doneCreatingLocales {
        halt("Cannot create additional LocaleModel instances");
      }
      init();
    }

    proc LocaleModel(parent_loc : locale) {
      if doneCreatingLocales {
        halt("Cannot create additional LocaleModel instances");
      }
      parent = parent_loc;
      init();
    }

    proc chpl_id() return _node_id;     // top-level locale (node) number
    proc chpl_localeid() {
      extern const c_sublocid_any: chpl_sublocID_t;
      return chpl_buildLocaleID(_node_id:chpl_nodeID_t, c_sublocid_any);
    }
    proc chpl_name() return local_name;

    proc readWriteThis(f) {
      // Most classes will define it like this:
//      f <~> name;
      // but here it is defined thus for backward compatibility.
      f <~> new ioLiteral("LOCALE") <~> _node_id;
    }

    proc getChildSpace() return childSpace;

    proc getChildCount() return numSublocales;

    iter getChildIndices() : int {
      for idx in childSpace do
        yield idx;
    }

    proc getChild(idx:int) : locale {
      if boundsChecking then
        if (idx < 0) || (idx >= numSublocales) then
          halt("sublocale child index out of bounds (",idx,")");
      return childLocales[idx];
    }

    iter getChildren() : locale  {
      for loc in childLocales do
        yield loc;
    }

    proc getChildArray() {
      return childLocales;
    }

    //------------------------------------------------------------------------{
    //- Implementation (private)
    //-
    proc init() {
      _node_id = chpl_nodeID: int;

      // chpl_nodeName is defined in chplsys.c.
      // It supplies a node name obtained by running uname(3) on the
      // current node.  For this reason (as well), the constructor (or
      // at least this init method) must be run on the node it is
      // intended to describe.
      var comm, spawnfn : string;
      extern proc chpl_nodeName() : string;
      // sys_getenv returns zero on success.
      if sys_getenv("CHPL_COMM", comm) == 0 && comm == "gasnet" &&
        sys_getenv("GASNET_SPAWNFN", spawnfn) == 0 && spawnfn == "L"
      then local_name = chpl_nodeName() + "-" + _node_id : string;
      else local_name = chpl_nodeName();

      extern proc chpl_task_getCallStackSize(): int;
      callStackSize = chpl_task_getCallStackSize();

      extern proc chpl_numCoresOnThisLocale(): int;
      numCores = chpl_numCoresOnThisLocale();

      extern proc chpl_task_getNumSublocales(): int(32);
      numSublocales = chpl_task_getNumSublocales();

      if numSublocales >= 1 {
        childSpace = {0..#numSublocales};
        const numCoresPerNumaDomain = numCores/numSublocales;
        const origSubloc = chpl_task_getRequestedSubloc(); // this should be any
        for i in childSpace {
          // allocate the structure on the domain?
          // MUST CHANGE SUBLOC HERE (prolly by primitive)
          chpl_task_setSubloc(i:chpl_sublocID_t);
          childLocales[i] = new NumaDomain(i:chpl_sublocID_t, this);
          childLocales[i].numCores = numCoresPerNumaDomain;
        }
        chpl_task_setSubloc(origSubloc);
      }
    }
    //------------------------------------------------------------------------}

    inline proc subloc return c_sublocid_any;
 }

  //
  // An instance of this class is the default contents 'rootLocale'.
  //
  // In the current implementation a platform-specific architectural description
  // may overwrite this instance or any of its children to establish a more customized
  // representation of the system resources.
  //
  class RootLocale : AbstractRootLocale {

    // Would like to make myLocaleSpace distributed with one index per node.
    const myLocaleSpace: domain(1) = {0..numLocales-1};
    const myLocales: [myLocaleSpace] locale;

    proc RootLocale() {
      parent = nil;
      numCores = 0;
    }

    // The init() function must use initOnLocales() to iterate (in
    // parallel) over the locales to set up the LocaleModel object.
    // In addition, the initial 'here' must be set.
    proc init() {
      forall locIdx in initOnLocales() {
        chpl_task_setSubloc(c_sublocid_any);
        const node = new LocaleModel(this);
        myLocales[locIdx] = node;
        numCores += node.numCores;
      }
    }

    // Has to be globally unique and not equal to a node ID.
    // We return numLocales for now, since we expect nodes to be
    // numbered less than this.
    // -1 is used in the abstract locale class to specify an invalid node ID.
    proc chpl_id() return numLocales;
    proc chpl_localeid() {
      extern const c_sublocid_any: chpl_sublocID_t;
      return chpl_buildLocaleID(numLocales:chpl_nodeID_t, c_sublocid_any);
    }
    proc chpl_name() return local_name();
    proc local_name() return "rootLocale";

    proc readWriteThis(f) {
      f <~> name;
    }

    proc getChildCount() return this.myLocaleSpace.numIndices;

    proc getChildSpace() return this.myLocaleSpace;

    iter getChildIndices() : int {
      for idx in this.myLocaleSpace do
        yield idx;
    }

    proc getChild(idx:int) return this.myLocales[idx];

    iter getChlidren() : locale  {
      for loc in this.myLocales do
        yield loc;
    }

    proc getDefaultLocaleSpace() return this.myLocaleSpace;
    proc getDefaultLocaleArray() return myLocales;

    proc localeIDtoLocale(id : chpl_localeID_t) {
      const dnode = chpl_nodeFromLocaleID(id);
      const dsubloc = chpl_sublocFromLocaleID(id);
      if (dsubloc == c_sublocid_curr) || (dsubloc == c_sublocid_any) then
        return (myLocales[dnode:int]):locale;
      else
        return (myLocales[dnode:int].getChild(dsubloc:int)):locale;
    }
  }

  //////////////////////////////////////////
  //
  // support for memory management
  //

  // The allocator pragma is used by scalar replacement.
  pragma "allocator"
  pragma "no sync demotion"
  pragma "locale model alloc"
  proc chpl_here_alloc(size:int, md:int(16)) {
    pragma "insert line file info"
      extern proc chpl_mem_alloc(size:int, md:int(16)) : opaque;
    return chpl_mem_alloc(size, md + chpl_memhook_md_num());
  }

  pragma "allocator"
  pragma "no sync demotion"
  proc chpl_here_calloc(size:int, number:int, md:int(16)) {
    pragma "insert line file info"
      extern proc chpl_mem_calloc(number:int, size:int, md:int(16)) : opaque;
    return chpl_mem_calloc(number, size, md + chpl_memhook_md_num());
  }

  pragma "allocator"
  pragma "no sync demotion"
  proc chpl_here_realloc(ptr:opaque, size:int, md:int(16)) {
    pragma "insert line file info"
      extern proc chpl_mem_realloc(ptr:opaque, size:int, md:int(16)) : opaque;
    return chpl_mem_realloc(ptr, size, md + chpl_memhook_md_num());
  }

  pragma "no sync demotion"
  pragma "locale model free"
  proc chpl_here_free(ptr:opaque) {
    pragma "insert line file info"
      extern proc chpl_mem_free(ptr:opaque): void;
    chpl_mem_free(ptr);
  }

  //////////////////////////////////////////
  //
  // support for "on" statements
  //

  //
  // runtime interface
  //
  extern proc chpl_comm_fork(loc_id: int, subloc_id: int,
                             fn: int, args: c_void_ptr, arg_size: int(32));
  extern proc chpl_comm_fork_fast(loc_id: int, subloc_id: int,
                                  fn: int, args: c_void_ptr, args_size: int(32));
  extern proc chpl_comm_fork_nb(loc_id: int, subloc_id: int,
                                fn: int, args: c_void_ptr, args_size: int(32));
  extern proc chpl_ftable_call(fn: int, args: c_void_ptr): void;
  extern proc chpl_task_setSubloc(subloc: int(32));
  extern const c_sublocid_any: chpl_sublocID_t;
  extern const c_sublocid_curr: chpl_sublocID_t;

  //
  // regular "on"
  //
  pragma "insert line file info"
  export
  proc chpl_executeOn(loc: chpl_localeID_t, // target locale
                      fn: int,              // on-body function idx
                      args: c_void_ptr,     // function args
                      args_size: int(32)    // args size
                     ) {
    const dnode =  chpl_nodeFromLocaleID(loc);
    const dsubloc =  chpl_sublocFromLocaleID(loc);
    if dnode != chpl_nodeID {
      chpl_comm_fork(dnode, dsubloc, fn, args, args_size);
    } else {
      // run directly on this node
      var origSubloc = chpl_task_getRequestedSubloc();
      if (dsubloc == origSubloc) {
        chpl_ftable_call(fn, args);
      } else {
        // move to a different sublocale
        chpl_task_setSubloc(dsubloc);
        chpl_ftable_call(fn, args);
        chpl_task_setSubloc(origSubloc);
      }
    }
  }

  //
  // fast "on" (doesn't do anything that could deadlock a comm layer,
  // in the Active Messages sense)
  //
  pragma "insert line file info"
  export
  proc chpl_executeOnFast(loc: chpl_localeID_t, // target locale
                          fn: int,              // on-body function idx
                          args: c_void_ptr,     // function args
                          args_size: int(32)    // args size
                         ) {
    const dnode =  chpl_nodeFromLocaleID(loc);
    const dsubloc =  chpl_sublocFromLocaleID(loc);
    if dnode != chpl_nodeID {
      chpl_comm_fork_fast(dnode, dsubloc, fn, args, args_size);
    } else {
      var origSubloc = chpl_task_getRequestedSubloc();
      if (dsubloc == origSubloc) {
        chpl_ftable_call(fn, args);
      } else {
        // move to a different sublocale
        chpl_task_setSubloc(dsubloc);
        chpl_ftable_call(fn, args);
        chpl_task_setSubloc(origSubloc);
      }
    }
  }

  // Unused for now due to bug in non-developer mode when using 'begin'
  inline proc chpl_executeOnNBAux(fn: int,         // on-body function idx
                                  args: c_void_ptr // function args
                                  ) {
    if __primitive("task_get_serial") then
      chpl_ftable_call(fn, args);
    else
      begin chpl_ftable_call(fn, args);
  }
  //
  // nonblocking "on" (doesn't wait for completion)
  //
  pragma "insert line file info"
  export
  proc chpl_executeOnNB(loc: chpl_localeID_t, // target locale
                        fn: int,              // on-body function idx
                        args: c_void_ptr,     // function args
                        args_size: int(32)    // args size
                       ) {
    //
    // If we're in serial mode, we should use blocking rather than
    // non-blocking "on" in order to serialize the forks.
    //
    const dnode =  chpl_nodeFromLocaleID(loc);
    const dsubloc =  chpl_sublocFromLocaleID(loc);
    if dnode != chpl_nodeID {
      if __primitive("task_get_serial") then
        chpl_comm_fork(dnode, dsubloc, fn, args, args_size);
      else
        chpl_comm_fork_nb(dnode, dsubloc, fn, args, args_size);
    } else {
      var origSubloc = chpl_task_getRequestedSubloc();
      // We'd like to call chpl_executeOnNBaux() here, but the begin
      //  statement seems to cause a problem
      if (dsubloc == origSubloc) {
        // run on this sublocale
        if false {
          chpl_executeOnNBAux(fn, args);
        } else {
          if __primitive("task_get_serial") then
            chpl_ftable_call(fn, args);
          else
            // begin chpl_ftable_call(fn, args);
            chpl_comm_fork_nb(dnode, dsubloc, fn, args, args_size);
        }
      } else {
        // move to a different sublocale
        chpl_task_setSubloc(dsubloc);
        if false {
          chpl_executeOnNBAux(fn, args);
        } else {
          if __primitive("task_get_serial") then
            chpl_ftable_call(fn, args);
          else
            // begin chpl_ftable_call(fn, args);
            chpl_comm_fork_nb(dnode, dsubloc, fn, args, args_size);
        }
        chpl_task_setSubloc(origSubloc);
      }
    }
  }

  //////////////////////////////////////////
  //
  // support for tasking statements: begin, cobegin, coforall
  //

  //
  // runtime interface
  //
  pragma "insert line file info"
  extern proc chpl_task_addToTaskList(fn: int, args: c_void_ptr, subloc_id: int,
                                      ref tlist: _task_list, tlist_node_id: int,
                                      is_begin: bool);
  extern proc chpl_task_processTaskList(tlist: _task_list);
  extern proc chpl_task_executeTasksInList(tlist: _task_list);
  extern proc chpl_task_freeTaskList(tlist: _task_list);

  //
  // add a task to a list of tasks being built for a begin statement
  //
  pragma "insert line file info"
  export
  proc chpl_taskListAddBegin(subloc_id: int,        // target sublocale
                             fn: int,               // task body function idx
                             args: c_void_ptr,      // function args
                             ref tlist: _task_list, // task list
                             tlist_node_id: int     // task list owner node
                            ) {
    chpl_task_addToTaskList(fn, args, subloc_id, tlist, tlist_node_id, true);
  }

  //
  // add a task to a list of tasks being built for a cobegin or coforall
  // statement
  //
  pragma "insert line file info"
  export
  proc chpl_taskListAddCoStmt(subloc_id: int,        // target sublocale
                              fn: int,               // task body function idx
                              args: c_void_ptr,      // function args
                              ref tlist: _task_list, // task list
                              tlist_node_id: int     // task list owner node
                             ) {
    chpl_task_addToTaskList(fn, args, subloc_id, tlist, tlist_node_id, false);
  }

  //
  // make sure all tasks in a list are known to the tasking layer
  //
  pragma "insert line file info"
  export
  proc chpl_taskListProcess(task_list: _task_list) {
    chpl_task_processTaskList(task_list);
  }

  //
  // make sure all tasks in a list have an opportunity to run
  //
  pragma "insert line file info"
  export
  proc chpl_taskListExecute(task_list: _task_list) {
    chpl_task_executeTasksInList(task_list);
  }

  //
  // do final cleanup for a task list
  //
  pragma "insert line file info"
  export
  proc chpl_taskListFree(task_list: _task_list) {
    chpl_task_freeTaskList(task_list);
  }
}


parallelizing communication

parallelizing communication

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

use Time;
use thermo;
use MDForce;
use BlockDist;

// used in testing system
config param printOriginal = false;
config param printPerf = true;
config param printCorrect = false;

// Stores user-configurable variables
// See printHelp for more information
config var input_file = "in.lj.miniMD";
config var numSteps = 100;
config var size = 32;
config var neigh_bins = -1;
config var units = "lj";
config var force = "lj";
config var data_file = "";
config var yaml_output = 1;
config var yaml_screen = false;

// user/dev utilities
config const debug = false;
config const pHelp = false;

// 3D vector type alias
type v3 = 3*real;
type v3int = 3*int;

// system variables from input files
var problemSize : v3 = (size:real,size:real,size:real);
var initialTemp = 1.44;
var density = .8442;
var dt = .005;
var dtforce = .0025;
var force_cut = 2.5;
var cutneigh = 2.8;
var neigh_every = 20;
var thermoEvery = 100;

// Used in deterministic 'random' number generator
// Based on Park-Miller
const IA = 16807;
const IM = 2147483647;
const AM = 1.0/IM;
const IQ = 127773;
const IR = 2836;
const MASK = 123459876;

// Dot product between two vectors
inline proc dot(a,b : v3) {
  var c = a * b;
  return c(1) + c(2) + c(3);
}

inline proc dot(a,b : v3int) {
  var c = a*b;
  return c(1) + c(2) + c(3);
}

record atom {
  // velocity, force
  var v, f : v3;

  // define storage for neighbor list, which stores the bin and index
  // of a neighboring atom
  var nspace : domain(1) = {1..100};
  var neighs : [nspace] (v3int,int);
  var ncount : int = 0;
}

// dimensions of simulation space
var box : v3;
var volume : real;
var boxlo, boxhi : v3;

// atom storage
var numAtoms : int;

// default mass
var mass : real = 1.0;

// number of bins that define our piece of the continguous space
var numBins : v3int;

// constants from c++ version, used in neighboring
const small = 1.0e-6;
const factor = .999;

// time for binAtoms and buildNeighbors
var buildTime : real;

// time for force computation (inside integration)
var forceTime : real;

// Time for communication
//
// Since chapel abstracts much of this away, sometimes we do communication
// without knowing (or caring). This value may not be completely accurate,
// but should reflect the bulk of communication that occurs.
var commTime : real;

// will halt if true
if pHelp then printHelp();

// entry point - read configuration file if one exists
inputFile();
dtforce = .5 * dt;

// generate our own atoms, or read from a data file?
const generating = data_file == "" || data_file == "none";

const cutneighsq = cutneigh * cutneigh;

// io for reading the data file
var dataFile : file;
var dataReader : channel(false, iokind.dynamic,false);

// no data file, use input file to generate uniform lattice
if generating {
  const lattice : real = (4.0 / density) ** (1.0 / 3.0);
  box = problemSize * (lattice,lattice,lattice);
  volume = box(1) * box(2) * box(3);

  boxhi = box;
  numAtoms = (4 * problemSize(1) * problemSize(2) * problemSize(3)) : int;

  for i in 1..3 do
    numBins(i) = (5.0/6.0 * problemSize(i)) : int;
} else {
  dataFile = open(data_file, iomode.r);
  dataReader = dataFile.reader();

  dataReader.readln(); // skip first line

  // we can only have 1 atom type
  var types = dataReader.readln(int);
  assert(types == 1, "You can only have one type of atom.");

  // sim dimensions
  for i in 1..3 do
    (boxlo(i), boxhi(i)) = dataReader.readln(real,real);
  box = boxhi - boxlo;
  volume = box(1) * box(2) * box(3);

  const masses = dataReader.readln(string);
  assert(masses == "Masses");
  var (mass_type, mass) = dataReader.readln(int,real);

  // density overriden if data file provided
  density = numAtoms / (volume);
  const nbs : real = (density * 16) ** (1.0/3.0 : real);
  for i in 1..3 do
    numBins(i) = (box(i) / nbs) : int;
}

initThermo();

// user-defined
if neigh_bins > 0 {
  numBins = (neigh_bins,neigh_bins,neigh_bins);
}

// physical size of a bin
const binsize = box / numBins;

// 1/binsize
const bininv = (1.0,1.0,1.0) / binsize;

// number of bins we need for neighboring
var numNeed : v3int;
for i in 1..3 {
  numNeed(i) = (cutneigh * bininv(i)) : int;
  if numNeed(i) * binsize(i) < factor * cutneigh then numNeed(i) += 1;
}

// stencil that defines our bin neighbor offsets
// for example, (0,1,0) will represent the bin above us
const stencil = {-numNeed(1) .. numNeed(1),
                  -numNeed(2) .. numNeed(2),
                  -numNeed(3) .. numNeed(3)};

// Defines the problem space
const binSpace = {1..numBins(1), 1..numBins(2), 1..numBins(3)};

// The 'special sauce'. Will distribute stuff across locales
const DistSpace = binSpace dmapped Block(binSpace);

// bin storage. we can likely assume that each bin will store
// about the same number of atoms
//
// TODO: can we deal with this on a per-locale basis? How do we deal with
// the case of not enough space when copying inside communication?
var perBinSpace : domain(1) = {1..8};

// locale's chunk of 'bins' (consists of whole bins)
class Chunk {
  var Fluff : domain(3);                          // real and ghost bins
  var Real : domain(3);                           // real bins
  var NeighDom : domain(3);                       // nearest neighbors
  var Bins : [Real] [perBinSpace] atom;           // bin and atom storage
  var Pos : [Fluff] [perBinSpace] v3;
  var Count : [Fluff] int(32);                    // # of actual atoms in a bin
  var DestSlice, SrcSlice : [NeighDom] domain(3); // local/remote ghost slices
  var Neighs : [NeighDom] (int,int,int);          // array of locale indices
  var PosOffset : [NeighDom] v3;
}

// This breaks the abstraction layer a bit. hopefully we can push this into a
// Chapel distribution at some point.
//
// LocaleGridDom is a set of indices that map into LocaleGrid, which
// contains 'locale' objects with which we can use the 'on' statement
// for actual distribution. These values are automatically calculated
// by the Block distribution, and it was simplest to re-use them in our
// code.
//
// TODO: Discuss implementing an interface for grabbing such useful values.
const LocaleGridDom = DistSpace._value.dist.targetLocDom;
const LocaleGrid = DistSpace._value.dist.targetLocales;

// storage across all locales
var Grid : [LocaleGridDom] Chunk;

// map of bin (3*int) to LocaleGridDom index (3*int)
var BinToLocale : [DistSpace] (int,int,int);

setupComms();

var fobj : Force;

if force == "lj" {
  fobj = new ForceLJ(force_cut);
} else {
  fobj = new ForceEAM(force_cut);
  mass = fobj.mass;
}

if printOriginal then writeln("# Create System:");

// if there's no data file to read from, generate a lattice of atoms
if generating {
  create_atoms();
  create_velocity();
} else {
  dataReader.readln(); // skip 'Atoms' line

  // read in positions
  var tempPos : [1..numAtoms] v3;
  for x in tempPos {
    dataReader.read(int,int);
    dataReader.readln(x(1),x(2),x(3));
  }

  // read velocities and add
  for x in tempPos {
    var v : v3;
    dataReader.read(int,int);
    dataReader.readln(v(1),v(2),v(3));
    addatom(new atom(v), x, coord2bin(x));
  }

  // cleanup
  dataReader.close();
  dataFile.close();
}

// setup/store slices and neighbors so we don't have to recompute them every
// time. Our neighbor bins won't change, and we'll always need the same slices.
proc setupComms() {
  coforall ijk in LocaleGridDom {
    on LocaleGrid[ijk] {
      // grab our chunk of the real domain
      const MyLocDom = DistSpace._value.locDoms[ijk].myBlock;
      if debug then writeln(here, " owns ", MyLocDom);

      // expand the maximum distance we might need
      const WithFluff = MyLocDom.expand(numNeed);
      if debug then writeln(here, "'s fluff: ", WithFluff);

      // directions of our nearest neighboring locales
      const NeighDom = {-1..1, -1..1, -1..1};

      var MyChunk = new Chunk(Fluff=WithFluff, Real=MyLocDom, NeighDom=NeighDom);
      Grid[ijk] = MyChunk;

      // alias to save typing
      var DestSlice => MyChunk.DestSlice;
      var SrcSlice => MyChunk.SrcSlice;
      var Neighs => MyChunk.Neighs;

      // Create 3D slices representing an overlap
      forall (Src, Dest, neigh) in zip(SrcSlice, DestSlice, NeighDom) {
        // the number of bins (numNeed) we need in a direction (neigh)
        Dest = MyLocDom.exterior(neigh * numNeed);

        // in the case of many locales, most of the time source and destination
        // will share the same indices. The wrapping case is handled soon.
        Src = Dest;
      }

      // use so we can move atoms around more easily
      BinToLocale[MyLocDom] = ijk;

      // adjust our remote-translated slices and neighbor pointer
      // store for future use
      forall (Src, Dest, PosOffset, neigh) in
        zip(SrcSlice, DestSlice, MyChunk.PosOffset, NeighDom) {
        // no comms with ourself, can't 'continue' inside a forall
        if neigh != (0,0,0) {
          // Get the index of the neighboring Locale
          var neighbor = ijk + neigh;

          // some of our slices will overlap with 'real' cells, but slices
          // on the exterior will need their cells to be offset so we can index
          // into the neighboring locale's bins.
          var SrcOffset = (0,0,0);

          // Adjust the neighbor index so we're actually referencing an
          // existing locale. Also compute the offset for source slices,
          // if necessary.
          for i in 1..3 {
            if neighbor(i) < 0 {
              neighbor(i) = LocaleGridDom.high(i);
              SrcOffset(i) = binSpace.high(i) - Dest.high(i);
            }
            else if neighbor(i) > LocaleGridDom.high(i) {
              neighbor(i) = 0;
              SrcOffset(i) = -binSpace.high(i) + binSpace.low(i) - 1;
            }
          }
          Src = Src.translate(SrcOffset);
          Neighs[neigh] = neighbor;

          var mask = (1.0,1.0,1.0);
          for i in 1..3 do
            if Dest.low(i) == Src.low(i) then mask(i) = 0.0;

          // ghost's position offset
          PosOffset = (neigh) * box * mask;

          if debug
            then writeln(Src, " is the remote neighbor of ", Dest);
          }
      }
    } // end of on statement
  } // end of coforall
}

// Reads an input file
proc inputFile() {
  var err : syserr;
  var fchan = open(err, input_file, iomode.r);

  if err then {
    input_file = "none";
    return;
  }

  var r = fchan.reader();

  // skip first line
  r.readln();

  // get unit type ('lj' vs 'metal')
  units = r.readln(string);

  // use data file?
  data_file = r.readln(string);

  // get force type : 'lj' vs 'eam'
  force = r.readln(string);

  // 'size of problem'
  problemSize = r.readln(int,int,int);

  // # iterations
  numSteps = r.readln(int);

  // simulated time step size
  dt = r.readln(real);

  // starting temperature
  initialTemp = r.readln(real);

  // start density (overriden if data file), used in EAM
  density = r.readln(real);

  // recompute neighbors every N iterations
  neigh_every = r.readln(int);

  // force cutoff: used to determine significance of force computation
  // neighbor cutoff: used to determine if a nearby atom may be significant
  (force_cut,cutneigh) = r.readln(real, real);

  // do thermo compute every N iterations
  thermoEvery = r.readln(int);

  // cutneigh = skin + force_cutoff, used in neighboring algorithm
  cutneigh += force_cut;

  // cleanup
  r.close();
  fchan.close();
}

proc printHelp() {
  writeln("Commandline Options:");
  writeln("\n  Chapel help:");
  writeln("\t--chapel:                Show Chapel's command line options");
  writeln("\n  Execution configuration:");
  writeln("\n  Simulation setup:");
  writeln("\t--input_file <string>:   set input file to be used (default: in.lj.miniMD)");
  writeln("\t--numSteps <int>:        set number of timesteps for simulation");
  writeln("\t--size <int>:            set linear dimension of systembox");
  writeln("\t--neigh_bins <int>:      set linear dimension of neighbor bin grid");
  writeln("\t--units <string>:        set units (lj or metal), see LAMMPS documentation");
  writeln("\t--force <string>:        set interaction model (lj or eam)");
  writeln("\t--data_file <string>:    read configuration from LAMMPS data file");
  writeln("\n  Miscelaneous:");
  writeln("\t                                within rcut_neighbor (outer force cutoff)");
  writeln("\t--yaml_output <int>:     level of yaml output (default 1)");
  writeln("\t--yaml_screen:                write yaml output also to screen");
  writeln("\t--pHelp:                  display this help message");
  writeln("\t--------------------------------------------------");
  exit(0);
}

// Print simulation settings
proc printSim() {
  if !printOriginal then return;
  writeln("# Done .... ");
  writeln("# miniMD-Reference 0.1 (Chapel) output ...");
  writeln("# Systemparameters: ");
  writeln("\t# input_file: ", input_file);
  if data_file != "" then
    writeln("\t# datafile: ", data_file);
  else
    writeln("\t# datafile: none");
  writeln("\t# force: ", force);
  write("\t# units: ");
  if units == "metal" then writeln("METAL");
  else writeln("LJ");
  writeln("\t# atoms: ", numAtoms);
  write("\t# System size: ");
  writef("%.2dr %.2dr %.2dr (unit cells: %i %i %i)\n",
      box(1), box(2), box(3), problemSize(1), problemSize(2), problemSize(3));
  writef("\t%# density: %.6dr\n", density);
  writef("\t%# Force cutoff: %.6dr\n", force_cut);
  writef("\t%# neigh cutoff: %.6dr\n", cutneigh);
  writeln("\t# Neighbor bins: ", numBins(1), " ", numBins(2), " ", numBins(3));
  writeln("\t# neighbor frequency ", neigh_every);
  writef("\t%# timestep size: %.6dr\n", dt );
  writeln("\t# thermo frequency: ", thermoEvery);
}

proc create_atoms() {
  const lattice : real = (4.0 / density) ** (1.0 / 3.0);

  var lo, hi : v3int;

  for i in 1..3 {
    lo(i) = (boxlo(i) / (.5 * lattice)) : int;
    hi(i) = (boxhi(i) / (.5 * lattice)) : int;
  }

  for i in 1..3 {
    lo(i) = max(lo(i), 0);
    hi(i) = min(hi(i), 2 * problemSize(i) - 1) : int;
  }

  var temp, v : v3;
  var s, o : v3int;
  var m, n : int;
  var curCoord : v3int;
  var subboxdim = 8;
  var flag = false;

  while o(3) * subboxdim <= hi(3) {
    curCoord = (o * (subboxdim,subboxdim,subboxdim) + s);

    if flag then continue;

    var withinBounds = true;
    for i in 1..3 {
      withinBounds = withinBounds && curCoord(i) >= lo(i) && curCoord(i) <= hi(i);
    }

    if ((curCoord(1) + curCoord(2) + curCoord(3)) % 2 == 0) && withinBounds {
      for i in 1..3 do
        temp(i) = .5 * lattice * curCoord(i);

      withinBounds = true;
      for i in 1..3 {
        withinBounds = withinBounds && temp(i) >= boxlo(i) && temp(i) < boxhi(i);
      }

      if withinBounds {
        n = (curCoord(3) * (2 * problemSize(2)) * (2*problemSize(1)) + curCoord(2) * (2 * problemSize(1)) + curCoord(1) + 1) : int;
        for i in 1..3 {
          for m in 1..5 { pmrand(n); }
          v(i) = pmrand(n);
        }
        addatom(new atom(v), temp, coord2bin(temp));
      }
    }

    s(1) += 1;

    if s(1) == subboxdim {
      s(1) = 0;
      s(2) += 1;
    }

    if s(2) == subboxdim {
      s(2) = 0;
      s(3) += 1;
    }

    if s(3) == subboxdim {
      s(3) = 0;
      o(1) += 1;
    }

    if o(1) * subboxdim > hi(1) {
      o(1) = 0;
      o(2) += 1;
    }

    if o(2) * subboxdim > hi(2) {
      o(2) = 0;
      o(3) += 1;
    }
  }
}

proc create_velocity() {
  var vtot : v3;

  // find the total velocity
  var vtotDist : [LocaleGridDom] v3;
  coforall (ijk) in LocaleGridDom {
    on LocaleGrid[ijk] {
      const Me = Grid[ijk];
      vtotDist[ijk] = + reduce forall bin in Me.Real do
      + reduce forall ind in 1..Me.Count[bin] do Me.Bins[bin][ind].v;
    }
  }
  vtot = + reduce vtotDist;

  // get the average
  vtot /= (numAtoms,numAtoms,numAtoms);

  // adjust using average
  coforall (ijk) in LocaleGridDom {
    on LocaleGrid[ijk] {
      const Me = Grid[ijk];
      forall (bin,c) in zip(Me.Bins[Me.Real], Me.Count[Me.Real]) {
        for a in bin[1..c] {
          a.v -= vtot;
        }
      }
    }
  }

  const factor = sqrt(initialTemp / temperature());

  coforall (ijk) in LocaleGridDom {
    on LocaleGrid[ijk] {
      const fac = (factor,factor,factor);
      const Me = Grid[ijk];
      forall (bin,c) in zip(Me.Bins[Me.Real], Me.Count[Me.Real]) {
        for a in bin[1..c] {
          a.v *= fac;
        }
      }
    }
  }
}

// Park/Miller RNG w/out MASKING
proc pmrand(ref n : int) : real {
  var k : int;
  var ans : real;

  k = n / IQ;
  n = IA * (n - k * IQ) - IR * k;
  if n < 0 then n += IM;
  ans = AM * n;
  return ans;
}

proc updateFluff() {
  coforall ijk in LocaleGridDom {
    on LocaleGrid[ijk] {
      const Me = Grid[ijk];
      forall (Src, Dest, Neighbor, Offset, neigh) in
        zip(Me.SrcSlice, Me.DestSlice, Grid[Me.Neighs], Me.PosOffset, Me.NeighDom) {
        // don't look at ourself
        if neigh != (0,0,0) {
          // copy over the bins' counts
          Me.Count[Dest] = Neighbor.Count[Src];

          // copy over fluff atoms' positions
          Me.Pos[Dest] = Neighbor.Pos[Src];

          // offset atoms if necessary
          if Offset != (0.0,0.0,0.0) {
            forall p in Me.Pos[Dest] do p += Offset;
          }
        }
      }
    }
  }
}

// if atoms moved outside the box, wrap them around
proc pbc() {
  coforall ijk in LocaleGridDom {
    on LocaleGrid[ijk] {
      const Me = Grid[ijk];
      const b = box;
      forall (p,c) in zip(Me.Pos[Me.Real],Me.Count[Me.Real]) {
        for x in p[1..c] {
          for i in 1..3 {
            if x(i) < 0 then x(i) += b(i);
            else if x(i) >= b(i) then x(i) -= b(i);
          }
        }
      }
    }
  }
}

proc buildNeighbors() {
  if debug then writeln("starting to build...");

  var neighTimer : Timer;
  neighTimer.start();

  // enforce boundaries
  pbc();

  commTime += neighTimer.elapsed();
  neighTimer.stop();
  neighTimer.clear();
  neighTimer.start();

  // if any atoms moved outside a bin, relocate
  binAtoms();

  buildTime += neighTimer.elapsed();
  neighTimer.stop();
  neighTimer.clear();
  neighTimer.start();

  if debug then writeln("starting comms...");

  // grab ghost/overlapping atoms
  updateFluff();

  if debug then writeln("comms done...");

  commTime += neighTimer.elapsed();
  neighTimer.stop();
  neighTimer.clear();
  neighTimer.start();

  coforall ijk in LocaleGridDom {
    on LocaleGrid[ijk] {
      const Me = Grid[ijk];
      forall (bin,posBin,r,c) in zip(Me.Bins, Me.Pos[Me.Real],Me.Real, Me.Count[Me.Real]) {
        const existing = 1..c;
        for (a,pos,i) in zip(bin[existing],posBin[existing],existing) {
          // reset neighbor list
          a.ncount = 0;

          // for each surrounding bin
          for s in stencil {
            const o = r + s;
            const existing = 1..Me.Count[o];
            for (npos,x) in zip(Me.Pos[o][existing],existing) {
              // if we're looking at ourself
              if r == o && x == i then continue;

              // are we within range?
              const del = pos - npos;
              const rsq = dot(del,del);
              if rsq <= cutneighsq {
                a.ncount += 1;

                // resize neighbor list if necessary
                var h = a.nspace.high;
                while a.ncount > h {
                  h = ((a.nspace.high*1.2) : int);
                  a.nspace = {1..h};
                }

                // store atom's bin and index
                a.neighs[a.ncount] = (o,x);
              }
            }
          }
        }
      }
    }
  }

  buildTime += neighTimer.elapsed();

  if debug then writeln("building done...");
} // end of buildNeighbors

// add an atom 'a' to bin 'b'
// resize if necessary
inline proc addatom(a : atom, x : v3, b : v3int) {
  const Target = Grid[BinToLocale[b]];

  // increment bin's # of atoms
  Target.Count[b] += 1;
  const end = Target.Count[b];

  // resize bin storage if needed
  if end >= perBinSpace.high {
    var h = (perBinSpace.high * 1.5) : int;
    perBinSpace = {1..h};
  }

  // add to the end of the bin
  Target.Bins[b][end] = a;
  Target.Pos[b][end] = x;
}

// helper class for moving atoms around
class Mov {
  var Space : domain(1) = {1..50};
  var List : [Space] (atom, v3, v3int);
  var Count : int;
}

// TODO: reduce communication here
proc binAtoms() {
  var Moved : [LocaleGridDom] Mov;
  coforall ijk in LocaleGridDom {
    on LocaleGrid[ijk] {
      var ToMove = new Mov();
      Moved[ijk] = ToMove;
      const Me = Grid[ijk];
      for (bin, pos, r, c) in zip(Me.Bins, Me.Pos[Me.Real] ,Me.Real ,Me.Count[Me.Real]) {
        var cur = 1;

        // for each atom, check if moved
        // because we move from the end, this setup allows us to examine
        // the atom pulled from the end
        while(cur <= c) {
          const destBin = coord2bin(pos[cur]);

          // atom moved
          if destBin != r {
            ToMove.Count += 1;

            // resize storage as needed
            if ToMove.Count >= ToMove.Space.high then
              ToMove.Space = {1..ToMove.Space.high * 2};

            ToMove.List[ToMove.Count] = (bin[cur], pos[cur], destBin);

            // replace with atom at end of list, if one exists
            if cur < c {
              bin[cur] = bin[c];
              pos[cur] = pos[c];
            }

            // correct bin count
            c -= 1;
          } else cur += 1;
        }
      }
    }
  }

  // actually move the atoms
  for ijk in LocaleGridDom {
    on LocaleGrid[ijk] {
      for (a, x, b) in Moved[ijk].List[1..Moved[ijk].Count] {
        addatom(a,x,b);
      }
    }
  }
}

// compute atom's correct bin based on its physical position
proc coord2bin(x : v3){
  var cur : v3int;

  // create a simple mask on a per-dimension basis
  var mask : v3int;
  for i in 1..3 do
    mask(i) = if x(i) >= box(i) then 1 else 0;

  // if the position has drifted outside the physical space,
  // adjust. Divide position by the size of a bin, and add
  // (1,1,1) so we're starting at the lowest possible bin
  const temp = (x - box*mask) * bininv + (1,1,1);

  // can't cast from 3*real to 3*int (yet?)
  for i in 1..3 do
    cur(i) = temp(i) : int;

  return cur;
}

use Time;
use thermo;
use MDForce;
use BlockDist;

// used in testing system
config param printOriginal = false;
config param printPerf = true;
config param printCorrect = false;

// Stores user-configurable variables
// See printHelp for more information
config var input_file = "in.lj.miniMD";
config var numSteps = 100;
config var size = 32;
config var neigh_bins = -1;
config var units = "lj";
config var force = "lj";
config var data_file = "";
config var yaml_output = 1;
config var yaml_screen = false;

// user/dev utilities
config const debug = false;
config const pHelp = false;

// 3D vector type alias
type v3 = 3*real;
type v3int = 3*int;

// system variables from input files
var problemSize : v3 = (size:real,size:real,size:real);
var initialTemp = 1.44;
var density = .8442;
var dt = .005;
var dtforce = .0025;
var force_cut = 2.5;
var cutneigh = 2.8;
var neigh_every = 20;
var thermoEvery = 100;

// Used in deterministic 'random' number generator
// Based on Park-Miller
const IA = 16807;
const IM = 2147483647;
const AM = 1.0/IM;
const IQ = 127773;
const IR = 2836;
const MASK = 123459876;

// Dot product between two vectors
inline proc dot(a,b : v3) {
  var c = a * b;
  return c(1) + c(2) + c(3);
}

inline proc dot(a,b : v3int) {
  var c = a*b;
  return c(1) + c(2) + c(3);
}

record atom {
  // velocity, force
  var v, f : v3;

  // define storage for neighbor list, which stores the bin and index
  // of a neighboring atom
  var nspace : domain(1) = {1..100};
  var neighs : [nspace] (v3int,int);
  var ncount : int = 0;
}

// dimensions of simulation space
var box : v3;
var volume : real;
var boxlo, boxhi : v3;

// atom storage
var numAtoms : int;

// default mass
var mass : real = 1.0;

// number of bins that define our piece of the continguous space
var numBins : v3int;

// constants from c++ version, used in neighboring
const small = 1.0e-6;
const factor = .999;

// time for binAtoms and buildNeighbors
var buildTime : real;

// time for force computation (inside integration)
var forceTime : real;

// Time for communication
//
// Since chapel abstracts much of this away, sometimes we do communication
// without knowing (or caring). This value may not be completely accurate,
// but should reflect the bulk of communication that occurs.
var commTime : real;

// will halt if true
if pHelp then printHelp();

// entry point - read configuration file if one exists
inputFile();
dtforce = .5 * dt;

// generate our own atoms, or read from a data file?
const generating = data_file == "" || data_file == "none";

const cutneighsq = cutneigh * cutneigh;

// io for reading the data file
var dataFile : file;
var dataReader : channel(false, iokind.dynamic,false);

// no data file, use input file to generate uniform lattice
if generating {
  const lattice : real = (4.0 / density) ** (1.0 / 3.0);
  box = problemSize * (lattice,lattice,lattice);
  volume = box(1) * box(2) * box(3);

  boxhi = box;
  numAtoms = (4 * problemSize(1) * problemSize(2) * problemSize(3)) : int;

  for i in 1..3 do
    numBins(i) = (5.0/6.0 * problemSize(i)) : int;
} else {
  dataFile = open(data_file, iomode.r);
  dataReader = dataFile.reader();

  dataReader.readln(); // skip first line

  // we can only have 1 atom type
  var types = dataReader.readln(int);
  assert(types == 1, "You can only have one type of atom.");

  // sim dimensions
  for i in 1..3 do
    (boxlo(i), boxhi(i)) = dataReader.readln(real,real);
  box = boxhi - boxlo;
  volume = box(1) * box(2) * box(3);

  const masses = dataReader.readln(string);
  assert(masses == "Masses");
  var (mass_type, mass) = dataReader.readln(int,real);

  // density overriden if data file provided
  density = numAtoms / (volume);
  const nbs : real = (density * 16) ** (1.0/3.0 : real);
  for i in 1..3 do
    numBins(i) = (box(i) / nbs) : int;
}

initThermo();

// user-defined
if neigh_bins > 0 {
  numBins = (neigh_bins,neigh_bins,neigh_bins);
}

// physical size of a bin
const binsize = box / numBins;

// 1/binsize
const bininv = (1.0,1.0,1.0) / binsize;

// number of bins we need for neighboring
var numNeed : v3int;
for i in 1..3 {
  numNeed(i) = (cutneigh * bininv(i)) : int;
  if numNeed(i) * binsize(i) < factor * cutneigh then numNeed(i) += 1;
}

// stencil that defines our bin neighbor offsets
// for example, (0,1,0) will represent the bin above us
const stencil = {-numNeed(1) .. numNeed(1),
                  -numNeed(2) .. numNeed(2),
                  -numNeed(3) .. numNeed(3)};

// Defines the problem space
const binSpace = {1..numBins(1), 1..numBins(2), 1..numBins(3)};

// The 'special sauce'. Will distribute stuff across locales
const DistSpace = binSpace dmapped Block(binSpace);

// bin storage. we can likely assume that each bin will store
// about the same number of atoms
//
// TODO: can we deal with this on a per-locale basis? How do we deal with
// the case of not enough space when copying inside communication?
var perBinSpace : domain(1) = {1..8};

// locale's chunk of 'bins' (consists of whole bins)
class Chunk {
  var Fluff : domain(3);                          // real and ghost bins
  var Real : domain(3);                           // real bins
  var NeighDom : domain(3);                       // nearest neighbors
  var Bins : [Real] [perBinSpace] atom;           // bin and atom storage
  var Pos : [Fluff] [perBinSpace] v3;
  var Count : [Fluff] int(32);                    // # of actual atoms in a bin
  var DestSlice, SrcSlice : [NeighDom] domain(3); // local/remote ghost slices
  var Neighs : [NeighDom] (int,int,int);          // array of locale indices
  var PosOffset : [NeighDom] v3;
}

// This breaks the abstraction layer a bit. hopefully we can push this into a
// Chapel distribution at some point.
//
// LocaleGridDom is a set of indices that map into LocaleGrid, which
// contains 'locale' objects with which we can use the 'on' statement
// for actual distribution. These values are automatically calculated
// by the Block distribution, and it was simplest to re-use them in our
// code.
//
// TODO: Discuss implementing an interface for grabbing such useful values.
const LocaleGridDom = DistSpace._value.dist.targetLocDom;
const LocaleGrid = DistSpace._value.dist.targetLocales;

// storage across all locales
var Grid : [LocaleGridDom] Chunk;

// map of bin (3*int) to LocaleGridDom index (3*int)
var BinToLocale : [DistSpace] (int,int,int);

setupComms();

var fobj : Force;

if force == "lj" {
  fobj = new ForceLJ(force_cut);
} else {
  fobj = new ForceEAM(force_cut);
  mass = fobj.mass;
}

if printOriginal then writeln("# Create System:");

// if there's no data file to read from, generate a lattice of atoms
if generating {
  create_atoms();
  create_velocity();
} else {
  dataReader.readln(); // skip 'Atoms' line

  // read in positions
  var tempPos : [1..numAtoms] v3;
  for x in tempPos {
    dataReader.read(int,int);
    dataReader.readln(x(1),x(2),x(3));
  }

  // read velocities and add
  for x in tempPos {
    var v : v3;
    dataReader.read(int,int);
    dataReader.readln(v(1),v(2),v(3));
    addatom(new atom(v), x, coord2bin(x));
  }

  // cleanup
  dataReader.close();
  dataFile.close();
}

// setup/store slices and neighbors so we don't have to recompute them every
// time. Our neighbor bins won't change, and we'll always need the same slices.
proc setupComms() {
  coforall ijk in LocaleGridDom {
    on LocaleGrid[ijk] {
      // grab our chunk of the real domain
      const MyLocDom = DistSpace._value.locDoms[ijk].myBlock;
      if debug then writeln(here, " owns ", MyLocDom);

      // expand the maximum distance we might need
      const WithFluff = MyLocDom.expand(numNeed);
      if debug then writeln(here, "'s fluff: ", WithFluff);

      // directions of our nearest neighboring locales
      const NeighDom = {-1..1, -1..1, -1..1};

      var MyChunk = new Chunk(Fluff=WithFluff, Real=MyLocDom, NeighDom=NeighDom);
      Grid[ijk] = MyChunk;

      // alias to save typing
      var DestSlice => MyChunk.DestSlice;
      var SrcSlice => MyChunk.SrcSlice;
      var Neighs => MyChunk.Neighs;

      // Create 3D slices representing an overlap
      forall (Src, Dest, neigh) in zip(SrcSlice, DestSlice, NeighDom) {
        // the number of bins (numNeed) we need in a direction (neigh)
        Dest = MyLocDom.exterior(neigh * numNeed);

        // in the case of many locales, most of the time source and destination
        // will share the same indices. The wrapping case is handled soon.
        Src = Dest;
      }

      // use so we can move atoms around more easily
      BinToLocale[MyLocDom] = ijk;

      // adjust our remote-translated slices and neighbor pointer
      // store for future use
      forall (Src, Dest, PosOffset, neigh) in
        zip(SrcSlice, DestSlice, MyChunk.PosOffset, NeighDom) {
        // no comms with ourself, can't 'continue' inside a forall
        if neigh != (0,0,0) {
          // Get the index of the neighboring Locale
          var neighbor = ijk + neigh;

          // some of our slices will overlap with 'real' cells, but slices
          // on the exterior will need their cells to be offset so we can index
          // into the neighboring locale's bins.
          var SrcOffset = (0,0,0);

          // Adjust the neighbor index so we're actually referencing an
          // existing locale. Also compute the offset for source slices,
          // if necessary.
          for i in 1..3 {
            if neighbor(i) < 0 {
              neighbor(i) = LocaleGridDom.high(i);
              SrcOffset(i) = binSpace.high(i) - Dest.high(i);
            }
            else if neighbor(i) > LocaleGridDom.high(i) {
              neighbor(i) = 0;
              SrcOffset(i) = -binSpace.high(i) + binSpace.low(i) - 1;
            }
          }
          Src = Src.translate(SrcOffset);
          Neighs[neigh] = neighbor;

          var mask = (1.0,1.0,1.0);
          for i in 1..3 do
            if Dest.low(i) == Src.low(i) then mask(i) = 0.0;

          // ghost's position offset
          PosOffset = (neigh) * box * mask;

          if debug
            then writeln(Src, " is the remote neighbor of ", Dest);
          }
      }
    } // end of on statement
  } // end of coforall
}

// Reads an input file
proc inputFile() {
  var err : syserr;
  var fchan = open(err, input_file, iomode.r);

  if err then {
    input_file = "none";
    return;
  }

  var r = fchan.reader();

  // skip first line
  r.readln();

  // get unit type ('lj' vs 'metal')
  units = r.readln(string);

  // use data file?
  data_file = r.readln(string);

  // get force type : 'lj' vs 'eam'
  force = r.readln(string);

  // 'size of problem'
  problemSize = r.readln(int,int,int);

  // # iterations
  numSteps = r.readln(int);

  // simulated time step size
  dt = r.readln(real);

  // starting temperature
  initialTemp = r.readln(real);

  // start density (overriden if data file), used in EAM
  density = r.readln(real);

  // recompute neighbors every N iterations
  neigh_every = r.readln(int);

  // force cutoff: used to determine significance of force computation
  // neighbor cutoff: used to determine if a nearby atom may be significant
  (force_cut,cutneigh) = r.readln(real, real);

  // do thermo compute every N iterations
  thermoEvery = r.readln(int);

  // cutneigh = skin + force_cutoff, used in neighboring algorithm
  cutneigh += force_cut;

  // cleanup
  r.close();
  fchan.close();
}

proc printHelp() {
  writeln("Commandline Options:");
  writeln("\n  Chapel help:");
  writeln("\t--chapel:                Show Chapel's command line options");
  writeln("\n  Execution configuration:");
  writeln("\n  Simulation setup:");
  writeln("\t--input_file <string>:   set input file to be used (default: in.lj.miniMD)");
  writeln("\t--numSteps <int>:        set number of timesteps for simulation");
  writeln("\t--size <int>:            set linear dimension of systembox");
  writeln("\t--neigh_bins <int>:      set linear dimension of neighbor bin grid");
  writeln("\t--units <string>:        set units (lj or metal), see LAMMPS documentation");
  writeln("\t--force <string>:        set interaction model (lj or eam)");
  writeln("\t--data_file <string>:    read configuration from LAMMPS data file");
  writeln("\n  Miscelaneous:");
  writeln("\t                                within rcut_neighbor (outer force cutoff)");
  writeln("\t--yaml_output <int>:     level of yaml output (default 1)");
  writeln("\t--yaml_screen:                write yaml output also to screen");
  writeln("\t--pHelp:                  display this help message");
  writeln("\t--------------------------------------------------");
  exit(0);
}

// Print simulation settings
proc printSim() {
  if !printOriginal then return;
  writeln("# Done .... ");
  writeln("# miniMD-Reference 0.1 (Chapel) output ...");
  writeln("# Systemparameters: ");
  writeln("\t# input_file: ", input_file);
  if data_file != "" then
    writeln("\t# datafile: ", data_file);
  else
    writeln("\t# datafile: none");
  writeln("\t# force: ", force);
  write("\t# units: ");
  if units == "metal" then writeln("METAL");
  else writeln("LJ");
  writeln("\t# atoms: ", numAtoms);
  write("\t# System size: ");
  writef("%.2dr %.2dr %.2dr (unit cells: %i %i %i)\n",
      box(1), box(2), box(3), problemSize(1), problemSize(2), problemSize(3));
  writef("\t%# density: %.6dr\n", density);
  writef("\t%# Force cutoff: %.6dr\n", force_cut);
  writef("\t%# neigh cutoff: %.6dr\n", cutneigh);
  writeln("\t# Neighbor bins: ", numBins(1), " ", numBins(2), " ", numBins(3));
  writeln("\t# neighbor frequency ", neigh_every);
  writef("\t%# timestep size: %.6dr\n", dt );
  writeln("\t# thermo frequency: ", thermoEvery);
}

proc create_atoms() {
  const lattice : real = (4.0 / density) ** (1.0 / 3.0);

  var lo, hi : v3int;

  for i in 1..3 {
    lo(i) = (boxlo(i) / (.5 * lattice)) : int;
    hi(i) = (boxhi(i) / (.5 * lattice)) : int;
  }

  for i in 1..3 {
    lo(i) = max(lo(i), 0);
    hi(i) = min(hi(i), 2 * problemSize(i) - 1) : int;
  }

  var temp, v : v3;
  var s, o : v3int;
  var m, n : int;
  var curCoord : v3int;
  var subboxdim = 8;
  var flag = false;

  while o(3) * subboxdim <= hi(3) {
    curCoord = (o * (subboxdim,subboxdim,subboxdim) + s);

    if flag then continue;

    var withinBounds = true;
    for i in 1..3 {
      withinBounds = withinBounds && curCoord(i) >= lo(i) && curCoord(i) <= hi(i);
    }

    if ((curCoord(1) + curCoord(2) + curCoord(3)) % 2 == 0) && withinBounds {
      for i in 1..3 do
        temp(i) = .5 * lattice * curCoord(i);

      withinBounds = true;
      for i in 1..3 {
        withinBounds = withinBounds && temp(i) >= boxlo(i) && temp(i) < boxhi(i);
      }

      if withinBounds {
        n = (curCoord(3) * (2 * problemSize(2)) * (2*problemSize(1)) + curCoord(2) * (2 * problemSize(1)) + curCoord(1) + 1) : int;
        for i in 1..3 {
          for m in 1..5 { pmrand(n); }
          v(i) = pmrand(n);
        }
        addatom(new atom(v), temp, coord2bin(temp));
      }
    }

    s(1) += 1;

    if s(1) == subboxdim {
      s(1) = 0;
      s(2) += 1;
    }

    if s(2) == subboxdim {
      s(2) = 0;
      s(3) += 1;
    }

    if s(3) == subboxdim {
      s(3) = 0;
      o(1) += 1;
    }

    if o(1) * subboxdim > hi(1) {
      o(1) = 0;
      o(2) += 1;
    }

    if o(2) * subboxdim > hi(2) {
      o(2) = 0;
      o(3) += 1;
    }
  }
}

proc create_velocity() {
  var vtot : v3;

  // find the total velocity
  var vtotDist : [LocaleGridDom] v3;
  coforall (ijk) in LocaleGridDom {
    on LocaleGrid[ijk] {
      const Me = Grid[ijk];
      vtotDist[ijk] = + reduce forall bin in Me.Real do
      + reduce forall ind in 1..Me.Count[bin] do Me.Bins[bin][ind].v;
    }
  }
  vtot = + reduce vtotDist;

  // get the average
  vtot /= (numAtoms,numAtoms,numAtoms);

  // adjust using average
  coforall (ijk) in LocaleGridDom {
    on LocaleGrid[ijk] {
      const Me = Grid[ijk];
      forall (bin,c) in zip(Me.Bins[Me.Real], Me.Count[Me.Real]) {
        for a in bin[1..c] {
          a.v -= vtot;
        }
      }
    }
  }

  const factor = sqrt(initialTemp / temperature());

  coforall (ijk) in LocaleGridDom {
    on LocaleGrid[ijk] {
      const fac = (factor,factor,factor);
      const Me = Grid[ijk];
      forall (bin,c) in zip(Me.Bins[Me.Real], Me.Count[Me.Real]) {
        for a in bin[1..c] {
          a.v *= fac;
        }
      }
    }
  }
}

// Park/Miller RNG w/out MASKING
proc pmrand(ref n : int) : real {
  var k : int;
  var ans : real;

  k = n / IQ;
  n = IA * (n - k * IQ) - IR * k;
  if n < 0 then n += IM;
  ans = AM * n;
  return ans;
}

proc updateFluff() {
  coforall ijk in LocaleGridDom {
    on LocaleGrid[ijk] {
      const Me = Grid[ijk];
      for (Src, Dest, Neighbor, Offset, neigh) in
        zip(Me.SrcSlice, Me.DestSlice, Grid[Me.Neighs], Me.PosOffset, Me.NeighDom) {
        // don't look at ourself
        if neigh == (0,0,0) then continue;

        // copy over the bins' counts
        Me.Count[Dest] = Neighbor.Count[Src];

        // copy over fluff atoms' positions
        Me.Pos[Dest] = Neighbor.Pos[Src];

        // offset atoms if necessary
        if Offset != (0.0,0.0,0.0) {
          forall p in Me.Pos[Dest] do p += Offset;
        }
      }
    }
  }
}

// if atoms moved outside the box, wrap them around
proc pbc() {
  coforall ijk in LocaleGridDom {
    on LocaleGrid[ijk] {
      const Me = Grid[ijk];
      const b = box;
      forall (p,c) in zip(Me.Pos[Me.Real],Me.Count[Me.Real]) {
        for x in p[1..c] {
          for i in 1..3 {
            if x(i) < 0 then x(i) += b(i);
            else if x(i) >= b(i) then x(i) -= b(i);
          }
        }
      }
    }
  }
}

proc buildNeighbors() {
  if debug then writeln("starting to build...");

  var neighTimer : Timer;
  neighTimer.start();

  // enforce boundaries
  pbc();

  commTime += neighTimer.elapsed();
  neighTimer.stop();
  neighTimer.clear();
  neighTimer.start();

  // if any atoms moved outside a bin, relocate
  binAtoms();

  buildTime += neighTimer.elapsed();
  neighTimer.stop();
  neighTimer.clear();
  neighTimer.start();

  if debug then writeln("starting comms...");

  // grab ghost/overlapping atoms
  updateFluff();

  if debug then writeln("comms done...");

  commTime += neighTimer.elapsed();
  neighTimer.stop();
  neighTimer.clear();
  neighTimer.start();

  coforall ijk in LocaleGridDom {
    on LocaleGrid[ijk] {
      const Me = Grid[ijk];
      forall (bin,posBin,r,c) in zip(Me.Bins, Me.Pos[Me.Real],Me.Real, Me.Count[Me.Real]) {
        const existing = 1..c;
        for (a,pos,i) in zip(bin[existing],posBin[existing],existing) {
          // reset neighbor list
          a.ncount = 0;

          // for each surrounding bin
          for s in stencil {
            const o = r + s;
            const existing = 1..Me.Count[o];
            for (npos,x) in zip(Me.Pos[o][existing],existing) {
              // if we're looking at ourself
              if r == o && x == i then continue;

              // are we within range?
              const del = pos - npos;
              const rsq = dot(del,del);
              if rsq <= cutneighsq {
                a.ncount += 1;

                // resize neighbor list if necessary
                var h = a.nspace.high;
                while a.ncount > h {
                  h = ((a.nspace.high*1.2) : int);
                  a.nspace = {1..h};
                }

                // store atom's bin and index
                a.neighs[a.ncount] = (o,x);
              }
            }
          }
        }
      }
    }
  }

  buildTime += neighTimer.elapsed();

  if debug then writeln("building done...");
} // end of buildNeighbors

// add an atom 'a' to bin 'b'
// resize if necessary
inline proc addatom(a : atom, x : v3, b : v3int) {
  const Target = Grid[BinToLocale[b]];

  // increment bin's # of atoms
  Target.Count[b] += 1;
  const end = Target.Count[b];

  // resize bin storage if needed
  if end >= perBinSpace.high {
    var h = (perBinSpace.high * 1.5) : int;
    perBinSpace = {1..h};
  }

  // add to the end of the bin
  Target.Bins[b][end] = a;
  Target.Pos[b][end] = x;
}

// helper class for moving atoms around
class Mov {
  var Space : domain(1) = {1..50};
  var List : [Space] (atom, v3, v3int);
  var Count : int;
}

// TODO: reduce communication here
proc binAtoms() {
  var Moved : [LocaleGridDom] Mov;
  coforall ijk in LocaleGridDom {
    on LocaleGrid[ijk] {
      var ToMove = new Mov();
      Moved[ijk] = ToMove;
      const Me = Grid[ijk];
      for (bin, pos, r, c) in zip(Me.Bins, Me.Pos[Me.Real] ,Me.Real ,Me.Count[Me.Real]) {
        var cur = 1;

        // for each atom, check if moved
        // because we move from the end, this setup allows us to examine
        // the atom pulled from the end
        while(cur <= c) {
          const destBin = coord2bin(pos[cur]);

          // atom moved
          if destBin != r {
            ToMove.Count += 1;

            // resize storage as needed
            if ToMove.Count >= ToMove.Space.high then
              ToMove.Space = {1..ToMove.Space.high * 2};

            ToMove.List[ToMove.Count] = (bin[cur], pos[cur], destBin);

            // replace with atom at end of list, if one exists
            if cur < c {
              bin[cur] = bin[c];
              pos[cur] = pos[c];
            }

            // correct bin count
            c -= 1;
          } else cur += 1;
        }
      }
    }
  }

  // actually move the atoms
  for ijk in LocaleGridDom {
    on LocaleGrid[ijk] {
      for (a, x, b) in Moved[ijk].List[1..Moved[ijk].Count] {
        addatom(a,x,b);
      }
    }
  }
}

// compute atom's correct bin based on its physical position
proc coord2bin(x : v3){
  var cur : v3int;

  // create a simple mask on a per-dimension basis
  var mask : v3int;
  for i in 1..3 do
    mask(i) = if x(i) >= box(i) then 1 else 0;

  // if the position has drifted outside the physical space,
  // adjust. Divide position by the size of a bin, and add
  // (1,1,1) so we're starting at the lowest possible bin
  const temp = (x - box*mask) * bininv + (1,1,1);

  // can't cast from 3*real to 3*int (yet?)
  for i in 1..3 do
    cur(i) = temp(i) : int;

  return cur;
}


Some tests were failing due to 20434, but declaring chpl_commDiagnostics 'extern' in ChapelLocale.chpl sets this right.

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

// ChapelLocale.chpl
//
pragma "no use ChapelStandard"
module ChapelLocale {

use DefaultRectangular;

// would like this to be the following, but it breaks about 20 tests:
//const LocaleSpace: domain(1) distributed(OnePer) = [0..numLocales-1];
const LocaleSpace: domain(1) = {0..numLocales-1};

var doneCreatingLocales: bool;

class locale {
  const chpl_id: int;
  const numCores: int;

  proc locale(id = -1) {
    if doneCreatingLocales {
      halt("locales cannot be created");
    }
    chpl_id = id;

    extern proc chpl_numCoresOnThisLocale(): int;
    numCores = chpl_numCoresOnThisLocale();
  }

  proc id {
    return chpl_id;
  }

  proc name {
    var locName: string;
    on this do locName = __primitive("chpl_localeName");
    return locName;
  }

  proc callStackSize: int {
    // Locales may have differing call stack sizes.
    extern proc chpl_task_getCallStackSize(): int;
    var retval: int;
    on this do retval = chpl_task_getCallStackSize();
    return retval;
  }

  proc readWriteThis(f) {
    f <~> new ioLiteral("LOCALE") <~> chpl_id;
  }
}

pragma "private" var _here: locale;

proc here return _here;

// Perform locale-specific initialization.
// This is where global variables declared 'pragma "private"' are initialized.
// That initialization is not currently arranged automatically by the compiler.
proc chpl_setupLocale(id) {
  var tmp: locale;
  on __primitive("chpl_on_locale_num", id) {
    tmp = new locale(id);
    _here = tmp;
    if (defaultDist._value == nil) {
      defaultDist = new dmap(new DefaultDist());
    }
  }
  return tmp;
}

const Locales: [LocaleSpace] locale;
// We cannot use a forall here because the default leader iterator will
// access data structures that are not yet initialized (i.e., Locales
// array/here).  An alternative would be to use a coforall+on and refactor
// chpl_setupLocale().
for loc in LocaleSpace do
  Locales(loc) = chpl_setupLocale(loc);

doneCreatingLocales = true;

//
// tree for recursive task invocation during privatization
//
record chpl_localeTreeRecord {
  var left, right: locale;
}
pragma "private" var chpl_localeTree: chpl_localeTreeRecord;

proc chpl_initLocaleTree() {
  for i in LocaleSpace {
    var left: locale = nil;
    var right: locale = nil;
    var child = (i+1)*2-1;
    if child < numLocales {
      left = Locales[child];
      child += 1;
      if child < numLocales then
        right = Locales[child];
    }
    on Locales(i) {
      chpl_localeTree.left = left;
      chpl_localeTree.right = right;
    }
  }
}

chpl_initLocaleTree();

//proc locale.numCores {
//  var numCores: int;
//  on this do numCores = __primitive("chpl_coresPerLocale");
//  return numCores;
//}

proc chpl_int_to_locale(id) {
  return Locales(id);
}

proc locale.totalThreads() {
  var totalThreads: int;

  on this do totalThreads = __primitive("chpl_numThreads");

  return totalThreads;
}

proc locale.idleThreads() {
  var idleThreads: int;

  on this do idleThreads = __primitive("chpl_numIdleThreads");

  return idleThreads;
}

proc locale.queuedTasks() {
  var queuedTasks: int;

  on this do queuedTasks = __primitive("chpl_numQueuedTasks");

  return queuedTasks;
}

proc locale.runningTasks() {
  var numTasks: int;

  on this do numTasks = __primitive("chpl_numRunningTasks");

  return numTasks;
}

proc locale.blockedTasks() {
  var blockedTasks: int;

  on this do blockedTasks = __primitive("chpl_numBlockedTasks");

  return blockedTasks;
}

proc chpl_getPrivatizedCopy(type objectType, objectPid:int): objectType
  return __primitive("chpl_getPrivatizedClass", nil:objectType, objectPid);

//
// 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.
extern record chpl_commDiagnostics {
  var get: uint(64);
  var get_nb: uint(64);
  var get_nb_test: uint(64);
  var get_nb_wait: uint(64);
  var put: uint(64);
  var fork: uint(64);
  var fork_fast: uint(64);
  var fork_nb: uint(64);
};

type commDiagnostics = chpl_commDiagnostics;

extern proc chpl_startVerboseComm();
extern proc chpl_stopVerboseComm();
extern proc chpl_startVerboseCommHere();
extern proc chpl_stopVerboseCommHere();
extern proc chpl_startCommDiagnostics();
extern proc chpl_stopCommDiagnostics();
extern proc chpl_startCommDiagnosticsHere();
extern proc chpl_stopCommDiagnosticsHere();
extern proc chpl_resetCommDiagnosticsHere();
extern proc chpl_getCommDiagnosticsHere(out cd: commDiagnostics);

proc startVerboseComm() { chpl_startVerboseComm(); }
proc stopVerboseComm() { chpl_stopVerboseComm(); }
proc startVerboseCommHere() { chpl_startVerboseCommHere(); }
proc stopVerboseCommHere() { chpl_stopVerboseCommHere(); }

proc startCommDiagnostics() { chpl_startCommDiagnostics(); }
proc stopCommDiagnostics() { chpl_stopCommDiagnostics(); }
proc startCommDiagnosticsHere() { chpl_startCommDiagnosticsHere(); }
proc stopCommDiagnosticsHere() { chpl_stopCommDiagnosticsHere(); }

proc resetCommDiagnostics() {
  for loc in Locales do on loc do
    resetCommDiagnosticsHere();
}

inline proc resetCommDiagnosticsHere() {
  chpl_resetCommDiagnosticsHere();
}

// See note above regarding extern records
extern proc chpl_numCommGets(): uint(64);
extern proc chpl_numCommNBGets(): uint(64);
extern proc chpl_numCommTestNBGets(): uint(64);
extern proc chpl_numCommWaitNBGets(): uint(64);
extern proc chpl_numCommPuts(): uint(64);
extern proc chpl_numCommForks(): uint(64);
extern proc chpl_numCommFastForks(): uint(64);
extern proc chpl_numCommNBForks(): uint(64);

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).put = chpl_numCommPuts();
    D(loc.id).fork = chpl_numCommForks();
    D(loc.id).fork_fast = chpl_numCommFastForks();
    D(loc.id).fork_nb = chpl_numCommNBForks();
    D(loc.id).get_nb = chpl_numCommNBGets();
    D(loc.id).get_nb_test = chpl_numCommTestNBGets();
    D(loc.id).get_nb_wait = chpl_numCommWaitNBGets();
  }
  return D;
}

proc getCommDiagnosticsHere() {
  var cd: commDiagnostics;
  cd.get = chpl_numCommGets();
  cd.put = chpl_numCommPuts();
  cd.fork = chpl_numCommForks();
  cd.fork_fast = chpl_numCommFastForks();
  cd.fork_nb = chpl_numCommNBForks();
  cd.get_nb = chpl_numCommNBGets();
  cd.get_nb_test = chpl_numCommTestNBGets();
  cd.get_nb_wait = chpl_numCommWaitNBGets();
  return cd;
}

config const
  memTrack: bool = false,
  memStats: bool = false,
  memLeaks: bool = false,
  memLeaksTable: bool = false,
  memMax: int = 0,
  memThreshold: int = 0,
  memLog: string = "";

pragma "no auto destroy"
config const
  memLeaksLog: string = "";

proc chpl_startTrackingMemory() {
  if Locales(0) == here {
    coforall loc in Locales {
      if loc == here {
        __primitive("chpl_setMemFlags", memTrack, memStats, memLeaks, memLeaksTable, memMax, memThreshold, memLog, memLeaksLog);
      } else on loc {
          __primitive("chpl_setMemFlags", memTrack, memStats, memLeaks, memLeaksTable, memMax, memThreshold, memLog, memLeaksLog);
      }
    }
  }
}

}

// ChapelLocale.chpl
//
pragma "no use ChapelStandard"
module ChapelLocale {

use DefaultRectangular;

// would like this to be the following, but it breaks about 20 tests:
//const LocaleSpace: domain(1) distributed(OnePer) = [0..numLocales-1];
const LocaleSpace: domain(1) = {0..numLocales-1};

var doneCreatingLocales: bool;

class locale {
  const chpl_id: int;
  const numCores: int;

  proc locale(id = -1) {
    if doneCreatingLocales {
      halt("locales cannot be created");
    }
    chpl_id = id;

    extern proc chpl_numCoresOnThisLocale(): int;
    numCores = chpl_numCoresOnThisLocale();
  }

  proc id {
    return chpl_id;
  }

  proc name {
    var locName: string;
    on this do locName = __primitive("chpl_localeName");
    return locName;
  }

  proc callStackSize: int {
    // Locales may have differing call stack sizes.
    extern proc chpl_task_getCallStackSize(): int;
    var retval: int;
    on this do retval = chpl_task_getCallStackSize();
    return retval;
  }

  proc readWriteThis(f) {
    f <~> new ioLiteral("LOCALE") <~> chpl_id;
  }
}

pragma "private" var _here: locale;

proc here return _here;

// Perform locale-specific initialization.
// This is where global variables declared 'pragma "private"' are initialized.
// That initialization is not currently arranged automatically by the compiler.
proc chpl_setupLocale(id) {
  var tmp: locale;
  on __primitive("chpl_on_locale_num", id) {
    tmp = new locale(id);
    _here = tmp;
    if (defaultDist._value == nil) {
      defaultDist = new dmap(new DefaultDist());
    }
  }
  return tmp;
}

const Locales: [LocaleSpace] locale;
// We cannot use a forall here because the default leader iterator will
// access data structures that are not yet initialized (i.e., Locales
// array/here).  An alternative would be to use a coforall+on and refactor
// chpl_setupLocale().
for loc in LocaleSpace do
  Locales(loc) = chpl_setupLocale(loc);

doneCreatingLocales = true;

//
// tree for recursive task invocation during privatization
//
record chpl_localeTreeRecord {
  var left, right: locale;
}
pragma "private" var chpl_localeTree: chpl_localeTreeRecord;

proc chpl_initLocaleTree() {
  for i in LocaleSpace {
    var left: locale = nil;
    var right: locale = nil;
    var child = (i+1)*2-1;
    if child < numLocales {
      left = Locales[child];
      child += 1;
      if child < numLocales then
        right = Locales[child];
    }
    on Locales(i) {
      chpl_localeTree.left = left;
      chpl_localeTree.right = right;
    }
  }
}

chpl_initLocaleTree();

//proc locale.numCores {
//  var numCores: int;
//  on this do numCores = __primitive("chpl_coresPerLocale");
//  return numCores;
//}

proc chpl_int_to_locale(id) {
  return Locales(id);
}

proc locale.totalThreads() {
  var totalThreads: int;

  on this do totalThreads = __primitive("chpl_numThreads");

  return totalThreads;
}

proc locale.idleThreads() {
  var idleThreads: int;

  on this do idleThreads = __primitive("chpl_numIdleThreads");

  return idleThreads;
}

proc locale.queuedTasks() {
  var queuedTasks: int;

  on this do queuedTasks = __primitive("chpl_numQueuedTasks");

  return queuedTasks;
}

proc locale.runningTasks() {
  var numTasks: int;

  on this do numTasks = __primitive("chpl_numRunningTasks");

  return numTasks;
}

proc locale.blockedTasks() {
  var blockedTasks: int;

  on this do blockedTasks = __primitive("chpl_numBlockedTasks");

  return blockedTasks;
}

proc chpl_getPrivatizedCopy(type objectType, objectPid:int): objectType
  return __primitive("chpl_getPrivatizedClass", nil:objectType, objectPid);

//
// 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.
record chpl_commDiagnostics {
  var get: uint(64);
  var get_nb: uint(64);
  var get_nb_test: uint(64);
  var get_nb_wait: uint(64);
  var put: uint(64);
  var fork: uint(64);
  var fork_fast: uint(64);
  var fork_nb: uint(64);
};

type commDiagnostics = chpl_commDiagnostics;

extern proc chpl_startVerboseComm();
extern proc chpl_stopVerboseComm();
extern proc chpl_startVerboseCommHere();
extern proc chpl_stopVerboseCommHere();
extern proc chpl_startCommDiagnostics();
extern proc chpl_stopCommDiagnostics();
extern proc chpl_startCommDiagnosticsHere();
extern proc chpl_stopCommDiagnosticsHere();
extern proc chpl_resetCommDiagnosticsHere();
extern proc chpl_getCommDiagnosticsHere(out cd: commDiagnostics);

proc startVerboseComm() { chpl_startVerboseComm(); }
proc stopVerboseComm() { chpl_stopVerboseComm(); }
proc startVerboseCommHere() { chpl_startVerboseCommHere(); }
proc stopVerboseCommHere() { chpl_stopVerboseCommHere(); }

proc startCommDiagnostics() { chpl_startCommDiagnostics(); }
proc stopCommDiagnostics() { chpl_stopCommDiagnostics(); }
proc startCommDiagnosticsHere() { chpl_startCommDiagnosticsHere(); }
proc stopCommDiagnosticsHere() { chpl_stopCommDiagnosticsHere(); }

proc resetCommDiagnostics() {
  for loc in Locales do on loc do
    resetCommDiagnosticsHere();
}

inline proc resetCommDiagnosticsHere() {
  chpl_resetCommDiagnosticsHere();
}

// See note above regarding extern records
extern proc chpl_numCommGets(): uint(64);
extern proc chpl_numCommNBGets(): uint(64);
extern proc chpl_numCommTestNBGets(): uint(64);
extern proc chpl_numCommWaitNBGets(): uint(64);
extern proc chpl_numCommPuts(): uint(64);
extern proc chpl_numCommForks(): uint(64);
extern proc chpl_numCommFastForks(): uint(64);
extern proc chpl_numCommNBForks(): uint(64);

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).put = chpl_numCommPuts();
    D(loc.id).fork = chpl_numCommForks();
    D(loc.id).fork_fast = chpl_numCommFastForks();
    D(loc.id).fork_nb = chpl_numCommNBForks();
    D(loc.id).get_nb = chpl_numCommNBGets();
    D(loc.id).get_nb_test = chpl_numCommTestNBGets();
    D(loc.id).get_nb_wait = chpl_numCommWaitNBGets();
  }
  return D;
}

proc getCommDiagnosticsHere() {
  var cd: commDiagnostics;
  cd.get = chpl_numCommGets();
  cd.put = chpl_numCommPuts();
  cd.fork = chpl_numCommForks();
  cd.fork_fast = chpl_numCommFastForks();
  cd.fork_nb = chpl_numCommNBForks();
  cd.get_nb = chpl_numCommNBGets();
  cd.get_nb_test = chpl_numCommTestNBGets();
  cd.get_nb_wait = chpl_numCommWaitNBGets();
  return cd;
}

config const
  memTrack: bool = false,
  memStats: bool = false,
  memLeaks: bool = false,
  memLeaksTable: bool = false,
  memMax: int = 0,
  memThreshold: int = 0,
  memLog: string = "";

pragma "no auto destroy"
config const
  memLeaksLog: string = "";

proc chpl_startTrackingMemory() {
  if Locales(0) == here {
    coforall loc in Locales {
      if loc == here {
        __primitive("chpl_setMemFlags", memTrack, memStats, memLeaks, memLeaksTable, memMax, memThreshold, memLog, memLeaksLog);
      } else on loc {
          __primitive("chpl_setMemFlags", memTrack, memStats, memLeaks, memLeaksTable, memMax, memThreshold, memLog, memLeaksLog);
      }
    }
  }
}

}