Add a yield in the spinlock for table access.

Greg noted that yield() in the spinlock would be a good idea in
general, but also would help avoid potential starvation.  As a side
benefit, yielding improved performance in the case of SSCA2 with fifo
tasking.

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

pragma "no use ChapelStandard"
module ChapelDistribution {

use List;

config const dataParTasksPerLocale = 0;
config const dataParIgnoreRunningTasks = true;
config const dataParMinGranularity: int = 1;

extern proc chpl_task_yield();

// NOTE: If module initialization order changes, this may be affected
if dataParTasksPerLocale<0 then halt("dataParTasksPerLocale must be >= 0");
if dataParMinGranularity<=0 then halt("dataParMinGranularity must be > 0");

//
// Abstract distribution class
//
pragma "base dist"
class BaseDist {
  var _distCnt: atomic int;   // distribution reference count
  var _doms: list(BaseDom);   // domains declared over this domain
  var _domsLock: atomic bool; //   and lock for concurrent access

  pragma "dont disable remote value forwarding"
  proc destroyDist(dom: BaseDom = nil) {
    if dom then remove_dom(dom);
    var cnt = _distCnt.fetchSub(1)-1;
    if !noRefCount {
      if cnt < 0 then
        halt("distribution reference count is negative!");
    } else {
      if cnt > 0 then
        halt("distribution reference count has been modified!");
    }
    return cnt;
  }

  inline proc remove_dom(x) {
    _lock_doms();
    _doms.remove(x);
    _unlock_doms();
  }

  inline proc add_dom(x) {
    _lock_doms();
    _doms.append(x);
    _unlock_doms();
  }

  inline proc _lock_doms() {
    while (_domsLock.testAndSet()) do chpl_task_yield();
  }

  inline proc _unlock_doms() {
    _domsLock.clear();
  }

  proc dsiNewRectangularDom(param rank: int, type idxType, param stridable: bool) {
    compilerError("rectangular domains not supported by this distribution");
  }

  proc dsiNewAssociativeDom(type idxType, param parSafe: bool) {
    compilerError("associative domains not supported by this distribution");
  }

  proc dsiNewAssociativeDom(type idxType, param parSafe: bool)
  where _isEnumeratedType(idxType) {
    compilerError("enumerated domains not supported by this distribution");
  }

  proc dsiNewOpaqueDom(type idxType, param parSafe: bool) {
    compilerError("opaque domains not supported by this distribution");
  }

  proc dsiNewSparseDom(param rank: int, type idxType, dom: domain) {
    compilerError("sparse domains not supported by this distribution");
  }

  proc dsiSupportsPrivatization() param return false;
  proc dsiRequiresPrivatization() param return false;

  proc dsiDestroyDistClass() { }

  proc dsiDisplayRepresentation() { }
}

//
// Abstract domain classes
//
pragma "base domain"
class BaseDom {
  var _domCnt: atomic int;    // domain reference count
  var _arrs: list(BaseArr);   // arrays declared over this domain
  var _arrsLock: atomic bool; //   and lock for concurrent access

  proc dsiMyDist(): BaseDist {
    halt("internal error: dsiMyDist is not implemented");
    return nil;
  }

  pragma "dont disable remote value forwarding"
  proc destroyDom(arr: BaseArr = nil) {
    if arr then remove_arr(arr);
    var cnt = _domCnt.fetchSub(1)-1;
    if !noRefCount {
      if cnt < 0 then
        halt("domain reference count is negative!");
    } else {
      if cnt > 0 then
        halt("domain reference count has been modified!");
    }
    if !noRefCount {
      if cnt == 0 && dsiLinksDistribution() {
        var dist = dsiMyDist();
        on dist {
          var cnt = dist.destroyDist(this);
          if cnt == 0 then
            delete dist;
        }
      }
    }
    return cnt;
  }

  inline proc remove_arr(x) {
    _lock_arrs();
    _arrs.remove(x);
    _unlock_arrs();
  }

  inline proc add_arr(x) {
    _lock_arrs();
    _arrs.append(x);
    _unlock_arrs();
  }

  inline proc _lock_arrs() {
    while (_arrsLock.testAndSet()) do chpl_task_yield();
  }

  inline proc _unlock_arrs() {
    _arrsLock.clear();
  }

  // used for associative domains/arrays
  proc _backupArrays() {
    for arr in _arrs do
      arr._backupArray();
  }

  proc _removeArrayBackups() {
    for arr in _arrs do
      arr._removeArrayBackup();
  }

  proc _preserveArrayElements(oldslot, newslot) {
    for arr in _arrs do
      arr._preserveArrayElement(oldslot, newslot);
  }

  proc dsiSupportsPrivatization() param return false;
  proc dsiRequiresPrivatization() param return false;

  // false for default distribution so that we don't increment the
  // default distribution's reference count and add domains to the
  // default distribution's list of domains
  proc linksDistribution() param return true;

  // dynamically-dispatched counterpart of linksDistribution
  proc dsiLinksDistribution() return true;

  proc dsiDisplayRepresentation() { }
}

class BaseRectangularDom : BaseDom {
  proc dsiClear() {
    halt("clear not implemented for this distribution");
  }

  proc clearForIteratableAssign() {
    compilerError("Illegal assignment to a rectangular domain");
  }

  proc dsiAdd(x) {
    compilerError("Cannot add indices to a rectangular domain");
  }

  proc dsiRemove(x) {
    compilerError("Cannot remove indices from a rectangular domain");
  }
}

class BaseSparseDom : BaseDom {
  proc dsiClear() {
    halt("clear not implemented for this distribution");
  }

  proc clearForIteratableAssign() {
    dsiClear();
  }
}

class BaseAssociativeDom : BaseDom {
  proc dsiClear() {
    halt("clear not implemented for this distribution");
  }

  proc clearForIteratableAssign() {
    dsiClear();
  }
}

class BaseOpaqueDom : BaseDom {
  proc dsiClear() {
    halt("clear not implemented for this distribution");
  }

  proc clearForIteratableAssign() {
    dsiClear();
  }
}

//
// Abstract array class
//
pragma "base array"
class BaseArr {
  var _arrCnt: atomic int; // array reference count
  var _arrAlias: BaseArr;  // reference to base array if an alias

  proc dsiStaticFastFollowCheck(type leadType) param return false;

  proc canCopyFromDevice param return false;
  proc canCopyFromHost param return false;

  proc dsiGetBaseDom(): BaseDom {
    halt("internal error: dsiGetBaseDom is not implemented");
    return nil;
  }

  pragma "dont disable remote value forwarding"
  proc destroyArr(): int {
    var cnt = _arrCnt.fetchSub(1)-1;
    if !noRefCount {
      if cnt < 0 then
        halt("array reference count is negative!");
    } else {
      if cnt > 0 then
        halt("array reference count has been modified!");
    }
    if cnt == 0 {
      if _arrAlias {
        on _arrAlias {
          var cnt = _arrAlias.destroyArr();
          if cnt == 0 then
            delete _arrAlias;
        }
      } else {
        dsiDestroyData();
      }
    }
    if !noRefCount {
      if cnt == 0 {
        var dom = dsiGetBaseDom();
        on dom {
          var cnt = dom.destroyDom(this);
          if cnt == 0 then
            delete dom;
        }
      }
    }
    return cnt;
  }

  proc dsiDestroyData() { }

  proc dsiReallocate(d: domain) {
    halt("reallocating not supported for this array type");
  }

  proc dsiPostReallocate() {
  }

  // This method is unsatisfactory -- see bradc's commit entries of
  // 01/02/08 around 14:30 for details
  proc _purge( ind: int) {
    halt("purging not supported for this array type");
  }

  proc _resize( length: int, old_map) {
    halt("resizing not supported for this array type");
  }

  //
  // Ultimately, these routines should not appear here; instead, we'd
  // like to do a dynamic cast in the sparse array class(es) that call
  // these routines in order to call them directly and avoid the
  // dynamic dispatch and leaking of this name to the class.  In order
  // to do this we'd need to hoist eltType to the base class, which
  // would require better subclassing of generic classes.  A good
  // summer project for Jonathan?
  //
  proc sparseShiftArray(shiftrange, initrange) {
    halt("sparseGrowDomain not supported for non-sparse arrays");
  }

  proc sparseShiftArrayBack(shiftrange) {
    halt("sparseShiftArrayBack not supported for non-sparse arrays");
  }

  // methods for associative arrays
  proc clearEntry(idx) {
    halt("clearEntry() not supported for non-associative arrays");
  }

  proc _backupArray() {
    halt("_backupArray() not supported for non-associative arrays");
  }

  proc _removeArrayBackup() {
    halt("_removeArrayBackup() not supported for non-associative arrays");
  }

  proc _preserveArrayElement(oldslot, newslot) {
    halt("_preserveArrayElement() not supported for non-associative arrays");
  }

  proc dsiSupportsAlignedFollower() param return false;

  proc dsiSupportsPrivatization() param return false;
  proc dsiRequiresPrivatization() param return false;

  proc dsiSupportsBulkTransfer() param return false;
  proc doiCanBulkTransfer() param return false;
  proc doiBulkTransfer(B){
    halt("This array type does not support bulk transfer.");
  }

  proc dsiDisplayRepresentation() { }
}

}

pragma "no use ChapelStandard"
module ChapelDistribution {

use List;

config const dataParTasksPerLocale = 0;
config const dataParIgnoreRunningTasks = true;
config const dataParMinGranularity: int = 1;

// NOTE: If module initialization order changes, this may be affected
if dataParTasksPerLocale<0 then halt("dataParTasksPerLocale must be >= 0");
if dataParMinGranularity<=0 then halt("dataParMinGranularity must be > 0");

//
// Abstract distribution class
//
pragma "base dist"
class BaseDist {
  var _distCnt: atomic int;   // distribution reference count
  var _doms: list(BaseDom);   // domains declared over this domain
  var _domsLock: atomic bool; //   and lock for concurrent access

  pragma "dont disable remote value forwarding"
  proc destroyDist(dom: BaseDom = nil) {
    if dom then remove_dom(dom);
    var cnt = _distCnt.fetchSub(1)-1;
    if !noRefCount {
      if cnt < 0 then
        halt("distribution reference count is negative!");
    } else {
      if cnt > 0 then
        halt("distribution reference count has been modified!");
    }
    return cnt;
  }

  inline proc remove_dom(x) {
    _lock_doms();
    _doms.remove(x);
    _unlock_doms();
  }

