Bug fix and small update to bulk transfer.

- Removed unnecessary extern prototypes for chpl_comm_get and
  chpl_comm_put (thanks for pointing that out, Rafa).

- Fixed a bug that was exposed by Anirudda's madness tests and a
  couple of Andy Stone's Matrix Multiplication test codes.  These
  tests change the domain of an array on a different locale than the
  array was initially declared on.  As a result, when doing bulk
  transfer, we need to check for the locale that the data field is
  allocated on and not the array descriptor.  There is a question
  regarding whether this is the kind of behavior we want (i.e., should
  the data field be reallocated on the locale that it was originally
  declared).

Last night's GASNet regressions should be fixed by this commit.

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

use DSIUtil;
config param debugDefaultDist = false;
config param debugDefaultDistBulkTransfer = false;
config param debugDataPar = false;

class DefaultDist: BaseDist {
  proc dsiNewRectangularDom(param rank: int, type idxType, param stridable: bool)
    return new DefaultRectangularDom(rank, idxType, stridable, this);

  proc dsiNewAssociativeDom(type idxType, param parSafe: bool)
    return new DefaultAssociativeDom(idxType, parSafe, this);

  proc dsiNewOpaqueDom(type idxType, param parSafe: bool)
    return new DefaultOpaqueDom(this, parSafe);

  proc dsiNewSparseDom(param rank: int, type idxType, dom: domain)
    return new DefaultSparseDom(rank, idxType, this, dom);

  proc dsiIndexToLocale(ind) return this.locale;

  proc dsiClone() return this;

  proc dsiAssign(other: this.type) { }

  proc dsiCreateReindexDist(newSpace, oldSpace) return this;
  proc dsiCreateRankChangeDist(param newRank, args) return this;
}

//
// Note that the replicated copies are set up in ChapelLocale on the
// other locales.  This just sets it up on this locale.
//
pragma "private" var defaultDist = new dmap(new DefaultDist());

class DefaultRectangularDom: BaseRectangularDom {
  param rank : int;
  type idxType;
  param stridable: bool;
  var dist: DefaultDist;
  var ranges : rank*range(idxType,BoundedRangeType.bounded,stridable);

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

  proc DefaultRectangularDom(param rank, type idxType, param stridable, dist) {
    this.dist = dist;
  }

  proc dsiClear() {
    var emptyRange: range(idxType, BoundedRangeType.bounded, stridable);
    for param i in 1..rank do
      ranges(i) = emptyRange;
  }

  // function and iterator versions, also for setIndices
  proc dsiGetIndices() return ranges;

  proc dsiSetIndices(x) {
    if ranges.size != x.size then
      compilerError("rank mismatch in domain assignment");
    if ranges(1).idxType != x(1).idxType then
      compilerError("index type mismatch in domain assignment");
    ranges = x;
  }

  iter these_help(param d: int) {
    if d == rank - 1 {
      for i in ranges(d) do
        for j in ranges(rank) do
          yield (i, j);
    } else {
      for i in ranges(d) do
        for j in these_help(d+1) do
          yield (i, (...j));
    }
  }

  iter these_help(param d: int, block) {
    if d == block.size - 1 {
      for i in block(d) do
        for j in block(block.size) do
          yield (i, j);
    } else {
      for i in block(d) do
        for j in these_help(d+1, block) do
          yield (i, (...j));
    }
  }

  iter these() {
    if rank == 1 {
      for i in ranges(1) do
        yield i;
    } else {
      for i in these_help(1) do
        yield i;
    }
  }

  iter these(param tag: iterator) where tag == iterator.leader {
    if debugDefaultDist then
      writeln("*** In domain/array leader code:"); // this = ", this);
    const numTasks = if dataParTasksPerLocale==0 then here.numCores
                     else dataParTasksPerLocale;
    const ignoreRunning = dataParIgnoreRunningTasks;
    const minIndicesPerTask = dataParMinGranularity;
    if debugDataPar {
      writeln("### numTasks = ", numTasks);
      writeln("### ignoreRunning = ", ignoreRunning);
      writeln("### minIndicesPerTask = ", minIndicesPerTask);
    }

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

    var (numChunks, parDim) = _computeChunkStuff(numTasks, ignoreRunning,
                                                 minIndicesPerTask, ranges);
    if debugDefaultDist then
      writeln("    numChunks=", numChunks, " parDim=", parDim,
              " ranges(", parDim, ").length=", ranges(parDim).length);

    if debugDataPar then writeln("### numChunks=", numChunks, " (parDim=", parDim, ")");

    if (CHPL_TARGET_PLATFORM != "xmt") {
      if numChunks == 1 {
        if rank == 1 {
          yield tuple(0..ranges(1).length-1);
        } else {
          var block: rank*range(idxType);
          for param i in 1..rank do
            block(i) = 0..ranges(i).length-1;
          yield block;
        }
      } else {
        var locBlock: rank*range(idxType);
        for param i in 1..rank do
          locBlock(i) = 0:ranges(i).low.type..#(ranges(i).length);
        if debugDefaultDist then
          writeln("*** DI: locBlock = ", locBlock);
        coforall chunk in 0..#numChunks {
          var tuple: rank*range(idxType) = locBlock;
          const (lo,hi) = _computeBlock(locBlock(parDim).length,
                                        numChunks, chunk,
                                        locBlock(parDim).high);
          tuple(parDim) = lo..hi;
          if debugDefaultDist then
            writeln("*** DI[", chunk, "]: tuple = ", tuple);
          yield tuple;
        }
      }
    } else {

      var per_stream_i: uint(64) = 0;
      var total_streams_n: uint(64) = 0;

      var locBlock: rank*range(idxType);
      for param i in 1..rank do
        locBlock(i) = 0:ranges(i).low.type..#(ranges(i).length);

      __primitive_loop("xmt pragma forall i in n", per_stream_i,
                       total_streams_n) {

        var tuple: rank*range(idxType) = locBlock;
        const (lo,hi) = _computeBlock(ranges(parDim).length,
                                      total_streams_n, per_stream_i,
                                      (ranges(parDim).length-1));
        tuple(parDim) = lo..hi;
        yield tuple;
      }
    }
  }

  iter these(param tag: iterator, follower) where tag == iterator.follower {
    proc anyStridable(rangeTuple, param i: int = 1) param
      return if i == rangeTuple.size then rangeTuple(i).stridable
             else rangeTuple(i).stridable || anyStridable(rangeTuple, i+1);

    chpl__testPar("default rectangular domain follower invoked on ", follower);
    if debugDefaultDist then
      writeln("In domain follower code: Following ", follower);
    param stridable = this.stridable || anyStridable(follower);
    var block: rank*range(idxType=idxType, stridable=stridable);
    if stridable {
      for param i in 1..rank {
        const rStride = ranges(i).stride:idxType,
              fStride = follower(i).stride:idxType;
        if ranges(i).stride > 0 {
          const low = ranges(i).low + follower(i).low*rStride,
                high = ranges(i).low + follower(i).high*rStride,
                stride = (rStride * fStride):int;
          block(i) = low..high by stride;
        } else {
          const low = ranges(i).high + follower(i).high*rStride,
                high = ranges(i).high + follower(i).low*rStride,
                stride = (rStride * fStride): int;
          block(i) = low..high by stride;
        }
      }
    } else {
      for  param i in 1..rank do
        block(i) = ranges(i).low+follower(i).low:idxType..ranges(i).low+follower(i).high:idxType;
    }

    if rank == 1 {
      for i in block {
        __primitive("noalias pragma");
        yield i;
      }
    } else {
      for i in these_help(1, block) {
        __primitive("noalias pragma");
        yield i;
      }
    }
  }

  proc dsiMember(ind: rank*idxType) {
    for param i in 1..rank do
      if !ranges(i).member(ind(i)) then
        return false;
    return true;
  }

  proc dsiIndexOrder(ind: rank*idxType) {
    var totOrder: idxType;
    var blk: idxType = 1;
    for param d in 1..rank by -1 {
      const orderD = ranges(d).indexOrder(ind(d));
      if (orderD == -1) then return orderD;
      totOrder += orderD * blk;
      blk *= ranges(d).length;
    }
    return totOrder;
  }

  proc dsiDims()
    return ranges;

  proc dsiDim(d : int)
    return ranges(d);

  // optional, is this necesary? probably not now that
  // homogeneous tuples are implemented as C vectors.
  proc dsiDim(param d : int)
    return ranges(d);

  proc dsiNumIndices {
    var sum = 1:idxType;
    for param i in 1..rank do
      sum *= ranges(i).length;
    return sum;
    // WANT: return * reduce (this(1..rank).length);
  }

  proc dsiLow {
    if rank == 1 {
      return ranges(1).low;
    } else {
      var result: rank*idxType;
      for param i in 1..rank do
        result(i) = ranges(i).low;
      return result;
    }
  }

  proc dsiHigh {
    if rank == 1 {
      return ranges(1).high;
    } else {
      var result: rank*idxType;
      for param i in 1..rank do
        result(i) = ranges(i).high;
      return result;
    }
  }

  proc dsiAlignedLow {
    if rank == 1 {
      return ranges(1).alignedLow;
    } else {
      var result: rank*idxType;
      for param i in 1..rank do
        result(i) = ranges(i).alignedLow;
      return result;
    }
  }

  proc dsiAlignedHigh {
    if rank == 1 {
      return ranges(1).alignedHigh;
    } else {
      var result: rank*idxType;
      for param i in 1..rank do
        result(i) = ranges(i).alignedHigh;
      return result;
    }
  }

  proc dsiStride {
    if rank == 1 {
      return ranges(1).stride;
    } else {
      var result: rank*chpl__signedType(idxType);
      for param i in 1..rank do
        result(i) = ranges(i).stride;
      return result;
    }
  }

  proc dsiAlignment {
    if rank == 1 {
      return ranges(1).alignment;
    } else {
      var result: rank*idxType;
      for param i in 1..rank do
        result(i) = ranges(i).alignment;
      return result;
    }
  }

  proc dsiFirst {
    if rank == 1 {
      return ranges(1).first;
    } else {
      var result: rank*idxType;
      for param i in 1..rank do
        result(i) = ranges(i).first;
      return result;
    }
  }

  proc dsiLast {
    if rank == 1 {
      return ranges(1).last;
    } else {
      var result: rank*idxType;
      for param i in 1..rank do
        result(i) = ranges(i).last;
      return result;
    }
  }

  proc dsiBuildArray(type eltType) {
    return new DefaultRectangularArr(eltType=eltType, rank=rank, idxType=idxType,
                                    stridable=stridable, dom=this);
  }

  proc dsiBuildRectangularDom(param rank: int, type idxType, param stridable: bool,
                            ranges: rank*range(idxType,
                                               BoundedRangeType.bounded,
                                               stridable)) {
    var dom = new DefaultRectangularDom(rank, idxType, stridable, dist);
    for i in 1..rank do
      dom.ranges(i) = ranges(i);
    return dom;
  }
}

