Use single argument version of _computeNumChunks in assoc standalone iters

All of the arguments used in these calls were the defaults of the single
argument version.  Use it instead.

/*
 * 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 {
        writeln("*** In associative domain standalone iterator");
      }
      // 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.
      const numIndices = tableSize;
      const numChunks = _computeNumChunks(numIndices);

      if debugAssocDataPar {
        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 {
            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 {
              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 {
        writeln("*** In associative array standalone iterator");
      }
      const numIndices = dom.tableSize;
      const numChunks = _computeNumChunks(numIndices);
      if numChunks == 1 {
        for slot in 0..#numIndices {
          if dom.table[slot].status == chpl__hash_status.full {
            yield data[slot];
          }
        }
      } else {
        coforall chunk in 0..#numChunks {
          const (lo, hi) = _computeBlock(numIndices, numChunks,
                                         chunk, numIndices-1);
          if debugAssocDataPar {
            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 {
              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 {
        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.
      const numIndices = tableSize;
      if debugAssocDataPar {
        writeln("### numTasks = ", numTasks);
        writeln("### ignoreRunning = ", ignoreRunning);
        writeln("### minIndicesPerTask = ", minIndicesPerTask);
      }

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

      if debugAssocDataPar {
        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 {
            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 {
              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 {
        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 {
            yield data[slot];
          }
        }
      } else {
        coforall chunk in 0..#numChunks {
          const (lo, hi) = _computeBlock(numIndices, numChunks,
                                         chunk, numIndices-1);
          if debugAssocDataPar {
            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 {
              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;
  }

}


Removed the domain(2*int) workaround here too.

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

/** FTree: The tree data structure used to store the numerical representation
    of a function.

    For 1d Madness, an FTree is a binary tree, for 2d it would
    be a quad tree, 3d an octtree, and so on.  The FTree used here uses level
    and index hashing to store the tree rather than storing connectivity
    information.  So, it is important that you do a has_coeffs() before
    indexing into the tree to be sure you don't create coeffs when you don't
    mean to.
 */

// FIXME: The Coeff record works around arrays of arrays.  Ideally, nodes
//        should be a mapping from indices onto :[coeffDom] real.
record Coeff {
    var dom  : domain(1);
    var data : [dom] real;
}

// The empty vector, returned when there are no Coeffs.
var None: [0..-1] real;
const rootNode = (0,0);
const emptyNode = (-1,-1);

// Check if we have None.
def isNone(x) {
    return x.numElements == 0;
}

class FTree {
    var order    : int;
    var coeffDom = [0..order-1];

    var indices  : domain(2*int);   // Indexed by 2-tuples of integers
    var nodes    : [indices] Coeff; // Associative Mapping: (:int, :int) => Coeff

    var zeroes   : [coeffDom] real; // Return zeroes from this() when reading
                                    // something that has not yet been set.

    def initialize() {
        if order == 0 then
            halt("FTree must be initialized with an order > 0");
    }

    /** Access an element in the associative domain.  If the element
        doesn't exist it will be created.

        We have to be really careful about creating extra boxes when we don't
        mean to.  The algorithms tend to be really sensitive to the structure
        of the tree.  Scaling coefficients are used to mark the leaves in the
        sum tree, so if you accidentally create scaling coeffs somewhere in the
        middle of the tree you will short circuit a whole subtree!

     */
    def this(lvl: int, idx: int) var {
        if !indices.member((lvl, idx)) {
            if setter {
              indices += ((lvl, idx));
              nodes[(lvl, idx)] = Coeff(coeffDom);
            } else {
              // This is a getter so it shouldn't be modifying what
              // we return, should be safe to return the zero vector.
              // FIXME: Zeroes should really be a const, but can'ti
              //        return const from a var fcn.
              return zeroes;
            }
        }

        return nodes[(lvl, idx)].data;
    }

    def this((lvl, idx)) var {
        return this(lvl,idx);
    }

    def path_upwards((lvl0, idx0), (lvl1, idx1)) {
        var l = idx0;
        for n in lvl1..lvl0 by -1 {
           yield ((n,l));
           l /= 2;
        }
    }

    def path_downwards((lvl0, idx0), (lvl1, idx1)) {
        for n in (lvl0..lvl1-1) {
          yield (n, idx1/(2**(lvl1-n)));
        }
    }

    def on_boundary((lvl, idx)) {
        return ((idx < 0 || idx >= 2**lvl));
    }

    def get_children((lvl, idx)) {
        return ((lvl+1, 2*idx), (lvl+1, 2*idx+1));
    }

    def get_neighbors((lvl, idx)) {
        return ((lvl, idx-1), (lvl, idx+1));
    }

    /** Access an element in the FTree.  If it doesn't exist,
        return None.
     */
    def peek(lvl: int, idx: int) var {
        if has_coeffs((lvl, idx)) then
            return this(lvl, idx);
        else
            return None;
    }

    /** Unordered iterator over all coefficients
     */
    def these() {
        for n in nodes yield n.data;
    }

    /** Unordered iterator over all boxes in a particular level.
        This is not a particularly fast way to do this, but for many of the
        Madness levelwise iterators that do all levels from 0..max_level this
        will be much faster when the data is not all the way down at max_level.
        A sparse array or an array of associative arrays may be more conducive
        to this type of iteration vs. the associative domain used here.
     */
    def lvl_iter(lvl: int) {
        for i in indices do
            if i(1) == lvl && indices.member(i) then yield nodes[i].data;
    }

    def index_iter() {
       for i in indices do
          yield i;
    }

    /** Return a copy of this FTree
     */
    def copy() {
        var t = FTree(order);
        t.indices = indices;
        t.nodes   = nodes;
        return t;
    }