  inline proc add_dom(x) {
    _lock_doms();
    _doms.append(x);
    _unlock_doms();
  }

  inline proc _lock_doms() {
    while (_domsLock.testAndSet()) do ;
  }

  inline proc _unlock_doms() {
    _domsLock.clear();
  }

  proc dsiNewRectangularDom(param rank: int, type idxType, param stridable: bool) {
    compilerError("rectangular domains not supported by this distribution");
  }

  proc dsiNewAssociativeDom(type idxType, param parSafe: bool) {
    compilerError("associative domains not supported by this distribution");
  }

  proc dsiNewAssociativeDom(type idxType, param parSafe: bool)
  where _isEnumeratedType(idxType) {
    compilerError("enumerated domains not supported by this distribution");
  }

  proc dsiNewOpaqueDom(type idxType, param parSafe: bool) {
    compilerError("opaque domains not supported by this distribution");
  }

  proc dsiNewSparseDom(param rank: int, type idxType, dom: domain) {
    compilerError("sparse domains not supported by this distribution");
  }

  proc dsiSupportsPrivatization() param return false;
  proc dsiRequiresPrivatization() param return false;

  proc dsiDestroyDistClass() { }

  proc dsiDisplayRepresentation() { }
}

//
// Abstract domain classes
//
pragma "base domain"
class BaseDom {
  var _domCnt: atomic int;    // domain reference count
  var _arrs: list(BaseArr);   // arrays declared over this domain
  var _arrsLock: atomic bool; //   and lock for concurrent access

  proc dsiMyDist(): BaseDist {
    halt("internal error: dsiMyDist is not implemented");
    return nil;
  }

  pragma "dont disable remote value forwarding"
  proc destroyDom(arr: BaseArr = nil) {
    if arr then remove_arr(arr);
    var cnt = _domCnt.fetchSub(1)-1;
    if !noRefCount {
      if cnt < 0 then
        halt("domain reference count is negative!");
    } else {
      if cnt > 0 then
        halt("domain reference count has been modified!");
    }
    if !noRefCount {
      if cnt == 0 && dsiLinksDistribution() {
        var dist = dsiMyDist();
        on dist {
          var cnt = dist.destroyDist(this);
          if cnt == 0 then
            delete dist;
        }
      }
    }
    return cnt;
  }

  inline proc remove_arr(x) {
    _lock_arrs();
    _arrs.remove(x);
    _unlock_arrs();
  }

  inline proc add_arr(x) {
    _lock_arrs();
    _arrs.append(x);
    _unlock_arrs();
  }

  inline proc _lock_arrs() {
    while (_arrsLock.testAndSet()) do ;
  }

  inline proc _unlock_arrs() {
    _arrsLock.clear();
  }

  // used for associative domains/arrays
  proc _backupArrays() {
    for arr in _arrs do
      arr._backupArray();
  }

  proc _removeArrayBackups() {
    for arr in _arrs do
      arr._removeArrayBackup();
  }

  proc _preserveArrayElements(oldslot, newslot) {
    for arr in _arrs do
      arr._preserveArrayElement(oldslot, newslot);
  }

  proc dsiSupportsPrivatization() param return false;
  proc dsiRequiresPrivatization() param return false;

  // false for default distribution so that we don't increment the
  // default distribution's reference count and add domains to the
  // default distribution's list of domains
  proc linksDistribution() param return true;

  // dynamically-dispatched counterpart of linksDistribution
  proc dsiLinksDistribution() return true;

  proc dsiDisplayRepresentation() { }
}

class BaseRectangularDom : BaseDom {
  proc dsiClear() {
    halt("clear not implemented for this distribution");
  }

  proc clearForIteratableAssign() {
    compilerError("Illegal assignment to a rectangular domain");
  }

  proc dsiAdd(x) {
    compilerError("Cannot add indices to a rectangular domain");
  }

  proc dsiRemove(x) {
    compilerError("Cannot remove indices from a rectangular domain");
  }
}

class BaseSparseDom : BaseDom {
  proc dsiClear() {
    halt("clear not implemented for this distribution");
  }

  proc clearForIteratableAssign() {
    dsiClear();
  }
}

class BaseAssociativeDom : BaseDom {
  proc dsiClear() {
    halt("clear not implemented for this distribution");
  }

  proc clearForIteratableAssign() {
    dsiClear();
  }
}

class BaseOpaqueDom : BaseDom {
  proc dsiClear() {
    halt("clear not implemented for this distribution");
  }

  proc clearForIteratableAssign() {
    dsiClear();
  }
}

//
// Abstract array class
//
pragma "base array"
class BaseArr {
  var _arrCnt: atomic int; // array reference count
  var _arrAlias: BaseArr;  // reference to base array if an alias

  proc dsiStaticFastFollowCheck(type leadType) param return false;

  proc canCopyFromDevice param return false;
  proc canCopyFromHost param return false;

  proc dsiGetBaseDom(): BaseDom {
    halt("internal error: dsiGetBaseDom is not implemented");
    return nil;
  }

  pragma "dont disable remote value forwarding"
  proc destroyArr(): int {
    var cnt = _arrCnt.fetchSub(1)-1;
    if !noRefCount {
      if cnt < 0 then
        halt("array reference count is negative!");
    } else {
      if cnt > 0 then
        halt("array reference count has been modified!");
    }
    if cnt == 0 {
      if _arrAlias {
        on _arrAlias {
          var cnt = _arrAlias.destroyArr();
          if cnt == 0 then
            delete _arrAlias;
        }
      } else {
        dsiDestroyData();
      }
    }
    if !noRefCount {
      if cnt == 0 {
        var dom = dsiGetBaseDom();
        on dom {
          var cnt = dom.destroyDom(this);
          if cnt == 0 then
            delete dom;
        }
      }
    }
    return cnt;
  }

  proc dsiDestroyData() { }

  proc dsiReallocate(d: domain) {
    halt("reallocating not supported for this array type");
  }

  proc dsiPostReallocate() {
  }

  // This method is unsatisfactory -- see bradc's commit entries of
  // 01/02/08 around 14:30 for details
  proc _purge( ind: int) {
    halt("purging not supported for this array type");
  }

  proc _resize( length: int, old_map) {
    halt("resizing not supported for this array type");
  }

  //
  // Ultimately, these routines should not appear here; instead, we'd
  // like to do a dynamic cast in the sparse array class(es) that call
  // these routines in order to call them directly and avoid the
  // dynamic dispatch and leaking of this name to the class.  In order
  // to do this we'd need to hoist eltType to the base class, which
  // would require better subclassing of generic classes.  A good
  // summer project for Jonathan?
  //
  proc sparseShiftArray(shiftrange, initrange) {
    halt("sparseGrowDomain not supported for non-sparse arrays");
  }

  proc sparseShiftArrayBack(shiftrange) {
    halt("sparseShiftArrayBack not supported for non-sparse arrays");
  }

  // methods for associative arrays
  proc clearEntry(idx) {
    halt("clearEntry() not supported for non-associative arrays");
  }

  proc _backupArray() {
    halt("_backupArray() not supported for non-associative arrays");
  }

  proc _removeArrayBackup() {
    halt("_removeArrayBackup() not supported for non-associative arrays");
  }

  proc _preserveArrayElement(oldslot, newslot) {
    halt("_preserveArrayElement() not supported for non-associative arrays");
  }

  proc dsiSupportsAlignedFollower() param return false;

  proc dsiSupportsPrivatization() param return false;
  proc dsiRequiresPrivatization() param return false;

  proc dsiSupportsBulkTransfer() param return false;
  proc doiCanBulkTransfer() param return false;
  proc doiBulkTransfer(B){
    halt("This array type does not support bulk transfer.");
  }

  proc dsiDisplayRepresentation() { }
}

}


Stop calling the associative domain leader from the array standalone iterator

Instead of calling the associative domain leader from the array standalone
iterator implement the logic in place.  This makes it more truthfully
standalone.

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

// DefaultAssociative.chpl
//
module DefaultAssociative {

  use DSIUtil;
  config param debugDefaultAssoc = false;
  config param debugAssocDataPar = false;

  use Sort /* only QuickSort */;

  // TODO: make the domain parameterized by this?
  type chpl_table_index_type = int;

  /* These declarations could/should both be nested within
     DefaultAssociativeDom? */
  enum chpl__hash_status { empty, full, deleted };

  record chpl_TableEntry {
    type idxType;
    var status: chpl__hash_status = chpl__hash_status.empty;
    var idx: idxType;
  }

  proc chpl__primes return (23, 53, 97, 193, 389, 769, 1543,
                           3079, 6151, 12289, 24593, 49157, 98317, 196613,
                           393241, 786433, 1572869, 3145739, 6291469, 12582917, 25165843,
                           50331653, 100663319, 201326611, 402653189, 805306457, 1610612741);

  class DefaultAssociativeDom: BaseAssociativeDom {
    type idxType;
    param parSafe: bool;

    var dist: DefaultDist;

    // The guts of the associative domain

    // We explicitly use processor atomics here since this is not
    // by design a distributed data structure
    var numEntries: atomic_int64;
    var tableLock: atomicflag; // do not access directly, use function below
    var tableSizeNum = 1;
    var tableSize = chpl__primes(tableSizeNum);
    var tableDom = {0..tableSize-1};
    var table: [tableDom] chpl_TableEntry(idxType);

    inline proc lockTable() {
      while tableLock.testAndSet() do chpl_task_yield();
    }

    inline proc unlockTable() {
      tableLock.clear();
    }

    // TODO: An ugly [0..-1] domain appears several times in the code --
    //       replace with a named constant/param?
    var postponeResize = false;

    proc linksDistribution() param return false;
    proc dsiLinksDistribution()     return false;

    proc DefaultAssociativeDom(type idxType,
                               param parSafe: bool,
                               dist: DefaultDist) {
      if !chpl__validDefaultAssocDomIdxType(idxType) then
        compilerError("Default Associative domains with idxType=",
                      typeToString(idxType), " are not allowed", 2);
      this.dist = dist;
    }

    //
    // Standard Internal Domain Interface
    //
    proc dsiBuildArray(type eltType) {
      return new DefaultAssociativeArr(eltType=eltType, idxType=idxType,
                                       parSafeDom=parSafe, dom=this);
    }