class DefaultRectangularArr: BaseArr {
  type eltType;
  param rank : int;
  type idxType;
  param stridable: bool;

  var dom : DefaultRectangularDom(rank=rank, idxType=idxType,
                                         stridable=stridable);
  var off: rank*idxType;
  var blk: rank*idxType;
  var str: rank*chpl__signedType(idxType);
  var origin: idxType;
  var factoredOffs: idxType;
  var data : _ddata(eltType);
  var noinit: bool = false;
  //var numelm: int = -1; // for correctness checking

  proc canCopyFromDevice param return true;

  // end class definition here, then defined secondary methods below

  // can the compiler create this automatically?
  proc dsiGetBaseDom() return dom;

  proc dsiDestroyData() {
    if dom.dsiNumIndices > 0 {
      pragma "no copy" pragma "no auto destroy" var dr = data;
      pragma "no copy" pragma "no auto destroy" var dv = __primitive("get ref", dr);
      pragma "no copy" pragma "no auto destroy" var er = __primitive("array_get", dv, 0);
      pragma "no copy" pragma "no auto destroy" var ev = __primitive("get ref", er);
      if (chpl__maybeAutoDestroyed(ev)) {
        for i in 0..dom.dsiNumIndices-1 {
          pragma "no copy" pragma "no auto destroy" var dr = data;
          pragma "no copy" pragma "no auto destroy" var dv = __primitive("get ref", dr);
          pragma "no copy" pragma "no auto destroy" var er = __primitive("array_get", dv, i);
          pragma "no copy" pragma "no auto destroy" var ev = __primitive("get ref", er);
          chpl__autoDestroy(ev);
        }
      }
    }
    delete data;
  }

  iter these() var {
    if rank == 1 {
      // This is specialized to avoid overheads of calling dsiAccess()
      if !dom.stridable {
        // This is specialized because the strided version disables the
        // "single loop iterator" optimization
        var first = getDataIndex(dom.dsiLow);
        var second = getDataIndex(dom.dsiLow+dom.ranges(1).stride:idxType);
        var step = (second-first):chpl__signedType(idxType);
        var last = first + (dom.dsiNumIndices-1) * step:idxType;
        for i in first..last by step do
          yield data(i);
      } else {
        const stride = dom.ranges(1).stride: idxType,
              start  = dom.ranges(1).first,
              first  = getDataIndex(start),
              second = getDataIndex(start + stride),
              step   = (second-first):chpl__signedType(idxType),
              last   = first + (dom.ranges(1).length-1) * step:idxType;
        if step > 0 then
          for i in first..last by step do
            yield data(i);
        else
          for i in last..first by step do
            yield data(i);
      }
    } else {
      for i in dom do
        yield dsiAccess(i);
    }
  }

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

  iter these(param tag: iterator, follower) var where tag == iterator.follower {
    if debugDefaultDist then
      writeln("*** In array follower code:"); // [\n", this, "]");
    for i in dom.these(tag=iterator.follower, follower) {
      __primitive("noalias pragma");
      yield dsiAccess(i);
    }
  }

  proc computeFactoredOffs() {
    factoredOffs = 0:idxType;
    for param i in 1..rank do {
      factoredOffs = factoredOffs + blk(i) * off(i);
    }
  }

  // change name to setup and call after constructor call sites
  // we want to get rid of all initialize functions everywhere
  proc initialize() {
    if noinit == true then return;
    for param dim in 1..rank {
      off(dim) = dom.dsiDim(dim).alignedLow;
      str(dim) = dom.dsiDim(dim).stride;
    }
    blk(rank) = 1:idxType;
    for param dim in 1..rank-1 by -1 do
      blk(dim) = blk(dim+1) * dom.dsiDim(dim+1).length;
    computeFactoredOffs();
    var size = blk(1) * dom.dsiDim(1).length;
    data = new _ddata(eltType);
    //assert(size >= 0);
    //assert(size:int(64) <= max(int):int(64));
    //numelm = size: int;
    data.init(size);
  }

  pragma "inline"
  proc getDataIndex(ind: idxType ...1) where rank == 1
    return getDataIndex(ind);

  pragma "inline"
  proc getDataIndex(ind: rank* idxType) {
    var sum = origin;
    if stridable {
      for param i in 1..rank do
        sum += (ind(i) - off(i)) * blk(i) / abs(str(i)):idxType;
    } else {
      for param i in 1..rank do
        sum += ind(i) * blk(i);
      sum -= factoredOffs;
    }
    return sum;
  }

  // only need second version because wrapper record can pass a 1-tuple
  pragma "inline"
  proc dsiAccess(ind: idxType ...1) var where rank == 1
    return dsiAccess(ind);

  pragma "inline"
  proc dsiAccess(ind : rank*idxType) var {
    if boundsChecking then
      if !dom.dsiMember(ind) then
        halt("array index out of bounds: ", ind);
    var dataInd = getDataIndex(ind);
    //assert(dataInd >= 0);
    //assert(numelm >= 0); // ensure it has been initialized
    //assert(dataInd: uint(64) < numelm: uint(64));
    return data(dataInd);
  }

  proc dsiReindex(d: DefaultRectangularDom) {
    var alias = new DefaultRectangularArr(eltType=eltType, rank=d.rank,
                                         idxType=d.idxType,
                                         stridable=d.stridable,
                                         dom=d, noinit=true);
    alias.data = data;
    //alias.numelm = numelm;
    for param i in 1..rank {
      alias.off(i) = d.dsiDim(i).low;
      alias.blk(i) = (blk(i) * dom.dsiDim(i).stride / str(i)) : d.idxType;
      alias.str(i) = d.dsiDim(i).stride;
    }
    alias.origin = origin:d.idxType;
    alias.computeFactoredOffs();
    return alias;
  }

