beginning testing for record wrapping bugs

/*
  A parallel-safe scalable distributed deque. A deque is a double-ended queue that supports
  insertion and removal from both ends of the queue, effectively supporting both
  FIFO, LIFO, and a Total ordering, where the order in which you add them will be
  the exact order you remove them in; for emphasis, a Deque can be used as a Queue,
  a Stack, and a List respectively. The deque enforces a 'barrier', which is a method
  of checking whether you may proceed with an operation, that is wait-free which
  guarantees scalability, where we perform bounds checking. Bounds checking performs
  the necessary checks to ensure two invariants: A `pop` operation never proceeds
  if the deque is empty, and that a `push` operation never proceeds if the deque
  is full. In the case where we have a `pop` and a non-empty deque, or a `push`
  with a non-full deque, we proceed within a single atomic fetchSub or fetchAdd
  respectively, hence is wait-free. In the case that we have a `pop` with a
  empty deque, or a `push` with a full deque, the queueSize becomes either
  negative or over capacity. When this happens, the faulty operation will, via
  remote execution (on-statement), perform a CAS-retry loop. If the opposite operation
  (`push` is the opposite of `pop` and vice-verse) sees the size in a incorrect state,
  it will continue its fetchSub/fetchAdd cycle, also bringing the size closer to
  its correct state. Hence, the fetchSub/fetchAdd cycle is bounded in that the number
  of faulty operations is bounded by the number of opposing operations and
  is also bounded and wait-free. The CAS-retry loop is also bounded by the number
  of overlapping operations and is helped along by the opposing operation, and hence
  is also bounded and wait-free.

  Deque operations are separated into three levels: global, local, and node.
  At a global level, we use simple fetchAdd and fetchSub counters to denote which
  local deque we apply our operation to based on the globalHead and globalTail in
  a way that emulates a deque. At the local-level, after you acquire the LocalDeque
  lock for an operation, you operate on linked nodes in a deque-like manner. Finally,
  at the node-level, each linked list node is an unroll block which is also a deque
  in and of itself. This hierarchical system ensures that we maintain this ordering
  but opens up a bit of non-determinism in terms of overlapping tasks hashing to the
  same LocalDeque, which is linearized on it's lock. While the Deque's ordering
  of elements are always preserved, the ordering in which tasks enter the 'barrier'
  to the point they complete their insertion is not. It is possible that given two
  tasks A and B, for A to finish at the global level before B, but for B to finish
  at the local level before A. However, it should be noted that for any MPMC queue,
  this non-determinism is inherent in all lock-free and wait-free data structures.
*/

module DistributedDeque {

  use Collection;
  use SharedObject;

  /*
    Size of each unroll block for each local deque node.
  */
  config param distributedDequeBlockSize = 8;

  /*
    The ordering used for serial iteration. NONE, the default, is the most performant
    and is algorithmically similar to parallel iteration.
  */
  enum Ordering {
    NONE,
    FIFO,
    LIFO
  }

  pragma "no doc"
  class DistributedDequeRC {
    type eltType;
    var _pid : int;

    proc deinit() {
      coforall loc in Locales do on loc {
          delete chpl_getPrivatizedCopy(DistributedBagImpl(eltType), _pid);
      }
    }
  }

  /*
    A parallel-safe scalable distributed double-ended queue that supports both
    insertion and removal from either end of the queue. Can be used as a Queue,
    Stack, or even a List.
  */
  record DistDeque {
    type eltType;

    // Privatization id
    pragma "no doc"
    var _pid : int;
    // Reference counting
    pragma "no doc"
    var _rc : SharedObject(DistributedDequeRC(eltType));

    proc DistDeque(type eltType, cap = -1, targetLocales = Locales) {
      _pid = (new DistributedDequeImpl(eltType, cap, targetLocales)).pid;
      _rc = new Shared(new DistributedDequeRC(eltType, _pid = _pid));
    }

    inline proc _value {
      if _pid == -1 {
        halt("DistDeque is uninitialized...");
      }
      return chpl_getPrivatizedCopy(DistributedDequeImpl(eltType), _pid);
    }

    forwarding _value;
  }

  /*
    Atomic counters that are allocated on a single node used by privatized instances.
    This comes with the benefit of being able to distribute communication across multiple
    nodes rather than one instance.
  */
  pragma "no doc"
  class DistributedDequeCounter {
    var _value : atomic int;

    forwarding _value;
  }

  /*
    A parallel-safe scalable distributed double-ended queue that supports both
    insertion and removal from either end of the queue. Can be used as a Queue,
    Stack, or even a List.
  */
  pragma "no doc"
  class DistributedDequeImpl : Collection {
    /*
      Capacity, the maximum number of elements a Deque can hold. A `cap` of -1 is
      considered unbounded.
    */
    var cap : int;
    pragma "no doc"
    var targetLocDom : domain(1);
    /*
      Locales to distribute the `Deque` across.
    */
    var targetLocales : [targetLocDom] locale;

    // Privatization id
    pragma "no doc"
    var pid : int;

    // Keeps track of which slot we are on...
    pragma "no doc"
    var globalHead : DistributedDequeCounter;
    pragma "no doc"
    var globalTail : DistributedDequeCounter;
    pragma "no doc"
    var queueSize : DistributedDequeCounter;

    // We maintain an array of slots, wherein each slot is a pointer into a node's
    // address space. To maximize parallelism, we maintain numLocales * maxTaskPar
    // to reduce the amount of contention.
    pragma "no doc"
    var nSlots : int;
    pragma "no doc"
    var slotSpace = {0..-1};
    pragma "no doc"
    var slots : [slotSpace] LocalDeque(eltType);

    proc DistributedDeque(type eltType, cap : int = -1, targetLocales : [?locDom] locale =Locales) {
      this.cap = cap;
      this.nSlots = here.maxTaskPar * targetLocales.size;
      this.slotSpace = {0..#this.nSlots};
      this.targetLocDom = locDom;
      this.targetLocales = targetLocales;

      // Initialize each slot. We use a round-robin algorithm.
      var idx : atomic int;
      for 0 .. #here.maxTaskPar {
        for loc in targetLocales do on loc {
          var i = idx.fetchAdd(1);
          slots[i] = new LocalDeque(eltType);
        }
      }

      // Distribute the globalHead, globalTail, and queueSize over the first 3 nodes...
      var countersLeftToAlloc = 3;
      while countersLeftToAlloc > 0 {
        for loc in targetLocales do on loc {
          select countersLeftToAlloc {
            when 3 do globalHead = new DistributedDequeCounter();
            when 2 do globalTail = new DistributedDequeCounter();
            when 1 do queueSize = new DistributedDequeCounter();
          }

          countersLeftToAlloc -= 1;
        }
      }

      pid = _newPrivatizedClass(this);
    }