    proc dsiSerialReadWrite(f /*: Reader or Writer*/) {
      var first = true;
      f <~> new ioLiteral("{");
      for idx in this {
        if first then
          first = false;
        else
          f <~> new ioLiteral(", ");
        f <~> idx;
      }
      f <~> new ioLiteral("}");
    }
    proc dsiSerialWrite(f: Writer) { this.dsiSerialReadWrite(f); }
    proc dsiSerialRead(f: Reader) { this.dsiSerialReadWrite(f); }

    //
    // Standard user domain interface
    //

    inline proc dsiNumIndices {
      return numEntries.read();
    }

    iter dsiIndsIterSafeForRemoving() {
      postponeResize = true;
      for i in this.these() do
        yield i;
      on this {
        postponeResize = false;
        if (numEntries.read()*8 < tableSize && tableSizeNum > 1) {
          if parSafe then lockTable();
          if (numEntries.read()*8 < tableSize && tableSizeNum > 1) {
            _resize(grow=false);
          }
          if parSafe then unlockTable();
        }
      }
    }

    iter these() {
      if !isEnumType(idxType) {
        for slot in _fullSlots() {
          yield table[slot].idx;
        }
      } else {
        for val in chpl_enumerate(idxType) {
          var (match, slot) = _findFilledSlot(val);
          if match then
            yield table[slot].idx;
        }
      }
    }

    iter these(param tag: iterKind) where tag == iterKind.standalone {
      if debugDefaultAssoc then
        writeln("*** In associative domain standalone iterator");
      const numTasks = if dataParTasksPerLocale==0 then here.maxTaskPar
                       else dataParTasksPerLocale;
      const ignoreRunning = dataParIgnoreRunningTasks;
      const minIndicesPerTask = dataParMinGranularity;
      // We are simply slicing up the table here.  Trying to do something
      //  more intelligent (like evenly dividing up the full slots, led
      //  to poor speed ups.
      // This requires that the zipppered domains match.
      const numIndices = tableSize;
      if debugAssocDataPar {
        writeln("### numTasks = ", numTasks);
        writeln("### ignoreRunning = ", ignoreRunning);
        writeln("### minIndicesPerTask = ", minIndicesPerTask);
      }

      const numChunks = _computeNumChunks(numTasks, ignoreRunning,
                                          minIndicesPerTask,
                                          numIndices);

      if debugAssocDataPar then writeln("### numChunks=", numChunks, ", numIndices=", numIndices);

      if numChunks == 1 {
        var followThisTab = this.table;
        for slot in 0..numIndices-1 {
          if table[slot].status == chpl__hash_status.full then
            yield table[slot].idx;
        }
      } else {
        coforall chunk in 0..#numChunks {
          const (lo, hi) = _computeBlock(numIndices, numChunks,
                                         chunk, numIndices-1);
          if debugAssocDataPar then
            writeln("*** chunk: ", chunk, " owns ", lo..hi);
          for slot in lo..hi {
            if table[slot].status == chpl__hash_status.full then
              yield table[slot].idx;
          }
        }
      }
    }