  proc dsiSlice(d: DefaultRectangularDom) {
    var alias = new DefaultRectangularArr(eltType=eltType, rank=rank,
                                         idxType=idxType,
                                         stridable=d.stridable,
                                         dom=d, noinit=true);
    alias.data = data;
    //alias.numelm = numelm;
    alias.blk = blk;
    alias.str = str;
    alias.origin = origin;
    for param i in 1..rank {
      alias.off(i) = d.dsiDim(i).low;
      alias.origin += blk(i) * (d.dsiDim(i).low - off(i)) / str(i);
    }
    alias.computeFactoredOffs();
    return alias;
  }

  proc dsiRankChange(d, param newRank: int, param newStridable: bool, args) {
    proc isRange(r: range(?e,?b,?s,?a)) param return 1;
    proc isRange(r) param return 0;

    var alias = new DefaultRectangularArr(eltType=eltType, rank=newRank,
                                         idxType=idxType,
                                         stridable=newStridable,
                                         dom=d, noinit=true);
    alias.data = data;
    //alias.numelm = numelm;
    var i = 1;
    alias.origin = origin;
    for param j in 1..args.size {
      if isRange(args(j)) {
        alias.off(i) = d.dsiDim(i).low;
        alias.origin += blk(j) * (d.dsiDim(i).low - off(j)) / str(j);
        alias.blk(i) = blk(j);
        alias.str(i) = str(j);
        i += 1;
      } else {
        alias.origin += blk(j) * (args(j) - off(j)) / str(j);
      }
    }
    alias.computeFactoredOffs();
    return alias;
  }

  proc dsiReallocate(d: domain) {
    if (d._value.type == dom.type) {
      var copy = new DefaultRectangularArr(eltType=eltType, rank=rank,
                                          idxType=idxType,
                                          stridable=d._value.stridable,
                                          dom=d._value);
      for i in d((...dom.ranges)) do
        copy.dsiAccess(i) = dsiAccess(i);
      off = copy.off;
      blk = copy.blk;
      str = copy.str;
      origin = copy.origin;
      factoredOffs = copy.factoredOffs;
      dsiDestroyData();
      data = copy.data;
      //numelm = copy.numelm;
      delete copy;
    } else {
      halt("illegal reallocation");
    }
  }

  proc dsiLocalSlice(ranges) {
    halt("all dsiLocalSlice calls on DefaultRectangulars should be handled in ChapelArray.chpl");
  }
}

proc DefaultRectangularDom.dsiSerialWrite(f: Writer) {
  f.write("[", dsiDim(1));
  for i in 2..rank do
    f.write(", ", dsiDim(i));
  f.write("]");
}

proc DefaultRectangularArr.dsiSerialWrite(f: Writer) {
  proc recursiveArrayWriter(in idx: rank*idxType, dim=1, in last=false) {
    var makeStridePositive = if dom.ranges(dim).stride > 0 then 1 else -1;
    if dim == rank {
      var first = true;
      if debugDefaultDist then f.writeln(dom.ranges(dim));
      for j in dom.ranges(dim) by makeStridePositive {
        if first then first = false; else f.write(" ");
        idx(dim) = j;
        f.write(dsiAccess(idx));
      }
    } else {
      for j in dom.ranges(dim) by makeStridePositive {
        var lastIdx =  dom.ranges(dim).last;
        idx(dim) = j;
        recursiveArrayWriter(idx, dim=dim+1,
                             last=(last || dim == 1) && (j == lastIdx));
      }
    }
    if !last && dim != 1 then
      f.writeln();
  }
  const zeroTup: rank*idxType;
  recursiveArrayWriter(zeroTup);
}

// This is very conservative.  For example, it will return false for
// 1-d array aliases that are shifted from the aliased array.
proc DefaultRectangularArr.isDataContiguous() {
  if debugDefaultDistBulkTransfer then
    writeln("isDataContiguous(): origin=", origin, " off=", off, " blk=", blk);
  if origin != 0 then return false;

  for param dim in 1..rank do
    if off(dim)!= dom.dsiDim(dim).first then return false;

  if blk(rank) != 1 then return false;

  for param dim in 1..rank-1 by -1 do
    if blk(dim) != blk(dim+1)*dom.dsiDim(dim+1).length then return false;

  if debugDefaultDistBulkTransfer then
    writeln("\tYES!");

  return true;
}

proc DefaultRectangularArr.dsiSupportsBulkTransfer() param return true;

proc DefaultRectangularArr.doiCanBulkTransfer() {
  if dom.stridable then
    for param i in 1..rank do
      if dom.ranges(i).stride != 1 then return false;

  if !isDataContiguous() then return false;

  return true;
}

proc DefaultRectangularArr.doiBulkTransfer(B) {
  const Adims = dom.dsiDims();
  var Alo: rank*dom.idxType;
  for param i in 1..rank do
    Alo(i) = Adims(i).first;

  const Bdims = B.domain.dims();
  var Blo: rank*dom.idxType;
  for param i in 1..rank do
    Blo(i) = Bdims(i).first;

  const len = dom.dsiNumIndices:int(32);
  _extern proc sizeof(type x): int(32);
  if debugBulkTransfer {
    const elemSize: int(32)=sizeof(B._value.eltType);
    writeln("In doiBulkTransfer(): Alo=", Alo, ", Blo=", Blo,
            ", len=", len, ", elemSize=", elemSize);
  }

  // NOTE: This does not work with --heterogeneous, but heterogeneous
  // compilation does not work right now.  The calls to chpl_comm_get
  // and chpl_comm_put should be changed once that is fixed.
  if this.data.locale==here {
    if debugDefaultDistBulkTransfer then
      writeln("\tlocal get() from ", B.locale.id);
    var dest = this.data;
    var src = B._value.data;
    __primitive("chpl_comm_get",
                __primitive("array_get", dest, getDataIndex(Alo)),
                B._value.data.locale.id,
                __primitive("array_get", src, B._value.getDataIndex(Blo)),
                len);
  } else if B._value.data.locale==here {
    if debugDefaultDistBulkTransfer then
      writeln("\tlocal put() to ", this.locale.id);
    var dest = this.data;
    var src = B._value.data;
    __primitive("chpl_comm_put",
                __primitive("array_get", src, B._value.getDataIndex(Blo)),
                this.data.locale.id,
                __primitive("array_get", dest, getDataIndex(Alo)),
                len);
  } else on this.data.locale {
    if debugDefaultDistBulkTransfer then
      writeln("\tremote get() on ", here.id, " from ", B.locale.id);
    var dest = this.data;
    var src = B._value.data;
    __primitive("chpl_comm_get",
                __primitive("array_get", dest, getDataIndex(Alo)),
                B._value.data.locale.id,
                __primitive("array_get", src, B._value.getDataIndex(Blo)),
                len);
  }
}

use DSIUtil;
config param debugDefaultDist = false;
config param debugDefaultDistBulkTransfer = false;
config param debugDataPar = false;

class DefaultDist: BaseDist {
  proc dsiNewRectangularDom(param rank: int, type idxType, param stridable: bool)
    return new DefaultRectangularDom(rank, idxType, stridable, this);

  proc dsiNewAssociativeDom(type idxType, param parSafe: bool)
    return new DefaultAssociativeDom(idxType, parSafe, this);

  proc dsiNewOpaqueDom(type idxType, param parSafe: bool)
    return new DefaultOpaqueDom(this, parSafe);

  proc dsiNewSparseDom(param rank: int, type idxType, dom: domain)
    return new DefaultSparseDom(rank, idxType, this, dom);

  proc dsiIndexToLocale(ind) return this.locale;

  proc dsiClone() return this;

  proc dsiAssign(other: this.type) { }

  proc dsiCreateReindexDist(newSpace, oldSpace) return this;
  proc dsiCreateRankChangeDist(param newRank, args) return this;
}

//
// Note that the replicated copies are set up in ChapelLocale on the
// other locales.  This just sets it up on this locale.
//
pragma "private" var defaultDist = new dmap(new DefaultDist());

class DefaultRectangularDom: BaseRectangularDom {
  param rank : int;
  type idxType;
  param stridable: bool;
  var dist: DefaultDist;
  var ranges : rank*range(idxType,BoundedRangeType.bounded,stridable);

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

  proc DefaultRectangularDom(param rank, type idxType, param stridable, dist) {
    this.dist = dist;
  }

  proc dsiClear() {
    var emptyRange: range(idxType, BoundedRangeType.bounded, stridable);
    for param i in 1..rank do
      ranges(i) = emptyRange;
  }