    pragma "no doc"
    proc DistributedDeque(other, privData, type eltType = other.eltType) {
      this.cap = other.cap;
      this.targetLocDom = other.targetLocDom;
      this.targetLocales = other.targetLocales;
      this.globalHead = other.globalHead;
      this.globalTail = other.globalTail;
      this.queueSize = other.queueSize;
      this.nSlots = other.nSlots;
      this.slotSpace = {0..#this.nSlots};
      slots = other.slots;
    }

    pragma "no doc"
    proc dsiPrivatize(privData) {
        return new DistributedDeque(this, privData);
    }

    pragma "no doc"
    proc dsiGetPrivatizeData() {
      return pid;
    }

    pragma "no doc"
    inline proc getPrivatizedThis {
      return chpl_getPrivatizedCopy(this.type, pid);
    }

    pragma "no doc"
    inline proc enterRemoveBarrier() {
      // If we have a capacity of 0, then we can't really remove anything anyway.
      if cap == 0 {
        return false;
      }

      // Similar to add, we use a wait-free method for updating the queue size,
      // using fetch-sub instead. Like enqueue, we make attempts to fix the queue
      // size in a lock-free manner (for as long as it is negative). It should be
      // noted that if we see that the queue size is over capacity, meaning an
      // enqueue operation has over committed, we consequentially help them as well
      // during the fetch-sub loop.
      while true {
        var size = queueSize.fetchSub(1);

        // Negative, fix before returning...
        if size <= 0 {
          on queueSize {
            var readSize = queueSize.read();
            // Attempt to fix, but yield to reduce potential contention and CPU hogging.
            while readSize < 0 && !queueSize.compareExchangeWeak(readSize, 0) {
              chpl_task_yield();
              readSize = queueSize.read();
            }
          }

          // Fixed, return early...
          return false;
        }
        // If we have a cap, then at this point, we have something between [0, cap],
        // if we do not have a cap then there is no need to 'fix' the queue size;
        // in both cases we are safe.
        else if cap < 0 || size <= cap {
          break;
        }
        // If the size is over capacity, a enqueuer has overcommitted. Since there can
        // be an element for us, we loop again.
      }

      return true;
    }

    pragma "no doc"
    inline proc enterAddBarrier() {
      // If we have a capacity of 0, then we can't really add anything anyway.
      if cap == 0 {
        return false;
      }

      // If we have a capacity, we must ensure that there is enough space for our
      // operation ahead of time. We take a wait-free approach by performing a
      // fetch-add on the queue size. If there is space, then we succeed within one
      // communication round-trip. If we fail, then we make attempts to fix the queue
      // size in a lock-free manner (for as long as it is over capacity). It should be
      // noted that if we see that the queue size is negative, meaning a dequeue operation
      // has over committed, we consequentially help them as well during the fetch-add loop.
      if cap > 0 {
        while true {
          var size = queueSize.fetchAdd(1);

          // Over capacity, fix before returning...
          if size >= cap {
            on queueSize {
              var readSize = queueSize.read();
              // Attempt to fix, but yield to reduce potential contention and CPU hogging.
              while readSize > this.cap && !queueSize.compareExchangeWeak(readSize, this.cap) {
                chpl_task_yield();
                readSize = queueSize.read();
              }
            }

            // Fixed, return early...
            return false;
          }
          // At this point, we either have a capacity and something between [0, cap],
          // or we do not have a capacity and we have something greater than 0,
          // either of which means we are safe.
          else if size >= 0 {
            break;
          }
          // If the size is negative, a dequeuer has overcommitted. Since there can
          // be an element for us, we loop again.
        }
      }
      // If we have a 'negative' capacity, we do not have one and can hold an
      // infinite amount; this gives us a more optimized code path.
      else {
        while true {
          var size = queueSize.fetchAdd(1);

          // We have reserved a spot for our operation.
          if size >= 0 {
            break;
          }
          // If the size is negative, a dequeuer has overcommitted. Since there can
          // be an element for us, we loop again.
        }
      }

      return true;
    }

    /*
      Syntactic sugar for `pushBack`.
    */
    proc add(elt : eltType) : bool {
      return pushBack(elt);
    }

    /*
      Syntactic sugar for `popFront`.
    */
    proc remove() : (bool, eltType) {
      return popFront();
    }

    /*
      Syntactic sugar for `pushBack`.
    */
    proc enqueue(elt : eltType) : bool {
      return pushBack(elt);
    }

    /*
      Syntactic sugar for `popFront`.
    */
    proc dequeue() : (bool, eltType) {
      return popFront();
    }

    /*
      Syntactic sugar for `pushBack`.
    */
    proc push(elt : eltType) : bool {
      return pushBack(elt);
    }

    /*
      Syntactic sugar for `popBack`.
    */
    proc pop() : (bool, eltType) {
      return popBack();
    }

    /*
      Appends the element to the tail.
    */
    proc pushBack(elt : eltType) : bool {
      // Test for if we can continue...
      if enterAddBarrier() == false {
        return false;
      }

      // At this point, we know we have a space for us. We find our slot based on another
      // fetch-add counter, making this wait-free as well.
      var tail = globalTail.fetchAdd(1) % nSlots;
      slots[abs(tail)].pushBack(elt);
      return true;
    }

    /*
      Removes the element at the tail.
    */
    proc popBack() : (bool, eltType) {
      // Test for if we can continue...
      if enterRemoveBarrier() == false {
        return (false, _defaultOf(eltType));
      }

      // We find our slot based on another fetch-add counter, making this wait-free as well.
      var tail = (globalTail.fetchSub(1) - 1) % nSlots;
      var elt = slots[abs(tail)].popBack();
      return (true, elt);
    }

    /*
      Appends the element to the head.
    */
    proc pushFront(elt : eltType) : bool {
      // Test if we can continue...
      if enterAddBarrier() == false {
        return false;
      }

      // We find our slot based on another fetch-add counter, making this wait-free as well.
      var head = (globalHead.fetchSub(1) - 1) % nSlots;
      slots[abs(head)].pushFront(elt);
      return true;
    }

    /*
      Removes the element at the head.
    */
    proc popFront() : (bool, eltType) {
      // Test for if we can continue...
      if enterRemoveBarrier() == false {
        return (false, _defaultOf(eltType));
      }

      // We find our slot based on another fetch-add counter, making this wait-free as well.
      var head = globalHead.fetchAdd(1) % nSlots;
      var elt = slots[abs(head)].popFront();
      return (true, elt);
    }

    /*
      Obtains the number of elements held by this queue.
    */
    proc getSize() : int {
      return queueSize.read();
    }

    /*
      Performs a lookup for the element in the data structure.
    */
    proc contains(elt : eltType) : bool {
      var containsElem : atomic bool;
      forall elem in this {
        if elem == elt {
          containsElem.write(true);
        }
      }
      return containsElem.read();
    }

    /*
      Iterate over all elements in the deque in the order specified.

      **Warning:** Calling other methods while inside of an iterator is not safe as
      it will likely lead to deadlock.

      **FIXME:** Likely can be worked around by either using snapshot iteration approach
      or by making the lock reentrant and forcing all iterators to acquire all locks in
      some global locking order.
    */
    iter these(param order : Ordering = Ordering.NONE) : eltType where order == Ordering.NONE {
      for slot in slots {
        slot.lock$ = true;
        var node = slot.head;

        while node != nil {
          var headIdx = node.headIdx;
          for 1 .. node.size {
            yield node.elements[headIdx];

            headIdx += 1;
            if headIdx > distributedDequeBlockSize {
              headIdx = 1;
            }
          }
          node = node.next;
        }

        slot.lock$;
      }
    }

    iter these(param order : Ordering = Ordering.NONE) : eltType where order == Ordering.FIFO {
      // Fill our slots to visit in FIFO order.
      var head = globalHead.read();
      var tail = globalTail.read();
      var size = queueSize.read();

      // Check if empty...
      if size == 0 {
        return;
      }

      // Acquire in locking order...
      for slot in slots do slot.lock$ = true;

      // We iterate directly over the heads of each slot, so we capture them in advance.
      var nodes : [{0..#nSlots}] (int, int, LocalDequeNode(eltType));
      for i in 0 .. #nSlots {
        var node = slots[i].head;
        nodes[i] = (node.size, node.headIdx, node);
      }

      // Iterate over captured head nodes; each time we read them we advance them
      var iterations = size;
      for i in head..#tail {
        if iterations == 0 then break;
        iterations -= 1;

        var idx = i % nSlots;
        var (size, headIdx, node) = nodes[idx];
        if node == nil {
          halt("DistributedDeque Internal Error: Iterating over nil nodes, head: ", head, ", tail: ", tail, ", idx: ", i);
        }
        yield node.elements[headIdx];

        // Update state...
        size -= 1;
        headIdx += 1;
        if headIdx > distributedDequeBlockSize {
          headIdx = 1;
        }

        // Advance...
        if size == 0 {
          node = node.next;
          if node != nil {
            nodes[idx] = (node.size, node.headIdx, node);
          } else {
            nodes[idx] = (-1, -1, node);
          }
        } else {
          // Else update state...
          nodes[idx] = (size, headIdx, node);
        }
      }

      // Release in locking order...
      for slot in slots do slot.lock$;
    }

    iter these(param order : Ordering = Ordering.NONE) : eltType where order == Ordering.LIFO {
      // Fill our slots to visit in FIFO order.
      var head = globalHead.read();
      var tail = globalTail.read();
      var size = queueSize.read();

      // Check if empty...
      if size == 0 {
        return;
      }

      // Acquire in locking order...
      for slot in slots do slot.lock$ = true;

      // We iterate directly over the heads of each slot, so we capture them in advance.
      var nodes : [{0..#nSlots}] (int, int, LocalDequeNode(eltType));
      for i in 0 .. #nSlots {
        var node = slots[i].tail;
        nodes[i] = (node.size, node.tailIdx, node);
      }

      // Iterate over captured head nodes; each time we read them we advance them
      var iterations = size;
      while tail > head {
        if iterations == 0 then break;
        iterations -= 1;

        var idx = (tail - 1) % nSlots;
        var (size, tailIdx, node) = nodes[idx];
        if node == nil {
          halt("DistributedDeque Internal Error: Iterating over nil nodes, head: ", head, ", tail: ", tail);
        }

        tailIdx -= 1;
        if tailIdx == 0 {
          tailIdx = distributedDequeBlockSize;
        }
        yield node.elements[tailIdx];

        // Update state...
        size -= 1;

        // Advance...
        if size == 0 {
          node = node.prev;
          if node != nil {
            nodes[idx] = (node.size, node.tailIdx, node);
          } else {
            nodes[idx] = (-1, -1, node);
          }
        } else {
          // Else update state...
          nodes[idx] = (size, tailIdx, node);
        }

        tail -= 1;
      }

      // Release in locking order...
      for slot in slots do slot.lock$;
    }

    iter these(param order : Ordering = Ordering.NONE, param tag : iterKind) where tag == iterKind.leader {
      if order != Ordering.NONE {
        compilerWarning("Parallel iteration only supports ordering of type: ", Ordering.NONE);
      }
      coforall slot in slots do on slot do yield slot;
    }

    iter these(param order : Ordering = Ordering.NONE, param tag : iterKind, followThis) where tag == iterKind.follower {
      if order != Ordering.NONE {
        compilerWarning("Parallel iteration only supports ordering of type: ", Ordering.NONE);
      }

      followThis.lock$ = true;
      var node = followThis.head;

      while node != nil {
        var headIdx = node.headIdx;
        for 1 .. node.size {
          yield node.elements[headIdx];

          headIdx += 1;
          if headIdx > distributedDequeBlockSize {
            headIdx = 1;
          }
        }
        node = node.next;
      }

      followThis.lock$;
    }

    proc ~DistributedDeque() {
      for slot in slots do delete slot;
    }
  }

  // For each node we manage an unroll block. This block needs to also support Deque
  // operations, and as such we maintain our own mini headIdx and tailIdx. Since we can
  // add and remove from either direction, we must also maintain the size ourselves...
  pragma "no doc"
  class LocalDequeNode {
    type eltType;
    var elements : distributedDequeBlockSize * eltType;
    var headIdx : int = 1;
    var tailIdx : int = 1;
    var size : int;
    var next : LocalDequeNode(eltType);
    var prev : LocalDequeNode(eltType);

    inline proc isFull {
      return size == distributedDequeBlockSize;
    }

    inline proc isEmpty {
      return size == 0;
    }

    inline proc pushBack(elt : eltType) {
      elements[tailIdx] = elt;

      tailIdx += 1;
      if tailIdx > distributedDequeBlockSize {
        tailIdx = 1;
      }
      size += 1;
    }

    inline proc popBack() : eltType {
      tailIdx -= 1;
      if tailIdx == 0 {
        tailIdx = distributedDequeBlockSize;
      }

      size -= 1;
      return elements[tailIdx];
    }

    inline proc pushFront(elt : eltType) {
      headIdx -= 1;
      if headIdx == 0 {
        headIdx = distributedDequeBlockSize;
      }

      elements[headIdx] = elt;
      size += 1;
    }

    inline proc popFront() : eltType {
      var elt = elements[headIdx];
      headIdx += 1;
      if headIdx > distributedDequeBlockSize {
        headIdx = 1;
      }

      size -= 1;
      return elt;
    }
  }

  /*
    For each slot (core) we maintain a deque.

    **TODO:** Need to convert LocalDequeNode to use C_Ptr, double the size of each
    successor for better locality, and use the snapshot approach so that iteration
    does not prevent usage of other methods on the same Deque from the same task.
  */
  pragma "no doc"
  class LocalDeque {
    type eltType;

    var lock$ : sync bool;

    var head : LocalDequeNode(eltType);
    var tail : LocalDequeNode(eltType);

    // We cache the last deleted node to handle cases where we have rapid mixed push/pop
    var cached : LocalDequeNode(eltType);

    // The size of a segment. This is used as both a means of knowing when an element
    // gets added, as well as a barrier to prevent the head and tail from being cached.
    var size : atomic int;

    inline proc recycleNode() {
      // If we have cached a previous used node, reuse it here...
      if cached != nil {
        var tmp = cached;
        cached = nil;

        // Clean...
        tmp.headIdx = 1;
        tmp.tailIdx = 1;
        tmp.size = 0;
        tmp.next = nil;
        tmp.prev = nil;

        return tmp;
      }

      // Create a new one...
      return  new LocalDequeNode(eltType);
    }

    inline proc retireNode(node) {
      if cached != nil {
        delete cached;
      }

      cached = node;
    }

    proc pushBack(elt : eltType) {
      on this {
        var _elt = elt;
        local {
          lock$ = true;

          // Its empty...
          if tail == nil {
            tail = recycleNode();
            head = tail;
          }

          // Its full...
          if tail.isFull {
            tail.next = recycleNode();
            tail.next.prev = tail;
            tail = tail.next;
          }

          // Push...
          tail.pushBack(_elt);
          size.add(1);

          lock$;
        }
      }
    }

    proc popBack() : eltType {
      var elt : eltType;
      on this {
        var _elt : eltType;
        local {
          while true {
            // Check if there is an element for us...
            if size.read() == 0 {
              while size.read() == 0 {
                chpl_task_yield();
              }
            }

            lock$ = true;

            // Someone else came in and took a value, wait for the next one...
            if size.read() == 0 {
              lock$;
              continue;
            }

            // Pop...
            _elt = tail.popBack();
            if tail.isEmpty {
              var node = tail;
              tail = tail.prev;

              // If not empty, remove reference to retired node...
              // If it is empty, fix the head...
              if tail != nil {
                tail.next = nil;
              } else {
                head = nil;
              }

              retireNode(node);
            }

            size.sub(1);
            lock$;
            break;
          }
        }
        elt = _elt;
      }

      return elt;
    }

    proc pushFront(elt : eltType) {
      on this {
        var _elt = elt;
        local {
          lock$ = true;

          // Its empty...
          if head == nil {
            head = recycleNode();
            tail = head;
          }

          // Its full...
          if head.isFull {
            head.prev = recycleNode();
            head.prev.next = head;
            head = head.prev;
          }

          // Push...
          head.pushFront(_elt);
          size.add(1);

          lock$;
        }
      }
    }

    proc popFront() : eltType {
      var elt : eltType;
      on this {
        var _elt : eltType;
        local {
          while true {
            // Check if there is an element for us...
            if size.read() == 0 {
              while size.read() == 0 {
                chpl_task_yield();
              }
            }

            lock$ = true;

            // Someone else came in and took a value, wait for the next one...
            if size.read() == 0 {
              lock$;
              continue;
            }

            // Pop...
            _elt = head.popFront();
            if head.isEmpty {
              var node = head;
              head = head.next;

              // If not empty, remove reference to retired node...
              // If it is empty, fix the tail...
              if head != nil {
                head.prev = nil;
              } else {
                tail = nil;
              }

              retireNode(node);
            }

            size.sub(1);
            lock$;
            break;
          }
        }
        elt = _elt;
      }

      return elt;
    }

    proc ~LocalDeque() {
      on this {
        var curr = head;

        while curr != nil {
          var tmp = curr.next;
          delete curr;
          curr = tmp;
        }

        if cached != nil {
          delete cached;
        }
      }
    }
  }
}

/*
  A parallel-safe scalable distributed deque. A deque is a double-ended queue that supports
  insertion and removal from both ends of the queue, effectively supporting both
  FIFO, LIFO, and a Total ordering, where the order in which you add them will be
  the exact order you remove them in; for emphasis, a Deque can be used as a Queue,
  a Stack, and a List respectively. The deque enforces a 'barrier', which is a method
  of checking whether you may proceed with an operation, that is wait-free which
  guarantees scalability, where we perform bounds checking. Bounds checking performs
  the necessary checks to ensure two invariants: A `pop` operation never proceeds
  if the deque is empty, and that a `push` operation never proceeds if the deque
  is full. In the case where we have a `pop` and a non-empty deque, or a `push`
  with a non-full deque, we proceed within a single atomic fetchSub or fetchAdd
  respectively, hence is wait-free. In the case that we have a `pop` with a
  empty deque, or a `push` with a full deque, the queueSize becomes either
  negative or over capacity. When this happens, the faulty operation will, via
  remote execution (on-statement), perform a CAS-retry loop. If the opposite operation
  (`push` is the opposite of `pop` and vice-verse) sees the size in a incorrect state,
  it will continue its fetchSub/fetchAdd cycle, also bringing the size closer to
  its correct state. Hence, the fetchSub/fetchAdd cycle is bounded in that the number
  of faulty operations is bounded by the number of opposing operations and
  is also bounded and wait-free. The CAS-retry loop is also bounded by the number
  of overlapping operations and is helped along by the opposing operation, and hence
  is also bounded and wait-free.

  Deque operations are separated into three levels: global, local, and node.
  At a global level, we use simple fetchAdd and fetchSub counters to denote which
  local deque we apply our operation to based on the globalHead and globalTail in
  a way that emulates a deque. At the local-level, after you acquire the LocalDeque
  lock for an operation, you operate on linked nodes in a deque-like manner. Finally,
  at the node-level, each linked list node is an unroll block which is also a deque
  in and of itself. This hierarchical system ensures that we maintain this ordering
  but opens up a bit of non-determinism in terms of overlapping tasks hashing to the
  same LocalDeque, which is linearized on it's lock. While the Deque's ordering
  of elements are always preserved, the ordering in which tasks enter the 'barrier'
  to the point they complete their insertion is not. It is possible that given two
  tasks A and B, for A to finish at the global level before B, but for B to finish
  at the local level before A. However, it should be noted that for any MPMC queue,
  this non-determinism is inherent in all lock-free and wait-free data structures.
*/

module DistributedDeque {