    iter these(param tag: iterKind) where tag == iterKind.leader {
      if debugDefaultAssoc then
        writeln("*** In domain leader code:");
      const numTasks = if dataParTasksPerLocale==0 then here.maxTaskPar
                       else dataParTasksPerLocale;
      const ignoreRunning = dataParIgnoreRunningTasks;
      const minIndicesPerTask = dataParMinGranularity;
      // We are simply slicing up the table here.  Trying to do something
      //  more intelligent (like evenly dividing up the full slots, led
      //  to poor speed ups.
      // This requires that the zipppered domains match.
      const numIndices = tableSize;

      if debugAssocDataPar {
        writeln("### numTasks = ", numTasks);
        writeln("### ignoreRunning = ", ignoreRunning);
        writeln("### minIndicesPerTask = ", minIndicesPerTask);
      }

      if debugDefaultAssoc then
        writeln("    numTasks=", numTasks, " (", ignoreRunning,
                "), minIndicesPerTask=", minIndicesPerTask);

      var numChunks = _computeNumChunks(numTasks, ignoreRunning,
                                        minIndicesPerTask,
                                        numIndices);
      if debugDefaultAssoc then
        writeln("    numChunks=", numChunks, "length=", numIndices);

      if debugAssocDataPar then writeln("### numChunks=", numChunks);

      if numChunks == 1 {
        yield (0..numIndices-1, this);
      } else {
        coforall chunk in 0..#numChunks {
          const (lo, hi) = _computeBlock(numIndices, numChunks,
                                         chunk, numIndices-1);
          if debugDefaultAssoc then
            writeln("*** DI[", chunk, "]: tuple = ", (lo..hi,));
          yield (lo..hi, this);
        }
      }
    }

    iter these(param tag: iterKind, followThis) where tag == iterKind.follower {
      var (chunk, followThisDom) = followThis;
      if followThisDom != this {
        // check to see if domains match
        var followThisTab = followThisDom.table;
        var myTab = table;
        var mismatch = false;
        // could use a reduction
        for slot in chunk.low..chunk.high do
          if followThisTab[slot].status != myTab[slot].status {
            mismatch = true;
            break;
          }
        if mismatch then
          halt("zippered associative domains do not match");
      }

      if debugDefaultAssoc then
        writeln("In domain follower code: Following ", chunk);

      for slot in chunk.low..chunk.high do
        if table[slot].status == chpl__hash_status.full then
          yield table[slot].idx;
    }

    //
    // Associative Domain Interface
    //
    proc dsiClear() {
      on this {
        if parSafe then lockTable();
        for slot in tableDom {
          table[slot].status = chpl__hash_status.empty;
        }
        numEntries.write(0);
        if parSafe then unlockTable();
      }
    }

    proc dsiMember(idx: idxType): bool {
      return _findFilledSlot(idx)(1);
    }

    proc dsiAdd(idx: idxType, in slotNum : index(tableDom) = -1, haveLock = !parSafe): index(tableDom) {
      const inSlot = slotNum;
      on this {
        const shouldLock = !haveLock && parSafe;
        if shouldLock then lockTable();
        var findAgain = shouldLock;
        if ((numEntries.read()+1)*2 > tableSize) {
          _resize(grow=true);
          findAgain = true;
        }
        if findAgain then
          slotNum = _add(idx, -1);
        else
          _add(idx, inSlot);
        if shouldLock then unlockTable();
      }
      return slotNum;
    }

    // This routine adds new indices without checking the table size and
    //  is thus appropriate for use by routines like _resize().
    //
    // NOTE: Calls to this routine assume that the tableLock has been acquired.
    //
    proc _add(idx: idxType, in slotNum : index(tableDom) = -1): index(tableDom) {
      var foundSlot : bool = (slotNum != -1);
      if !foundSlot then
        (foundSlot, slotNum) = _findEmptySlot(idx);
      if foundSlot {
        table[slotNum].status = chpl__hash_status.full;
        table[slotNum].idx = idx;
        numEntries.add(1);
      } else {
        if (slotNum < 0) {
          halt("couldn't add ", idx, " -- ", numEntries.read(), " / ", tableSize, " taken");
          return -1;
        }
        // otherwise, re-adding an index that's already in there
      }
      return slotNum;
    }

    proc dsiRemove(idx: idxType) {
      on this {
        if parSafe then lockTable();
        const (foundSlot, slotNum) = _findFilledSlot(idx, haveLock=parSafe);
        if (foundSlot) {
          for a in _arrs do
            a.clearEntry(idx, true);
          table[slotNum].status = chpl__hash_status.deleted;
          numEntries.sub(1);
        } else {
          halt("index not in domain: ", idx);
        }
        if (numEntries.read()*8 < tableSize && tableSizeNum > 1) {
          _resize(grow=false);
        }
        if parSafe then unlockTable();
      }
    }

    proc dsiRequestCapacity(numKeys:int) {
      var entries = numEntries.read();

      if entries < numKeys {

        //Find the first suitable prime
        var threshhold = (numKeys + 1) * 2;
        var prime = 0;
        var primeLoc = 0;
        for i in 1..chpl__primes.size {
            if chpl__primes(i) > threshhold {
              prime = chpl__primes(i);
              primeLoc = i;
              break;
            }
        }

        //No suitable prime found
        if prime == 0 {
          halt("Requested capacity (", numKeys, ") exceeds maximum size");
        }

        //Changing underlying strucure, time for locking
        if parSafe then lockTable();
        if entries > 0 {
          // Slow path: back up required
          _backupArrays();

          // copy the table (TODO: could use swap between two versions)
          var copyDom = tableDom;
          var copyTable: [copyDom] chpl_TableEntry(idxType) = table;

          tableSizeNum=primeLoc;
          tableSize=prime;
          tableDom = {0..tableSize-1};

          //numEntries will be reconstructed as keys are readded
          numEntries.write(0);

          // insert old data into newly resized table
          for slot in _fullSlots(copyTable) {
            const newslot = _add(copyTable[slot].idx);
            _preserveArrayElements(oldslot=slot, newslot=newslot);
          }

          _removeArrayBackups();
        } else {
          //Fast path, nothing to backup
          tableSizeNum=primeLoc;
          tableSize=prime;
          tableDom = {0..tableSize-1};
        }

        //Unlock the table
        if parSafe then unlockTable();
      } else if entries > numKeys {
        warning("Requested capacity (" + numKeys + ") " +
                "is less than current size (" + entries + ")");
      }
    }

    iter dsiSorted() {
      var tableCopy: [0..#numEntries.read()] idxType;

      for (tmp, slot) in zip(tableCopy.domain, _fullSlots()) do
        tableCopy(tmp) = table[slot].idx;

      QuickSort(tableCopy);

      for ind in tableCopy do
        yield ind;
    }

    //
    // Internal interface (private)
    //
    // NOTE: Calls to this routine assume that the tableLock has been acquired.
    //
    proc _resize(grow:bool) {
      if postponeResize then return;
      // back up the arrays
      _backupArrays();

      // copy the table (TODO: could use swap between two versions)
      var copyDom = tableDom;
      var copyTable: [copyDom] chpl_TableEntry(idxType) = table;

      // grow original table
      tableDom = {0..(-1:chpl_table_index_type)}; // non-preserving resize
      numEntries.write(0); // reset, because the adds below will re-set this
      tableSizeNum += if grow then 1 else -1;
      if tableSizeNum > chpl__primes.size then halt("associative array exceeds maximum size");
      tableSize = chpl__primes(tableSizeNum);
      tableDom = {0..tableSize-1};

      // insert old data into newly resized table
      for slot in _fullSlots(copyTable) {
        const newslot = _add(copyTable[slot].idx);
        _preserveArrayElements(oldslot=slot, newslot=newslot);
      }

      _removeArrayBackups();
    }

    // Searches for 'idx' in a filled slot.
    //
    // Returns true if found, along with the first open slot that may be
    // re-used for faster addition to the domain
    proc _findFilledSlot(idx: idxType, param haveLock = false) : (bool, index(tableDom)) {
      if parSafe && !haveLock then lockTable();
      var firstOpen = -1;
      for slotNum in _lookForSlots(idx, table.domain.high+1) {
        const slotStatus = table[slotNum].status;
        // if we encounter a slot that's empty, our element could not
        // be found past this point.
        if (slotStatus == chpl__hash_status.empty) {
          if firstOpen == -1 then firstOpen = slotNum;
          if parSafe && !haveLock then unlockTable();
          return (false, firstOpen);
        } else if (slotStatus == chpl__hash_status.full) {
          if (table[slotNum].idx == idx) {
            if parSafe && !haveLock then unlockTable();
            return (true, slotNum);
          }
        } else { // this entry was removed, but is the first slot we could use
          if firstOpen == -1 then firstOpen = slotNum;
        }
      }
      if parSafe && !haveLock then unlockTable();
      return (false, -1);
    }

    //
    // NOTE: Calls to this routine assume that the tableLock has been acquired.
    //
    proc _findEmptySlot(idx: idxType, haveLock = false): (bool, index(tableDom)) {
      for slotNum in _lookForSlots(idx) {
        const slotStatus = table[slotNum].status;
        if (slotStatus == chpl__hash_status.empty ||
            slotStatus == chpl__hash_status.deleted) {
          return (true, slotNum);
        } else if (table[slotNum].idx == idx) {
          return (false, slotNum);
        }
      }
      return (false, -1);
    }

    //
    // NOTE: Calls to this routine assume that the tableLock has been acquired.
    //
    iter _lookForSlots(idx: idxType, numSlots = tableSize) {
      const baseSlot = chpl__defaultHashWrapper(idx);
      for probe in 0..numSlots/2 {
        yield (baseSlot + probe**2)%numSlots;
      }
    }

    iter _fullSlots(tab = table) {
      for slot in tab.domain {
        if tab[slot].status == chpl__hash_status.full then
          yield slot;
      }
    }
  }

  class DefaultAssociativeArr: BaseArr {
    type eltType;
    type idxType;
    param parSafeDom: bool;
    var dom : DefaultAssociativeDom(idxType, parSafe=parSafeDom);

    var data : [dom.tableDom] eltType;

    var tmpDom = {0..(-1:chpl_table_index_type)};
    var tmpTable: [tmpDom] eltType;

    //
    // Standard internal array interface
    //

    proc dsiGetBaseDom() return dom;

    proc clearEntry(idx: idxType, haveLock = false) {
      const initval: eltType;
      dsiAccess(idx, haveLock) = initval;
    }

    proc dsiAccess(idx : idxType, haveLock = false) ref {
      const shouldLock = dom.parSafe && !haveLock;
      if shouldLock then dom.lockTable();
      var (found, slotNum) = dom._findFilledSlot(idx, haveLock=true);
      if found {
        if shouldLock then dom.unlockTable();
        return data(slotNum);
      }
      else if setter && slotNum != -1 { // do an insert using the slot we found
        if dom._arrs.length != 1 {
          halt("cannot implicitly add to an array's domain when the domain is used by more than one array: ", dom._arrs.length);
          return data(0);
        } else {
          const newSlot = dom.dsiAdd(idx, slotNum, haveLock=true);
          if shouldLock then dom.unlockTable();
          return data(newSlot);
        }
      } else {
        halt("array index out of bounds: ", idx);
        return data(0);
      }
    }

    iter these() ref {
      for slot in dom {
        yield dsiAccess(slot);
      }
    }

    iter these(param tag: iterKind) ref where tag == iterKind.standalone {
      if debugDefaultAssoc then
        writeln("*** In associative array standalone iterator");
      const numTasks = if dataParTasksPerLocale==0 then here.maxTaskPar
                       else dataParTasksPerLocale;
      const ignoreRunning = dataParIgnoreRunningTasks;
      const minIndicesPerTask = dataParMinGranularity;
      const numIndices = dom.tableSize;
      const numChunks = _computeNumChunks(numTasks, ignoreRunning,
                                          minIndicesPerTask, numIndices);
      if numChunks == 1 {
        for slot in 0..#numIndices {
          if dom.table[slot].status == chpl__hash_status.full then
            yield data[slot];
        }
      } else {
        coforall chunk in 0..#numChunks {
          const (lo, hi) = _computeBlock(numIndices, numChunks,
                                         chunk, numIndices-1);
          if debugAssocDataPar then
            writeln("In associative array standalone iterator: chunk = ", chunk);
          var table = dom.table;
          for slot in lo..hi {
            if dom.table[slot].status == chpl__hash_status.full then
              yield data[slot];
          }
        }
      }
    }

    iter these(param tag: iterKind) where tag == iterKind.leader {
      for followThis in dom.these(tag) do
        yield followThis;
    }

    iter these(param tag: iterKind, followThis) ref where tag == iterKind.follower {
      var (chunk, followThisDom) = followThis;
      if followThisDom != dom {
        // check to see if domains match
        var followThisTab = followThisDom.table;
        var myTab = dom.table;
        var mismatch = false;
        // could use a reduction
        for slot in chunk.low..chunk.high do
          if followThisTab[slot].status != myTab[slot].status {
            mismatch = true;
            break;
          }
        if mismatch then
          halt("zippered associative array does not match the iterated domain");
      }
      if debugDefaultAssoc then
        writeln("In array follower code: Following ", chunk);
      var tab = dom.table;  // cache table for performance
      for slot in chunk.low..chunk.high do
        if tab[slot].status == chpl__hash_status.full then
          yield data(slot);
    }

    proc dsiSerialReadWrite(f /*: Reader or Writer*/) {
      var first = true;
      for val in this {
        if (first) then
          first = false;
        else
          f <~> new ioLiteral(" ");
        f <~> val;
      }
    }
    proc dsiSerialWrite(f: Writer) { this.dsiSerialReadWrite(f); }
    proc dsiSerialRead(f: Reader) { this.dsiSerialReadWrite(f); }

    //
    // Associative array interface
    //

    iter dsiSorted() {
      var tableCopy: [0..dom.dsiNumIndices-1] eltType;
      for (copy, slot) in zip(tableCopy.domain, dom._fullSlots()) do
        tableCopy(copy) = data(slot);

      QuickSort(tableCopy);

      for elem in tableCopy do
        yield elem;
    }

    //
    // Internal associative array interface
    //

    proc _backupArray() {
      tmpDom = dom.tableDom;
      tmpTable = data;
    }

    proc _removeArrayBackup() {
      tmpDom = {0..(-1:chpl_table_index_type)};
    }

    proc _preserveArrayElement(oldslot, newslot) {
      data(newslot) = tmpTable[oldslot];
    }

    proc dsiTargetLocales() {
      compilerError("targetLocales is unsupported by associative domains");
    }

    proc dsiHasSingleLocalSubdomain() param return true;

    proc dsiLocalSubdomain() {
      return _newDomain(dom);
    }
  }

  proc chpl__defaultHashWrapper(x): chpl_table_index_type {
    const hash = chpl__defaultHash(x);
    return (hash & max(chpl_table_index_type)): chpl_table_index_type;
  }

  // Thomas Wang's 64b mix function from http://www.concentric.net/~Ttwang/tech/inthash.htm
  proc _gen_key(i: int(64)): int(64) {
    var key = i;
    key += ~(key << 32);
    key = key ^ (key >> 22);
    key += ~(key << 13);
    key = key ^ (key >> 8);
    key += (key << 3);
    key = key ^ (key >> 15);
    key += ~(key << 27);
    key = key ^ (key >> 31);
    return (key & max(int(64))): int(64);  // YAH, make non-negative
  }

  inline proc chpl__defaultHash(b: bool): int(64) {
    if (b) then
      return 0;
    else
      return 1;
  }

  inline proc chpl__defaultHash(i: int(64)): int(64) {
    return _gen_key(i);
  }

  inline proc chpl__defaultHash(u: uint(64)): int(64) {
    return _gen_key(u:int(64));
  }

  inline proc chpl__defaultHash(f: real): int(64) {
    return _gen_key(__primitive( "real2int", f));
  }

  inline proc chpl__defaultHash(c: complex): int(64) {
    return _gen_key(__primitive("real2int", c.re) ^ __primitive("real2int", c.im));
  }

  inline proc chpl__defaultHash(a: imag): int(64) {
    return _gen_key(__primitive( "real2int", _i2r(a)));
  }

  inline proc chpl__defaultHash(u: chpl_taskID_t): int(64) {
    return _gen_key(u:int(64));
  }

  // Use djb2 (Dan Bernstein in comp.lang.c)
  inline proc chpl__defaultHash(x : string): int(64) {
    return chpl__defaultHash(x.c_str());
  }

  inline proc chpl__defaultHash(x : c_string): int(64) {
    var hash: int(64) = 0;
    for c in 1..(x.length) {
      hash = ((hash << 5) + hash) ^ ascii(x.substring(c));
    }
    return _gen_key(hash);
  }

  inline proc chpl__defaultHash(l : []) {
      var hash : int(64) = 0;
      for obj in l {
          hash = (31 * hash) + chpl__defaultHash(obj);
      }

      return _gen_key(hash);
  }

  inline proc chpl__defaultHash(o: object): int(64) {
    return _gen_key(__primitive( "object2int", o));
  }

  // Is 'idxType' legal to create a default associative domain with?
  // Currently based on the availability of chpl__defaultHash().
  // Enumerated, opaque, and sparse domains are handled separately.
  // Tuples and records also work, somehow.
  proc chpl__validDefaultAssocDomIdxType(type idxType) param return false;

  proc chpl__validDefaultAssocDomIdxType(type idxType) param where
      // one check per an implementation of chpl__defaultHash() above
      isBoolType(idxType)     ||
      isIntType(idxType)      ||
      isUintType(idxType)    ||
      isRealType(idxType)        ||
      isImagType(idxType)        ||
      isComplexType(idxType)     ||
      idxType == chpl_taskID_t    ||
      idxType == string           ||
      idxType == c_string         ||
      isClassType(idxType)        ||
      // these are handled differently
      isEnumType(idxType)  ||
      isTupleType(idxType)        ||
      isRecordType(idxType)
  {
    return true;
  }

}

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