    /** Check if there are coefficients in box (lvl, idx)
     */
    def has_coeffs((lvl, idx)) {
        return indices.member((lvl, idx));
    }

    /** Remove an element from the associative domain.  If the element
        does not exist, it is ignored.
     */
    def remove((lvl,idx)) {
        if indices.member((lvl, idx)) then indices.remove((lvl, idx));
    }
}

def main() {
    var f = FTree(2);

    for (i, j) in [0..2, 0..2] do f[i, j] = (i, j);

    for (i, j) in [1..0, 1..0] do f.remove((i, j));

    for (i, j) in [0..1, 0..1] do f[i, j] = (-(i:real), -(j:real));

    for (i, j) in [2..1, 2..1] do f.remove((i, j));

    for (i, j) in [1..2, 1..2] do f[i, j] = (-(i:real), -(j:real));

    for (i, j) in [0..2, 0..2] do
        writeln("(",i,", ",j,") = ", f.peek(i, j));

    for i in 0..2 do
        for n in f.lvl_iter(i) do
            writeln(i, ": ", n);
}

/** FTree: The tree data structure used to store the numerical representation
    of a function.

    For 1d Madness, an FTree is a binary tree, for 2d it would
    be a quad tree, 3d an octtree, and so on.  The FTree used here uses level
    and index hashing to store the tree rather than storing connectivity
    information.  So, it is important that you do a has_coeffs() before
    indexing into the tree to be sure you don't create coeffs when you don't
    mean to.
 */

// FIXME: The Coeff record works around arrays of arrays.  Ideally, nodes
//        should be a mapping from indices onto :[coeffDom] real.
record Coeff {
    var dom  : domain(1);
    var data : [dom] real;
}

// The empty vector, returned when there are no Coeffs.
var None: [0..-1] real;
const rootNode = (0,0);
const emptyNode = (-1,-1);

// Check if we have None.
def isNone(x) {
    return x.numElements == 0;
}

class FTree {
    var order    : int;
    var coeffDom = [0..order-1];
    var idx_t    : 2*int;           // FIXME: Can't write domain(2*int)

    var indices  : domain(idx_t.type);   // Indexed by 2-tuples of integers
    var nodes    : [indices] Coeff; // Associative Mapping: (:int, :int) => Coeff

    var zeroes   : [coeffDom] real; // Return zeroes from this() when reading
                                    // something that has not yet been set.

    def initialize() {
        if order == 0 then
            halt("FTree must be initialized with an order > 0");
    }

    /** Access an element in the associative domain.  If the element
        doesn't exist it will be created.

        We have to be really careful about creating extra boxes when we don't
        mean to.  The algorithms tend to be really sensitive to the structure
        of the tree.  Scaling coefficients are used to mark the leaves in the
        sum tree, so if you accidentally create scaling coeffs somewhere in the
        middle of the tree you will short circuit a whole subtree!

     */
    def this(lvl: int, idx: int) var {
        if !indices.member((lvl, idx)) {
            if setter {
              indices += ((lvl, idx));
              nodes[(lvl, idx)] = Coeff(coeffDom);
            } else {
              // This is a getter so it shouldn't be modifying what
              // we return, should be safe to return the zero vector.
              // FIXME: Zeroes should really be a const, but can'ti
              //        return const from a var fcn.
              return zeroes;
            }
        }

        return nodes[(lvl, idx)].data;
    }

    def this((lvl, idx)) var {
        return this(lvl,idx);
    }

    def path_upwards((lvl0, idx0), (lvl1, idx1)) {
        var l = idx0;
        for n in lvl1..lvl0 by -1 {
           yield ((n,l));
           l /= 2;
        }
    }

    def path_downwards((lvl0, idx0), (lvl1, idx1)) {
        for n in (lvl0..lvl1-1) {
          yield (n, idx1/(2**(lvl1-n)));
        }
    }

    def on_boundary((lvl, idx)) {
        return ((idx < 0 || idx >= 2**lvl));
    }

    def get_children((lvl, idx)) {
        return ((lvl+1, 2*idx), (lvl+1, 2*idx+1));
    }

    def get_neighbors((lvl, idx)) {
        return ((lvl, idx-1), (lvl, idx+1));
    }

    /** Access an element in the FTree.  If it doesn't exist,
        return None.
     */
    def peek(lvl: int, idx: int) var {
        if has_coeffs((lvl, idx)) then
            return this(lvl, idx);
        else
            return None;
    }

    /** Unordered iterator over all coefficients
     */
    def these() {
        for n in nodes yield n.data;
    }

    /** Unordered iterator over all boxes in a particular level.
        This is not a particularly fast way to do this, but for many of the
        Madness levelwise iterators that do all levels from 0..max_level this
        will be much faster when the data is not all the way down at max_level.
        A sparse array or an array of associative arrays may be more conducive
        to this type of iteration vs. the associative domain used here.
     */
    def lvl_iter(lvl: int) {
        for i in indices do
            if i(1) == lvl && indices.member(i) then yield nodes[i].data;
    }

    def index_iter() {
       for i in indices do
          yield i;
    }

    /** Return a copy of this FTree
     */
    def copy() {
        var t = FTree(order);
        t.indices = indices;
        t.nodes   = nodes;
        return t;
    }

    /** Check if there are coefficients in box (lvl, idx)
     */
    def has_coeffs((lvl, idx)) {
        return indices.member((lvl, idx));
    }

    /** Remove an element from the associative domain.  If the element
        does not exist, it is ignored.
     */
    def remove((lvl,idx)) {
        if indices.member((lvl, idx)) then indices.remove((lvl, idx));
    }
}