  use Collection;
  use SharedObject;

  /*
    Size of each unroll block for each local deque node.
  */
  config param distributedDequeBlockSize = 8;

  /*
    The ordering used for serial iteration. NONE, the default, is the most performant
    and is algorithmically similar to parallel iteration.
  */
  enum Ordering {
    NONE,
    FIFO,
    LIFO
  }

  pragma "no doc"
  class DistributedDequeRC {
    type eltType;
    var _pid : int;

    proc deinit() {
      coforall loc in Locales do on loc {
          delete chpl_getPrivatizedCopy(DistributedBagImpl(eltType), _pid);
      }
    }
  }

  /*
    A parallel-safe scalable distributed double-ended queue that supports both
    insertion and removal from either end of the queue. Can be used as a Queue,
    Stack, or even a List.
  */
  record DistDeque {
    type eltType;

    // Privatization id
    pragma "no doc"
    var _pid : int;
    // Reference counting
    pragma "no doc"
    var _rc : SharedObject(DistributedDequeRC(eltType));

    proc DistDeque(type eltType, cap = -1, targetLocales = Locales) {
      _pid = (new DistributedDequeImpl(eltType, cap, targetLocales)).pid;
      _rc = new Shared(new DistributedDequeRC(eltType, _pid = _pid));
    }

    inline proc _value {
      if _pid == -1 {
        halt("DistDeque is uninitialized...");
      }
      return chpl_getPrivatizedCopy(DistributedDequeImpl(eltType), _pid);
    }

    forwarding _value;
  }

  // Atomic counters that are allocated on a single node used by privatized instances.
  // Because these classes can be allocated on nodes at-will, we can distributed these
  // to random nodes.
  pragma "no doc"
  class DistributedDequeCounter {
    var _value : atomic int;

    forwarding _value;
  }

  /*
    A parallel-safe scalable distributed double-ended queue that supports both
    insertion and removal from either end of the queue. Can be used as a Queue,
    Stack, or even a List.
  */
  pragma "no doc"
  class DistributedDequeImpl : Collection {
    /*
      Capacity, the maximum number of elements a Deque can hold. A `cap` of -1 is
      considered unbounded.
    */
    var cap : int;
    pragma "no doc"
    var targetLocDom : domain(1);
    /*
      Locales to distribute the `Deque` across.
    */
    var targetLocales : [targetLocDom] locale;

    // Privatization id
    pragma "no doc"
    var pid : int;

    // Keeps track of which slot we are on...
    pragma "no doc"
    var globalHead : DistributedDequeCounter;
    pragma "no doc"
    var globalTail : DistributedDequeCounter;
    pragma "no doc"
    var queueSize : DistributedDequeCounter;

    // We maintain an array of slots, wherein each slot is a pointer into a node's
    // address space. To maximize parallelism, we maintain numLocales * maxTaskPar
    // to reduce the amount of contention.
    pragma "no doc"
    var nSlots : int;
    pragma "no doc"
    var slotSpace = {0..-1};
    pragma "no doc"
    var slots : [slotSpace] LocalDeque(eltType);