// DefaultAssociative.chpl
//
module DefaultAssociative {

  use DSIUtil;
  config param debugDefaultAssoc = false;
  config param debugAssocDataPar = false;

  use Sort /* only QuickSort */;

  // TODO: make the domain parameterized by this?
  type chpl_table_index_type = int;

  /* These declarations could/should both be nested within
     DefaultAssociativeDom? */
  enum chpl__hash_status { empty, full, deleted };

  record chpl_TableEntry {
    type idxType;
    var status: chpl__hash_status = chpl__hash_status.empty;
    var idx: idxType;
  }

  proc chpl__primes return (23, 53, 97, 193, 389, 769, 1543,
                           3079, 6151, 12289, 24593, 49157, 98317, 196613,
                           393241, 786433, 1572869, 3145739, 6291469, 12582917, 25165843,
                           50331653, 100663319, 201326611, 402653189, 805306457, 1610612741);

  class DefaultAssociativeDom: BaseAssociativeDom {
    type idxType;
    param parSafe: bool;

    var dist: DefaultDist;

    // The guts of the associative domain

    // We explicitly use processor atomics here since this is not
    // by design a distributed data structure
    var numEntries: atomic_int64;
    var tableLock: atomicflag; // do not access directly, use function below
    var tableSizeNum = 1;
    var tableSize = chpl__primes(tableSizeNum);
    var tableDom = {0..tableSize-1};
    var table: [tableDom] chpl_TableEntry(idxType);

    inline proc lockTable() {
      while tableLock.testAndSet() do chpl_task_yield();
    }

    inline proc unlockTable() {
      tableLock.clear();
    }

    // TODO: An ugly [0..-1] domain appears several times in the code --
    //       replace with a named constant/param?
    var postponeResize = false;

    proc linksDistribution() param return false;
    proc dsiLinksDistribution()     return false;

    proc DefaultAssociativeDom(type idxType,
                               param parSafe: bool,
                               dist: DefaultDist) {
      if !chpl__validDefaultAssocDomIdxType(idxType) then
        compilerError("Default Associative domains with idxType=",
                      typeToString(idxType), " are not allowed", 2);
      this.dist = dist;
    }

    //
    // Standard Internal Domain Interface
    //
    proc dsiBuildArray(type eltType) {
      return new DefaultAssociativeArr(eltType=eltType, idxType=idxType,
                                       parSafeDom=parSafe, dom=this);
    }

    proc dsiSerialReadWrite(f /*: Reader or Writer*/) {
      var first = true;
      f <~> new ioLiteral("{");
      for idx in this {
        if first then
          first = false;
        else
          f <~> new ioLiteral(", ");
        f <~> idx;
      }
      f <~> new ioLiteral("}");
    }
    proc dsiSerialWrite(f: Writer) { this.dsiSerialReadWrite(f); }
    proc dsiSerialRead(f: Reader) { this.dsiSerialReadWrite(f); }

    //
    // Standard user domain interface
    //

    inline proc dsiNumIndices {
      return numEntries.read();
    }

    iter dsiIndsIterSafeForRemoving() {
      postponeResize = true;
      for i in this.these() do
        yield i;
      on this {
        postponeResize = false;
        if (numEntries.read()*8 < tableSize && tableSizeNum > 1) {
          if parSafe then lockTable();
          if (numEntries.read()*8 < tableSize && tableSizeNum > 1) {
            _resize(grow=false);
          }
          if parSafe then unlockTable();
        }
      }
    }

    iter these() {
      if !isEnumType(idxType) {
        for slot in _fullSlots() {
          yield table[slot].idx;
        }
      } else {
        for val in chpl_enumerate(idxType) {
          var (match, slot) = _findFilledSlot(val);
          if match then
            yield table[slot].idx;
        }
      }
    }

    iter these(param tag: iterKind) where tag == iterKind.standalone {
      if debugDefaultAssoc then
        writeln("*** In domain standalone code:");
      const numTasks = if dataParTasksPerLocale==0 then here.maxTaskPar
                       else dataParTasksPerLocale;
      const ignoreRunning = dataParIgnoreRunningTasks;
      const minIndicesPerTask = dataParMinGranularity;
      // We are simply slicing up the table here.  Trying to do something
      //  more intelligent (like evenly dividing up the full slots, led
      //  to poor speed ups.
      // This requires that the zipppered domains match.
      const numIndices = tableSize;
      if debugAssocDataPar {
        writeln("### numTasks = ", numTasks);
        writeln("### ignoreRunning = ", ignoreRunning);
        writeln("### minIndicesPerTask = ", minIndicesPerTask);
      }

      if debugDefaultAssoc then
        writeln("    numTasks=", numTasks, " (", ignoreRunning,
                "), minIndicesPerTask=", minIndicesPerTask);

      const numChunks = _computeNumChunks(numTasks, ignoreRunning,
                                          minIndicesPerTask,
                                          numIndices);
      if debugDefaultAssoc then
        writeln("    numChunks=", numChunks, " length=", numIndices);

      if debugAssocDataPar then writeln("### numChunks=", numChunks);

      if numChunks == 1 {
        var followThisTab = this.table;
        for slot in 0..numIndices-1 {
          if table[slot].status == chpl__hash_status.full then
            yield table[slot].idx;
        }
      } else {
        coforall chunk in 0..#numChunks {
          const (lo, hi) = _computeBlock(numIndices, numChunks,
                                         chunk, numIndices-1);
          if debugDefaultAssoc then
            writeln("*** DI[", chunk, "]: tuple = ", (lo..hi,));
          for slot in lo..hi {
            if table[slot].status == chpl__hash_status.full then
              yield table[slot].idx;
          }
        }
      }
    }