  // function and iterator versions, also for setIndices
  proc dsiGetIndices() return ranges;

  proc dsiSetIndices(x) {
    if ranges.size != x.size then
      compilerError("rank mismatch in domain assignment");
    if ranges(1).idxType != x(1).idxType then
      compilerError("index type mismatch in domain assignment");
    ranges = x;
  }

  iter these_help(param d: int) {
    if d == rank - 1 {
      for i in ranges(d) do
        for j in ranges(rank) do
          yield (i, j);
    } else {
      for i in ranges(d) do
        for j in these_help(d+1) do
          yield (i, (...j));
    }
  }

  iter these_help(param d: int, block) {
    if d == block.size - 1 {
      for i in block(d) do
        for j in block(block.size) do
          yield (i, j);
    } else {
      for i in block(d) do
        for j in these_help(d+1, block) do
          yield (i, (...j));
    }
  }

  iter these() {
    if rank == 1 {
      for i in ranges(1) do
        yield i;
    } else {
      for i in these_help(1) do
        yield i;
    }
  }

  iter these(param tag: iterator) where tag == iterator.leader {
    if debugDefaultDist then
      writeln("*** In domain/array leader code:"); // this = ", this);
    const numTasks = if dataParTasksPerLocale==0 then here.numCores
                     else dataParTasksPerLocale;
    const ignoreRunning = dataParIgnoreRunningTasks;
    const minIndicesPerTask = dataParMinGranularity;
    if debugDataPar {
      writeln("### numTasks = ", numTasks);
      writeln("### ignoreRunning = ", ignoreRunning);
      writeln("### minIndicesPerTask = ", minIndicesPerTask);
    }

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

    var (numChunks, parDim) = _computeChunkStuff(numTasks, ignoreRunning,
                                                 minIndicesPerTask, ranges);
    if debugDefaultDist then
      writeln("    numChunks=", numChunks, " parDim=", parDim,
              " ranges(", parDim, ").length=", ranges(parDim).length);

    if debugDataPar then writeln("### numChunks=", numChunks, " (parDim=", parDim, ")");

    if (CHPL_TARGET_PLATFORM != "xmt") {
      if numChunks == 1 {
        if rank == 1 {
          yield tuple(0..ranges(1).length-1);
        } else {
          var block: rank*range(idxType);
          for param i in 1..rank do
            block(i) = 0..ranges(i).length-1;
          yield block;
        }
      } else {
        var locBlock: rank*range(idxType);
        for param i in 1..rank do
          locBlock(i) = 0:ranges(i).low.type..#(ranges(i).length);
        if debugDefaultDist then
          writeln("*** DI: locBlock = ", locBlock);
        coforall chunk in 0..#numChunks {
          var tuple: rank*range(idxType) = locBlock;
          const (lo,hi) = _computeBlock(locBlock(parDim).length,
                                        numChunks, chunk,
                                        locBlock(parDim).high);
          tuple(parDim) = lo..hi;
          if debugDefaultDist then
            writeln("*** DI[", chunk, "]: tuple = ", tuple);
          yield tuple;
        }
      }
    } else {

      var per_stream_i: uint(64) = 0;
      var total_streams_n: uint(64) = 0;

      var locBlock: rank*range(idxType);
      for param i in 1..rank do
        locBlock(i) = 0:ranges(i).low.type..#(ranges(i).length);

      __primitive_loop("xmt pragma forall i in n", per_stream_i,
                       total_streams_n) {

        var tuple: rank*range(idxType) = locBlock;
        const (lo,hi) = _computeBlock(ranges(parDim).length,
                                      total_streams_n, per_stream_i,
                                      (ranges(parDim).length-1));
        tuple(parDim) = lo..hi;
        yield tuple;
      }
    }
  }

  iter these(param tag: iterator, follower) where tag == iterator.follower {
    proc anyStridable(rangeTuple, param i: int = 1) param
      return if i == rangeTuple.size then rangeTuple(i).stridable
             else rangeTuple(i).stridable || anyStridable(rangeTuple, i+1);

    chpl__testPar("default rectangular domain follower invoked on ", follower);
    if debugDefaultDist then
      writeln("In domain follower code: Following ", follower);
    param stridable = this.stridable || anyStridable(follower);
    var block: rank*range(idxType=idxType, stridable=stridable);
    if stridable {
      for param i in 1..rank {
        const rStride = ranges(i).stride:idxType,
              fStride = follower(i).stride:idxType;
        if ranges(i).stride > 0 {
          const low = ranges(i).low + follower(i).low*rStride,
                high = ranges(i).low + follower(i).high*rStride,
                stride = (rStride * fStride):int;
          block(i) = low..high by stride;
        } else {
          const low = ranges(i).high + follower(i).high*rStride,
                high = ranges(i).high + follower(i).low*rStride,
                stride = (rStride * fStride): int;
          block(i) = low..high by stride;
        }
      }
    } else {
      for  param i in 1..rank do
        block(i) = ranges(i).low+follower(i).low:idxType..ranges(i).low+follower(i).high:idxType;
    }

    if rank == 1 {
      for i in block {
        __primitive("noalias pragma");
        yield i;
      }
    } else {
      for i in these_help(1, block) {
        __primitive("noalias pragma");
        yield i;
      }
    }
  }

  proc dsiMember(ind: rank*idxType) {
    for param i in 1..rank do
      if !ranges(i).member(ind(i)) then
        return false;
    return true;
  }

  proc dsiIndexOrder(ind: rank*idxType) {
    var totOrder: idxType;
    var blk: idxType = 1;
    for param d in 1..rank by -1 {
      const orderD = ranges(d).indexOrder(ind(d));
      if (orderD == -1) then return orderD;
      totOrder += orderD * blk;
      blk *= ranges(d).length;
    }
    return totOrder;
  }

  proc dsiDims()
    return ranges;

  proc dsiDim(d : int)
    return ranges(d);

  // optional, is this necesary? probably not now that
  // homogeneous tuples are implemented as C vectors.
  proc dsiDim(param d : int)
    return ranges(d);

  proc dsiNumIndices {
    var sum = 1:idxType;
    for param i in 1..rank do
      sum *= ranges(i).length;
    return sum;
    // WANT: return * reduce (this(1..rank).length);
  }

  proc dsiLow {
    if rank == 1 {
      return ranges(1).low;
    } else {
      var result: rank*idxType;
      for param i in 1..rank do
        result(i) = ranges(i).low;
      return result;
    }
  }

  proc dsiHigh {
    if rank == 1 {
      return ranges(1).high;
    } else {
      var result: rank*idxType;
      for param i in 1..rank do
        result(i) = ranges(i).high;
      return result;
    }
  }

  proc dsiAlignedLow {
    if rank == 1 {
      return ranges(1).alignedLow;
    } else {
      var result: rank*idxType;
      for param i in 1..rank do
        result(i) = ranges(i).alignedLow;
      return result;
    }
  }

  proc dsiAlignedHigh {
    if rank == 1 {
      return ranges(1).alignedHigh;
    } else {
      var result: rank*idxType;
      for param i in 1..rank do
        result(i) = ranges(i).alignedHigh;
      return result;
    }
  }

  proc dsiStride {
    if rank == 1 {
      return ranges(1).stride;
    } else {
      var result: rank*chpl__signedType(idxType);
      for param i in 1..rank do
        result(i) = ranges(i).stride;
      return result;
    }
  }

  proc dsiAlignment {
    if rank == 1 {
      return ranges(1).alignment;
    } else {
      var result: rank*idxType;
      for param i in 1..rank do
        result(i) = ranges(i).alignment;
      return result;
    }
  }

  proc dsiFirst {
    if rank == 1 {
      return ranges(1).first;
    } else {
      var result: rank*idxType;
      for param i in 1..rank do
        result(i) = ranges(i).first;
      return result;
    }
  }

  proc dsiLast {
    if rank == 1 {
      return ranges(1).last;
    } else {
      var result: rank*idxType;
      for param i in 1..rank do
        result(i) = ranges(i).last;
      return result;
    }
  }

  proc dsiBuildArray(type eltType) {
    return new DefaultRectangularArr(eltType=eltType, rank=rank, idxType=idxType,
                                    stridable=stridable, dom=this);
  }

  proc dsiBuildRectangularDom(param rank: int, type idxType, param stridable: bool,
                            ranges: rank*range(idxType,
                                               BoundedRangeType.bounded,
                                               stridable)) {
    var dom = new DefaultRectangularDom(rank, idxType, stridable, dist);
    for i in 1..rank do
      dom.ranges(i) = ranges(i);
    return dom;
  }
}