    proc DistributedDeque(type eltType, cap : int = -1, targetLocales : [?locDom] locale =Locales) {
      this.cap = cap;
      this.nSlots = here.maxTaskPar * targetLocales.size;
      this.slotSpace = {0..#this.nSlots};
      this.targetLocDom = locDom;
      this.targetLocales = targetLocales;

      // Initialize each slot. We use a round-robin algorithm.
      var idx : atomic int;
      for 0 .. #here.maxTaskPar {
        for loc in targetLocales do on loc {
          var i = idx.fetchAdd(1);
          slots[i] = new LocalDeque(eltType);
        }
      }

      // Distribute the globalHead, globalTail, and queueSize over the first 3 nodes...
      var countersLeftToAlloc = 3;
      while countersLeftToAlloc > 0 {
        for loc in targetLocales do on loc {
          select countersLeftToAlloc {
            when 3 do globalHead = new DistributedDequeCounter();
            when 2 do globalTail = new DistributedDequeCounter();
            when 1 do queueSize = new DistributedDequeCounter();
          }

          countersLeftToAlloc -= 1;
        }
      }

      pid = _newPrivatizedClass(this);
    }

    pragma "no doc"
    proc DistributedDeque(other, privData, type eltType = other.eltType) {
      this.cap = other.cap;
      this.targetLocDom = other.targetLocDom;
      this.targetLocales = other.targetLocales;
      this.globalHead = other.globalHead;
      this.globalTail = other.globalTail;
      this.queueSize = other.queueSize;
      this.nSlots = other.nSlots;
      this.slotSpace = {0..#this.nSlots};
      slots = other.slots;
    }

    pragma "no doc"
    proc dsiPrivatize(privData) {
        return new DistributedDeque(this, privData);
    }

    pragma "no doc"
    proc dsiGetPrivatizeData() {
      return pid;
    }

    pragma "no doc"
    inline proc getPrivatizedThis {
      return chpl_getPrivatizedCopy(this.type, pid);
    }

    pragma "no doc"
    inline proc enterRemoveBarrier(localThis) {
      // If we have a capacity of 0, then we can't really remove anything anyway.
      if localThis.cap == 0 {
        return false;
      }

      // Similar to add, we use a wait-free method for updating the queue size,
      // using fetch-sub instead. Like enqueue, we make attempts to fix the queue
      // size in a lock-free manner (for as long as it is negative). It should be
      // noted that if we see that the queue size is over capacity, meaning an
      // enqueue operation has over committed, we consequentially help them as well
      // during the fetch-sub loop.
      while true {
        var size = queueSize.fetchSub(1);

        // Negative, fix before returning...
        if size <= 0 {
          on this {
            var readSize = queueSize.read();
            // Attempt to fix, but yield to reduce potential contention and CPU hogging.
            while readSize < 0 && !queueSize.compareExchangeWeak(readSize, 0) {
              chpl_task_yield();
              readSize = queueSize.read();
            }
          }

          // Fixed, return early...
          return false;
        }
        // If we have a cap, then at this point, we have something between [0, cap],
        // if we do not have a cap then there is no need to 'fix' the queue size;
        // in both cases we are safe.
        else if localThis.cap < 0 || size <= localThis.cap {
          break;
        }
        // If the size is over capacity, a enqueuer has overcommitted. Since there can
        // be an element for us, we loop again.
      }

      return true;
    }

    pragma "no doc"
    inline proc enterAddBarrier(localThis) {
      // If we have a capacity of 0, then we can't really add anything anyway.
      if localThis.cap == 0 {
        return false;
      }

      // If we have a capacity, we must ensure that there is enough space for our
      // operation ahead of time. We take a wait-free approach by performing a
      // fetch-add on the queue size. If there is space, then we succeed within one
      // communication round-trip. If we fail, then we make attempts to fix the queue
      // size in a lock-free manner (for as long as it is over capacity). It should be
      // noted that if we see that the queue size is negative, meaning a dequeue operation
      // has over committed, we consequentially help them as well during the fetch-add loop.
      if localThis.cap > 0 {
        while true {
          var size = queueSize.fetchAdd(1);

          // Over capacity, fix before returning...
          if size >= localThis.cap {
            on this {
              var readSize = queueSize.read();
              // Attempt to fix, but yield to reduce potential contention and CPU hogging.
              while readSize > this.cap && !queueSize.compareExchangeWeak(readSize, this.cap) {
                chpl_task_yield();
                readSize = queueSize.read();
              }
            }

            // Fixed, return early...
            return false;
          }
          // At this point, we either have a capacity and something between [0, cap],
          // or we do not have a capacity and we have something greater than 0,
          // either of which means we are safe.
          else if size >= 0 {
            break;
          }
          // If the size is negative, a dequeuer has overcommitted. Since there can
          // be an element for us, we loop again.
        }
      }
      // If we have a 'negative' capacity, we do not have one and can hold an
      // infinite amount; this gives us a more optimized code path.
      else {
        while true {
          var size = queueSize.fetchAdd(1);

          // We have reserved a spot for our operation.
          if size >= 0 {
            break;
          }
          // If the size is negative, a dequeuer has overcommitted. Since there can
          // be an element for us, we loop again.
        }
      }

      return true;
    }

    /*
      Syntactic sugar for `pushBack`.
    */
    proc add(elt : eltType) : bool {
      return pushBack(elt);
    }

    /*
      Syntactic sugar for `popFront`.
    */
    proc remove() : (bool, eltType) {
      return popFront();
    }

    /*
      Syntactic sugar for `pushBack`.
    */
    proc enqueue(elt : eltType) : bool {
      return pushBack(elt);
    }

    /*
      Syntactic sugar for `popFront`.
    */
    proc dequeue() : (bool, eltType) {
      return popFront();
    }

    /*
      Syntactic sugar for `pushBack`.
    */
    proc push(elt : eltType) : bool {
      return pushBack(elt);
    }

    /*
      Syntactic sugar for `popBack`.
    */
    proc pop() : (bool, eltType) {
      return popBack();
    }

    /*
      Appends the element to the tail.
    */
    proc pushBack(elt : eltType) : bool {
      var localThis = getPrivatizedThis;

      // Test for if we can continue...
      if enterAddBarrier(localThis) == false {
        return false;
      }

      // At this point, we know we have a space for us. We find our slot based on another
      // fetch-add counter, making this wait-free as well.
      var tail = globalTail.fetchAdd(1) % localThis.nSlots;
      localThis.slots[abs(tail)].pushBack(elt);
      return true;
    }

    /*
      Removes the element at the tail.
    */
    proc popBack() : (bool, eltType) {
      var localThis = getPrivatizedThis;

      // Test for if we can continue...
      if enterRemoveBarrier(localThis) == false {
        return (false, _defaultOf(eltType));
      }

      // We find our slot based on another fetch-add counter, making this wait-free as well.
      var tail = (globalTail.fetchSub(1) - 1) % localThis.nSlots;
      var elt = localThis.slots[abs(tail)].popBack();
      return (true, elt);
    }

    /*
      Appends the element to the head.
    */
    proc pushFront(elt : eltType) : bool {
      var localThis = getPrivatizedThis;

      // Test if we can continue...
      if enterAddBarrier(localThis) == false {
        return false;
      }

      // We find our slot based on another fetch-add counter, making this wait-free as well.
      var head = (globalHead.fetchSub(1) - 1) % localThis.nSlots;
      localThis.slots[abs(head)].pushFront(elt);
      return true;
    }

    /*
      Removes the element at the head.
    */
    proc popFront() : (bool, eltType) {
      var localThis = getPrivatizedThis;

      // Test for if we can continue...
      if enterRemoveBarrier(localThis) == false {
        return (false, _defaultOf(eltType));
      }

      // We find our slot based on another fetch-add counter, making this wait-free as well.
      var head = globalHead.fetchAdd(1) % localThis.nSlots;
      var elt = localThis.slots[abs(head)].popFront();
      return (true, elt);
    }

    /*
      Obtains the number of elements held by this queue.
    */
    proc getSize() : int {
      return queueSize.read();
    }

    /*
      Performs a lookup for the element in the data structure.
    */
    proc contains(elt : eltType) : bool {
      var containsElem : atomic bool;
      forall elem in this {
        if elem == elt {
          containsElem.write(true);
        }
      }
      return containsElem.read();
    }

    /*
      Iterate over all elements in the deque in the order specified.

      **Warning:** Calling other methods while inside of an iterator is not safe as
      it will likely lead to deadlock.

      **FIXME:** Likely can be worked around by either using snapshot iteration approach
      or by making the lock reentrant and forcing all iterators to acquire all locks in
      some global locking order.
    */
    iter these(param order : Ordering = Ordering.NONE) : eltType where order == Ordering.NONE {
      for slot in getPrivatizedThis.slots {
        slot.lock$ = true;
        var node = slot.head;

        while node != nil {
          var headIdx = node.headIdx;
          for 1 .. node.size {
            yield node.elements[headIdx];

            headIdx += 1;
            if headIdx > distributedDequeBlockSize {
              headIdx = 1;
            }
          }
          node = node.next;
        }

        slot.lock$;
      }
    }

    iter these(param order : Ordering = Ordering.NONE) : eltType where order == Ordering.FIFO {
      var localThis = getPrivatizedThis;

      // Fill our slots to visit in FIFO order.
      var head = globalHead.read();
      var tail = globalTail.read();
      var size = queueSize.read();

      // Check if empty...
      if size == 0 {
        return;
      }

      // Acquire in locking order...
      for slot in slots do slot.lock$ = true;

      // We iterate directly over the heads of each slot, so we capture them in advance.
      var nodes : [{0..#nSlots}] (int, int, LocalDequeNode(eltType));
      for i in 0 .. #nSlots {
        var node = slots[i].head;
        nodes[i] = (node.size, node.headIdx, node);
      }

      // Iterate over captured head nodes; each time we read them we advance them
      var iterations = size;
      for i in head..#tail {
        if iterations == 0 then break;
        iterations -= 1;

        var idx = i % nSlots;
        var (size, headIdx, node) = nodes[idx];
        if node == nil {
          halt("DistributedDeque Internal Error: Iterating over nil nodes, head: ", head, ", tail: ", tail, ", idx: ", i);
        }
        yield node.elements[headIdx];

        // Update state...
        size -= 1;
        headIdx += 1;
        if headIdx > distributedDequeBlockSize {
          headIdx = 1;
        }

        // Advance...
        if size == 0 {
          node = node.next;
          if node != nil {
            nodes[idx] = (node.size, node.headIdx, node);
          } else {
            nodes[idx] = (-1, -1, node);
          }
        } else {
          // Else update state...
          nodes[idx] = (size, headIdx, node);
        }
      }

      // Release in locking order...
      for slot in slots do slot.lock$;
    }

    iter these(param order : Ordering = Ordering.NONE) : eltType where order == Ordering.LIFO {
      var localThis = getPrivatizedThis;

      // Fill our slots to visit in FIFO order.
      var head = globalHead.read();
      var tail = globalTail.read();
      var size = queueSize.read();

      // Check if empty...
      if size == 0 {
        return;
      }

      // Acquire in locking order...
      for slot in slots do slot.lock$ = true;

      // We iterate directly over the heads of each slot, so we capture them in advance.
      var nodes : [{0..#nSlots}] (int, int, LocalDequeNode(eltType));
      for i in 0 .. #nSlots {
        var node = slots[i].tail;
        nodes[i] = (node.size, node.tailIdx, node);
      }

      // Iterate over captured head nodes; each time we read them we advance them
      var iterations = size;
      while tail > head {
        if iterations == 0 then break;
        iterations -= 1;

        var idx = (tail - 1) % nSlots;
        var (size, tailIdx, node) = nodes[idx];
        if node == nil {
          halt("DistributedDeque Internal Error: Iterating over nil nodes, head: ", head, ", tail: ", tail);
        }

        tailIdx -= 1;
        if tailIdx == 0 {
          tailIdx = distributedDequeBlockSize;
        }
        yield node.elements[tailIdx];

        // Update state...
        size -= 1;

        // Advance...
        if size == 0 {
          node = node.prev;
          if node != nil {
            nodes[idx] = (node.size, node.tailIdx, node);
          } else {
            nodes[idx] = (-1, -1, node);
          }
        } else {
          // Else update state...
          nodes[idx] = (size, tailIdx, node);
        }

        tail -= 1;
      }

      // Release in locking order...
      for slot in slots do slot.lock$;
    }

    iter these(param order : Ordering = Ordering.NONE, param tag : iterKind) where tag == iterKind.leader {
      if order != Ordering.NONE {
        compilerWarning("Parallel iteration only supports ordering of type: ", Ordering.NONE);
      }
      coforall slot in getPrivatizedThis.slots do on slot do yield slot;
    }

    iter these(param order : Ordering = Ordering.NONE, param tag : iterKind, followThis) where tag == iterKind.follower {
      if order != Ordering.NONE {
        compilerWarning("Parallel iteration only supports ordering of type: ", Ordering.NONE);
      }

      followThis.lock$ = true;
      var node = followThis.head;

      while node != nil {
        var headIdx = node.headIdx;
        for 1 .. node.size {
          yield node.elements[headIdx];

          headIdx += 1;
          if headIdx > distributedDequeBlockSize {
            headIdx = 1;
          }
        }
        node = node.next;
      }

      followThis.lock$;
    }

    proc ~DistributedDeque() {
      var localThis = getPrivatizedThis;
      for slot in localThis.slots do delete slot;
    }
  }

  // For each node we manage an unroll block. This block needs to also support Deque
  // operations, and as such we maintain our own mini headIdx and tailIdx. Since we can
  // add and remove from either direction, we must also maintain the size ourselves...
  pragma "no doc"
  class LocalDequeNode {
    type eltType;
    var elements : distributedDequeBlockSize * eltType;
    var headIdx : int = 1;
    var tailIdx : int = 1;
    var size : int;
    var next : LocalDequeNode(eltType);
    var prev : LocalDequeNode(eltType);

    inline proc isFull {
      return size == distributedDequeBlockSize;
    }

    inline proc isEmpty {
      return size == 0;
    }

    inline proc pushBack(elt : eltType) {
      elements[tailIdx] = elt;

      tailIdx += 1;
      if tailIdx > distributedDequeBlockSize {
        tailIdx = 1;
      }
      size += 1;
    }

    inline proc popBack() : eltType {
      tailIdx -= 1;
      if tailIdx == 0 {
        tailIdx = distributedDequeBlockSize;
      }

      size -= 1;
      return elements[tailIdx];
    }

    inline proc pushFront(elt : eltType) {
      headIdx -= 1;
      if headIdx == 0 {
        headIdx = distributedDequeBlockSize;
      }

      elements[headIdx] = elt;
      size += 1;
    }

    inline proc popFront() : eltType {
      var elt = elements[headIdx];
      headIdx += 1;
      if headIdx > distributedDequeBlockSize {
        headIdx = 1;
      }

      size -= 1;
      return elt;
    }
  }

  /*
    For each slot (core) we maintain a deque.

    **TODO:** Need to convert LocalDequeNode to use C_Ptr, double the size of each
    successor for better locality, and use the snapshot approach so that iteration
    does not prevent usage of other methods on the same Deque from the same task.
  */
  pragma "no doc"
  class LocalDeque {
    type eltType;

    var lock$ : sync bool;

    var head : LocalDequeNode(eltType);
    var tail : LocalDequeNode(eltType);

    // We cache the last deleted node to handle cases where we have rapid mixed push/pop
    var cached : LocalDequeNode(eltType);

    // The size of a segment. This is used as both a means of knowing when an element
    // gets added, as well as a barrier to prevent the head and tail from being cached.
    var size : atomic int;

    inline proc recycleNode() {
      // If we have cached a previous used node, reuse it here...
      if cached != nil {
        var tmp = cached;
        cached = nil;

        // Clean...
        tmp.headIdx = 1;
        tmp.tailIdx = 1;
        tmp.size = 0;
        tmp.next = nil;
        tmp.prev = nil;

        return tmp;
      }

      // Create a new one...
      return  new LocalDequeNode(eltType);
    }

    inline proc retireNode(node) {
      if cached != nil {
        delete cached;
      }

      cached = node;
    }

    proc pushBack(elt : eltType) {
      on this {
        var _elt = elt;
        local {
          lock$ = true;

          // Its empty...
          if tail == nil {
            tail = recycleNode();
            head = tail;
          }

          // Its full...
          if tail.isFull {
            tail.next = recycleNode();
            tail.next.prev = tail;
            tail = tail.next;
          }

          // Push...
          tail.pushBack(_elt);
          size.add(1);

          lock$;
        }
      }
    }

    proc popBack() : eltType {
      var elt : eltType;
      on this {
        var _elt : eltType;
        local {
          while true {
            // Check if there is an element for us...
            if size.read() == 0 {
              while size.read() == 0 {
                chpl_task_yield();
              }
            }

            lock$ = true;

            // Someone else came in and took a value, wait for the next one...
            if size.read() == 0 {
              lock$;
              continue;
            }

            // Pop...
            _elt = tail.popBack();
            if tail.isEmpty {
              var node = tail;
              tail = tail.prev;

              // If not empty, remove reference to retired node...
              // If it is empty, fix the head...
              if tail != nil {
                tail.next = nil;
              } else {
                head = nil;
              }

              retireNode(node);
            }

            size.sub(1);
            lock$;
            break;
          }
        }
        elt = _elt;
      }

      return elt;
    }

    proc pushFront(elt : eltType) {
      on this {
        var _elt = elt;
        local {
          lock$ = true;

          // Its empty...
          if head == nil {
            head = recycleNode();
            tail = head;
          }

          // Its full...
          if head.isFull {
            head.prev = recycleNode();
            head.prev.next = head;
            head = head.prev;
          }

          // Push...
          head.pushFront(_elt);
          size.add(1);

          lock$;
        }
      }
    }

    proc popFront() : eltType {
      var elt : eltType;
      on this {
        var _elt : eltType;
        local {
          while true {
            // Check if there is an element for us...
            if size.read() == 0 {
              while size.read() == 0 {
                chpl_task_yield();
              }
            }

            lock$ = true;

            // Someone else came in and took a value, wait for the next one...
            if size.read() == 0 {
              lock$;
              continue;
            }

            // Pop...
            _elt = head.popFront();
            if head.isEmpty {
              var node = head;
              head = head.next;

              // If not empty, remove reference to retired node...
              // If it is empty, fix the tail...
              if head != nil {
                head.prev = nil;
              } else {
                tail = nil;
              }

              retireNode(node);
            }

            size.sub(1);
            lock$;
            break;
          }
        }
        elt = _elt;
      }

      return elt;
    }

    proc ~LocalDeque() {
      on this {
        var curr = head;

        while curr != nil {
          var tmp = curr.next;
          delete curr;
          curr = tmp;
        }

        if cached != nil {
          delete cached;
        }
      }
    }
  }
}


Add no doc pragma to BitOps_internal, for testing.

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

/**
 *  Bit Manipulation Functions
 */
module BitOps {