    iter these(param tag: iterKind) where tag == iterKind.leader {
      if debugDefaultAssoc then
        writeln("*** In domain leader code:");
      const numTasks = if dataParTasksPerLocale==0 then here.maxTaskPar
                       else dataParTasksPerLocale;
      const ignoreRunning = dataParIgnoreRunningTasks;
      const minIndicesPerTask = dataParMinGranularity;
      // We are simply slicing up the table here.  Trying to do something
      //  more intelligent (like evenly dividing up the full slots, led
      //  to poor speed ups.
      // This requires that the zipppered domains match.
      const numIndices = tableSize;

      if debugAssocDataPar {
        writeln("### numTasks = ", numTasks);
        writeln("### ignoreRunning = ", ignoreRunning);
        writeln("### minIndicesPerTask = ", minIndicesPerTask);
      }

      if debugDefaultAssoc then
        writeln("    numTasks=", numTasks, " (", ignoreRunning,
                "), minIndicesPerTask=", minIndicesPerTask);

      var numChunks = _computeNumChunks(numTasks, ignoreRunning,
                                        minIndicesPerTask,
                                        numIndices);
      if debugDefaultAssoc then
        writeln("    numChunks=", numChunks, "length=", numIndices);

      if debugAssocDataPar then writeln("### numChunks=", numChunks);

      if numChunks == 1 {
        yield (0..numIndices-1, this);
      } else {
        coforall chunk in 0..#numChunks {
          const (lo, hi) = _computeBlock(numIndices, numChunks,
                                         chunk, numIndices-1);
          if debugDefaultAssoc then
            writeln("*** DI[", chunk, "]: tuple = ", (lo..hi,));
          yield (lo..hi, this);
        }
      }
    }

    iter these(param tag: iterKind, followThis) where tag == iterKind.follower {
      var (chunk, followThisDom) = followThis;
      if followThisDom != this {
        // check to see if domains match
        var followThisTab = followThisDom.table;
        var myTab = table;
        var mismatch = false;
        // could use a reduction
        for slot in chunk.low..chunk.high do
          if followThisTab[slot].status != myTab[slot].status {
            mismatch = true;
            break;
          }
        if mismatch then
          halt("zippered associative domains do not match");
      }

      if debugDefaultAssoc then
        writeln("In domain follower code: Following ", chunk);

      for slot in chunk.low..chunk.high do
        if table[slot].status == chpl__hash_status.full then
          yield table[slot].idx;
    }

    //
    // Associative Domain Interface
    //
    proc dsiClear() {
      on this {
        if parSafe then lockTable();
        for slot in tableDom {
          table[slot].status = chpl__hash_status.empty;
        }
        numEntries.write(0);
        if parSafe then unlockTable();
      }
    }

    proc dsiMember(idx: idxType): bool {
      return _findFilledSlot(idx)(1);
    }

    proc dsiAdd(idx: idxType, in slotNum : index(tableDom) = -1, haveLock = !parSafe): index(tableDom) {
      const inSlot = slotNum;
      on this {
        const shouldLock = !haveLock && parSafe;
        if shouldLock then lockTable();
        var findAgain = shouldLock;
        if ((numEntries.read()+1)*2 > tableSize) {
          _resize(grow=true);
          findAgain = true;
        }
        if findAgain then
          slotNum = _add(idx, -1);
        else
          _add(idx, inSlot);
        if shouldLock then unlockTable();
      }
      return slotNum;
    }

    // This routine adds new indices without checking the table size and
    //  is thus appropriate for use by routines like _resize().
    //
    // NOTE: Calls to this routine assume that the tableLock has been acquired.
    //
    proc _add(idx: idxType, in slotNum : index(tableDom) = -1): index(tableDom) {
      var foundSlot : bool = (slotNum != -1);
      if !foundSlot then
        (foundSlot, slotNum) = _findEmptySlot(idx);
      if foundSlot {
        table[slotNum].status = chpl__hash_status.full;
        table[slotNum].idx = idx;
        numEntries.add(1);
      } else {
        if (slotNum < 0) {
          halt("couldn't add ", idx, " -- ", numEntries.read(), " / ", tableSize, " taken");
          return -1;
        }
        // otherwise, re-adding an index that's already in there
      }
      return slotNum;
    }

    proc dsiRemove(idx: idxType) {
      on this {
        if parSafe then lockTable();
        const (foundSlot, slotNum) = _findFilledSlot(idx, haveLock=parSafe);
        if (foundSlot) {
          for a in _arrs do
            a.clearEntry(idx, true);
          table[slotNum].status = chpl__hash_status.deleted;
          numEntries.sub(1);
        } else {
          halt("index not in domain: ", idx);
        }
        if (numEntries.read()*8 < tableSize && tableSizeNum > 1) {
          _resize(grow=false);
        }
        if parSafe then unlockTable();
      }
    }

    proc dsiRequestCapacity(numKeys:int) {
      var entries = numEntries.read();

      if entries < numKeys {

        //Find the first suitable prime
        var threshhold = (numKeys + 1) * 2;
        var prime = 0;
        var primeLoc = 0;
        for i in 1..chpl__primes.size {
            if chpl__primes(i) > threshhold {
              prime = chpl__primes(i);
              primeLoc = i;
              break;
            }
        }

        //No suitable prime found
        if prime == 0 {
          halt("Requested capacity (", numKeys, ") exceeds maximum size");
        }

        //Changing underlying strucure, time for locking
        if parSafe then lockTable();
        if entries > 0 {
          // Slow path: back up required
          _backupArrays();

          // copy the table (TODO: could use swap between two versions)
          var copyDom = tableDom;
          var copyTable: [copyDom] chpl_TableEntry(idxType) = table;

          tableSizeNum=primeLoc;
          tableSize=prime;
          tableDom = {0..tableSize-1};

          //numEntries will be reconstructed as keys are readded
          numEntries.write(0);

          // insert old data into newly resized table
          for slot in _fullSlots(copyTable) {
            const newslot = _add(copyTable[slot].idx);
            _preserveArrayElements(oldslot=slot, newslot=newslot);
          }

          _removeArrayBackups();
        } else {
          //Fast path, nothing to backup
          tableSizeNum=primeLoc;
          tableSize=prime;
          tableDom = {0..tableSize-1};
        }

        //Unlock the table
        if parSafe then unlockTable();
      } else if entries > numKeys {
        warning("Requested capacity (" + numKeys + ") " +
                "is less than current size (" + entries + ")");
      }
    }

    iter dsiSorted() {
      var tableCopy: [0..#numEntries.read()] idxType;

      for (tmp, slot) in zip(tableCopy.domain, _fullSlots()) do
        tableCopy(tmp) = table[slot].idx;

      QuickSort(tableCopy);

      for ind in tableCopy do
        yield ind;
    }

    //
    // Internal interface (private)
    //
    // NOTE: Calls to this routine assume that the tableLock has been acquired.
    //
    proc _resize(grow:bool) {
      if postponeResize then return;
      // back up the arrays
      _backupArrays();

      // copy the table (TODO: could use swap between two versions)
      var copyDom = tableDom;
      var copyTable: [copyDom] chpl_TableEntry(idxType) = table;

      // grow original table
      tableDom = {0..(-1:chpl_table_index_type)}; // non-preserving resize
      numEntries.write(0); // reset, because the adds below will re-set this
      tableSizeNum += if grow then 1 else -1;
      if tableSizeNum > chpl__primes.size then halt("associative array exceeds maximum size");
      tableSize = chpl__primes(tableSizeNum);
      tableDom = {0..tableSize-1};

      // insert old data into newly resized table
      for slot in _fullSlots(copyTable) {
        const newslot = _add(copyTable[slot].idx);
        _preserveArrayElements(oldslot=slot, newslot=newslot);
      }

      _removeArrayBackups();
    }

    // Searches for 'idx' in a filled slot.
    //
    // Returns true if found, along with the first open slot that may be
    // re-used for faster addition to the domain
    proc _findFilledSlot(idx: idxType, param haveLock = false) : (bool, index(tableDom)) {
      if parSafe && !haveLock then lockTable();
      var firstOpen = -1;
      for slotNum in _lookForSlots(idx, table.domain.high+1) {
        const slotStatus = table[slotNum].status;
        // if we encounter a slot that's empty, our element could not
        // be found past this point.
        if (slotStatus == chpl__hash_status.empty) {
          if firstOpen == -1 then firstOpen = slotNum;
          if parSafe && !haveLock then unlockTable();
          return (false, firstOpen);
        } else if (slotStatus == chpl__hash_status.full) {
          if (table[slotNum].idx == idx) {
            if parSafe && !haveLock then unlockTable();
            return (true, slotNum);
          }
        } else { // this entry was removed, but is the first slot we could use
          if firstOpen == -1 then firstOpen = slotNum;
        }
      }
      if parSafe && !haveLock then unlockTable();
      return (false, -1);
    }

    //
    // NOTE: Calls to this routine assume that the tableLock has been acquired.
    //
    proc _findEmptySlot(idx: idxType, haveLock = false): (bool, index(tableDom)) {
      for slotNum in _lookForSlots(idx) {
        const slotStatus = table[slotNum].status;
        if (slotStatus == chpl__hash_status.empty ||
            slotStatus == chpl__hash_status.deleted) {
          return (true, slotNum);
        } else if (table[slotNum].idx == idx) {
          return (false, slotNum);
        }
      }
      return (false, -1);
    }

    //
    // NOTE: Calls to this routine assume that the tableLock has been acquired.
    //
    iter _lookForSlots(idx: idxType, numSlots = tableSize) {
      const baseSlot = chpl__defaultHashWrapper(idx);
      for probe in 0..numSlots/2 {
        yield (baseSlot + probe**2)%numSlots;
      }
    }

    iter _fullSlots(tab = table) {
      for slot in tab.domain {
        if tab[slot].status == chpl__hash_status.full then
          yield slot;
      }
    }
  }

  class DefaultAssociativeArr: BaseArr {
    type eltType;
    type idxType;
    param parSafeDom: bool;
    var dom : DefaultAssociativeDom(idxType, parSafe=parSafeDom);

    var data : [dom.tableDom] eltType;

    var tmpDom = {0..(-1:chpl_table_index_type)};
    var tmpTable: [tmpDom] eltType;

    //
    // Standard internal array interface
    //

    proc dsiGetBaseDom() return dom;

    proc clearEntry(idx: idxType, haveLock = false) {
      const initval: eltType;
      dsiAccess(idx, haveLock) = initval;
    }

    proc dsiAccess(idx : idxType, haveLock = false) ref {
      const shouldLock = dom.parSafe && !haveLock;
      if shouldLock then dom.lockTable();
      var (found, slotNum) = dom._findFilledSlot(idx, haveLock=true);
      if found {
        if shouldLock then dom.unlockTable();
        return data(slotNum);
      }
      else if setter && slotNum != -1 { // do an insert using the slot we found
        if dom._arrs.length != 1 {
          halt("cannot implicitly add to an array's domain when the domain is used by more than one array: ", dom._arrs.length);
          return data(0);
        } else {
          const newSlot = dom.dsiAdd(idx, slotNum, haveLock=true);
          if shouldLock then dom.unlockTable();
          return data(newSlot);
        }
      } else {
        halt("array index out of bounds: ", idx);
        return data(0);
      }
    }

    iter these() ref {
      for slot in dom {
        yield dsiAccess(slot);
      }
    }

    iter these(param tag: iterKind) ref where tag == iterKind.standalone {
      if debugDefaultAssoc then
        writeln("In array standalone code");

      for followThis in dom.these(iterKind.leader) {
        var (chunk, unused) = followThis;
        if debugDefaultAssoc then
          writeln("In array standalone code: chunk = ", chunk);
        var table = dom.table;
        for slot in chunk {
          if table[slot].status == chpl__hash_status.full then
            yield data[slot];
        }
      }
    }

    iter these(param tag: iterKind) where tag == iterKind.leader {
      for followThis in dom.these(tag) do
        yield followThis;
    }

    iter these(param tag: iterKind, followThis) ref where tag == iterKind.follower {
      var (chunk, followThisDom) = followThis;
      if followThisDom != dom {
        // check to see if domains match
        var followThisTab = followThisDom.table;
        var myTab = dom.table;
        var mismatch = false;
        // could use a reduction
        for slot in chunk.low..chunk.high do
          if followThisTab[slot].status != myTab[slot].status {
            mismatch = true;
            break;
          }
        if mismatch then
          halt("zippered associative array does not match the iterated domain");
      }
      if debugDefaultAssoc then
        writeln("In array follower code: Following ", chunk);
      var tab = dom.table;  // cache table for performance
      for slot in chunk.low..chunk.high do
        if tab[slot].status == chpl__hash_status.full then
          yield data(slot);
    }

    proc dsiSerialReadWrite(f /*: Reader or Writer*/) {
      var first = true;
      for val in this {
        if (first) then
          first = false;
        else
          f <~> new ioLiteral(" ");
        f <~> val;
      }
    }
    proc dsiSerialWrite(f: Writer) { this.dsiSerialReadWrite(f); }
    proc dsiSerialRead(f: Reader) { this.dsiSerialReadWrite(f); }

    //
    // Associative array interface
    //

    iter dsiSorted() {
      var tableCopy: [0..dom.dsiNumIndices-1] eltType;
      for (copy, slot) in zip(tableCopy.domain, dom._fullSlots()) do
        tableCopy(copy) = data(slot);

      QuickSort(tableCopy);

      for elem in tableCopy do
        yield elem;
    }

    //
    // Internal associative array interface
    //

    proc _backupArray() {
      tmpDom = dom.tableDom;
      tmpTable = data;
    }

    proc _removeArrayBackup() {
      tmpDom = {0..(-1:chpl_table_index_type)};
    }

    proc _preserveArrayElement(oldslot, newslot) {
      data(newslot) = tmpTable[oldslot];
    }

    proc dsiTargetLocales() {
      compilerError("targetLocales is unsupported by associative domains");
    }

    proc dsiHasSingleLocalSubdomain() param return true;

    proc dsiLocalSubdomain() {
      return _newDomain(dom);
    }
  }

  proc chpl__defaultHashWrapper(x): chpl_table_index_type {
    const hash = chpl__defaultHash(x);
    return (hash & max(chpl_table_index_type)): chpl_table_index_type;
  }

  // Thomas Wang's 64b mix function from http://www.concentric.net/~Ttwang/tech/inthash.htm
  proc _gen_key(i: int(64)): int(64) {
    var key = i;
    key += ~(key << 32);
    key = key ^ (key >> 22);
    key += ~(key << 13);
    key = key ^ (key >> 8);
    key += (key << 3);
    key = key ^ (key >> 15);
    key += ~(key << 27);
    key = key ^ (key >> 31);
    return (key & max(int(64))): int(64);  // YAH, make non-negative
  }

  inline proc chpl__defaultHash(b: bool): int(64) {
    if (b) then
      return 0;
    else
      return 1;
  }

  inline proc chpl__defaultHash(i: int(64)): int(64) {
    return _gen_key(i);
  }

  inline proc chpl__defaultHash(u: uint(64)): int(64) {
    return _gen_key(u:int(64));
  }

  inline proc chpl__defaultHash(f: real): int(64) {
    return _gen_key(__primitive( "real2int", f));
  }

  inline proc chpl__defaultHash(c: complex): int(64) {
    return _gen_key(__primitive("real2int", c.re) ^ __primitive("real2int", c.im));
  }

  inline proc chpl__defaultHash(a: imag): int(64) {
    return _gen_key(__primitive( "real2int", _i2r(a)));
  }

  inline proc chpl__defaultHash(u: chpl_taskID_t): int(64) {
    return _gen_key(u:int(64));
  }

  // Use djb2 (Dan Bernstein in comp.lang.c)
  inline proc chpl__defaultHash(x : string): int(64) {
    return chpl__defaultHash(x.c_str());
  }

  inline proc chpl__defaultHash(x : c_string): int(64) {
    var hash: int(64) = 0;
    for c in 1..(x.length) {
      hash = ((hash << 5) + hash) ^ ascii(x.substring(c));
    }
    return _gen_key(hash);
  }

  inline proc chpl__defaultHash(l : []) {
      var hash : int(64) = 0;
      for obj in l {
          hash = (31 * hash) + chpl__defaultHash(obj);
      }

      return _gen_key(hash);
  }

  inline proc chpl__defaultHash(o: object): int(64) {
    return _gen_key(__primitive( "object2int", o));
  }

  // Is 'idxType' legal to create a default associative domain with?
  // Currently based on the availability of chpl__defaultHash().
  // Enumerated, opaque, and sparse domains are handled separately.
  // Tuples and records also work, somehow.
  proc chpl__validDefaultAssocDomIdxType(type idxType) param return false;

  proc chpl__validDefaultAssocDomIdxType(type idxType) param where
      // one check per an implementation of chpl__defaultHash() above
      isBoolType(idxType)     ||
      isIntType(idxType)      ||
      isUintType(idxType)    ||
      isRealType(idxType)        ||
      isImagType(idxType)        ||
      isComplexType(idxType)     ||
      idxType == chpl_taskID_t    ||
      idxType == string           ||
      idxType == c_string         ||
      isClassType(idxType)        ||
      // these are handled differently
      isEnumType(idxType)  ||
      isTupleType(idxType)        ||
      isRecordType(idxType)
  {
    return true;
  }

}