class DefaultRectangularArr: BaseArr {
  type eltType;
  param rank : int;
  type idxType;
  param stridable: bool;

  var dom : DefaultRectangularDom(rank=rank, idxType=idxType,
                                         stridable=stridable);
  var off: rank*idxType;
  var blk: rank*idxType;
  var str: rank*chpl__signedType(idxType);
  var origin: idxType;
  var factoredOffs: idxType;
  var data : _ddata(eltType);
  var noinit: bool = false;
  //var numelm: int = -1; // for correctness checking

  proc canCopyFromDevice param return true;

  // end class definition here, then defined secondary methods below

  // can the compiler create this automatically?
  proc dsiGetBaseDom() return dom;

  proc dsiDestroyData() {
    if dom.dsiNumIndices > 0 {
      pragma "no copy" pragma "no auto destroy" var dr = data;
      pragma "no copy" pragma "no auto destroy" var dv = __primitive("get ref", dr);
      pragma "no copy" pragma "no auto destroy" var er = __primitive("array_get", dv, 0);
      pragma "no copy" pragma "no auto destroy" var ev = __primitive("get ref", er);
      if (chpl__maybeAutoDestroyed(ev)) {
        for i in 0..dom.dsiNumIndices-1 {
          pragma "no copy" pragma "no auto destroy" var dr = data;
          pragma "no copy" pragma "no auto destroy" var dv = __primitive("get ref", dr);
          pragma "no copy" pragma "no auto destroy" var er = __primitive("array_get", dv, i);
          pragma "no copy" pragma "no auto destroy" var ev = __primitive("get ref", er);
          chpl__autoDestroy(ev);
        }
      }
    }
    delete data;
  }

  iter these() var {
    if rank == 1 {
      // This is specialized to avoid overheads of calling dsiAccess()
      if !dom.stridable {
        // This is specialized because the strided version disables the
        // "single loop iterator" optimization
        var first = getDataIndex(dom.dsiLow);
        var second = getDataIndex(dom.dsiLow+dom.ranges(1).stride:idxType);
        var step = (second-first):chpl__signedType(idxType);
        var last = first + (dom.dsiNumIndices-1) * step:idxType;
        for i in first..last by step do
          yield data(i);
      } else {
        const stride = dom.ranges(1).stride: idxType,
              start  = dom.ranges(1).first,
              first  = getDataIndex(start),
              second = getDataIndex(start + stride),
              step   = (second-first):chpl__signedType(idxType),
              last   = first + (dom.ranges(1).length-1) * step:idxType;
        if step > 0 then
          for i in first..last by step do
            yield data(i);
        else
          for i in last..first by step do
            yield data(i);
      }
    } else {
      for i in dom do
        yield dsiAccess(i);
    }
  }

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

  iter these(param tag: iterator, follower) var where tag == iterator.follower {
    if debugDefaultDist then
      writeln("*** In array follower code:"); // [\n", this, "]");
    for i in dom.these(tag=iterator.follower, follower) {
      __primitive("noalias pragma");
      yield dsiAccess(i);
    }
  }

  proc computeFactoredOffs() {
    factoredOffs = 0:idxType;
    for param i in 1..rank do {
      factoredOffs = factoredOffs + blk(i) * off(i);
    }
  }

  // change name to setup and call after constructor call sites
  // we want to get rid of all initialize functions everywhere
  proc initialize() {
    if noinit == true then return;
    for param dim in 1..rank {
      off(dim) = dom.dsiDim(dim).alignedLow;
      str(dim) = dom.dsiDim(dim).stride;
    }
    blk(rank) = 1:idxType;
    for param dim in 1..rank-1 by -1 do
      blk(dim) = blk(dim+1) * dom.dsiDim(dim+1).length;
    computeFactoredOffs();
    var size = blk(1) * dom.dsiDim(1).length;
    data = new _ddata(eltType);
    //assert(size >= 0);
    //assert(size:int(64) <= max(int):int(64));
    //numelm = size: int;
    data.init(size);
  }

  pragma "inline"
  proc getDataIndex(ind: idxType ...1) where rank == 1
    return getDataIndex(ind);

  pragma "inline"
  proc getDataIndex(ind: rank* idxType) {
    var sum = origin;
    if stridable {
      for param i in 1..rank do
        sum += (ind(i) - off(i)) * blk(i) / abs(str(i)):idxType;
    } else {
      for param i in 1..rank do
        sum += ind(i) * blk(i);
      sum -= factoredOffs;
    }
    return sum;
  }

  // only need second version because wrapper record can pass a 1-tuple
  pragma "inline"
  proc dsiAccess(ind: idxType ...1) var where rank == 1
    return dsiAccess(ind);

  pragma "inline"
  proc dsiAccess(ind : rank*idxType) var {
    if boundsChecking then
      if !dom.dsiMember(ind) then
        halt("array index out of bounds: ", ind);
    var dataInd = getDataIndex(ind);
    //assert(dataInd >= 0);
    //assert(numelm >= 0); // ensure it has been initialized
    //assert(dataInd: uint(64) < numelm: uint(64));
    return data(dataInd);
  }

  proc dsiReindex(d: DefaultRectangularDom) {
    var alias = new DefaultRectangularArr(eltType=eltType, rank=d.rank,
                                         idxType=d.idxType,
                                         stridable=d.stridable,
                                         dom=d, noinit=true);
    alias.data = data;
    //alias.numelm = numelm;
    for param i in 1..rank {
      alias.off(i) = d.dsiDim(i).low;
      alias.blk(i) = (blk(i) * dom.dsiDim(i).stride / str(i)) : d.idxType;
      alias.str(i) = d.dsiDim(i).stride;
    }
    alias.origin = origin:d.idxType;
    alias.computeFactoredOffs();
    return alias;
  }

  proc dsiSlice(d: DefaultRectangularDom) {
    var alias = new DefaultRectangularArr(eltType=eltType, rank=rank,
                                         idxType=idxType,
                                         stridable=d.stridable,
                                         dom=d, noinit=true);
    alias.data = data;
    //alias.numelm = numelm;
    alias.blk = blk;
    alias.str = str;
    alias.origin = origin;
    for param i in 1..rank {
      alias.off(i) = d.dsiDim(i).low;
      alias.origin += blk(i) * (d.dsiDim(i).low - off(i)) / str(i);
    }
    alias.computeFactoredOffs();
    return alias;
  }

  proc dsiRankChange(d, param newRank: int, param newStridable: bool, args) {
    proc isRange(r: range(?e,?b,?s,?a)) param return 1;
    proc isRange(r) param return 0;

    var alias = new DefaultRectangularArr(eltType=eltType, rank=newRank,
                                         idxType=idxType,
                                         stridable=newStridable,
                                         dom=d, noinit=true);
    alias.data = data;
    //alias.numelm = numelm;
    var i = 1;
    alias.origin = origin;
    for param j in 1..args.size {
      if isRange(args(j)) {
        alias.off(i) = d.dsiDim(i).low;
        alias.origin += blk(j) * (d.dsiDim(i).low - off(j)) / str(j);
        alias.blk(i) = blk(j);
        alias.str(i) = str(j);
        i += 1;
      } else {
        alias.origin += blk(j) * (args(j) - off(j)) / str(j);
      }
    }
    alias.computeFactoredOffs();
    return alias;
  }

  proc dsiReallocate(d: domain) {
    if (d._value.type == dom.type) {
      var copy = new DefaultRectangularArr(eltType=eltType, rank=rank,
                                          idxType=idxType,
                                          stridable=d._value.stridable,
                                          dom=d._value);
      for i in d((...dom.ranges)) do
        copy.dsiAccess(i) = dsiAccess(i);
      off = copy.off;
      blk = copy.blk;
      str = copy.str;
      origin = copy.origin;
      factoredOffs = copy.factoredOffs;
      dsiDestroyData();
      data = copy.data;
      //numelm = copy.numelm;
      delete copy;
    } else {
      halt("illegal reallocation");
    }
  }

  proc dsiLocalSlice(ranges) {
    halt("all dsiLocalSlice calls on DefaultRectangulars should be handled in ChapelArray.chpl");
  }
}

proc DefaultRectangularDom.dsiSerialWrite(f: Writer) {
  f.write("[", dsiDim(1));
  for i in 2..rank do
    f.write(", ", dsiDim(i));
  f.write("]");
}