  /*
    count leading zeros

    x: unsigned integer of size `bits`
    bits: 8, 16, 32, 64

    returns: the number of 0 bits before the most significant 1 bit in `x` as
             `x.type`
   */
  inline proc clz(x: uint(?bits)) {
    // the select will be folded out at compile time.
    select bits {
      when 64 do
        return BitOps_internal.chpl_bitops_clz_64(x);
      when 32 do
        return BitOps_internal.chpl_bitops_clz_32(x);
      when 16 do
        // gets promoted to 32bit, subtract the extra leading 0s
        return (BitOps_internal.chpl_bitops_clz_32(x)-16):uint(16);
      when 8 do
        // gets promoted to 32bit, subtract the extra leading 0s
        return (BitOps_internal.chpl_bitops_clz_32(x)-24):uint(8);
      otherwise
        // NOTE: this actually cant happen with how the integer types are setup
        //       right now - leaving it here for the future when we support
        //       >64bit types
        compilerError("clz is not supported for that bit width.");
    }
  }

  /*
    count leading zeros

    x: integer of size `bits`
    bits: 8, 16, 32, 64

    returns: the number of 0 bits before the most significant 1 bit in `x` as
             `x.type`
   */
  inline proc clz(x: int(?bits)) {
    return clz(x:uint(bits)):int(bits);
  }