More chameneos cleanup

More chameneos cleanup

* removed a duplicate comment

* added a TODO

* reordered procedures to reflect where populations are created now

* improved a few comments

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

/* The Computer Language Benchmarks Game
   http://benchmarksgame.alioth.debian.org/

   contributed by Hannah Hemmaplardh
   modified by Lydia Duncan and Brad Chamberlain
*/

//
// the following params indicate the number of bits to use when storing
// IDs in a meeting place's 'state' and the corresponding bitmask
// to use when extracting chameneos IDs, respectively.
//
config param NUM_CHAMENEOS_ID_BITS = 8;
param CHAMENEOS_ID_MASK = (0x1 << NUM_CHAMENEOS_ID_BITS) - 1;

config const n = 100,                // number of meetings to take place
             numChameneos1 = 3,      // size of population 1
             numChameneos2 = 10;     // size of population 2

if (numChameneos1 < 2 || numChameneos2 < 2) then
  halt("There must be at least 2 chameneos");

if (n < 0) then
  halt("the number of meetings must be non-negative");

//
// TODO: We should arguably also check that the number of bits
// devoted to chameneos IDs and meeting IDs are enough to store
// numChameneos1/2 and n, respectively.
//

//
// the colors the chameneos can take on
//
param numColors = 3;
enum Color {blue=0, red, yellow};
//
// TODO: Would be cool to support a param .size query for enums to
// avoid the whole C "declare one extra enum for the number" hack and
// then we could do param numColors = Color.size; (or, if not size,
// some other query function).
//

proc main() {
  //
  // print out the equations that govern chameneos color changes
  //
  printColorEquations();

  //
  // run two simulations for the two different population sizes
  //
  run(numChameneos1);
  run(numChameneos2);
}

//
// run() takes a number of chameneos as input and creates as
// population of that size, then allows them to meet in parallel.
//
proc run(numChameneos) {
  //
  // create a meeting place
  //
  const meetingPlace = new MeetingPlace(n);

  //
  // create the population of chameneos
  //
  const chameneos = createChameneos(numChameneos);

  //
  // print the chameneos's initial colors
  //
  for c in chameneos do
    write(" ", c.color);
  writeln();

  //
  // fire off a task per chameneos, and have them try to meet
  //
  coforall c in chameneos do
    c.tryToMeet(meetingPlace, chameneos);

  //
  // print information about the run
  //
  printInfo(chameneos);
}

//
// This class represents a place for chameneos to meet
//
class MeetingPlace {
  //
  // the 'state' variable packs a chameneos ID in the bottom
  // NUM_CHAMENEOS_ID_BITS bits and the number of meetings in the
  // upper ones, permitting atomic operations to be performed on both
  // values simultaneously.
  //
  var state: atomic int;

  //
  // constructor initializes the number of meetings to take place
  //
  proc MeetingPlace(numMeetings) {
    state.write(numMeetings << NUM_CHAMENEOS_ID_BITS);
  }
}

//
// createChameneos() creates an array of chameneos of the given size.
// If the size is 10, it uses the predefined array of colors;
// otherwise, it deals out colors round-robin.
//
//
// TODO: Currently, the compiler prints out an error if we remove the
// return type from here; seems it would be nicer if it just put in
// the array temp?  (unless we think we want to return unevaluated
// iterators, which we may?  But even then, maybe in the meantime, we
// should realize it?)
//
proc createChameneos(size): [1..size] Chameneos {
  //
  // TODO: Really want support for 'use Color' for cases like this
  //
  const colorsFor10 = [Color.blue, Color.red, Color.yellow, Color.red,
                       Color.yellow, Color.blue, Color.red, Color.yellow,
                       Color.red, Color.blue];

  return [i in 1..size] new Chameneos(i, if (size == 10) then colorsFor10[i]
                                                         else ((i-1)%3):Color);
}

//
// a class representing a chameneos
//
class Chameneos {
  const id: int;                       // its unique ID
  var color: Color;                    // its color
  var meetings,                        // the number of meetings it's had
      meetingsWithSelf: int;           // the number of meetings with itself
  var meetingCompleted: atomic bool;   // indicates that a meeting is over

  //
  // tryToMeet() tells a chameneos to go to a given MeetingPlace,
  // and try to get involved in meetings with the rest of the
  // population.  If it is first, it can try to wait for another
  // chameneos to arrive; if it is second, it can try to meet with the
  // first chameneos.  The word 'try' is used because other chameneos
  // may be trying to do the same thing simultaneously and beat it to
  // the action.
  //
  proc tryToMeet(meetingPlace, chameneos) {
    //
    // keep trying to meet, as long as there are meetings remaining
    //
    do {
      //
      // grab a copy of the current state
      //
      const currentState = meetingPlace.state.read(memory_order_acquire);

      //
      // if the current state is non-empty, meetings remain
      //
      if (currentState) {
        //
        // extract the number of remaining meetings and the other
        // chameneos's index (if one is present) from the state
        //
        const meetingsLeft = currentState >> NUM_CHAMENEOS_ID_BITS,
              peer_idx = currentState & CHAMENEOS_ID_MASK;

        var newState: int;  // we'll store the new state here

        if (peer_idx) {
          //
          // if another chameneos was waiting in the meeting place, we
          // will hope to meet with it; if we can, the resulting state
          // would have one fewer meetings and no waiting chameneos.
          //
          newState = (meetingsLeft - 1) << NUM_CHAMENEOS_ID_BITS;
        } else {
          //
          // if no other chameneos was waiting, we will hope to enter
          // the meeting place; if we can, the resulting state would
          // have the same number of meetings and our ID stored in the
          // low bits.
          //
          newState = currentState | id;
        }

        //
        // use a CAS to see if the state remains the same, and to swap
        // in the new state we've computed if it is.
        //
        if (meetingPlace.state.compareExchangeStrong(currentState, newState,
                                                     memory_order_acq_rel)) {
          //
          // We get to meet!
          //
          if (peer_idx) {
            //
            // If we were the second chameneos in, we run the meeting
            //
            meetWith(chameneos[peer_idx]);
          } else {
            //
            // If we were the first chameneos in, we wait for the
            // other to complete the meeting
            //
            meetingCompleted.waitFor(true);
            //
            // and then reset our meetingCompleted flag for next time
            //
            meetingCompleted.write(false, memory_order_release);
          }
        }
      }
      //
      // continue looping as long as meetings remain
      //
    } while (currentState);
  }

  //
  // meetWith() computes the meeting between a chameneos ('this')
  // and its peer
  //
  proc meetWith(peer) {
    //
    // If we meet with ourself, something's wrong, so check for that
    //
    const metSelf = (peer == this);

    //
    // compute the new color that we'll share as a function of our
    // current colors
    //
    const newColor = getNewColor(color, peer.color);

    //
    // Update our peer's state: store the new color, update its
    // meetings, and then tell it that the meeting's over
    //
    //
    // TODO: abstract the following two assignments into a method to
    // avoid repetition?  Or is that more trouble than it's worth?
    //
    peer.color = newColor;
    peer.meetings += 1;
    peer.meetingsWithSelf += metSelf;
    peer.meetingCompleted.write(true, memory_order_release);

    //
    // Then update ourself similarly
    //
    color = newColor;
    meetings += 1;
    meetingsWithSelf += metSelf;
  }
}

//
// getNewColor() returns the complement of two colors; if the two colors
// are the same value, the color stays the same; otherwise, it becomes the
// third color.
//
inline proc getNewColor(myColor, otherColor) {
  select myColor {
    when Color.blue {
      select otherColor {
        when Color.blue do return Color.blue;
        when Color.red  do return Color.yellow;
        otherwise          return Color.red;
      }
    }
    when Color.red {
      select otherColor {
        when Color.blue do return Color.yellow;
        when Color.red  do return Color.red;
        otherwise          return Color.blue;
      }
    }
    otherwise {
      select otherColor {
        when Color.blue do return Color.red;
        when Color.red  do return Color.blue;
        otherwise          return Color.yellow;
      }
    }
  }
}