proc DefaultRectangularArr.dsiSerialWrite(f: Writer) {
  proc recursiveArrayWriter(in idx: rank*idxType, dim=1, in last=false) {
    var makeStridePositive = if dom.ranges(dim).stride > 0 then 1 else -1;
    if dim == rank {
      var first = true;
      if debugDefaultDist then f.writeln(dom.ranges(dim));
      for j in dom.ranges(dim) by makeStridePositive {
        if first then first = false; else f.write(" ");
        idx(dim) = j;
        f.write(dsiAccess(idx));
      }
    } else {
      for j in dom.ranges(dim) by makeStridePositive {
        var lastIdx =  dom.ranges(dim).last;
        idx(dim) = j;
        recursiveArrayWriter(idx, dim=dim+1,
                             last=(last || dim == 1) && (j == lastIdx));
      }
    }
    if !last && dim != 1 then
      f.writeln();
  }
  const zeroTup: rank*idxType;
  recursiveArrayWriter(zeroTup);
}

// This is very conservative.  For example, it will return false for
// 1-d array aliases that are shifted from the aliased array.
proc DefaultRectangularArr.isDataContiguous() {
  if debugDefaultDistBulkTransfer then
    writeln("isDataContiguous(): origin=", origin, " off=", off, " blk=", blk);
  if origin != 0 then return false;

  for param dim in 1..rank do
    if off(dim)!= dom.dsiDim(dim).first then return false;

  if blk(rank) != 1 then return false;

  for param dim in 1..rank-1 by -1 do
    if blk(dim) != blk(dim+1)*dom.dsiDim(dim+1).length then return false;

  if debugDefaultDistBulkTransfer then
    writeln("\tYES!");

  return true;
}

proc DefaultRectangularArr.dsiSupportsBulkTransfer() param return true;

proc DefaultRectangularArr.doiCanBulkTransfer() {
  if dom.stridable then
    for param i in 1..rank do
      if dom.ranges(i).stride != 1 then return false;

  if !isDataContiguous() then return false;

  return true;
}

proc DefaultRectangularArr.doiBulkTransfer(B) {
  const Adims = dom.dsiDims();
  var Alo: rank*dom.idxType;
  for param i in 1..rank do
    Alo(i) = Adims(i).first;

  const Bdims = B.domain.dims();
  var Blo: rank*dom.idxType;
  for param i in 1..rank do
    Blo(i) = Bdims(i).first;

  const len = dom.dsiNumIndices:int(32);
  _extern proc sizeof(type x): int(32);
  const elemSize: int(32)=sizeof(B._value.eltType);
  _extern proc chpl_comm_get(inout addr, localeID:int(32),
                             inout raddr, elemSize, typeIndex:int(32),
                             len:int(32), ln:int(32), fn:string);

  _extern proc chpl_comm_put(inout addr, localeID:int(32),
                             inout raddr, elemSize, typeIndex:int(32),
                             len:int(32), ln:int(32), fn:string);

  if debugBulkTransfer then
    writeln("In doiBulkTransfer(): Alo=", Alo, ", Blo=", Blo,
            ", len=", len, ", elemSize=", elemSize);

  // NOTE: This does not work with --heterogeneous, but heterogeneous
  // compilation does not work right now.  The calls to chpl_comm_get
  // and chpl_comm_put should be changed once that is fixed.
  if this.locale==here {
    if debugDefaultDistBulkTransfer then
      writeln("\tlocal get() from ", B.locale.id);
    var dest = this.data;
    var src = B._value.data;
    __primitive("chpl_comm_get",
                __primitive("array_get", dest, getDataIndex(Alo)),
                B.locale.id,
                __primitive("array_get", src, B._value.getDataIndex(Blo)),
                len);
  } else if B.locale==here {
    if debugDefaultDistBulkTransfer then
      writeln("\tlocal put() to ", this.locale.id);
    var dest = this.data;
    var src = B._value.data;
    __primitive("chpl_comm_put",
                __primitive("array_get", src, B._value.getDataIndex(Blo)),
                this.locale.id,
                __primitive("array_get", dest, getDataIndex(Alo)),
                len);
  } else on this.locale {
    if debugDefaultDistBulkTransfer then
      writeln("\tremote get() on ", here.id, " from ", B.locale.id);
    var dest = this.data;
    var src = B._value.data;
    __primitive("chpl_comm_get",
                __primitive("array_get", dest, getDataIndex(Alo)),
                B.locale.id,
                __primitive("array_get", src, B._value.getDataIndex(Blo)),
                len);
  }
}


Delete test_issue.chpl

Delete test_issue.chpl

class Collection {
	type eltType;
	proc add(elt : eltType) : bool {
		halt("Bad");
	}
}

class Deque : Collection {
	proc add(elt : eltType) : bool {
		writeln("Called");
		return true;
	}
}

record wrapper {
	type t;

	inline proc _value() {
		return new Deque(t);
	}

	forwarding _value;
}

var w : wrapper(int);
w.add(1);


Change extern prototypes to specify c_string instead of string