  /*
    count trailing zeros

    x: unsigned integer of size `bits`
    bits: 8, 16, 32, 64

    returns: the number of 0 bits after the least significant 1 bit in `x` as
             `x.type`
   */
  inline proc ctz(x: uint(?bits)) {
    // the select will be folded out at compile time.
    select bits {
      when 64 do
        return BitOps_internal.chpl_bitops_ctz_64(x);
      when 32 do
        return BitOps_internal.chpl_bitops_ctz_32(x);
      when 16 do
        return BitOps_internal.chpl_bitops_ctz_32(x):uint(16);
      when 8 do
        return BitOps_internal.chpl_bitops_ctz_32(x):uint(8);
      otherwise
        // NOTE: this actually cant happen with how the integer types are setup
        //       right now - leaving it here for the future when we support
        //       >64bit types
        compilerError("ctz is not supported for that bit width.");
    }
  }

  /*
    count trailing zeros

    x: integer of size `bits`
    bits: 8, 16, 32, 64

    returns: the number of 0 bits after the least significant 1 bit in `x` as
             `x.type`
   */
  inline proc ctz(x: int(?bits)) {
    return ctz(x:uint(bits)):int(bits);
  }

  /*
    population count

    x: unsigned integer of size `bits`
    bits: 8, 16, 32, 64

    returns: the number of 1 bits set in `x` as `x.type`
   */
  inline proc popcount(x: uint(?bits)) {
    // the select will be folded out at compile time.
    select bits {
      when 64 do
        return BitOps_internal.chpl_bitops_popcount_64(x);
      when 32 do
        return BitOps_internal.chpl_bitops_popcount_32(x);
      when 16 do
        return BitOps_internal.chpl_bitops_popcount_32(x):uint(16);
      when 8 do
        return BitOps_internal.chpl_bitops_popcount_32(x):uint(8);
      // In the future we could also break a large int (128+) into 64bit chucks
      // and add up the results.
      otherwise
        // NOTE: this actually cant happen with how the integer types are setup
        //       right now - leaving it here for the future when we support
        //       >64bit types
        compilerError("popcount is not supported for that bit width.");
    }
  }

  /*
    population count

    x: integer of size `bits`
    bits: 8, 16, 32, 64

    returns: the number of 1 bits set in `x` as `x.type`
   */
  inline proc popcount(x: int(?bits)) {
    return popcount(x:uint(bits)):int(bits);
  }

  // Legacy operations
  // -----------------
  // kyleb: a few tests use these, but I'm not sure if there too much value

  // do a bitwise matrix-multiplication of x and y treating
  // them as 8x8 bit matrices and using | as the combinator
  // function.  There should be a similar version using xor
  // as the combinator, but I'm not sure where that would
  // go to be perfectly truthful
  proc bitMatMultOr(x: uint(64), y: uint(64)): uint(64) {
    // return the transpose of x, treating it as an 8x8 bit-matrix.
    proc bitMatTrans(x: uint(64))
      return ((x & 0x8040201008040201)       |
              (x & 0x0080402010080402) <<  7 |
              (x & 0x0000804020100804) << 14 |
              (x & 0x0000008040201008) << 21 |
              (x & 0x0000000080402010) << 28 |
              (x & 0x0000000000804020) << 35 |
              (x & 0x0000000000008040) << 42 |
              (x & 0x0000000000000080) << 49 |
              (x >>  7) & 0x0080402010080402 |
              (x >> 14) & 0x0000804020100804 |
              (x >> 21) & 0x0000008040201008 |
              (x >> 28) & 0x0000000080402010 |
              (x >> 35) & 0x0000000000804020 |
              (x >> 42) & 0x0000000000008040 |
              (x >> 49) & 0x0000000000000080);

    // set every eighth bit to one or zero based on the results of the
    // eight reductions of the sets of eight bits
    inline proc byteOrReduce(u: uint(64)) {
      var t1 = u | (u >> 4);
      var t2 = t1 | (t1 >> 2);
      var t3 = t2 | (t2 >> 1);
      return t3 & 0x0101010101010101;
    }

    // set every bit in sets of eight to one if the last one is one
    inline proc byteExpand(u: uint(64))
      return 0x8080808080808080 ^ (0x8080808080808080 - u);

    var result:uint(64) = 0;
    var yTranspose = bitMatTrans(y);
    result |= byteExpand(byteOrReduce(x & yTranspose)) & 0x8040201008040201;
    yTranspose = bitRotLeft(yTranspose, 8);
    result |= byteExpand(byteOrReduce(x & yTranspose)) & 0x4020100804020180;
    yTranspose = bitRotLeft(yTranspose, 8);
    result |= byteExpand(byteOrReduce(x & yTranspose)) & 0x2010080402018040;
    yTranspose = bitRotLeft(yTranspose, 8);
    result |= byteExpand(byteOrReduce(x & yTranspose)) & 0x1008040201804020;
    yTranspose = bitRotLeft(yTranspose, 8);
    result |= byteExpand(byteOrReduce(x & yTranspose)) & 0x0804020180402010;
    yTranspose = bitRotLeft(yTranspose, 8);
    result |= byteExpand(byteOrReduce(x & yTranspose)) & 0x0402018040201008;
    yTranspose = bitRotLeft(yTranspose, 8);
    result |= byteExpand(byteOrReduce(x & yTranspose)) & 0x0201804020100804;
    yTranspose = bitRotLeft(yTranspose, 8);
    result |= byteExpand(byteOrReduce(x & yTranspose)) & 0x0180402010080402;
    return result;
  }

  inline proc bitRotLeft(x, shift) {
    var backshift = numBits(x.type) - shift;
    return (x << shift:int) | (x >> backshift:int);
  }

  inline proc bitRotRight(x: uint(64), shift) {
    var backshift = numBits(x.type) - shift;
    return (x >> shift:int) | (x << backshift:int);
  }
}

/**
 * module to hide the extern procedures
 */
pragma "no doc"
module BitOps_internal {
  extern proc chpl_bitops_popcount_32(x: c_uint) : uint(32);
  extern proc chpl_bitops_popcount_64(x: c_ulonglong) : uint(64);

  extern proc chpl_bitops_clz_32(x: c_uint) : uint(32);
  extern proc chpl_bitops_clz_64(x: c_ulonglong) : uint(64);

  extern proc chpl_bitops_ctz_32(x: c_uint) : uint(32);
  extern proc chpl_bitops_ctz_64(x: c_ulonglong) : uint(64);
}

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

/**
 *  Bit Manipulation Functions
 */
module BitOps {

  /*
    count leading zeros

    x: unsigned integer of size `bits`
    bits: 8, 16, 32, 64

    returns: the number of 0 bits before the most significant 1 bit in `x` as
             `x.type`
   */
  inline proc clz(x: uint(?bits)) {
    // the select will be folded out at compile time.
    select bits {
      when 64 do
        return BitOps_internal.chpl_bitops_clz_64(x);
      when 32 do
        return BitOps_internal.chpl_bitops_clz_32(x);
      when 16 do
        // gets promoted to 32bit, subtract the extra leading 0s
        return (BitOps_internal.chpl_bitops_clz_32(x)-16):uint(16);
      when 8 do
        // gets promoted to 32bit, subtract the extra leading 0s
        return (BitOps_internal.chpl_bitops_clz_32(x)-24):uint(8);
      otherwise
        // NOTE: this actually cant happen with how the integer types are setup
        //       right now - leaving it here for the future when we support
        //       >64bit types
        compilerError("clz is not supported for that bit width.");
    }
  }

  /*
    count leading zeros

    x: integer of size `bits`
    bits: 8, 16, 32, 64

    returns: the number of 0 bits before the most significant 1 bit in `x` as
             `x.type`
   */
  inline proc clz(x: int(?bits)) {
    return clz(x:uint(bits)):int(bits);
  }

  /*
    count trailing zeros

    x: unsigned integer of size `bits`
    bits: 8, 16, 32, 64

    returns: the number of 0 bits after the least significant 1 bit in `x` as
             `x.type`
   */
  inline proc ctz(x: uint(?bits)) {
    // the select will be folded out at compile time.
    select bits {
      when 64 do
        return BitOps_internal.chpl_bitops_ctz_64(x);
      when 32 do
        return BitOps_internal.chpl_bitops_ctz_32(x);
      when 16 do
        return BitOps_internal.chpl_bitops_ctz_32(x):uint(16);
      when 8 do
        return BitOps_internal.chpl_bitops_ctz_32(x):uint(8);
      otherwise
        // NOTE: this actually cant happen with how the integer types are setup
        //       right now - leaving it here for the future when we support
        //       >64bit types
        compilerError("ctz is not supported for that bit width.");
    }
  }

  /*
    count trailing zeros

    x: integer of size `bits`
    bits: 8, 16, 32, 64

    returns: the number of 0 bits after the least significant 1 bit in `x` as
             `x.type`
   */
  inline proc ctz(x: int(?bits)) {
    return ctz(x:uint(bits)):int(bits);
  }