//
// printColorEquations() prints the result of getNewColor() for all
// pairs of colors
//
proc printColorEquations() {
  const colors = [Color.blue, Color.red, Color.yellow];
  for color1 in colors {
    for color2 in colors {
      writeln(color1, " + ", color2, " -> ", getNewColor(color1, color2));
    }
  }
  writeln();
}

//
// printInfo() prints out information about the population using
// a combination of numbers and English text
//
proc printInfo(chameneos) {
  //
  // for each chameneos, print the number of meetings and spell out
  // the number of self-meetings for each chameneos
  //
  for c in chameneos {
    write(c.meetings);
    spellInt(c.meetingsWithSelf);
  }

  //
  // compute the total number of meetings and spell it out
  //
  const totalMeetings = + reduce chameneos.meetings;
  spellInt(totalMeetings);
  writeln();
}

//
// the base-10 digits
//
// TODO: Would be nice to be able to make this local to spellInt()
//
enum Digit {zero=0, one, two, three, four, five, six, seven, eight, nine};

//
// spellInt() takes out an integer value and prints its digits out
// in English
//
proc spellInt(n) {
  //
  // Cast n to a string so that it's easier (?!) to pick out its characters
  //
  var s = n:string;
  //
  // TODO: would be nice to replace this with a character iterator?
  //
  for i in 1..s.length do
    write(" ", (s.substring(i):int):Digit);
  writeln();
}

/* The Computer Language Benchmarks Game
   http://benchmarksgame.alioth.debian.org/

   contributed by Hannah Hemmaplardh
   modified by Lydia Duncan and Brad Chamberlain
*/

//
// the following params indicate the number of bits to use when storing
// IDs in a meeting place's 'state' and the corresponding bitmask
// to use when extracting chameneos IDs, respectively.
//
config param NUM_CHAMENEOS_ID_BITS = 8;  // # of state bits to use for IDs
param CHAMENEOS_ID_MASK = (0x1 << NUM_CHAMENEOS_ID_BITS) - 1;

config const n = 100,                // number of meetings to take place
             numChameneos1 = 3,      // size of population 1
             numChameneos2 = 10;     // size of population 2

if (numChameneos1 < 2 || numChameneos2 < 2) then
  halt("There must be at least 2 chameneos");

if (n < 0) then
  halt("the number of meetings must be non-negative");

//
// the colors the chameneos can take on
//
param numColors = 3;
enum Color {blue=0, red, yellow};
//
// TODO: Would be cool to support a param .size query for enums to
// avoid the whole C "declare one extra enum for the number" hack and
// then we could do param numColors = Color.size; (or, if not size,
// some other query function).
//

proc main() {
  //
  // print out the equations that govern chameneos color changes
  //
  printColorEquations();

  //
  // run two simulations for the two different population sizes
  //
  run(numChameneos1);
  run(numChameneos2);
}

//
// createChameneos() creates an array of chameneos of the given size.
// If the size is 10, it uses the predefined array of colors;
// otherwise, it deals out colors round-robin.
//
//
// TODO: Currently, the compiler prints out an error if we remove the
// return type from here; seems it would be nicer if it just put in
// the array temp?  (unless we think we want to return unevaluated
// iterators, which we may?  But even then, maybe in the meantime, we
// should realize it?)
//
proc createChameneos(size): [1..size] Chameneos {
  //
  // TODO: Really want support for 'use Color' for cases like this
  //
  const colorsFor10 = [Color.blue, Color.red, Color.yellow, Color.red,
                       Color.yellow, Color.blue, Color.red, Color.yellow,
                       Color.red, Color.blue];

  return [i in 1..size] new Chameneos(i, if (size == 10) then colorsFor10[i]
                                                         else ((i-1)%3):Color);
}

//
// run() takes a number of chameneos as input and creates as
// population of that size, then allows them to meet in parallel.
//
proc run(numChameneos) {
  //
  // create a meeting place
  //
  const meetingPlace = new MeetingPlace(n);

  //
  // create the population of chameneos
  //
  const chameneos = createChameneos(numChameneos);

  //
  // print the chameneos's initial colors
  //
  for c in chameneos do
    write(" ", c.color);
  writeln();

  //
  // fire off a task per chameneos, and have them try to meet
  //
  coforall c in chameneos do
    c.tryToMeet(meetingPlace, chameneos);

  printInfo(chameneos);
}

//
// This class represents a place for chameneos to meet
//
class MeetingPlace {
  //
  // the 'state' variable packs a chameneos ID in the bottom
  // NUM_CHAMENEOS_ID_BITS bits and the number of meetings in the
  // upper ones, permitting atomic operations to be performed on both
  // values simultaneously.
  //
  var state: atomic int;

  //
  // constructor initializes the number of meetings to take place
  //
  proc MeetingPlace(numMeetings) {
    state.write(numMeetings << NUM_CHAMENEOS_ID_BITS);
  }
}

//
// a class representing a chameneos
//
class Chameneos {
  const id: int;                       // its unique ID
  var color: Color;                    // its color
  var meetings,                        // the number of meetings it's had
      meetingsWithSelf: int;           // the number of meetings with itself
  var meetingCompleted: atomic bool;   // indicates that a meeting is over

  //
  // tryToMeet() tells a chameneos to go to a given MeetingPlace,
  // and try to get involved in meetings with the rest of the
  // population.  If it is first, it can try to wait for another
  // chameneos to arrive; if it is second, it can try to meet with the
  // first chameneos.  The word 'try' is used because other chameneos
  // may be trying to do the same thing simultaneously and beat it to
  // the action.
  //
  proc tryToMeet(meetingPlace, chameneos) {
    //
    // keep trying to meet, as long as there are meetings remaining
    //
    do {
      //
      // grab a copy of the current state
      //
      const currentState = meetingPlace.state.read(memory_order_acquire);

      //
      // if the current state is non-empty, meetings remain
      //
      if (currentState) {
        //
        // extract the number of remaining meetings and the other
        // chameneos's index (if one is present) from the state
        //
        const meetingsLeft = currentState >> NUM_CHAMENEOS_ID_BITS,
              peer_idx = currentState & CHAMENEOS_ID_MASK;

        var newState: int;  // we'll store the new state here

        if (peer_idx) {
          //
          // if another chameneos was waiting in the meeting place, we
          // will hope to meet with it; if we can, the resulting state
          // would have one fewer meetings and no waiting chameneos.
          //
          newState = (meetingsLeft - 1) << NUM_CHAMENEOS_ID_BITS;
        } else {
          //
          // if no other chameneos was waiting, we will hope to enter
          // the meeting place; if we can, the resulting state would
          // have the same number of meetings and our ID stored in the
          // low bits.
          //
          newState = currentState | id;
        }

        //
        // use a CAS to see if the state remains the same, and to swap
        // in the new state we've computed if it is.
        //
        if (meetingPlace.state.compareExchangeStrong(currentState, newState,
                                                     memory_order_acq_rel)) {
          //
          // We get to meet!
          //
          if (peer_idx) {
            //
            // If we were the second chameneos in, we run the meeting
            //
            meetWith(chameneos[peer_idx]);
          } else {
            //
            // If we were the first chameneos in, we wait for the
            // other to complete the meeting
            //
            meetingCompleted.waitFor(true);
            //
            // and then reset our meetingCompleted flag for next time
            //
            meetingCompleted.write(false, memory_order_release);
          }
        }
      }
      //
      // continue looping as long as meetings remain
      //
    } while (currentState);
  }

  //
  // meetWith() computes the meeting between a chameneos ('this')
  // and its peer
  //
  proc meetWith(peer) {
    //
    // If we meet with ourself, something's wrong, so check for that
    //
    const metSelf = (peer == this);

    //
    // compute the new color that we'll share as a function of our
    // current colors
    //
    const newColor = getNewColor(color, peer.color);

    //
    // Update our peer's state: store the new color, update its
    // meetings, and then tell it that the meeting's over
    //
    //
    // TODO: abstract the following two assignments into a method to
    // avoid repetition?  Or is that more trouble than it's worth?
    //
    peer.color = newColor;
    peer.meetings += 1;
    peer.meetingsWithSelf += metSelf;
    peer.meetingCompleted.write(true, memory_order_release);

    //
    // Then update ourself similarly
    //
    color = newColor;
    meetings += 1;
    meetingsWithSelf += metSelf;
  }
}

//
// getNewColor() returns the complement of two colors; if the two colors
// are the same value, the color stays the same; otherwise, it becomes the
// third color.
//
inline proc getNewColor(myColor, otherColor) {
  select myColor {
    when Color.blue {
      select otherColor {
        when Color.blue do return Color.blue;
        when Color.red  do return Color.yellow;
        otherwise          return Color.red;
      }
    }
    when Color.red {
      select otherColor {
        when Color.blue do return Color.yellow;
        when Color.red  do return Color.red;
        otherwise          return Color.blue;
      }
    }
    otherwise {
      select otherColor {
        when Color.blue do return Color.red;
        when Color.red  do return Color.blue;
        otherwise          return Color.yellow;
      }
    }
  }
}

//
// printColorEquations() prints the result of getNewColor() for all
// pairs of colors
//
proc printColorEquations() {
  const colors = [Color.blue, Color.red, Color.yellow];
  for color1 in colors {
    for color2 in colors {
      writeln(color1, " + ", color2, " -> ", getNewColor(color1, color2));
    }
  }
  writeln();
}

//
// printInfo() prints out information about the population using
// a combination of numbers and English text
//
proc printInfo(chameneos) {
  //
  // for each chameneos, print the number of meetings and spell out
  // the number of self-meetings for each chameneos
  //
  for c in chameneos {
    write(c.meetings);
    spellInt(c.meetingsWithSelf);
  }

  //
  // compute the total number of meetings and spell it out
  //
  const totalMeetings = + reduce chameneos.meetings;
  spellInt(totalMeetings);
  writeln();
}

//
// the base-10 digits
//
// TODO: Would be nice to be able to make this local?
//
enum Digit {zero=0, one, two, three, four, five, six, seven, eight, nine};

//
// spellInt() takes out an integer value and prints its digits out
// in English
//
proc spellInt(n) {
  //
  // Cast n to a string so that it's easier (?!) to pick out its characters
  //
  var s = n:string;
  //
  // TODO: would be nice to replace this with a character iterator?
  //
  for i in 1..s.length do
    write(" ", (s.substring(i):int):Digit);
  writeln();
}