def main() {
    var f = FTree(2);

    for (i, j) in [0..2, 0..2] do f[i, j] = (i, j);

    for (i, j) in [1..0, 1..0] do f.remove((i, j));

    for (i, j) in [0..1, 0..1] do f[i, j] = (-(i:real), -(j:real));

    for (i, j) in [2..1, 2..1] do f.remove((i, j));

    for (i, j) in [1..2, 1..2] do f[i, j] = (-(i:real), -(j:real));

    for (i, j) in [0..2, 0..2] do
        writeln("(",i,", ",j,") = ", f.peek(i, j));

    for i in 0..2 do
        for n in f.lvl_iter(i) do
            writeln(i, ": ", n);
}


Improve the chpldoc comments.

Improve the chpldoc comments.

/*
 * Copyright 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.
 */

/*

   Support for the visualization tool "chplvis"

   This module provides access to and enables hooks to dump out
   task and communication information for post-run visualization
   of the tasks and communication.

*/
module VisualDebug
{

  use String;

  pragma "no doc"
  extern proc chpl_now_time():real;

  //
  // Data Generation for the Visual Debug tool  (offline)
  //

  pragma "no doc"
  extern proc chpl_vdebug_start ( rootname: c_string, time:real);

  pragma "no doc"
  extern proc chpl_vdebug_stop ();

  pragma "no doc"
  extern proc chpl_vdebug_tag ( tagname: c_string);

  pragma "no doc"
  extern proc chpl_vdebug_pause ();

  pragma "no doc"
  extern proc chpl_vdebug_nolog ();

/* Tree "coforall procedure .... calls one of the above rotunes */

pragma "no doc"
  enum vis_op {v_start, v_stop, v_tag, v_pause};

pragma "no doc"
  proc VDebugTree (what: vis_op, name: string, time: real, id: int = 0) {
      var child = id * 2 + 1;
      chpl_vdebug_nolog();
      cobegin {
         /* left */
         if child < numLocales then
             on Locales[child] do VDebugTree (what, name, time, child);
	 /* right */
         if child+1 < numLocales then
             on Locales[child+1] do VDebugTree (what, name, time, child+1);
     }
	 /* Do the op at the root  */
	 select what {
	    when vis_op.v_start    do chpl_vdebug_start (name.c_str(), time);
            when vis_op.v_stop     do chpl_vdebug_stop ();
            when vis_op.v_tag      do chpl_vdebug_tag (name.c_str());
            when vis_op.v_pause    do chpl_vdebug_pause ();
         }
  }

/*
  Start logging events for VisualDebug.  Open a new set of data
  files, one for each locale, for chplvis.  This routine should be
  called only once for each program.  It creates a directory with the
  rootname and creates the files in that directory.  The files are
  named with the rootname and "-n" is added where n is the locale
  number.

  :arg rootname:  Directory name and rootname for files.
*/
  proc startVdebug ( rootname : string ) {
    var now = chpl_now_time();
    //coforall l in Locales do
    //  on l do chpl_vdebug_start (rootname.c_str(), now);
    VDebugTree (vis_op.v_start, rootname, now);
  }

/*
  Add a tag to the data for chplvis to allow "view points" in the data.

  :arg tagname: name of the tag
*/
  proc tagVdebug ( tagname : string ) {
    //coforall l in Locales[1..] do
    //  on l do chpl_vdebug_tag (tagname.c_str(), 0);
    //chpl_vdebug_tag (tagname.c_str(), 0);
    VDebugTree (vis_op.v_tag, tagname, 0);
  }

/*
  Stop collecting VisualDebug data and close the data files.
*/
  proc stopVdebug () {
    // chpl_vdebug_stop();
    // coforall l in Locales[1..] do
    //  on l do chpl_vdebug_stop();
    VDebugTree (vis_op.v_stop, "", 0);
  }

/*
  Suspend collection of VisualDebug data.
*/
  proc pauseVdebug () {
    //coforall l in Locales[1..] do
    //  on l do chpl_vdebug_tag (tagname.c_str(), 1);
    //chpl_vdebug_tag(tagname.c_str(), 1);
    VDebugTree (vis_op.v_pause, "", 0);
  }

/*
  Resume collection of VisualDebug data for chplvis after a pauseVdebug().
  This also generates a tag record visible by chplvis.

  :arg tagname: name of the tag
*/
  proc resumeVdebug ( tagname : string ) {
    //coforall l in Locales[1..] do
    //  on l do chpl_vdebug_resume ();
    //chpl_vdebug_resume(tagname);
    VDebugTree (vis_op.v_tag, tagname, 0);
  }

}

/*
 * Copyright 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.
 */

/*

    Support for the visualization tool "chplvis"

    This module provides access to and enables hooks to dump out
    task and communication information for post-run visualization
    of the tasks and communication.

 */
module VisualDebug
{

  use String;

  // get access to this quickly?
  extern proc chpl_now_time():real;

  //
  // Data Generation for the Visual Debug tool  (offline)
  //

  extern proc chpl_vdebug_start ( rootname: c_string, time:real);
  extern proc chpl_vdebug_stop ();
  extern proc chpl_vdebug_tag ( tagname: c_string);
  extern proc chpl_vdebug_pause ();
  extern proc chpl_vdebug_nolog ();

/* Tree "coforall procedure .... calls one of the above rotunes */

  enum vis_op {v_start, v_stop, v_tag, v_pause};