  /*
    population count

    x: unsigned integer of size `bits`
    bits: 8, 16, 32, 64

    returns: the number of 1 bits set in `x` as `x.type`
   */
  inline proc popcount(x: uint(?bits)) {
    // the select will be folded out at compile time.
    select bits {
      when 64 do
        return BitOps_internal.chpl_bitops_popcount_64(x);
      when 32 do
        return BitOps_internal.chpl_bitops_popcount_32(x);
      when 16 do
        return BitOps_internal.chpl_bitops_popcount_32(x):uint(16);
      when 8 do
        return BitOps_internal.chpl_bitops_popcount_32(x):uint(8);
      // In the future we could also break a large int (128+) into 64bit chucks
      // and add up the results.
      otherwise
        // NOTE: this actually cant happen with how the integer types are setup
        //       right now - leaving it here for the future when we support
        //       >64bit types
        compilerError("popcount is not supported for that bit width.");
    }
  }

  /*
    population count

    x: integer of size `bits`
    bits: 8, 16, 32, 64

    returns: the number of 1 bits set in `x` as `x.type`
   */
  inline proc popcount(x: int(?bits)) {
    return popcount(x:uint(bits)):int(bits);
  }

  // Legacy operations
  // -----------------
  // kyleb: a few tests use these, but I'm not sure if there too much value

  // do a bitwise matrix-multiplication of x and y treating
  // them as 8x8 bit matrices and using | as the combinator
  // function.  There should be a similar version using xor
  // as the combinator, but I'm not sure where that would
  // go to be perfectly truthful
  proc bitMatMultOr(x: uint(64), y: uint(64)): uint(64) {
    // return the transpose of x, treating it as an 8x8 bit-matrix.
    proc bitMatTrans(x: uint(64))
      return ((x & 0x8040201008040201)       |
              (x & 0x0080402010080402) <<  7 |
              (x & 0x0000804020100804) << 14 |
              (x & 0x0000008040201008) << 21 |
              (x & 0x0000000080402010) << 28 |
              (x & 0x0000000000804020) << 35 |
              (x & 0x0000000000008040) << 42 |
              (x & 0x0000000000000080) << 49 |
              (x >>  7) & 0x0080402010080402 |
              (x >> 14) & 0x0000804020100804 |
              (x >> 21) & 0x0000008040201008 |
              (x >> 28) & 0x0000000080402010 |
              (x >> 35) & 0x0000000000804020 |
              (x >> 42) & 0x0000000000008040 |
              (x >> 49) & 0x0000000000000080);

    // set every eighth bit to one or zero based on the results of the
    // eight reductions of the sets of eight bits
    inline proc byteOrReduce(u: uint(64)) {
      var t1 = u | (u >> 4);
      var t2 = t1 | (t1 >> 2);
      var t3 = t2 | (t2 >> 1);
      return t3 & 0x0101010101010101;
    }

    // set every bit in sets of eight to one if the last one is one
    inline proc byteExpand(u: uint(64))
      return 0x8080808080808080 ^ (0x8080808080808080 - u);

    var result:uint(64) = 0;
    var yTranspose = bitMatTrans(y);
    result |= byteExpand(byteOrReduce(x & yTranspose)) & 0x8040201008040201;
    yTranspose = bitRotLeft(yTranspose, 8);
    result |= byteExpand(byteOrReduce(x & yTranspose)) & 0x4020100804020180;
    yTranspose = bitRotLeft(yTranspose, 8);
    result |= byteExpand(byteOrReduce(x & yTranspose)) & 0x2010080402018040;
    yTranspose = bitRotLeft(yTranspose, 8);
    result |= byteExpand(byteOrReduce(x & yTranspose)) & 0x1008040201804020;
    yTranspose = bitRotLeft(yTranspose, 8);
    result |= byteExpand(byteOrReduce(x & yTranspose)) & 0x0804020180402010;
    yTranspose = bitRotLeft(yTranspose, 8);
    result |= byteExpand(byteOrReduce(x & yTranspose)) & 0x0402018040201008;
    yTranspose = bitRotLeft(yTranspose, 8);
    result |= byteExpand(byteOrReduce(x & yTranspose)) & 0x0201804020100804;
    yTranspose = bitRotLeft(yTranspose, 8);
    result |= byteExpand(byteOrReduce(x & yTranspose)) & 0x0180402010080402;
    return result;
  }

  inline proc bitRotLeft(x, shift) {
    var backshift = numBits(x.type) - shift;
    return (x << shift:int) | (x >> backshift:int);
  }

  inline proc bitRotRight(x: uint(64), shift) {
    var backshift = numBits(x.type) - shift;
    return (x >> shift:int) | (x << backshift:int);
  }
}

/**
 * module to hide the extern procedures
 */
module BitOps_internal {
  extern proc chpl_bitops_popcount_32(x: c_uint) : uint(32);
  extern proc chpl_bitops_popcount_64(x: c_ulonglong) : uint(64);

  extern proc chpl_bitops_clz_32(x: c_uint) : uint(32);
  extern proc chpl_bitops_clz_64(x: c_ulonglong) : uint(64);