[ok'ed by Brad]

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

extern proc return_string_test():c_string;
extern proc return_string_arg_test(ref c_string);

writeln("returned string ",return_string_test()); stdout.flush();
var s:string;
on Locales(1) do
  return_string_arg_test(s);
writeln("returned string arg ",s);

extern proc return_string_test():string;
extern proc return_string_arg_test(ref string);

writeln("returned string ",return_string_test()); stdout.flush();
var s:string;
on Locales(1) do
  return_string_arg_test(s);
writeln("returned string arg ",s);


Made associative domains/arrays shrink on remove

Improved the associative domain/array implementation
such that calling the remove method will cause the
table size to be approximately halved when it is
sufficiently empty (< 1/8 full).

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

use Sort /* only QuickSort */;

// TODO: make the domain parameterized by this?
// TODO: make int(64) the default index type here and in arithemtic domains
type chpl_table_index_type = int(32);

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

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

const chpl_primes : [0..26] chpl_table_index_type
                  = (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 SingleLocaleAssociativeDomain: BaseDomain {
  type idxType;

  // The guts of the associative domain
  var numEntries: chpl_table_index_type = 0;
  var tableSizeNum = 0;
  var tableSize = chpl_primes(tableSizeNum);
  var tableDom = [0..tableSize-1];
  var table: [tableDom] chpl_TableEntry(idxType);

  // Temporary arrays for side computations:
  // TODO: Slosh back and forth between two tables rather than copying back
  // TODO: This ugly [0..-1] domain appears several times in the code --
  //       replace with a named constant/param?
  var tmpDom = [0..-1:chpl_table_index_type];
  var tmpTable: [tmpDom] chpl_TableEntry(idxType);
  var tmpDom2 = [0..-1:chpl_table_index_type];
  var tmpTable2: [tmpDom2] idxType;

  // BLC: Didn't want to have this, but _wrapDomain requires it
  param rank = 1;

  //
  // Standard Internal Domain Interface
  //
  def buildEmptyDomain() {
    return new SingleLocaleAssociativeDomain(idxType=idxType);
  }

  def buildArray(type eltType) {
    if (this == nil) then
      return new SingleLocaleAssociativeArray(eltType, idxType, dom=new SingleLocaleAssociativeDomain(idxType=idxType));
    else
      return new SingleLocaleAssociativeArray(eltType, idxType, dom=this);
  }

  def getIndices()
    return this;

  def setIndices(b: SingleLocaleAssociativeDomain) {
    // store cache of old domain/arrays
    _backupArrays();
    tmpDom = tableDom;
    tmpTable = table;

    // clear out old table
    numEntries = 0;
    tableDom = [0..-1:chpl_table_index_type];

    // choose new table size
    for primeNum in chpl_primes.domain {
      if (b.numEntries * 2 < chpl_primes(primeNum)) {
        tableSizeNum = primeNum;
        break;
      }
    }
    tableSize = chpl_primes(tableSizeNum);
    tableDom = [0..tableSize-1];

    // add indices and copy array data over
    for idx in b {
      const newSlotNum = add(idx);
      const (foundit, slot) = _findFilledSlot(idx, tmpTable);
      if (foundit) {
        _preserveArrayElement(oldslot=slot, newslot=newSlotNum);
      }
    }
    tmpDom = [0..-1:chpl_table_index_type];
    tmpDom2 = [0..-1:chpl_table_index_type];
    _removeArrayBackups();
  }

  def writeThis(f: Writer) {
    var first = true;
    f.write("[");
    for slot in _fullSlots() {
      if first then
        first = false;
      else
        f.write(", ");
      f.write(table(slot).idx);
    }
    f.write("]");
  }

  //
  // Standard user domain interface
  //

  def numIndices {
    return numEntries;
  }

  def these() {
    for slot in _fullSlots() {
      yield table(slot).idx;
    }
  }

  //
  // Associative Domain Interface
  //
  def clear() {
    for slot in tableDom {
      table(slot).status = chpl_hash_status.empty;
    }
    numEntries = 0;
  }

  def member(idx: idxType): bool {
    return _findFilledSlot(idx)(1);
  }

  def add(idx: idxType): index(tableDom) {
    if ((numEntries+1)*2 > tableSize) {
      // TODO: should also make sure that we don't exceed the maximum table
      // size
      _resize(grow=true);
    }
    const (foundSlot, slotNum) = _findEmptySlot(idx);
    if (foundSlot) {
      table(slotNum).status = chpl_hash_status.full;
      table(slotNum).idx = idx;
      numEntries += 1;
    } else {
      if (slotNum < 0) {
        halt("couldn't add ", idx, " -- ", numEntries, " / ", tableSize, " taken");
        return -1;
      }
      // otherwise, re-adding an index that's already in there
    }
    return slotNum;
  }

  def remove(idx: idxType) {
    const (foundSlot, slotNum) = _findFilledSlot(idx);
    if (foundSlot) {
      table(slotNum).status = chpl_hash_status.deleted;
      numEntries -= 1;
    } else {
      halt("index not in domain: ", idx);
    }
    if (numEntries*8 < tableSize && tableSizeNum > 0) {
      _resize(grow=false);
    }
  }

  def sorted() {
    _createSortedTmpTable2();
    for ind in tmpTable2 do
      yield ind;
    _destroySortedTmpTable2();
  }

  //
  // Internal interface (private)
  //
  def _createSortedTmpTable2() {
    // TODO: should assert that tmpDom2 is non-empty to avoid conflicting
    // calls? Or not -- to support early exit from iterator?
    tmpDom2 = [0..numEntries-1];
    var count: chpl_table_index_type = 0;
    for slot in _fullSlots() {
      tmpTable2(count) = table(slot).idx;
      count += 1;
    }
    QuickSort(tmpTable2);
  }

  def _destroySortedTmpTable2() {
    tmpDom2 = [0..-1:chpl_table_index_type];
  }

  def _resize(grow:bool) {
    // back up the arrays
    _backupArrays();

    // copy the table (TODO: could use swap between two versions)
    tmpDom = tableDom;
    tmpTable = table;

    // grow original table
    tableDom = [0..-1:chpl_table_index_type]; // non-preserving resize
    numEntries = 0; // reset, because the adds below will re-set this
    tableSizeNum += if grow then 1 else -1;
    tableSize = chpl_primes(tableSizeNum);
    tableDom = [0..tableSize-1];

    // insert old data into newly resized table
    for slot in _fullSlots(tmpTable) {
      const newslot = add(tmpTable(slot).idx);
      _preserveArrayElement(oldslot=slot, newslot=newslot);
    }

    // deallocate tmpTable
    tmpDom = [0..-1:chpl_table_index_type];
    _removeArrayBackups();
  }

  def _findFilledSlot(idx: idxType, tab = table): (bool, index(tableDom)) {
    for slotNum in _lookForSlots(idx, tab.domain.high+1) {
      const slotStatus = tab(slotNum).status;
      if (slotStatus == chpl_hash_status.empty) {
        return (false, -1);
      } else if (slotStatus == chpl_hash_status.full) {
        if (tab(slotNum).idx == idx) {
          return (true, slotNum);
        }
      }
    }
    return (false, -1);
  }

  def _findEmptySlot(idx: idxType): (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);
  }

  def _lookForSlots(idx: idxType, numSlots = tableSize) {
    const baseSlot = _associative_hash_wrapper(idx);
    for probe in 0..numSlots/2 {
      yield (baseSlot + probe**2)%numSlots;
    }
  }

  def _fullSlots(tab = table) {
    for slot in tab.domain {
      if tab(slot).status == chpl_hash_status.full then
        yield slot;
    }
  }
}

class SingleLocaleAssociativeArray: BaseArray {
  type eltType;
  type idxType;
  var dom : SingleLocaleAssociativeDomain(idxType=idxType);

  var data : [dom.tableDom] eltType;

  var tmpDom = [0..-1:chpl_table_index_type];
  var tmpTable: [tmpDom] eltType;

  //
  // Standard internal array interface
  //

  def reallocate(d: _domain) {
    // reallocation is done in the setIndices function
  }

  //
  // Standard array interface
  //
  def numElements {
    return dom.numIndices;
  }

  def this(idx : idxType) var : eltType {
    const (found, slotNum) = dom._findFilledSlot(idx);
    if (found) then
      return data(slotNum);
    else {
      halt("array index out of bounds: ", idx);
      return data(0);
    }
  }

  def these() var {
    for slot in dom._fullSlots() {
      yield data(slot);
    }
  }

  def writeThis(f: Writer) {
    var first = true;
    for slot in dom._fullSlots() {
      if (first) then
        first = false;
      else
        f.write(" ");
      f.write(data(slot));
    }
  }

  //
  // Associative array interface
  //

  def sorted() {
    _createSortedTmpTable();
    for elem in tmpTable do
      yield elem;
    _destroySortedTmpTable();
  }

  //
  // Internal associative array interface
  //

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

  def _removeArrayBackup() {
    tmpDom = [0..-1:chpl_table_index_type];
  }

  def _preserveArrayElement(oldslot, newslot) {
    data(newslot) = tmpTable(oldslot);
  }

  // private internal interface

  def _createSortedTmpTable() {
    tmpDom = [0..numElements-1];
    var count: chpl_table_index_type = 0;
    for slot in dom._fullSlots() {
      tmpTable(count) = data(slot);
      count += 1;
    }
    QuickSort(tmpTable);
  }

  def _destroySortedTmpTable() {
    tmpDom = [0..-1:chpl_table_index_type];
  }
}

def _associative_hash_wrapper(x): chpl_table_index_type {
  const hash = _associative_hash(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
def _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
}

pragma "inline"
def _associative_hash(b: bool): int(64) {
  if (b)
    return 0;
  else
    return 1;
}

pragma "inline"
def _associative_hash(i: int(64)): int(64) {
  return _gen_key(i);
}

pragma "inline"
def _associative_hash(u: uint(64)): int(64) {
  return _gen_key(u:int(64));
}

pragma "inline"
def _associative_hash(f: real): int(64) {
  return _gen_key(__primitive( "real2int", f));
}

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

// Use djb2 (Dan Bernstein in comp.lang.c.
pragma "inline"
def _associative_hash(x : string): int(64) {
  var hash: int(64) = 0;
  for c in 1..length(x) {
    hash = ((hash << 5) + hash) ^ ascii(x.substring(c));
  }
  return _gen_key(hash);
}

pragma "inline"
def _associative_hash(o: object): int(64) {
  return _gen_key(__primitive( "object2int", o));
}

use Sort /* only QuickSort */;

// TODO: make the domain parameterized by this?
// TODO: make int(64) the default index type here and in arithemtic domains
type chpl_table_index_type = int(32);

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

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

const chpl_primes : [0..26] chpl_table_index_type
                  = (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 SingleLocaleAssociativeDomain: BaseDomain {
  type idxType;

  // The guts of the associative domain
  var numEntries: chpl_table_index_type = 0;
  var tableSizeNum = 0;
  var tableSize = chpl_primes(tableSizeNum);
  var tableDom = [0..tableSize-1];
  var table: [tableDom] chpl_TableEntry(idxType);

  // Temporary arrays for side computations:
  // TODO: Slosh back and forth between two tables rather than copying back
  // TODO: This ugly [0..-1] domain appears several times in the code --
  //       replace with a named constant/param?
  var tmpDom = [0..-1:chpl_table_index_type];
  var tmpTable: [tmpDom] chpl_TableEntry(idxType);
  var tmpDom2 = [0..-1:chpl_table_index_type];
  var tmpTable2: [tmpDom2] idxType;

  // BLC: Didn't want to have this, but _wrapDomain requires it
  param rank = 1;

  //
  // Standard Internal Domain Interface
  //
  def buildEmptyDomain() {
    return new SingleLocaleAssociativeDomain(idxType=idxType);
  }

  def buildArray(type eltType) {
    if (this == nil) then
      return new SingleLocaleAssociativeArray(eltType, idxType, dom=new SingleLocaleAssociativeDomain(idxType=idxType));
    else
      return new SingleLocaleAssociativeArray(eltType, idxType, dom=this);
  }

  def getIndices()
    return this;

  def setIndices(b: SingleLocaleAssociativeDomain) {
    // store cache of old domain/arrays
    _backupArrays();
    tmpDom = tableDom;
    tmpTable = table;

    // clear out old table
    numEntries = 0;
    tableDom = [0..-1:chpl_table_index_type];

    // choose new table size
    for primeNum in chpl_primes.domain {
      if (b.numEntries * 2 < chpl_primes(primeNum)) {
        tableSizeNum = primeNum;
        break;
      }
    }
    tableSize = chpl_primes(tableSizeNum);
    tableDom = [0..tableSize-1];

    // add indices and copy array data over
    for idx in b {
      const newSlotNum = add(idx);
      const (foundit, slot) = _findFilledSlot(idx, tmpTable);
      if (foundit) {
        _preserveArrayElement(oldslot=slot, newslot=newSlotNum);
      }
    }
    tmpDom = [0..-1:chpl_table_index_type];
    tmpDom2 = [0..-1:chpl_table_index_type];
    _removeArrayBackups();
  }

  def writeThis(f: Writer) {
    var first = true;
    f.write("[");
    for slot in _fullSlots() {
      if first then
        first = false;
      else
        f.write(", ");
      f.write(table(slot).idx);
    }
    f.write("]");
  }

  //
  // Standard user domain interface
  //

  def numIndices {
    return numEntries;
  }

  def these() {
    for slot in _fullSlots() {
      yield table(slot).idx;
    }
  }

  //
  // Associative Domain Interface
  //
  def clear() {
    for slot in tableDom {
      table(slot).status = chpl_hash_status.empty;
    }
    numEntries = 0;
  }

  def member(idx: idxType): bool {
    return _findFilledSlot(idx)(1);
  }

  def add(idx: idxType): index(tableDom) {
    if ((numEntries+1)*2 > tableSize) {
      _grow();
    }
    const (foundSlot, slotNum) = _findEmptySlot(idx);
    if (foundSlot) {
      table(slotNum).status = chpl_hash_status.full;
      table(slotNum).idx = idx;
      numEntries += 1;
    } else {
      if (slotNum < 0) {
        halt("couldn't add ", idx, " -- ", numEntries, " / ", tableSize, " taken");
        return -1;
      }
      // otherwise, re-adding an index that's already in there
    }
    return slotNum;
  }

  def remove(idx: idxType) {
    // TODO: shrink table if less than 1/4 full
    const (foundSlot, slotNum) = _findFilledSlot(idx);
    if (foundSlot) {
      table(slotNum).status = chpl_hash_status.deleted;
      numEntries -= 1;
    } else {
      halt("index not in domain: ", idx);
    }
  }

  def sorted() {
    _createSortedTmpTable2();
    for ind in tmpTable2 do
      yield ind;
    _destroySortedTmpTable2();
  }

  //
  // Internal interface (private)
  //
  def _createSortedTmpTable2() {
    // TODO: should assert that tmpDom2 is non-empty to avoid conflicting
    // calls? Or not -- to support early exit from iterator?
    tmpDom2 = [0..numEntries-1];
    var count: chpl_table_index_type = 0;
    for slot in _fullSlots() {
      tmpTable2(count) = table(slot).idx;
      count += 1;
    }
    QuickSort(tmpTable2);
  }

  def _destroySortedTmpTable2() {
    tmpDom2 = [0..-1:chpl_table_index_type];
  }

  def _grow() {
    // back up the arrays
    _backupArrays();

    // copy the table (TODO: could use swap between two versions)
    tmpDom = tableDom;
    tmpTable = table;

    // grow original table
    tableDom = [0..-1:chpl_table_index_type]; // non-preserving resize
    numEntries = 0; // reset, because the adds below will re-set this
    tableSizeNum += 1;
    tableSize = chpl_primes(tableSizeNum);
    tableDom = [0..tableSize-1];

    // insert old data into newly resized table
    for slot in _fullSlots(tmpTable) {
      const newslot = add(tmpTable(slot).idx);
      _preserveArrayElement(oldslot=slot, newslot=newslot);
    }

    // deallocate tmpTable
    tmpDom = [0..-1:chpl_table_index_type];
    _removeArrayBackups();
  }

  def _findFilledSlot(idx: idxType, tab = table): (bool, index(tableDom)) {
    for slotNum in _lookForSlots(idx, tab.domain.high+1) {
      const slotStatus = tab(slotNum).status;
      if (slotStatus == chpl_hash_status.empty) {
        return (false, -1);
      } else if (slotStatus == chpl_hash_status.full) {
        if (tab(slotNum).idx == idx) {
          return (true, slotNum);
        }
      }
    }
    return (false, -1);
  }

  def _findEmptySlot(idx: idxType): (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);
  }

  def _lookForSlots(idx: idxType, numSlots = tableSize) {
    const baseSlot = _associative_hash_wrapper(idx);
    for probe in 0..numSlots/2 {
      yield (baseSlot + probe**2)%numSlots;
    }
  }

  def _fullSlots(tab = table) {
    for slot in tab.domain {
      if tab(slot).status == chpl_hash_status.full then
        yield slot;
    }
  }
}

class SingleLocaleAssociativeArray: BaseArray {
  type eltType;
  type idxType;
  var dom : SingleLocaleAssociativeDomain(idxType=idxType);

  var data : [dom.tableDom] eltType;

  var tmpDom = [0..-1:chpl_table_index_type];
  var tmpTable: [tmpDom] eltType;

  //
  // Standard internal array interface
  //

  def reallocate(d: _domain) {
    // reallocation is done in the setIndices function
  }

  //
  // Standard array interface
  //
  def numElements {
    return dom.numIndices;
  }

  def this(idx : idxType) var : eltType {
    const (found, slotNum) = dom._findFilledSlot(idx);
    if (found) then
      return data(slotNum);
    else {
      halt("array index out of bounds: ", idx);
      return data(0);
    }
  }

  def these() var {
    for slot in dom._fullSlots() {
      yield data(slot);
    }
  }

  def writeThis(f: Writer) {
    var first = true;
    for slot in dom._fullSlots() {
      if (first) then
        first = false;
      else
        f.write(" ");
      f.write(data(slot));
    }
  }

  //
  // Associative array interface
  //

  def sorted() {
    _createSortedTmpTable();
    for elem in tmpTable do
      yield elem;
    _destroySortedTmpTable();
  }

  //
  // Internal associative array interface
  //

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

  def _removeArrayBackup() {
    tmpDom = [0..-1:chpl_table_index_type];
  }

  def _preserveArrayElement(oldslot, newslot) {
    data(newslot) = tmpTable(oldslot);
  }

  // private internal interface

  def _createSortedTmpTable() {
    tmpDom = [0..numElements-1];
    var count: chpl_table_index_type = 0;
    for slot in dom._fullSlots() {
      tmpTable(count) = data(slot);
      count += 1;
    }
    QuickSort(tmpTable);
  }

  def _destroySortedTmpTable() {
    tmpDom = [0..-1:chpl_table_index_type];
  }
}

def _associative_hash_wrapper(x): chpl_table_index_type {
  const hash = _associative_hash(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
def _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
}

pragma "inline"
def _associative_hash(b: bool): int(64) {
  if (b)
    return 0;
  else
    return 1;
}

pragma "inline"
def _associative_hash(i: int(64)): int(64) {
  return _gen_key(i);
}

pragma "inline"
def _associative_hash(u: uint(64)): int(64) {
  return _gen_key(u:int(64));
}

pragma "inline"
def _associative_hash(f: real): int(64) {
  return _gen_key(__primitive( "real2int", f));
}

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

// Use djb2 (Dan Bernstein in comp.lang.c.
pragma "inline"
def _associative_hash(x : string): int(64) {
  var hash: int(64) = 0;
  for c in 1..length(x) {
    hash = ((hash << 5) + hash) ^ ascii(x.substring(c));
  }
  return _gen_key(hash);
}

pragma "inline"
def _associative_hash(o: object): int(64) {
  return _gen_key(__primitive( "object2int", o));
}