  proc VDebugTree (what: vis_op, name: string, time: real, id: int = 0) {
      var child = id * 2 + 1;
      chpl_vdebug_nolog();
      cobegin {
         /* left */
         if child < numLocales then
             on Locales[child] do VDebugTree (what, name, time, child);
	 /* right */
         if child+1 < numLocales then
             on Locales[child+1] do VDebugTree (what, name, time, child+1);
     }
	 /* Do the op at the root  */
	 select what {
	    when vis_op.v_start    do chpl_vdebug_start (name.c_str(), time);
            when vis_op.v_stop     do chpl_vdebug_stop ();
            when vis_op.v_tag      do chpl_vdebug_tag (name.c_str());
            when vis_op.v_pause    do chpl_vdebug_pause ();
         }
  }

/*
  Open a new set of data files, one for each locale, for chplvis.
  :arg rootname:  Rootname for file. "-n" is added where n is locale number.
*/
  proc startVdebug ( rootname : string ) {
    var now = chpl_now_time();
    //coforall l in Locales do
    //  on l do chpl_vdebug_start (rootname.c_str(), now);
    VDebugTree (vis_op.v_start, rootname, now);
  }

/*
  Add a tag to the data for chplvis to allow "view points" in the data.
  :arg tagname: name of the tag
*/
  proc tagVdebug ( tagname : string ) {
    //coforall l in Locales[1..] do
    //  on l do chpl_vdebug_tag (tagname.c_str(), 0);
    //chpl_vdebug_tag (tagname.c_str(), 0);
    VDebugTree (vis_op.v_tag, tagname, 0);
  }

/*
  Stop collecting data of chplvis and close the data files.
*/
  proc stopVdebug () {
    chpl_vdebug_stop();
    // coforall l in Locales[1..] do
    //  on l do chpl_vdebug_stop();
    VDebugTree (vis_op.v_stop, "", 0);
  }

/*
  Stop collection of data for chplvis and tag the pause point.
  :arg tagname: name of the tag
*/
  proc pauseVdebug () {
    //coforall l in Locales[1..] do
    //  on l do chpl_vdebug_tag (tagname.c_str(), 1);
    //chpl_vdebug_tag(tagname.c_str(), 1);
    VDebugTree (vis_op.v_pause, "", 0);
  }

/*
  Resume collection of data for chplvis after a pauseVdebug().
  This is a "no-op" if pauseVdebug was not called before.
*/
  proc resumeVdebug ( tagname : string ) {
    //coforall l in Locales[1..] do
    //  on l do chpl_vdebug_resume ();
    //chpl_vdebug_resume();
    VDebugTree (vis_op.v_tag, tagname, 0);
  }

}


more switches to explore optimizations

more switches to explore optimizations

use Histogram;
use Random;
use Time;

// Test flags
config const isTest=false;
config const isPerf=false;
config const doBrute=false;
config param doHist=true;

// Performance test parameters
config const nParticles=10000;

// Input/Output filenames
config const fn1 = "test.dat";
config const fn2 = "test.dat";
config const pairfn = "test-DD.dat";

// Dimension constanst
param NDIM=3;
param NEXT=2; // w, r2
param NTOT=NDIM+NEXT;
const W=NDIM;
const R2=NDIM+1;
const ParticleAttrib = 0.. #NTOT;
const DimSpace = 0.. #NDIM;

// Tree parameters
config const minpart=500;

// Histogram parameters
config const smax=200.0;
config const smax2=smax**2;
config const nmubins=5;
config const nsbins=5;

// Global variables
var gtime1 : Timer;

proc main() {
  doPairs();
}

class Particle3D {
  var npart : int = 0;
  var Darr : domain(2);
  var Dpart : domain(1);
  var arr : [Darr] real;

  var _tmp : [Dpart] real;
  var _n1, _ndx : [Dpart] int;