  extern proc chpl_bitops_ctz_32(x: c_uint) : uint(32);
  extern proc chpl_bitops_ctz_64(x: c_ulonglong) : uint(64);
}


more cleanup

more cleanup

use Regexp;
use Histogram;
use Time;

// Use the test/twopt code
config const isTest=false;
config const doBrute=false;

config const fn1 = "test.dat";
config const fn2 = "test.dat";
config const pairfn = "test-DD.dat";

param NDIM  = 3;
const Ddim = {1.. #NDIM};

config const spaces=compile("\\s+");
config const bufsize=10000;
config const minpart=500;

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();
}

record WeightedParticle3D {
  var x : NDIM*real;
  var w : real;
  var r2 : real;
}

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, pp : []WeightedParticle3D)  {
  const maxcols=25;

  var ff = open(fn, iomode.r);
  var cols : [1.. #maxcols] real;
  var icol=1;
  var ipart = 0;
  for iff in ff.lines() {
   icol = 1;
   for col1 in iff.split(spaces) {
     if (col1.length==0) then continue;
     cols[icol] = col1 : real;
     icol += 1;
   }
   if (icol < 4) then assert(false,"malformed line...");
   for jj in Ddim do pp[ipart].x(jj) = cols[jj];
   pp[ipart].w = cols[4];
   pp[ipart].r2 = + reduce (pp[ipart].x**2);
   ipart += 1;
  }
}

proc smuAccumulate(hh : UniformBins, p1, p2 : []WeightedParticle3D, d1,d2 : domain(1), scale : real) {
  forall 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 = p1[ii].x(1); y1 = p1[ii].x(2); z1 = p1[ii].x(3); w1 = p1[ii].w; r2 = p1[ii].r2;

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

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

proc splitOn(pp : []WeightedParticle3D, scr : []WeightedParticle3D, splitDim : int, xsplit : real) : int {
  var npart, lnpart : int;
  var lo = pp.domain.low;
  var hi = pp.domain.high;
  npart = pp.domain.size;
  lnpart = 0;
  for ipp in pp {
    if (ipp.x(splitDim) < xsplit) then lnpart+=1;
  }
  var li, ri : int;
  li = lo; ri = (lo+lnpart);
  for ipp in pp {
    if (ipp.x(splitDim) < xsplit) {
      scr[li] = ipp;
      li+=1;
    } else {
      scr[ri] = ipp;
      ri+=1;
    }
  }
  assert(li==(lo+lnpart), "splitOn : li != lo+npart");
  assert(ri==(hi+1), "splitOn : ri != hi+1");
  pp = scr;

  return lnpart;
}

class KDNode {
  var lo, hi,npart,id : int;
  var dom : domain(1);
  var xcen : NDIM*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 : []WeightedParticle3D, scr : []WeightedParticle3D, id : int) : KDNode{
  gtime1.start();
  var me = new KDNode();
  var dom = pp.domain;
  me.lo = dom.low;
  me.hi = dom.high;
  me.dom = {me.lo..me.hi};
  me.id = id;
  me.npart = (me.hi-me.lo)+1;

  //  work out xcen and vantage point radius
  var pmin = pp[me.lo].x;
  var pmax = pp[me.lo].x;
  for ipp in pp {
    for idim in Ddim {
      if (ipp.x(idim) < pmin(idim)) then pmin(idim) = ipp.x(idim);
      if (ipp.x(idim) > pmax(idim)) then pmax(idim) = ipp.x(idim);
    }
  }
  me.xcen = (pmax+pmin)/2.0;
  var dx : NDIM*real;
  me.rcell = 0.0;
  var r1 : real;
  for ipp in pp {
    dx = (ipp.x - me.xcen);
    r1 = sqrt(+ reduce dx**2);
    if (r1 > me.rcell) then me.rcell = r1;
  }

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

  // Find dimension to split on
  dx = pmax - pmin;
  var splitDim = 1;
  for idim in Ddim {
    if (dx(idim) > dx(splitDim)) then splitDim=idim;
  }

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

proc TreeAccumulate(hh : UniformBins, p1, p2 : []WeightedParticle3D, 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 main code
proc doPairs() {
  var tt : Timer;

  // Read in the file
  tt.clear(); tt.start();
  var nlines1 = countLines(fn1);
  var pp1 : [0.. #nlines1] WeightedParticle3D;
  readFile(fn1,pp1);
  var nlines2 = countLines(fn2);
  var pp2 : [0.. #nlines2] WeightedParticle3D;
  readFile(fn1,pp2);
  tt.stop();
  if (!isTest) {
    writef("Read in %i lines from file %s \n", pp1.size, fn1);
    writef("Read in %i lines from file %s \n", pp2.size, fn2);
    writef("Time to read : %r \n", tt.elapsed());
  }

  // Build the tree
  tt.clear(); tt.start(); gtime1.clear();
  var scr1 : [0.. #nlines1] WeightedParticle3D;
  var root1 = BuildTree(pp1,scr1,0);
  var scr2 : [0.. #nlines2] WeightedParticle3D;
  var root2 = BuildTree(pp2,scr2,0);
  tt.stop();
  if (!isTest) {
    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)));

  // AOS -> SOA
  // TODO : Turn off this swapping...
  tt.clear(); tt.start();
//  var soa1 = new SOA_WeightedParticle3D(pp1);
//  var soa2 = new SOA_WeightedParticle3D(pp2);
  tt.stop();
  if !isTest then writef("Time to SOA : %r \n", tt.elapsed());

  /*
  // Brute force paircounts
  // This is only here for comparisons... and should be turned off in general
  if (doBrute && !isTest) {
    tt.clear(); tt.start();
    smuAccumulate(hh, soa1,soa2, soa1.Dpart, soa2.Dpart, 1.0);
    tt.stop();
    writef("Time to brute force paircount : %r \n", tt.elapsed());
    var ff1 = openwriter("%s.brute".format(pairfn));
    writeHist(ff1,hh);
    ff1.close();
  }
  */

   // 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());
    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 soa1;
//  delete soa2;
  delete hh;
  delete root1;
  delete root2;
}

use Regexp;
use Histogram;
use Time;

// Use the test/twopt code
config const isTest=false;
config const doBrute=false;

config const fn1 = "test.dat";
config const fn2 = "test.dat";
config const pairfn = "test-DD.dat";

param NDIM  = 3;
const Ddim = {1.. #NDIM};

config const spaces=compile("\\s+");
config const bufsize=10000;
config const minpart=500;

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();
}

record WeightedParticle3D {
  var x : NDIM*real;
  var w : real;
}

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, pp : []WeightedParticle3D)  {
  const maxcols=25;

  var ff = open(fn, iomode.r);
  var cols : [1.. #maxcols] real;
  var icol=1;
  var ipart = 0;
  for iff in ff.lines() {
   icol = 1;
   for col1 in iff.split(spaces) {
     if (col1.length==0) then continue;
     cols[icol] = col1 : real;
     icol += 1;
   }
   if (icol < 4) then assert(false,"malformed line...");
   for jj in Ddim do pp[ipart].x(jj) = cols[jj];
   pp[ipart].w = cols[4];
   ipart += 1;
  }
}

class SOA_WeightedParticle3D {
  var npart : int;
  var Dpart : domain(1);
  var x,y,z,w,r2 : [Dpart] real;

  proc SOA_WeightedParticle3D(pp : []WeightedParticle3D) {
    npart = pp.size;
    Dpart = 0.. #npart;

    forall ii in Dpart {
      x[ii] = pp[ii].x(1);
      y[ii] = pp[ii].x(2);
      z[ii] = pp[ii].x(3);
      w[ii] = pp[ii].w;
      r2[ii] = + reduce (pp[ii].x**2);
    }
  }
}

proc smuAccumulate(hh : UniformBins, p1,p2 : SOA_WeightedParticle3D, d1,d2 : domain(1), scale : real) {
  forall 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 = p1.x[ii]; y1 = p1.y[ii]; z1 = p1.z[ii]; w1 = p1.w[ii]; r2 = p1.r2[ii];

    for jj in d2 { // Second set of particles
      mu=2*(p2.x[jj]*x1 + p2.y[jj]*y1 + p2.z[jj]*z1);
      sl = r2 - p2.r2[jj];
      l1 = r2 + p2.r2[jj];
      s2 = l1 - mu;
      l2 = l1 + mu;
      if ((s2 >= smax2) || (s2 < 1.0e-20)) then continue;
      wprod = scale * w1 * p2.w[jj];
      s1 = sqrt(s2);
      mu = sl/(s1*sqrt(l2));
      if (mu < 0) then mu = -mu;

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

proc splitOn(pp : []WeightedParticle3D, scr : []WeightedParticle3D, splitDim : int, xsplit : real) : int {
  var npart, lnpart : int;
  var lo = pp.domain.low;
  var hi = pp.domain.high;
  npart = pp.domain.size;
  lnpart = 0;
  for ipp in pp {
    if (ipp.x(splitDim) < xsplit) then lnpart+=1;
  }
  var li, ri : int;
  li = lo; ri = (lo+lnpart);
  for ipp in pp {
    if (ipp.x(splitDim) < xsplit) {
      scr[li] = ipp;
      li+=1;
    } else {
      scr[ri] = ipp;
      ri+=1;
    }
  }
  assert(li==(lo+lnpart), "splitOn : li != lo+npart");
  assert(ri==(hi+1), "splitOn : ri != hi+1");
  pp = scr;

  return lnpart;
}

class KDNode {
  var lo, hi,npart,id : int;
  var dom : domain(1);
  var xcen : NDIM*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 : []WeightedParticle3D, scr : []WeightedParticle3D, id : int) : KDNode{
  gtime1.start();
  var me = new KDNode();
  var dom = pp.domain;
  me.lo = dom.low;
  me.hi = dom.high;
  me.dom = {me.lo..me.hi};
  me.id = id;
  me.npart = (me.hi-me.lo)+1;

  //  work out xcen and vantage point radius
  var pmin = pp[me.lo].x;
  var pmax = pp[me.lo].x;
  for ipp in pp {
    for idim in Ddim {
      if (ipp.x(idim) < pmin(idim)) then pmin(idim) = ipp.x(idim);
      if (ipp.x(idim) > pmax(idim)) then pmax(idim) = ipp.x(idim);
    }
  }
  me.xcen = (pmax+pmin)/2.0;
  var dx : NDIM*real;
  me.rcell = 0.0;
  var r1 : real;
  for ipp in pp {
    dx = (ipp.x - me.xcen);
    r1 = sqrt(+ reduce dx**2);
    if (r1 > me.rcell) then me.rcell = r1;
  }

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

  // Find dimension to split on
  dx = pmax - pmin;
  var splitDim = 1;
  for idim in Ddim {
    if (dx(idim) > dx(splitDim)) then splitDim=idim;
  }

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

proc TreeAccumulate(hh : UniformBins, p1, p2 : SOA_WeightedParticle3D, 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 main code
proc doPairs() {
  var tt : Timer;

  // Read in the file
  tt.clear(); tt.start();
  var nlines1 = countLines(fn1);
  var pp1 : [0.. #nlines1] WeightedParticle3D;
  readFile(fn1,pp1);
  var nlines2 = countLines(fn2);
  var pp2 : [0.. #nlines2] WeightedParticle3D;
  readFile(fn1,pp2);
  tt.stop();
  if (!isTest) {
    writef("Read in %i lines from file %s \n", pp1.size, fn1);
    writef("Read in %i lines from file %s \n", pp2.size, fn2);
    writef("Time to read : %r \n", tt.elapsed());
  }

  // Build the tree
  tt.clear(); tt.start(); gtime1.clear();
  var scr1 : [0.. #nlines1] WeightedParticle3D;
  var root1 = BuildTree(pp1,scr1,0);
  var scr2 : [0.. #nlines2] WeightedParticle3D;
  var root2 = BuildTree(pp2,scr2,0);
  tt.stop();
  if (!isTest) {
    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)));

  // AOS -> SOA
  // TODO : Turn off this swapping...
  tt.clear(); tt.start();
  var soa1 = new SOA_WeightedParticle3D(pp1);
  var soa2 = new SOA_WeightedParticle3D(pp2);
  tt.stop();
  if !isTest then writef("Time to SOA : %r \n", tt.elapsed());

  /*
  // Brute force paircounts
  // This is only here for comparisons... and should be turned off in general
  if (doBrute && !isTest) {
    tt.clear(); tt.start();
    smuAccumulate(hh, soa1,soa2, soa1.Dpart, soa2.Dpart, 1.0);
    tt.stop();
    writef("Time to brute force paircount : %r \n", tt.elapsed());
    var ff1 = openwriter("%s.brute".format(pairfn));
    writeHist(ff1,hh);
    ff1.close();
  }
  */

   // Do the paircounts with a tree
  hh.reset();
  tt.clear(); tt.start();
  sync TreeAccumulate(hh, soa1, soa2, root1, root2);
  tt.stop();
  if (!isTest) {
    writef("Time to tree paircount : %r \n", tt.elapsed());
    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 soa1;
  delete soa2;
  delete hh;
  delete root1;
  delete root2;
}


Enable module-level documentation of module Assert

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

/*
  Support for simple assert() routines.

  .. note::
            In the current implementation, these asserts never become
            no-ops.  That is, using them will always incur
            execution-time checks.
*/
module Assert {

/*
  Assert that a boolean condition is true.  If it is false, prints
  'assert failed' and halts the program.

  :arg test: the boolean condition
  :type test: `bool`
*/
proc assert(test: bool) {
  if !test then
    __primitive("chpl_error", "assert failed");
}

/*
  Assert that a boolean condition is true.  If it is false, prints
  'assert failed - ' followed by all subsequent arguments, as though
  printed using :proc:`~IO.write()`.

  :arg test: the boolean condition
  :type test: `bool`

  :arg args: other arguments to print
*/
proc assert(test: bool, args ...?numArgs) {
  if !test {
    var tmpstring: c_string;
    tmpstring.write((...args));
    __primitive("chpl_error", "assert failed - " + tmpstring);
  }
}

}

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

/*
  Provide simple assertion capabilities.

  Note that in the current implementation, these asserts never become
  no-ops.  That is, using them will always incur execution-time
  checks.
*/

//
// TODO: Uncomment the following (didn't make it in in time for code
// freeze or a few nights of testing before doc freeze for 1.11)
//
// module Assert {

/*
  Assert that a boolean condition is true.  If it is false, prints
  'assert failed' and halts the program.

  :arg test: the boolean condition
  :type test: `bool`
*/
proc assert(test: bool) {
  if !test then
    __primitive("chpl_error", "assert failed");
}

/*
  Assert that a boolean condition is true.  If it is false, prints
  'assert failed - ' followed by all subsequent arguments, as though
  printed using :proc:`~IO.write()`.

  :arg test: the boolean condition
  :type test: `bool`

  :arg args: other arguments to print
*/
proc assert(test: bool, args ...?numArgs) {
  if !test {
    var tmpstring: c_string;
    tmpstring.write((...args));
    __primitive("chpl_error", "assert failed - " + tmpstring);
  }
}

//
// See TOOO above
//
// }
//