  proc Particle3D(npart1 : int, random : bool = false) {
    npart = npart1;
    Darr = {ParticleAttrib, 0.. #npart};
    Dpart = {0.. #npart};
    if random {
      var rng = new RandomStream();
      var x, y, z : real;
      for ii in Dpart {
        x = rng.getNext()*1000.0; y = rng.getNext()*1000.0; z = rng.getNext()*1000.0;
        arr[0,ii] = x; arr[1, ii] = y; arr[2, ii] = z;
        arr[3,ii] = 1.0;
        arr[4,ii] = x**2 + y**2 + z**2;
      }
      delete rng;
    }
  }

  proc this(ii : int) : NTOT*real {
    // ??? Hardcoded hack!
    return (arr[0,ii],arr[1,ii],arr[2,ii],arr[3,ii],arr[4,ii]);
  }

  // Reorder all the arrays according to _ndx (we assume you have set this)
  proc reorder(idom : domain(1)) {

    for kk in ParticleAttrib {
      forall ii in idom {
        _tmp[_ndx[ii]] = arr[kk,ii];
      }
      forall ii in idom {
        arr[kk,ii] = _tmp[ii];
      }
    }
  }

  // Shuffles the elements of the array...
  // Note that the random number generator cannot cover the space
  // of all permutations, but that's fine for what we need.
  proc shuffle() {
    // Fill in _ndx
    forall ii in Dpart {
      _ndx[ii] = ii;
    }

    // Set the random number generator
    var rng = new RandomStream(41);
    var jj : int;
    for ii in 0..(npart-2) {
      jj = (rng.getNext()*(npart-ii)):int + ii;
      _ndx[jj] <=> _ndx[ii];
    }
    delete rng;

    reorder(Dpart);
  }

}

proc countLines(fn : string) : int {
  var ff = open(fn, iomode.r);
  var ipart = 0;
  for iff in ff.lines() do ipart +=1;
  ff.close();
  return ipart;
}

proc readFile(fn : string) : Particle3D  {
  var npart = countLines(fn);
  var pp = new Particle3D(npart);

  var ff = openreader(fn);
  var ipart = 0;
  var x,y,z,w,r2 : real;
  while (ff.read(x,y,z,w)) {
    r2 = x**2 + y**2 + z**2;
    pp.arr[..,ipart] = [x,y,z,w,r2];
    ipart += 1;
  }
  ff.close();

  return pp;
}

proc splitOn(pp : Particle3D, idom : domain(1), splitDim : int, xsplit : real) : int {
  // Setup for a prefix scan
  forall ii in idom {
    if (pp.arr[splitDim,ii] < xsplit) {
      pp._n1[ii] = 1;
    } else {
      pp._n1[ii] = 0;
    }
  }

  var lnpart : int = 0;
  for ii in idom do lnpart += pp._n1[ii];
  var li = idom.low;
  var ri = li+lnpart;
  for ii in idom {
    if (pp._n1[ii] == 1) {
      pp._ndx[ii] = li;
      li += 1;
    } else {
      pp._ndx[ii] = ri;
      ri += 1;
    }
  }

  pp.reorder(idom);

  return lnpart;
}

class KDNode {
  var lo, hi,npart,id : int;
  var dom : domain(1);
  var xcen : [DimSpace]real;
  var rcell : real;
  var left, right : KDNode;

  proc isLeaf() : bool {
    return (left==nil) && (right==nil);
  }

  proc ~KDNode() {
    if left then delete left;
    if right then delete right;
  }

}

proc BuildTree(pp : Particle3D, lo : int, hi : int, id : int) : KDNode  {
  var me : KDNode = new KDNode();
  me.lo = lo;
  me.hi = hi;
  me.dom = {lo..hi};
  me.id = id;
  me.npart = (me.hi-me.lo)+1;

  //  work out xcen and vantage point radius
  var pmin, pmax : [DimSpace] real;
  for idim in DimSpace {
    pmin[idim] = min reduce pp.arr[idim,lo..hi];
    pmax[idim] = max reduce pp.arr[idim,lo..hi];
  }
  me.xcen = (pmax+pmin)/2.0;
  me.rcell = 0.0;
  var r1 : real;
  for ii in lo..hi {
    r1 = 0.0;
    for idim in DimSpace {
      r1 += (pp.arr[idim,ii]-me.xcen[idim])**2;
    }
    r1 = sqrt(r1);
    if (r1 > me.rcell) then me.rcell = r1;
  }

  // Continue to split
  if (me.npart <= minpart) then return me; // Don't split further.

  // Find dimension to split on
  var dx : [DimSpace] real;
  dx = pmax - pmin;
  var splitDim = 0;
  for idim in DimSpace {
    if (dx[idim] > dx[splitDim]) then splitDim=idim;
  }

  // Split
  var lnpart = splitOn(pp,me.dom,splitDim, me.xcen[splitDim]);
  me.left  = BuildTree(pp, lo, lo+lnpart-1, 2*id+1);
  me.right = BuildTree(pp, lo+lnpart, hi,2*id+2);
  return me;
}

proc TreeAccumulate(hh : UniformBins, p1, p2 : Particle3D, node1, node2 : KDNode) {
  // Compute the distance between node1 and node2
  var rr = sqrt (+ reduce(node1.xcen - node2.xcen)**2);
  var rmin = rr - (node1.rcell+node2.rcell);

  // If distance is greater than all cases
  if (rmin > smax) then return;

  // If both nodes are leaves
  if (node1.isLeaf() & node2.isLeaf()) {
    begin smuAccumulate(hh, p1, p2, node1.dom, node2.dom,1);
    return;
  }

  // If one node is a leaf
  if (node1.isLeaf()) {
    TreeAccumulate(hh, p1, p2, node1, node2.left);
    TreeAccumulate(hh, p1, p2, node1, node2.right);
    return;
  }
  if (node2.isLeaf()) {
    TreeAccumulate(hh, p1, p2, node1.left, node2);
    TreeAccumulate(hh, p1, p2, node1.right, node2);
    return;
  }

  // Split the larger case;
  if (node1.npart > node2.npart) {
    TreeAccumulate(hh, p1, p2, node1.left, node2);
    TreeAccumulate(hh, p1, p2, node1.right, node2);
    return;
  } else {
    TreeAccumulate(hh, p1, p2, node1, node2.left);
    TreeAccumulate(hh, p1, p2, node1, node2.right);
    return;
  }

}

// The basic pair counter
proc smuAccumulate(hh : UniformBins, p1,p2 : Particle3D, d1,d2 : domain(1), scale : real) {
  for ii in d1 { // Loop over first set of particles

    var x1,y1,z1,w1,r2 : real;
    var sl, s2, l1, s1, l2, mu, wprod : real;
    (x1,y1,z1,w1,r2) = p1[ii];

    for jj in d2 { // Second set of particles
      mu=2*(p2.arr[0,jj]*x1 + p2.arr[1,jj]*y1 + p2.arr[2,jj]*z1);
      sl = r2 - p2.arr[R2,jj];
      l1 = r2 + p2.arr[R2,jj];
      s2 = l1 - mu;
      l2 = l1 + mu;
      if ((s2 < smax2) && (s2 > 1.0e-20)) {
        wprod = scale * w1 * p2.arr[W,jj];
        s1 = sqrt(s2);
        mu = sl/(s1*sqrt(l2));
        if (mu < 0) then mu = -mu;

        if doHist then hh.add((s1,mu),wprod);
      }
    }
  }
}

proc doPairs() {
  var tt : Timer;

  // Read in the file
  tt.clear(); tt.start();
  var pp1, pp2 : Particle3D;
  if isPerf {
    pp1 = new Particle3D(nParticles, true);
    pp2 = new Particle3D(nParticles, true);
  } else {
    pp1 = readFile(fn1);
    pp2 = readFile(fn2);
    if !isTest {
      writef("Read in %i lines from file %s \n", pp1.npart, fn1);
      writef("Read in %i lines from file %s \n", pp2.npart, fn2);
    }
  }
  tt.stop();
  if !isTest {
    writef("Time to read : %r \n", tt.elapsed());
  }

  // Shuffle the particles -- this is not used here, but will be usef for the multilocale version
  tt.clear(); tt.start();
  pp1.shuffle();
  pp2.shuffle();
  tt.stop();
  if !isTest then writef("Time to shuffle : %r \n",tt.elapsed());

  // Build the tree
  tt.clear(); tt.start(); gtime1.clear();
  var root1 = BuildTree(pp1, 0, pp1.npart-1, 0);
  var root2 = BuildTree(pp2, 0, pp2.npart-1, 0);
  tt.stop();
  if !isTest then writef("Time to build trees : %r \n", tt.elapsed());
  //writef("Time in splitOn : %r \n", gtime1.elapsed());

  // Set up the histogram
  var hh = new UniformBins(2,(nsbins,nmubins), ((0.0,smax),(0.0,1.0+1.e-10)));

  // Do the paircounts with a tree
  hh.reset();
  tt.clear(); tt.start();
  sync TreeAccumulate(hh, pp1,pp2, root1, root2);
  tt.stop();
  if (!isTest) {
    writef("Time to tree paircount : %r \n", tt.elapsed());
    if !isPerf {
      var ff = openwriter("%s.tree".format(pairfn));
      writeHist(ff,hh);
      ff.close();
    }
  } else {
    hh.set((0,0),0.0);
    writeHist(stdout,hh,"%20.5er ");
  }

  //
  // clean up
  //
  delete pp1;
  delete pp2;
  delete root1;
  delete root2;
  delete hh;
}

use Histogram;
use Random;
use Time;

// Test flags
config const isTest=false;
config const isPerf=false;
config const doBrute=false;

// Performance test parameters
config const nParticles=10000;

// Input/Output filenames
config const fn1 = "test.dat";
config const fn2 = "test.dat";
config const pairfn = "test-DD.dat";

// Dimension constanst
param NDIM=3;
param NEXT=2; // w, r2
param NTOT=NDIM+NEXT;
const W=NDIM;
const R2=NDIM+1;
const ParticleAttrib = 0.. #NTOT;
const DimSpace = 0.. #NDIM;

// Tree parameters
config const minpart=500;

// Histogram parameters
config const smax=200.0;
config const smax2=smax**2;
config const nmubins=5;
config const nsbins=5;

// Global variables
var gtime1 : Timer;

proc main() {
  doPairs();
}

class Particle3D {
  var npart : int = 0;
  var Darr : domain(2);
  var Dpart : domain(1);
  var arr : [Darr] real;

  var _tmp : [Dpart] real;
  var _n1, _ndx : [Dpart] int;

  proc Particle3D(npart1 : int, random : bool = false) {
    npart = npart1;
    Darr = {ParticleAttrib, 0.. #npart};
    Dpart = {0.. #npart};
    if random {
      var rng = new RandomStream();
      var x, y, z : real;
      for ii in Dpart {
        x = rng.getNext()*1000.0; y = rng.getNext()*1000.0; z = rng.getNext()*1000.0;
        arr[0,ii] = x; arr[1, ii] = y; arr[2, ii] = z;
        arr[3,ii] = 1.0;
        arr[4,ii] = x**2 + y**2 + z**2;
      }
      delete rng;
    }
  }

  proc this(ii : int) : NTOT*real {
    // ??? Hardcoded hack!
    return (arr[0,ii],arr[1,ii],arr[2,ii],arr[3,ii],arr[4,ii]);
  }

  // Reorder all the arrays according to _ndx (we assume you have set this)
  proc reorder(idom : domain(1)) {

    for kk in ParticleAttrib {
      forall ii in idom {
        _tmp[_ndx[ii]] = arr[kk,ii];
      }
      forall ii in idom {
        arr[kk,ii] = _tmp[ii];
      }
    }
  }

  // Shuffles the elements of the array...
  // Note that the random number generator cannot cover the space
  // of all permutations, but that's fine for what we need.
  proc shuffle() {
    // Fill in _ndx
    forall ii in Dpart {
      _ndx[ii] = ii;
    }

    // Set the random number generator
    var rng = new RandomStream(41);
    var jj : int;
    for ii in 0..(npart-2) {
      jj = (rng.getNext()*(npart-ii)):int + ii;
      _ndx[jj] <=> _ndx[ii];
    }
    delete rng;

    reorder(Dpart);
  }

}

proc countLines(fn : string) : int {
  var ff = open(fn, iomode.r);
  var ipart = 0;
  for iff in ff.lines() do ipart +=1;
  ff.close();
  return ipart;
}

proc readFile(fn : string) : Particle3D  {
  var npart = countLines(fn);
  var pp = new Particle3D(npart);

  var ff = openreader(fn);
  var ipart = 0;
  var x,y,z,w,r2 : real;
  while (ff.read(x,y,z,w)) {
    r2 = x**2 + y**2 + z**2;
    pp.arr[..,ipart] = [x,y,z,w,r2];
    ipart += 1;
  }
  ff.close();

  return pp;
}

proc splitOn(pp : Particle3D, idom : domain(1), splitDim : int, xsplit : real) : int {
  // Setup for a prefix scan
  forall ii in idom {
    if (pp.arr[splitDim,ii] < xsplit) {
      pp._n1[ii] = 1;
    } else {
      pp._n1[ii] = 0;
    }
  }

  var lnpart : int = 0;
  for ii in idom do lnpart += pp._n1[ii];
  var li = idom.low;
  var ri = li+lnpart;
  for ii in idom {
    if (pp._n1[ii] == 1) {
      pp._ndx[ii] = li;
      li += 1;
    } else {
      pp._ndx[ii] = ri;
      ri += 1;
    }
  }

  pp.reorder(idom);

  return lnpart;
}

class KDNode {
  var lo, hi,npart,id : int;
  var dom : domain(1);
  var xcen : [DimSpace]real;
  var rcell : real;
  var left, right : KDNode;

  proc isLeaf() : bool {
    return (left==nil) && (right==nil);
  }

  proc ~KDNode() {
    if left then delete left;
    if right then delete right;
  }

}

proc BuildTree(pp : Particle3D, lo : int, hi : int, id : int) : KDNode  {
  var me : KDNode = new KDNode();
  me.lo = lo;
  me.hi = hi;
  me.dom = {lo..hi};
  me.id = id;
  me.npart = (me.hi-me.lo)+1;

  //  work out xcen and vantage point radius
  var pmin, pmax : [DimSpace] real;
  for idim in DimSpace {
    pmin[idim] = min reduce pp.arr[idim,lo..hi];
    pmax[idim] = max reduce pp.arr[idim,lo..hi];
  }
  me.xcen = (pmax+pmin)/2.0;
  me.rcell = 0.0;
  var r1 : real;
  for ii in lo..hi {
    r1 = 0.0;
    for idim in DimSpace {
      r1 += (pp.arr[idim,ii]-me.xcen[idim])**2;
    }
    r1 = sqrt(r1);
    if (r1 > me.rcell) then me.rcell = r1;
  }

  // Continue to split
  if (me.npart <= minpart) then return me; // Don't split further.

  // Find dimension to split on
  var dx : [DimSpace] real;
  dx = pmax - pmin;
  var splitDim = 0;
  for idim in DimSpace {
    if (dx[idim] > dx[splitDim]) then splitDim=idim;
  }

  // Split
  var lnpart = splitOn(pp,me.dom,splitDim, me.xcen[splitDim]);
  me.left  = BuildTree(pp, lo, lo+lnpart-1, 2*id+1);
  me.right = BuildTree(pp, lo+lnpart, hi,2*id+2);
  return me;
}

proc TreeAccumulate(hh : UniformBins, p1, p2 : Particle3D, node1, node2 : KDNode) {
  // Compute the distance between node1 and node2
  var rr = sqrt (+ reduce(node1.xcen - node2.xcen)**2);
  var rmin = rr - (node1.rcell+node2.rcell);

  // If distance is greater than all cases
  if (rmin > smax) then return;

  // If both nodes are leaves
  if (node1.isLeaf() & node2.isLeaf()) {
    begin smuAccumulate(hh, p1, p2, node1.dom, node2.dom,1);
    return;
  }

  // If one node is a leaf
  if (node1.isLeaf()) {
    TreeAccumulate(hh, p1, p2, node1, node2.left);
    TreeAccumulate(hh, p1, p2, node1, node2.right);
    return;
  }
  if (node2.isLeaf()) {
    TreeAccumulate(hh, p1, p2, node1.left, node2);
    TreeAccumulate(hh, p1, p2, node1.right, node2);
    return;
  }

  // Split the larger case;
  if (node1.npart > node2.npart) {
    TreeAccumulate(hh, p1, p2, node1.left, node2);
    TreeAccumulate(hh, p1, p2, node1.right, node2);
    return;
  } else {
    TreeAccumulate(hh, p1, p2, node1, node2.left);
    TreeAccumulate(hh, p1, p2, node1, node2.right);
    return;
  }

}

// The basic pair counter
proc smuAccumulate(hh : UniformBins, p1,p2 : Particle3D, d1,d2 : domain(1), scale : real) {
  for ii in d1 { // Loop over first set of particles

    var x1,y1,z1,w1,r2 : real;
    var sl, s2, l1, s1, l2, mu, wprod : real;
    (x1,y1,z1,w1,r2) = p1[ii];

    for jj in d2 { // Second set of particles
      mu=2*(p2.arr[0,jj]*x1 + p2.arr[1,jj]*y1 + p2.arr[2,jj]*z1);
      sl = r2 - p2.arr[R2,jj];
      l1 = r2 + p2.arr[R2,jj];
      s2 = l1 - mu;
      l2 = l1 + mu;
      if ((s2 < smax2) && (s2 > 1.0e-20)) {
        wprod = scale * w1 * p2.arr[W,jj];
        s1 = sqrt(s2);
        mu = sl/(s1*sqrt(l2));
        if (mu < 0) then mu = -mu;

        hh.add((s1,mu),wprod);
      }
    }
  }
}

proc doPairs() {
  var tt : Timer;

  // Read in the file
  tt.clear(); tt.start();
  var pp1, pp2 : Particle3D;
  if isPerf {
    pp1 = new Particle3D(nParticles, true);
    pp2 = new Particle3D(nParticles, true);
  } else {
    pp1 = readFile(fn1);
    pp2 = readFile(fn2);
    if !isTest {
      writef("Read in %i lines from file %s \n", pp1.npart, fn1);
      writef("Read in %i lines from file %s \n", pp2.npart, fn2);
    }
  }
  tt.stop();
  if !isTest {
    writef("Time to read : %r \n", tt.elapsed());
  }

  // Shuffle the particles -- this is not used here, but will be usef for the multilocale version
  tt.clear(); tt.start();
  pp1.shuffle();
  pp2.shuffle();
  tt.stop();
  if !isTest then writef("Time to shuffle : %r \n",tt.elapsed());

  // Build the tree
  tt.clear(); tt.start(); gtime1.clear();
  var root1 = BuildTree(pp1, 0, pp1.npart-1, 0);
  var root2 = BuildTree(pp2, 0, pp2.npart-1, 0);
  tt.stop();
  if !isTest then writef("Time to build trees : %r \n", tt.elapsed());
  //writef("Time in splitOn : %r \n", gtime1.elapsed());

  // Set up the histogram
  var hh = new UniformBins(2,(nsbins,nmubins), ((0.0,smax),(0.0,1.0+1.e-10)));

  // Do the paircounts with a tree
  hh.reset();
  tt.clear(); tt.start();
  sync TreeAccumulate(hh, pp1,pp2, root1, root2);
  tt.stop();
  if (!isTest) {
    writef("Time to tree paircount : %r \n", tt.elapsed());
    if !isPerf {
      var ff = openwriter("%s.tree".format(pairfn));
      writeHist(ff,hh);
      ff.close();
    }
  } else {
    hh.set((0,0),0.0);
    writeHist(stdout,hh,"%20.5er ");
  }

  //
  // clean up
  //
  delete pp1;
  delete pp2;
  delete root1;
  delete root2;
  delete hh;
}


updated ra-seq to work with new RA modules in release/examples/hpcc

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

use Time;

use HPCCProblemSize, RARandomStream;

param numTables = 1;
type elemType = randType,
     indexType = randType;

config const n = computeProblemSize(numTables, elemType,
                                    returnLog2=true): indexType,
             N_U = 2**(n+2);   // numUpdates

const m = 2**n,                // probSize
      indexMask = m-1;

config const sequentialVerify = (numLocales < log2(m)),
             errorTolerance = 1.0e-2;

config const printParams = true,
             printArrays = false,
             printStats = true;

def main() {
  printConfiguration();

  const TableSpace: domain(1, indexType) distributed(Block) = [0:indexType..#m];
  var T: [TableSpace] elemType;

  const UpdateSpace: domain(1, indexType) distributed(Block) = [0:indexType..#N_U];

  const startTime = getCurrentTime();

  [i in TableSpace] T(i) = i;

  for block in UpdateSpace.subBlocks do
    forall (_,r) in (block,RAStream()) do
      T(r & indexMask) ^= r;

  const execTime = getCurrentTime() - startTime;

  const validAnswer = verifyResults(T, UpdateSpace);
  printResults(validAnswer, execTime);
}

def printConfiguration() {
  if (printParams) {
    printProblemSize(elemType, numTables, m);
    writeln("Number of updates = ", N_U, "\n");
  }
}

def verifyResults(T: [?TDom], UpdateSpace) {
  if (printArrays) then writeln("After updates, T is: ", T, "\n");

  if (sequentialVerify) then
    forall (_,r) in (0:indexType..#N_U, RAStream()) do
      T(r & indexMask) ^= r;
  else
    forall i in UpdateSpace {
      const r = getNthRandom(i+1);
      atomic T(r & indexMask) ^= r;
    }

  if (printArrays) then writeln("After verification, T is: ", T, "\n");

  const numErrors = + reduce [i in TDom] (T(i) != i);
  if (printStats) then writeln("Number of errors is: ", numErrors, "\n");

  return numErrors <= (errorTolerance * N_U);
}

def printResults(successful, execTime) {
  writeln("Validation: ", if successful then "SUCCESS" else "FAILURE");
  if (printStats) {
    writeln("Execution time = ", execTime);
    writeln("Performance (GUPS) = ", N_U / execTime * 1.0e-9);
  }
}

use Time;

use HPCCProblemSize, RARandomStream;

param numTables = 1;
type elemType = randType,
     indexType = randType;

config const n = computeProblemSize(elemType, numTables,
                                    returnLog2=true): indexType,
             N_U = 2**(n+2);   // numUpdates

const m = 2**n,                // probSize
      indexMask = m-1;

config const sequentialVerify = (numLocales < log2(m)),
             errorTolerance = 1.0e-2;

config const printParams = true,
             printArrays = false,
             printStats = true;

def main() {
  printConfiguration();

  const TableSpace: domain(1, indexType) distributed(Block) = [0:indexType..#m];
  var T: [TableSpace] elemType;

  const UpdateSpace: domain(1, indexType) distributed(Block) = [0:indexType..#N_U];

  const startTime = getCurrentTime();

  [i in TableSpace] T(i) = i;

  for block in UpdateSpace.subBlocks do
    for r in RAStream(block) do
      T(r & indexMask) ^= r;

  const execTime = getCurrentTime() - startTime;

  const validAnswer = verifyResults(T, UpdateSpace);
  printResults(validAnswer, execTime);
}

def printConfiguration() {
  if (printParams) {
    printProblemSize(elemType, numTables, m);
    writeln("Number of updates = ", N_U, "\n");
  }
}

def verifyResults(T: [?TDom], UpdateSpace) {
  if (printArrays) then writeln("After updates, T is: ", T, "\n");

  if (sequentialVerify) then
    for r in RAStream(0:indexType..#N_U) do
      T(r & indexMask) ^= r;
  else
    forall i in UpdateSpace {
      const r = getNthRandom(i+1);
      atomic T(r & indexMask) ^= r;
    }

  if (printArrays) then writeln("After verification, T is: ", T, "\n");

  const numErrors = + reduce [i in TDom] (T(i) != i);
  if (printStats) then writeln("Number of errors is: ", numErrors, "\n");

  return numErrors <= (errorTolerance * N_U);
}

def printResults(successful, execTime) {
  writeln("Validation: ", if successful then "SUCCESS" else "FAILURE");
  if (printStats) {
    writeln("Execution time = ", execTime);
    writeln("Performance (GUPS) = ", N_U / execTime * 1.0e-9);
  }
}