Wrap in 'module'; Minor additional comments

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

/*
  This module contains several iterators that can be used to drive a ``forall``
  loop by performing dynamic and adaptive splitting of a range's iterations.

  For more information, see "User-Defined Parallel Zippered iterators
  in Chapel". Bradford L. Chamberlain, Sung-Eun Choi, Steven J. Deitz,
  Angeles Navarro. PGAS 2011: Fifth Conference on Partitioned Global
  Address Space Programming Models, October 2011.
*/
module AdvancedIters {

/*
   An atomic test-and-set lock.
*/
pragma "no doc"
record vlock {
  var l: atomic bool;
  proc lock() {
    on this do while l.testAndSet() != false do chpl_task_yield();
  }
  proc unlock() {
    l.write(false);
  }
}

/*
   Toggle debugging output.
*/
config param debugAdvancedIters:bool=false;

//************************* Dynamic iterator

/*
   The serial version of the dynamic iterator.
   Equivalent to serial iteration over the range ``c``.
*/
iter dynamic(c:range(?), chunkSize:int, numTasks:int=0) {

  if debugAdvancedIters then
    writeln("Serial dynamic Iterator. Working with range ", c);

  for i in c do yield i;
}

// Parallel iterator

/*
:arg c: The range to iterate over. The length of the range must be greater than zero.
:type c: range(?)
:arg chunkSize: The size of chunks to be yielded to each thread. Must be greater than zero.
:type chunkSize: int
:arg numTasks: The number of tasks to use. Must be >= zero. If this argument has the value 0, it will use the value indicated by ``dataParTasksPerLocale``.
:type numTasks: int

:yields: Indices in the range ``c``.

This iterator is equivalent to the dynamic scheduling approach of OpenMP.
Given an input range ``c``, each task is assigned chunks of size
``chunkSize`` from ``c`` (or the remaining iterations if there are fewer
than ``chunkSize``). This continues until there are no remaining iterations
in ``c``.

*/
iter dynamic(param tag:iterKind, c:range(?), chunkSize:int, numTasks:int=0)
where tag == iterKind.leader
{
  assert(chunkSize > 0); // caller's responsibility

  use UtilMath;
  // # of tasks the range can fill. (fast) ceil so all work is represented
  const chunkTasks = divceilpos(c.length, chunkSize): int;

  // Check if the number of tasks is 0, in that case it returns a default value
  const nTasks = min(chunkTasks, defaultNumTasks(numTasks));

  type rType=c.type;

  // We're going to have to densify at some point, might as well
  // do it early and make range slicing easier.
  const remain:rType=densify(c,c);

  // If the number of tasks is insufficient, yield in serial
  if c.length == 0 then halt("The range is empty");
  if nTasks == 1 then {
    if debugAdvancedIters then
      writeln("Dynamic Iterator: serial execution because there is not enough work");
    yield (remain,);
  } else {
    var moreWork : bool =true;
    var curIndex : atomic remain.low.type;
    curIndex.write(remain.low);

    coforall tid in 0..#nTasks with (ref remain, ref moreWork, ref curIndex) do {
      while moreWork do {
        // There is local work in remain
        const low = curIndex.fetchAdd(chunkSize);
        var high = low + chunkSize-1;

        if low > remain.high {
          break;
        } else if high > remain.high {
          high = remain.high;
          moreWork = false;
        }

        const current:rType = remain(low .. high);

        if high >= low then {
          if debugAdvancedIters then
            writeln("Parallel dynamic Iterator. Working at tid ", tid, " with range ", unDensify(current,c), " yielded as ", current);
          yield (current,);
        }
      }
    }
  }
}

// Follower
pragma "no doc"
iter dynamic(param tag:iterKind, c:range(?), chunkSize:int, numTasks:int, followThis)
where tag == iterKind.follower
{
  type rType=c.type;
  const current:rType=unDensify(followThis(1),c);
  if debugAdvancedIters then
    writeln("Follower received range ", followThis, " ; shifting to ", current);
  for i in current do {
    yield i;
  }
}

//************************* Guided iterator

/*
   The serial version of the guided iterator.
   Equivalent to serial iteration over the range ``c``.
*/
iter guided(c:range(?), numTasks:int=0) {

  if debugAdvancedIters then
    writeln("Serial guided Iterator. Working with range ", c);

  for i in c do yield i;
}

/*
  :arg c: The range to iterate over. Must have a length greater than zero.
  :type c: range(?)
  :arg numTasks: The number of tasks to use. Must be >= zero. If this argument has the value 0, it will use the value indicated by ``dataParTasksPerLocale``.
  :type numTasks: int

  This iterator is equivalent to the guided policy of OpenMP: Given an input
  range ``c``, each task is assigned chunks of variable size, until there are
  no remaining iterations in ``c``. The size of each chunk is the number of
  unassigned iterations divided by the number of tasks, ``numTasks``. The size
  decreases approximately exponentially to 1. The splitting strategy is
  therefore adaptive.

*/
iter guided(param tag:iterKind, c:range(?), numTasks:int=0)
where tag == iterKind.leader
{
  // Check if the number of tasks is 0, in that case it returns a default value
  const nTasks=min(c.length, defaultNumTasks(numTasks));
  type rType=c.type;
  var remain:rType = densify(c,c);
  // If the number of tasks is insufficient, yield in serial
  if c.length == 0 then halt("The range is empty");
  if nTasks == 1 then {
    if debugAdvancedIters then
      writeln("Guided Iterator: serial execution because there is not enoguh work");
    yield (remain,);
  }

  else {
    var undone=true;
    const factor=nTasks;
    var lock : vlock;

    coforall tid in 0..#nTasks with (ref remain, ref undone, ref lock) do {
      while undone do {
        // There is local work in remain(tid)
        const current:rType=adaptSplit(remain, factor, undone, lock);
        if current.length !=0 then {
          if debugAdvancedIters then
            writeln("Parallel guided Iterator. Working at tid ", tid, " with range ", unDensify(current,c), " yielded as ", current);
          yield (current,);
        }
      }
    }
  }
}

// Follower
pragma "no doc"
iter guided(param tag:iterKind, c:range(?), numTasks:int, followThis)
where tag == iterKind.follower

{
  type rType=c.type;
  const current:rType=unDensify(followThis(1),c);
  if debugAdvancedIters then
    writeln("Follower received range ", followThis, " ; shifting to ", current);
  for i in current do {
    yield i;
  }
}

//************************* Adaptive work-stealing iterator
/*
   The serial version of the adaptive iterator.
   Equivalent to serial iteration over the range ``c``.
*/
iter adaptive(c:range(?), numTasks:int=0) {

  if debugAdvancedIters then
    writeln("Serial adaptive work-stealing Iterator. Working with range ", c);

  for i in c do yield i;

}

// Parallel iterator
/*
The enum used to represent adaptive methods.

- ``Whole``
  Each task without work tries to steal from its neighbor range
  until it exhausts that range. Then the task continues with the next
  neighbor range, and so on until there is no more work. This is the default
  policy.

- ``RoundRobin``
  Each task without work tries to steal once from its neighbor range, next
  from the following neighbor range and so on in a round-robin way until
  there is no more work.

- ``WholeTail``
  Similar to the ``Whole`` method, but now the splitting in the victim
  range is performed from its tail.
*/
enum Method {
  Whole = 0,
  RoundRobin = 1,
  WholeTail = 2
};

/*
  Used to select the adaptive stealing method. Defaults to ``Whole``.
  See :data:`Method` for more information.
*/
config param methodStealing = Method.Whole;

/*
  :arg c: The range to iterate over. Must have a length greater than zero.
  :type c: range(?)
  :arg numTasks: The number of tasks to use. Must be >= zero. If this argument has the value 0, it will use the value indicated by ``dataParTasksPerLocale``.
  :type numTasks: int

  This iterator implements a naive adaptive binary splitting work-stealing
  strategy: Initially the leader iterator distributes the range to split, ``c``,
  evenly among the ``numTasks`` tasks.

  Then, each task performs adaptive splitting on its local sub-range's iterations.
  When a task exhausts its local iterations, it steals and splits from the
  range of another task (the victim). The splitting method on the local range
  and on the victim range is binary: i.e. the size of each chunk is computed as
  the number of unassigned iterations divided by 2. There are three stealing
  strategies that can be selected at compile time using the config param
  :param:`methodStealing`.
*/
iter adaptive(param tag:iterKind, c:range(?), numTasks:int=0)
where tag == iterKind.leader

{
  /*if (methodStealing != Method.Whole || methodStealing != Method.WholeTail) then
    compilerError("methodStealing value must be between 0 and 2");*/

  // Check if the number of tasks is 0, in that case it returns a default value
  const nTasks=min(c.length, defaultNumTasks(numTasks));
  type rType=c.type;

  // If the number of tasks is insufficient, yield in serial
  if c.length == 0 then halt("The range is empty");
  if nTasks == 1 then {
    if debugAdvancedIters then
      writeln("Adaptive work-stealing Iterator: serial execution because there is not enough work");
    yield (densify(c,c),);

  }
  else {
    const r:rType=densify(c,c);
    const SpaceThreads:domain(1)=0..#nTasks;
    var localWork:[SpaceThreads] rType; // The remaining range to split on each Thread
    var moreLocalWork:[SpaceThreads] bool=true; // bool var to signal there is still work on each local range
    var locks:[SpaceThreads] vlock; // sync var to control the splitting on each Thread
    const factor:int=2;

    const factorSteal:int=2;
    var moreWork:bool=true; // A global var to control the termination

    // Variables to put a barrier to ensure the initial range is computed on each Thread
    var barrier : atomic int;

    // Start the parallel work
    coforall tid in 0..#nTasks with (ref localWork, ref moreLocalWork, ref moreWork, ref r) do {

      // Step 1: Initial range per Thread/Task

      // Initial Local range in localWork[tid]
      const chunkSize = c.length/nTasks;
      localWork[tid]=
      if tid==nTasks-1 then
        r#(chunkSize*(nTasks-1)-r.length)
      else
        (r+tid*chunkSize)#chunkSize;
      barrier.add(1);

      if debugAdvancedIters then
        writeln("Parallel adaptive work-stealing Iterator. Working at tid ", tid, " with initial range ", localWork[tid]);

      // A barrier waiting for each thread to finish the initial assignment
      barrier.waitFor(nTasks);

      // Step 2: While there is work at tid, do splitting

      while moreLocalWork[tid] do {
        // There is local work
        // The current range we get after splitting locally
        const zeroBasedIters:rType=adaptSplit(localWork[tid], factorSteal, moreLocalWork[tid], locks[tid]);
        if zeroBasedIters.length !=0 then {
          if debugAdvancedIters then
            writeln("Parallel adaptive Iterator. Working locally at tid ", tid, " with range yielded as ", zeroBasedIters);
          yield (zeroBasedIters,);
        }
      }

      // Step3: Task tid finished its work, so it will try to steal from a neighbor

      var nVisitedVictims:int=0;
      var victim=(tid+1) % nTasks;
      var stealFailed:bool=false;

      while moreWork do {
        if debugAdvancedIters then
          writeln("Entering at Stealing phase in tid ", tid," with victim ", victim, " using method of Stealing ", methodStealing);

        // Perform the spliting at the victim remaining range

        if methodStealing == Method.RoundRobin {
          if moreLocalWork[victim] then {
            // There is work in victim
            const zeroBasedIters2:rType=adaptSplit(localWork[victim], factorSteal, moreLocalWork[victim], locks[victim]);
            if zeroBasedIters2.length !=0 then {
              if debugAdvancedIters then
                writeln("Range stealed at victim ", victim," yielded as ", zeroBasedIters2," by tid ", tid);
              yield (zeroBasedIters2,);
            }
          } else {
            stealFailed=true;
          }
        } else {
          while moreLocalWork[victim] do {
            // There is work in victim
            const zeroBasedIters2:rType=adaptSplit(localWork[victim], factorSteal, moreLocalWork[victim], locks[victim], methodStealing==Method.WholeTail);
                                          //after splitting from a victim range
            if zeroBasedIters2.length !=0 then {
              if debugAdvancedIters then
                writeln("Range stealed at victim ", victim," yielded as ", zeroBasedIters2," by tid ", tid);
              yield (zeroBasedIters2,);
            }
          }
        }

        // If here, then it can have failed the stealing intent at the victim (method 1),
        // or we have exhausted the victim range (methods 0, 2)

        if (methodStealing==Method.Whole || methodStealing==Method.WholeTail || (methodStealing==Method.RoundRobin && stealFailed)) then {
          nVisitedVictims += 1; // Signal that there is no more work in victim
          stealFailed=false;
          if debugAdvancedIters then
            writeln("Failed Stealing intent at tid ", tid," with victim ", victim, " and total no. of visited victims ", nVisitedVictims);
        }
        // Check if there is no more work
        if nVisitedVictims >= nTasks-1 then
          moreWork=false; // Signal that there is no more work in any victim
        else {  // There can be still work in other victim
          victim=(victim+1) % nTasks; // New victim to steal
          if methodStealing==Method.RoundRobin && victim==tid then
            victim=(victim+1) % nTasks;
        }
      }
    }
  }
}

// Follower
pragma "no doc"
iter adaptive(param tag:iterKind, c:range(?), numTasks:int, followThis)
where tag == iterKind.follower
{
  type rType=c.type;
  var current:rType=unDensify(followThis(1),c);
  if debugAdvancedIters then
    writeln("Follower received range ", followThis, " ; shifting to ", current);
  for i in current do {
    yield i;
  }
}

//************************* Helper functions
pragma "no doc"
proc defaultNumTasks(nTasks:int)
{
  var dnTasks=nTasks;
  if nTasks==0 then {
    if dataParTasksPerLocale==0 then dnTasks=here.maxTaskPar;
      else dnTasks=dataParTasksPerLocale;
  } else if nTasks<0 then {
    halt("'numTasks' is negative");
  }
  return dnTasks;
}

pragma "no doc"
proc adaptSplit(ref rangeToSplit:range(?), splitFactor:int, ref itLeft:bool, ref lock : vlock, splitTail:bool=false)
{
  type rType=rangeToSplit.type;
  type lenType=rangeToSplit.length.type;
  var totLen, size:lenType;
  const profThreshold=1;

  lock.lock();
  totLen=rangeToSplit.length;
  if totLen > profThreshold then
    size=max(totLen/splitFactor, profThreshold);
  else {
    size=totLen;
    itLeft=false;}
  const direction = if splitTail then -1 else 1;
  const firstRange:rType=rangeToSplit#(direction*size);
  rangeToSplit=rangeToSplit#(direction*(size-totLen));
  lock.unlock();
  return firstRange;
}

}

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

/*
  For more information, see "User-Defined Parallel Zippered iterators
  in Chapel". Bradford L. Chamberlain, Sung-Eun Choi, Steven J. Deitz,
  Angeles Navarro. PGAS 2011: Fifth Conference on Partitioned Global
  Address Space Programming Models, October 2011.
*/

/*
   An atomic test-and-set lock.
*/
pragma "no doc"
record vlock {
  var l: atomic bool;
  proc lock() {
    on this do while l.testAndSet() != false do chpl_task_yield();
  }
  proc unlock() {
    l.write(false);
  }
}

/*
   Toggle debugging output.
*/
config param debugAdvancedIters:bool=false;

//************************* Dynamic iterator

/*
   The serial version of the dynamic iterator.
   Equivalent to serial iteration over the range ``c``.
*/
iter dynamic(c:range(?), chunkSize:int, numTasks:int=0) {

  if debugAdvancedIters then
    writeln("Serial dynamic Iterator. Working with range ", c);

  for i in c do yield i;
}

// Parallel iterator

/*
:arg c: The range to iterate over. The length of the range must be greater than zero.
:type c: range(?)
:arg chunkSize: The size of chunks to be yielded to each thread. Must be greater than zero.
:type chunkSize: int
:arg numTasks: The number of tasks to use. Must be >= zero. If this argument has the value 0, it will use the value indicated by ``dataParTasksPerLocale``.
:type numTasks: int

:yields: Indices in the range ``c``.

This iterator is equivalent to the dynamic scheduling approach of OpenMP.
Given an input range ``c``, each task is assigned chunks of size
``chunkSize`` from ``c`` (or the remaining iterations if there are fewer
than ``chunkSize``). This continues until there are no remaining iterations
in ``c``.

*/
iter dynamic(param tag:iterKind, c:range(?), chunkSize:int, numTasks:int=0)
where tag == iterKind.leader
{
  assert(chunkSize > 0); // caller's responsibility

  use UtilMath;
  // # of tasks the range can fill. (fast) ceil so all work is represented
  const chunkTasks = divceilpos(c.length, chunkSize): int;

  // Check if the number of tasks is 0, in that case it returns a default value
  const nTasks = min(chunkTasks, defaultNumTasks(numTasks));

  type rType=c.type;

  // We're going to have to densify at some point, might as well
  // do it early and make range slicing easier.
  const remain:rType=densify(c,c);

  // If the number of tasks is insufficient, yield in serial
  if c.length == 0 then halt("The range is empty");
  if nTasks == 1 then {
    if debugAdvancedIters then
      writeln("Dynamic Iterator: serial execution because there is not enough work");
    yield (remain,);
  } else {
    var moreWork : bool =true;
    var curIndex : atomic remain.low.type;
    curIndex.write(remain.low);

    coforall tid in 0..#nTasks with (ref remain, ref moreWork, ref curIndex) do {
      while moreWork do {
        // There is local work in remain
        const low = curIndex.fetchAdd(chunkSize);
        var high = low + chunkSize-1;

        if low > remain.high {
          break;
        } else if high > remain.high {
          high = remain.high;
          moreWork = false;
        }

        const current:rType = remain(low .. high);

        if high >= low then {
          if debugAdvancedIters then
            writeln("Parallel dynamic Iterator. Working at tid ", tid, " with range ", unDensify(current,c), " yielded as ", current);
          yield (current,);
        }
      }
    }
  }
}

// Follower
pragma "no doc"
iter dynamic(param tag:iterKind, c:range(?), chunkSize:int, numTasks:int, followThis)
where tag == iterKind.follower
{
  type rType=c.type;
  const current:rType=unDensify(followThis(1),c);
  if debugAdvancedIters then
    writeln("Follower received range ", followThis, " ; shifting to ", current);
  for i in current do {
    yield i;
  }
}

//************************* Guided iterator

/*
   The serial version of the guided iterator.
   Equivalent to serial iteration over the range ``c``.
*/
iter guided(c:range(?), numTasks:int=0) {

  if debugAdvancedIters then
    writeln("Serial guided Iterator. Working with range ", c);

  for i in c do yield i;
}

/*
  :arg c: The range to iterate over. Must have a length greater than zero.
  :type c: range(?)
  :arg numTasks: The number of tasks to use. Must be >= zero. If this argument has the value 0, it will use the value indicated by ``dataParTasksPerLocale``.
  :type numTasks: int

  This iterator is equivalent to the guided policy of OpenMP: Given an input
  range ``c``, each task is assigned chunks of variable size, until there are
  no remaining iterations in ``c``. The size of each chunk is the number of
  unassigned iterations divided by the number of tasks, ``numTasks``. The size
  decreases approximately exponentially to 1. The splitting strategy is
  therefore adaptive.

*/
iter guided(param tag:iterKind, c:range(?), numTasks:int=0)
where tag == iterKind.leader
{
  // Check if the number of tasks is 0, in that case it returns a default value
  const nTasks=min(c.length, defaultNumTasks(numTasks));
  type rType=c.type;
  var remain:rType = densify(c,c);
  // If the number of tasks is insufficient, yield in serial
  if c.length == 0 then halt("The range is empty");
  if nTasks == 1 then {
    if debugAdvancedIters then
      writeln("Guided Iterator: serial execution because there is not enoguh work");
    yield (remain,);
  }

  else {
    var undone=true;
    const factor=nTasks;
    var lock : vlock;

    coforall tid in 0..#nTasks with (ref remain, ref undone, ref lock) do {
      while undone do {
        // There is local work in remain(tid)
        const current:rType=adaptSplit(remain, factor, undone, lock);
        if current.length !=0 then {
          if debugAdvancedIters then
            writeln("Parallel guided Iterator. Working at tid ", tid, " with range ", unDensify(current,c), " yielded as ", current);
          yield (current,);
        }
      }
    }
  }
}

// Follower
pragma "no doc"
iter guided(param tag:iterKind, c:range(?), numTasks:int, followThis)
where tag == iterKind.follower

{
  type rType=c.type;
  const current:rType=unDensify(followThis(1),c);
  if debugAdvancedIters then
    writeln("Follower received range ", followThis, " ; shifting to ", current);
  for i in current do {
    yield i;
  }
}

//************************* Adaptive work-stealing iterator
/*
   The serial version of the adaptive iterator.
   Equivalent to serial iteration over the range ``c``.
*/
iter adaptive(c:range(?), numTasks:int=0) {

  if debugAdvancedIters then
    writeln("Serial adaptive work-stealing Iterator. Working with range ", c);

  for i in c do yield i;

}

// Parallel iterator
/*
The enum used to represent adaptive methods.

- ``Whole``
  Each task without work tries to steal from its neighbor range
  until it exhausts that range. Then the task continues with the next
  neighbor range, and so on until there is no more work. This is the default
  policy.

- ``RoundRobin``
  Each task without work tries to steal once from its neighbor range, next
  from the following neighbor range and so on in a round-robin way until
  there is no more work.

- ``WholeTail``
  Similar to the ``Whole`` method, but now the splitting in the victim
  range is performed from its tail.
*/
enum Method {
  Whole = 0,
  RoundRobin = 1,
  WholeTail = 2
};

/*
  Used to select the adaptive stealing method. Defaults to ``Whole``.
  See :data:`Method` for more information.
*/
config param methodStealing = Method.Whole;

/*
  :arg c: The range to iterate over. Must have a length greater than zero.
  :type c: range(?)
  :arg numTasks: The number of tasks to use. Must be >= zero. If this argument has the value 0, it will use the value indicated by ``dataParTasksPerLocale``.
  :type numTasks: int

  This iterator implements a naive adaptive binary splitting work-stealing
  strategy: Initially the leader iterator distributes the range to split, ``c``,
  evenly among the ``numTasks`` tasks.

  Then, each task performs adaptive splitting on its local sub-range's iterations.
  When a task exhausts its local iterations, it steals and splits from the
  range of another task (the victim). The splitting method on the local range
  and on the victim range is binary: i.e. the size of each chunk is computed as
  the number of unassigned iterations divided by 2. There are three stealing
  strategies that can be selected at compile time using the config param
  :param:`methodStealing`.
*/
iter adaptive(param tag:iterKind, c:range(?), numTasks:int=0)
where tag == iterKind.leader

{
  /*if (methodStealing != Method.Whole || methodStealing != Method.WholeTail) then
    compilerError("methodStealing value must be between 0 and 2");*/

  // Check if the number of tasks is 0, in that case it returns a default value
  const nTasks=min(c.length, defaultNumTasks(numTasks));
  type rType=c.type;

  // If the number of tasks is insufficient, yield in serial
  if c.length == 0 then halt("The range is empty");
  if nTasks == 1 then {
    if debugAdvancedIters then
      writeln("Adaptive work-stealing Iterator: serial execution because there is not enough work");
    yield (densify(c,c),);

  }
  else {
    const r:rType=densify(c,c);
    const SpaceThreads:domain(1)=0..#nTasks;
    var localWork:[SpaceThreads] rType; // The remaining range to split on each Thread
    var moreLocalWork:[SpaceThreads] bool=true; // bool var to signal there is still work on each local range
    var locks:[SpaceThreads] vlock; // sync var to control the splitting on each Thread
    const factor:int=2;

    const factorSteal:int=2;
    var moreWork:bool=true; // A global var to control the termination

    // Variables to put a barrier to ensure the initial range is computed on each Thread
    var barrier : atomic int;

    // Start the parallel work
    coforall tid in 0..#nTasks with (ref localWork, ref moreLocalWork, ref moreWork, ref r) do {

      // Step 1: Initial range per Thread/Task

      // Initial Local range in localWork[tid]
      const chunkSize = c.length/nTasks;
      localWork[tid]=
      if tid==nTasks-1 then
        r#(chunkSize*(nTasks-1)-r.length)
      else
        (r+tid*chunkSize)#chunkSize;
      barrier.add(1);

      if debugAdvancedIters then
        writeln("Parallel adaptive work-stealing Iterator. Working at tid ", tid, " with initial range ", localWork[tid]);

      // A barrier waiting for each thread to finish the initial assignment
      barrier.waitFor(nTasks);

      // Step 2: While there is work at tid, do splitting

      while moreLocalWork[tid] do {
        // There is local work
        // The current range we get after splitting locally
        const zeroBasedIters:rType=adaptSplit(localWork[tid], factorSteal, moreLocalWork[tid], locks[tid]);
        if zeroBasedIters.length !=0 then {
          if debugAdvancedIters then
            writeln("Parallel adaptive Iterator. Working locally at tid ", tid, " with range yielded as ", zeroBasedIters);
          yield (zeroBasedIters,);
        }
      }

      // Step3: Task tid finished its work, so it will try to steal from a neighbor

      var nVisitedVictims:int=0;
      var victim=(tid+1) % nTasks;
      var stealFailed:bool=false;

      while moreWork do {
        if debugAdvancedIters then
          writeln("Entering at Stealing phase in tid ", tid," with victim ", victim, " using method of Stealing ", methodStealing);

        // Perform the spliting at the victim remaining range

        if methodStealing == Method.RoundRobin {
          if moreLocalWork[victim] then {
            // There is work in victim
            const zeroBasedIters2:rType=adaptSplit(localWork[victim], factorSteal, moreLocalWork[victim], locks[victim]);
            if zeroBasedIters2.length !=0 then {
              if debugAdvancedIters then
                writeln("Range stealed at victim ", victim," yielded as ", zeroBasedIters2," by tid ", tid);
              yield (zeroBasedIters2,);
            }
          } else {
            stealFailed=true;
          }
        } else {
          while moreLocalWork[victim] do {
            // There is work in victim
            const zeroBasedIters2:rType=adaptSplit(localWork[victim], factorSteal, moreLocalWork[victim], locks[victim], methodStealing==Method.WholeTail);
                                          //after splitting from a victim range
            if zeroBasedIters2.length !=0 then {
              if debugAdvancedIters then
                writeln("Range stealed at victim ", victim," yielded as ", zeroBasedIters2," by tid ", tid);
              yield (zeroBasedIters2,);
            }
          }
        }

        // If here, then it can have failed the stealing intent at the victim (method 1),
        // or we have exhausted the victim range (methods 0, 2)

        if (methodStealing==Method.Whole || methodStealing==Method.WholeTail || (methodStealing==Method.RoundRobin && stealFailed)) then {
          nVisitedVictims += 1; // Signal that there is no more work in victim
          stealFailed=false;
          if debugAdvancedIters then
            writeln("Failed Stealing intent at tid ", tid," with victim ", victim, " and total no. of visited victims ", nVisitedVictims);
        }
        // Check if there is no more work
        if nVisitedVictims >= nTasks-1 then
          moreWork=false; // Signal that there is no more work in any victim
        else {  // There can be still work in other victim
          victim=(victim+1) % nTasks; // New victim to steal
          if methodStealing==Method.RoundRobin && victim==tid then
            victim=(victim+1) % nTasks;
        }
      }
    }
  }
}

// Follower
pragma "no doc"
iter adaptive(param tag:iterKind, c:range(?), numTasks:int, followThis)
where tag == iterKind.follower
{
  type rType=c.type;
  var current:rType=unDensify(followThis(1),c);
  if debugAdvancedIters then
    writeln("Follower received range ", followThis, " ; shifting to ", current);
  for i in current do {
    yield i;
  }
}

//************************* Helper functions
pragma "no doc"
proc defaultNumTasks(nTasks:int)
{
  var dnTasks=nTasks;
  if nTasks==0 then {
    if dataParTasksPerLocale==0 then dnTasks=here.maxTaskPar;
      else dnTasks=dataParTasksPerLocale;
  } else if nTasks<0 then {
    halt("'numTasks' is negative");
  }
  return dnTasks;
}

pragma "no doc"
proc adaptSplit(ref rangeToSplit:range(?), splitFactor:int, ref itLeft:bool, ref lock : vlock, splitTail:bool=false)
{
  type rType=rangeToSplit.type;
  type lenType=rangeToSplit.length.type;
  var totLen, size:lenType;
  const profThreshold=1;

  lock.lock();
  totLen=rangeToSplit.length;
  if totLen > profThreshold then
    size=max(totLen/splitFactor, profThreshold);
  else {
    size=totLen;
    itLeft=false;}
  const direction = if splitTail then -1 else 1;
  const firstRange:rType=rangeToSplit#(direction*size);
  rangeToSplit=rangeToSplit#(direction*(size-totLen));
  lock.unlock();
  return firstRange;
}


Pull the external declarations out

Pull the external declarations out

// Wrapper for FFTW version 3.
module FFTW {

  use SysCTypes;

  // Define the various planner flags
  // See Sec. 4.3.2 of FFTW manual "Planner Flags"
  extern const FFTW_FORWARD : c_int;
  extern const FFTW_BACKWARD : c_int;
  extern const FFTW_ESTIMATE : c_uint;
  extern const FFTW_MEASURE : c_uint;
  extern const FFTW_PATIENT : c_uint;
  extern const FFTW_EXHAUSTIVE : c_uint;
  extern const FFTW_WISDOM_ONLY : c_uint;
  extern const FFTW_DESTROY_INPUT : c_uint;
  extern const FFTW_PRESERVE_INPUT : c_uint;
  extern const FFTW_UNALIGNED : c_uint;

  // Define types
  // NOTE : Ideally, this should be mapped to complex(128), but I seem to run into
  // casting issues in the C code. This is a simple workaround for now - although ugly.
  // Also note that if one used complex types, then one would need to include complex.h at the command line
  extern type fftw_complex = 2*real(64); // 4.1.1
  extern type fftw_plan; // opaque type
  type _cxptr = c_ptr(2*c_double);
  type _rptr = c_ptr(c_double);

  // Planner functions
  // Complex : 4.3.1
  // NOTE : We pass in arrays using ref
  proc plan_dft(in1 : [] fftw_complex, out1 : [] fftw_complex, sign : c_int, flags :c_uint) : fftw_plan
  {
    param rank = in1.rank: c_int;

    var dims: rank*c_int;
    for param i in 1..rank do
      dims(i) = in1.domain.dim(i).size: c_int;

    extern proc fftw_plan_dft(rank: c_int,
        n,  // BLC: having trouble being specific
        in1: [] fftw_complex,
        out1: [] fftw_complex,
        sign : c_int, flags : c_uint) : fftw_plan;

    return fftw_plan_dft(rank, dims, in1, out1, sign, flags);
  }

  // Real-to-complex and complex-to-real out-of-place planning routines
  // We handle these with a type parameter to let the user pass in an appropriately sized
  // real array for the complex part, most usually when doing an in-place transform.

  // Since the calls to FFTW are the same, pull the extern declarations out.
  // TODO : This should be cleaned up further and made consistent across the file
  extern proc fftw_plan_dft_r2c(rank: c_int,
      n,  // BLC: having trouble being specific
      in1: [] real(64),
      out1: [] fftw_complex,
      flags : c_uint) : fftw_plan;
  extern proc fftw_plan_dft_c2r(rank: c_int,
      n,  // BLC: having trouble being specific
      in1: [] fftw_complex,
      out1: [] real(64),
      flags : c_uint) : fftw_plan;

  proc plan_dft_r2c(in1 : [] real(64), out1 : [] fftw_complex, flags :c_uint) : fftw_plan
  {
    param rank = in1.rank: c_int;

    var dims: rank*c_int;
    for param i in 1..rank do
      dims(i) = in1.domain.dim(i).size: c_int;

    return fftw_plan_dft_r2c(rank, dims, in1, out1, flags);
  }
  proc plan_dft_c2r(in1 : [] fftw_complex, out1 : [] real(64),  flags :c_uint) : fftw_plan
  {
    param rank = out1.rank: c_int; // The dimensions are that of the real array

    var dims: rank*c_int;
    for param i in 1..rank do
      dims(i) = out1.domain.dim(i).size: c_int;

    return fftw_plan_dft_c2r(rank, dims, in1, out1, flags);
  }

  // Real-to-complex and complex-to-real plans
  // We handle these with a type parameter to let the user pass in an appropriately sized
  // real array for the complex part, most usually when doing an in-place transform.
//  proc plan_dft_r2c(dims, ref in1 : ?t, ref out1 : ?tt, flags : c_uint) : fftw_plan
//    where ((t.type==real(64)) || (t.type==fftw_complex)) && ((tt.type==real(64)) || (tt.type==fftw_complex)) && (isHomogeneousTuple(dims))
//    {
//      //-- define the extern proc
//      extern proc fftw_plan_dft_r2c(rank : c_int, const ref n : c_int,  in1 : _rptr,  out1 : _cxptr, flags : c_uint) : fftw_plan;
//      // Make sure types are correct
//      param ndim : c_int = dims.size;
//      return fftw_plan_dft_r2c(ndim,dims(1),c_ptrTo(in1) : c_ptr(c_double), c_ptrTo(out1) : _cxptr, flags);
//    }
//  proc plan_dft_c2r(dims, ref in1 : ?t, ref out1 : ?tt, flags : c_uint) : fftw_plan
//    where ((t.type==real(64)) || (t.type==fftw_complex)) && ((tt.type==real(64)) || (tt.type==fftw_complex)) && (isHomogeneousTuple(dims))
//    {
//      //-- define the extern proc
//      extern proc fftw_plan_dft_c2r(rank : c_int, const ref n : c_int, in1 : _cxptr,  out1 : _rptr, flags : c_uint) : fftw_plan;
//      // Make sure types are correct
//      param ndim : c_int = dims.size;
//      return fftw_plan_dft_c2r(ndim, dims(1),c_ptrTo(in1) : _cxptr, c_ptrTo(out1) : c_ptr(c_double), flags);
//    }

  // Using plans
  proc execute(const plan : fftw_plan) {
    extern proc fftw_execute(const plan : fftw_plan);
    fftw_execute(plan);
  }
  proc destroy_plan(plan : fftw_plan) {
    extern proc fftw_destroy_plan(plan : fftw_plan);
    fftw_destroy_plan(plan);
  }
  proc cleanup() {
    extern proc fftw_cleanup();
    cleanup();
  }

  // Utilities -- not in FFTW
  proc abs((r,c) : fftw_complex) : real(64) {
    return sqrt(r*r + c*c);
  }

  proc re((r,c) : fftw_complex) : real(64) {
    return r;
  }
  proc im((r,c) : fftw_complex) : real(64) {
    return c;
  }

}

// Wrapper for FFTW version 3.
module FFTW {

  use SysCTypes;

  // Define the various planner flags
  // See Sec. 4.3.2 of FFTW manual "Planner Flags"
  extern const FFTW_FORWARD : c_int;
  extern const FFTW_BACKWARD : c_int;
  extern const FFTW_ESTIMATE : c_uint;
  extern const FFTW_MEASURE : c_uint;
  extern const FFTW_PATIENT : c_uint;
  extern const FFTW_EXHAUSTIVE : c_uint;
  extern const FFTW_WISDOM_ONLY : c_uint;
  extern const FFTW_DESTROY_INPUT : c_uint;
  extern const FFTW_PRESERVE_INPUT : c_uint;
  extern const FFTW_UNALIGNED : c_uint;

  // Define types
  // NOTE : Ideally, this should be mapped to complex(128), but I seem to run into
  // casting issues in the C code. This is a simple workaround for now - although ugly.
  // Also note that if one used complex types, then one would need to include complex.h at the command line
  extern type fftw_complex = 2*real(64); // 4.1.1
  extern type fftw_plan; // opaque type
  type _cxptr = c_ptr(2*c_double);
  type _rptr = c_ptr(c_double);

  // Planner functions
  // Complex : 4.3.1
  // NOTE : We pass in arrays using ref
  proc plan_dft(in1 : [] fftw_complex, out1 : [] fftw_complex, sign : c_int, flags :c_uint) : fftw_plan
  {
    param rank = in1.rank: c_int;

    var dims: rank*c_int;
    for param i in 1..rank do
      dims(i) = in1.domain.dim(i).size: c_int;

    extern proc fftw_plan_dft(rank: c_int,
        n,  // BLC: having trouble being specific
        in1: [] fftw_complex,
        out1: [] fftw_complex,
        sign : c_int, flags : c_uint) : fftw_plan;

    return fftw_plan_dft(rank, dims, in1, out1, sign, flags);
  }

  // Real-to-complex and complex-to-real out-of-place planning routines
  // We handle these with a type parameter to let the user pass in an appropriately sized
  // real array for the complex part, most usually when doing an in-place transform.
  proc plan_dft_r2c(in1 : [] real(64), out1 : [] fftw_complex, flags :c_uint) : fftw_plan
  {
    param rank = in1.rank: c_int;

    var dims: rank*c_int;
    for param i in 1..rank do
      dims(i) = in1.domain.dim(i).size: c_int;

    extern proc fftw_plan_dft_r2c(rank: c_int,
        n,  // BLC: having trouble being specific
        in1: [] real(64),
        out1: [] fftw_complex,
        flags : c_uint) : fftw_plan;

    return fftw_plan_dft_r2c(rank, dims, in1, out1, flags);
  }
  proc plan_dft_c2r(in1 : [] fftw_complex, out1 : [] real(64),  flags :c_uint) : fftw_plan
  {
    param rank = out1.rank: c_int; // The dimensions are that of the real array

    var dims: rank*c_int;
    for param i in 1..rank do
      dims(i) = out1.domain.dim(i).size: c_int;

    extern proc fftw_plan_dft_c2r(rank: c_int,
        n,  // BLC: having trouble being specific
        in1: [] fftw_complex,
        out1: [] real(64),
        flags : c_uint) : fftw_plan;

    return fftw_plan_dft_c2r(rank, dims, in1, out1, flags);
  }

  // Real-to-complex and complex-to-real plans
  // We handle these with a type parameter to let the user pass in an appropriately sized
  // real array for the complex part, most usually when doing an in-place transform.
//  proc plan_dft_r2c(dims, ref in1 : ?t, ref out1 : ?tt, flags : c_uint) : fftw_plan
//    where ((t.type==real(64)) || (t.type==fftw_complex)) && ((tt.type==real(64)) || (tt.type==fftw_complex)) && (isHomogeneousTuple(dims))
//    {
//      //-- define the extern proc
//      extern proc fftw_plan_dft_r2c(rank : c_int, const ref n : c_int,  in1 : _rptr,  out1 : _cxptr, flags : c_uint) : fftw_plan;
//      // Make sure types are correct
//      param ndim : c_int = dims.size;
//      return fftw_plan_dft_r2c(ndim,dims(1),c_ptrTo(in1) : c_ptr(c_double), c_ptrTo(out1) : _cxptr, flags);
//    }
//  proc plan_dft_c2r(dims, ref in1 : ?t, ref out1 : ?tt, flags : c_uint) : fftw_plan
//    where ((t.type==real(64)) || (t.type==fftw_complex)) && ((tt.type==real(64)) || (tt.type==fftw_complex)) && (isHomogeneousTuple(dims))
//    {
//      //-- define the extern proc
//      extern proc fftw_plan_dft_c2r(rank : c_int, const ref n : c_int, in1 : _cxptr,  out1 : _rptr, flags : c_uint) : fftw_plan;
//      // Make sure types are correct
//      param ndim : c_int = dims.size;
//      return fftw_plan_dft_c2r(ndim, dims(1),c_ptrTo(in1) : _cxptr, c_ptrTo(out1) : c_ptr(c_double), flags);
//    }

  // Using plans
  proc execute(const plan : fftw_plan) {
    extern proc fftw_execute(const plan : fftw_plan);
    fftw_execute(plan);
  }
  proc destroy_plan(plan : fftw_plan) {
    extern proc fftw_destroy_plan(plan : fftw_plan);
    fftw_destroy_plan(plan);
  }
  proc cleanup() {
    extern proc fftw_cleanup();
    cleanup();
  }

  // Utilities -- not in FFTW
  proc abs((r,c) : fftw_complex) : real(64) {
    return sqrt(r*r + c*c);
  }

  proc re((r,c) : fftw_complex) : real(64) {
    return r;
  }
  proc im((r,c) : fftw_complex) : real(64) {
    return c;
  }

}


Added the config param BUILD_TORUS_VERSIONS back in and set the
defaults for the other versions (BUILD_XD_TORUS_VERSION) to use it as
a default.

This should re-enable the SSCA2 nightly performance tests.

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

module SSCA2_compilation_config_params

// +==========================================================================+
// |  compilation time configuration parameters                               |
// |                                                                          |
// |  "FILTERING" turns edge filtering on and off (the value of the edge      |
// |  weight determines whether the edge is filtered or not).                 |
// |                                                                          |
// |  "VALIDATE_BC" causes the code to do additional work to demonstrate      |
// |  correct functioning.                                                    |
// |                                                                          |
// |  "REPRODUCIBLE_PROBLEMS" causes all random number streams to start from  |
// |  fixed (deterministic) seeds.                                            |
// |                                                                          |
// |  "PRINT_TIMING_STATISTICS" enables or disables timing measurement and    |
// |  documentation.  This mode is normally used with the preceding mode to   |
// |  create deterministic output for compiler regression testing.            |
// |                                                                          |
// |  "DISTRIBUTION_TYPE" selects among different distribution possiblities.  |
// |  At present, only "BLOCK" distributions is supported in the code.        |
// |  The alternative to "BLOCK" is "none" (undistributed).                   |
// +==========================================================================+

{
  config param FILTERING = false;

  config param VALIDATE_BC = false;

  config param DEBUG_GRAPH_GENERATOR = false;

  config param DEBUG_WEIGHT_GENERATOR = false;

  config param DEBUG_KERNEL2 = false;

  config param DEBUG_KERNEL3 = false;

  config param DEBUG_KERNEL4 = false;

  config param REPRODUCIBLE_PROBLEMS = true;

  config param PRINT_TIMING_STATISTICS = true;

  config param DISTRIBUTION_TYPE = "BLOCK";

  config param BUILD_RMAT_VERSION = true;

  config param BUILD_TORUS_VERSIONS = false;

  config param BUILD_1D_TORUS_VERSION = BUILD_TORUS_VERSIONS;

  config param BUILD_2D_TORUS_VERSION = BUILD_TORUS_VERSIONS;

  config param BUILD_3D_TORUS_VERSION = BUILD_TORUS_VERSIONS;

  config param BUILD_4D_TORUS_VERSION = BUILD_TORUS_VERSIONS;
}

module SSCA2_compilation_config_params

// +==========================================================================+
// |  compilation time configuration parameters                               |
// |                                                                          |
// |  "FILTERING" turns edge filtering on and off (the value of the edge      |
// |  weight determines whether the edge is filtered or not).                 |
// |                                                                          |
// |  "VALIDATE_BC" causes the code to do additional work to demonstrate      |
// |  correct functioning.                                                    |
// |                                                                          |
// |  "REPRODUCIBLE_PROBLEMS" causes all random number streams to start from  |
// |  fixed (deterministic) seeds.                                            |
// |                                                                          |
// |  "PRINT_TIMING_STATISTICS" enables or disables timing measurement and    |
// |  documentation.  This mode is normally used with the preceding mode to   |
// |  create deterministic output for compiler regression testing.            |
// |                                                                          |
// |  "DISTRIBUTION_TYPE" selects among different distribution possiblities.  |
// |  At present, only "BLOCK" distributions is supported in the code.        |
// |  The alternative to "BLOCK" is "none" (undistributed).                   |
// +==========================================================================+

{
  config param FILTERING = false;

  config param VALIDATE_BC = false;

  config param DEBUG_GRAPH_GENERATOR = false;

  config param DEBUG_WEIGHT_GENERATOR = false;

  config param DEBUG_KERNEL2 = false;

  config param DEBUG_KERNEL3 = false;

  config param DEBUG_KERNEL4 = false;

  config param REPRODUCIBLE_PROBLEMS = true;

  config param PRINT_TIMING_STATISTICS = true;

  config param DISTRIBUTION_TYPE = "BLOCK";

  config param BUILD_RMAT_VERSION = true;

  config param BUILD_1D_TORUS_VERSION = false;

  config param BUILD_2D_TORUS_VERSION = false;

  config param BUILD_3D_TORUS_VERSION = false;

  config param BUILD_4D_TORUS_VERSION = false;
}


SubLoc => Subloc (again!)

SubLoc => Subloc (again!)

Fix capitalization due to renaming in qthreads layer.

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

extern proc chpl_task_getSubLoc(): chpl_sublocID_t;
extern proc chpl_task_getRequestedSubloc(): chpl_sublocID_t;

for loc in Locales do on loc {
  if chpl_task_getRequestedSubloc() != c_sublocid_any then
    writeln("[", here.id,
            "] Wrong subloc (wanted ", c_sublocid_any,
            ", got ", chpl_task_getSubLoc(), ")");

  for i in 0..#(here:LocaleModel).numSubLocales do
    on (here:LocaleModel).getChild(i) do
      if i!=chpl_task_getSubLoc() then
        writeln("[", here.id,
                "] Wrong subloc (wanted ", i,
                ", got ", chpl_task_getSubLoc(), ")");
}

extern proc chpl_task_getSubLoc(): chpl_sublocID_t;
extern proc chpl_task_getRequestedSubLoc(): chpl_sublocID_t;

for loc in Locales do on loc {
  if chpl_task_getRequestedSubLoc() != c_sublocid_any then
    writeln("[", here.id,
            "] Wrong subloc (wanted ", c_sublocid_any,
            ", got ", chpl_task_getSubLoc(), ")");

  for i in 0..#(here:LocaleModel).numSubLocales do
    on (here:LocaleModel).getChild(i) do
      if i!=chpl_task_getSubLoc() then
        writeln("[", here.id,
                "] Wrong subloc (wanted ", i,
                ", got ", chpl_task_getSubLoc(), ")");
}


Added the "pure_return" for the boolean for the string
equals and not-equals comparisons in the prelude, per
John's suggestion.

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

pragma "no codegen";

class object { }
class value { }

function typeof(x) { }

function sizeof(x) { return __primitive("pure_return", integer); }

// dynamic data block class
pragma "data class"
class _ddata {
  type elt_type;
  var size : integer;
  pragma "data block" var _elt : elt_type;
  pragma "rename _data_get"
  function this(i : integer) : elt_type {
    return _elt;
  }
  pragma "rename _data_set"
  function =this(i : integer, val : elt_type) {
    _elt = val;
  }
}

-- I/O

class CFILEPTR {
}

const _NULLCFILEPTR   : CFILEPTR = CFILEPTR();
const _STDINCFILEPTR  : CFILEPTR = CFILEPTR();
const _STDOUTCFILEPTR : CFILEPTR = CFILEPTR();
const _STDERRCFILEPTR : CFILEPTR = CFILEPTR();

pragma "rename fopen" function _fopen(filename, mode : string) : CFILEPTR {
  return CFILEPTR();
}

pragma "rename fclose" function _fclose(fp : CFILEPTR) : integer;

const errno: integer;
function strerror(errno: integer) : string {
  return "";
}

pragma "rename _chpl_write_linefeed" function writeln() : void {
         __primitive("writeln");
}

function fprintf(fp: CFILEPTR, fmt: string, val) : integer {
         __primitive("write", val);
}

function fscanf(fp: CFILEPTR, fmt: string, inout val) : integer {
         __primitive("read", val);
}

function _chpl_fwrite_float_help(f: CFILEPTR, val: float) : void {
         __primitive("write", val);
}

function _chpl_fread_string_help(f: CFILEPTR, inout val: string) : void {
         __primitive("read", val);
}

pragma "rename _chpl_read_complex" function read(inout x : complex) : void {
         __primitive("read", x);
}

pragma "rename _chpl_tostring_boolean"
function _tostring(x : boolean, format : string) : string {
         return __primitive("coerce", string, x);
}

pragma "rename _chpl_tostring_integer"
function _tostring(x : integer, format : string) : string {
         return __primitive("coerce", string, x);
}

pragma "rename _chpl_tostring_float"
function _tostring(x : float, format : string) : string {
         return __primitive("coerce", string, x);
}

pragma "rename _chpl_tostring_complex"
function _tostring(x : complex, format : string) : string {
         return __primitive("coerce", string, x);
}

-- intrinsic type values

const false: boolean = 0;
const true: boolean = 1;

-- math

function sqrt(x: float): float {}
function abs(x): float {}  -- BLC: should be ": t"  SJD: redo with primitive?
function ceil(x: float): float {}
function min(x, y) {
  if (x < y) {
    return x;
  } else {
    return y;
  }
}
function max(x, y) {
  if (x > y) {
    return x;
  } else {
    return y;
  }
}

-- boundary classes/functions

function wrap() {}

-- reductions

class reduction {
}

class sum {
}

class max {
}

class min {
}

class maxloc {
}

class minloc {
}

-- timers

class timer {
  function start();
  function stop();
  function read(): float;
}

-- exits

pragma "rename _chpl_exit" function exit(status : integer);

function halt() {
  __primitive("halt");
}

function assert() {
  __primitive("assert");
}

-- memory tests (These tests will be moved to a module, once we have modules.)

function _chpl_memtest_printMemTable();
function _chpl_memtest_printMemStat();
function _chpl_memtest_resetMemStat();
function _chpl_memtest_allocAndFree();
function _chpl_memtest_freedMalloc();
function _chpl_memtest_freedWithoutMalloc();
function _chpl_memtest_reallocWithoutMalloc();
function _chpl_memtest_reallocZeroSize();
function _chpl_memtest_mallocOutOfMemory();
function _chpl_memtest_reallocOutOfMemory();

function startTrackingMem();

function _complex_read_hack(inout x) {
  __primitive("read", x);
}

function _complex_tostring_hack(x, format : string) : string {
  return __primitive("coerce", string, x);
}

const numLocales: integer = 1;

-- FROM INTERNAL PRELUDE

record _methodTokenType {
  var _methodTokenTypeFieldDummy : integer;
}

var _methodToken : _methodTokenType;

record _setterTokenType {
  var _setterTokenTypeFieldDummy : integer;
}

var _setterToken : _setterTokenType;

class _seq { -- this is no longer necessary
}

class Array {
  function this(i) {
    return __primitive("array_index", this, i);
  }
  function this(i, j) {
    return __primitive("array_index", this, i, j);
  }
  function this(i, j, k) {
    return __primitive("array_index", this, i, j, k);
  }
  function =this(i, x) {
    return __primitive("array_set", this, i, x);
  }
  function =this(i, j, x) {
    return __primitive("array_set", this, i, j, x);
  }
  function =this(i, j, k, x) {
    return __primitive("array_set", this, i, j, k, x);
  }
}

class Domain {
}

record Tuple {
  var _tuple_dummy_field : integer;
  function this(pragma "clone_for_constants" i) {
    return __primitive("index_object", this, i);
  }
  function =this(pragma "clone_for_constants" i, x) {
    return __primitive("set_index_object", this, i, x);
  }
}

pragma "builtin" function +(a : Array, b : Array) { return __primitive("array_pointwise_op", a, b); }
pragma "builtin" function -(a : Array, b : Array) { return __primitive("array_pointwise_op", a, b); }
pragma "builtin" function *(a : Array, b : Array) { return __primitive("array_pointwise_op", a, b); }
pragma "builtin" function /(a : Array, b : Array) { return __primitive("array_pointwise_op", a, b); }
pragma "builtin" function &(a : Array, b : Array) { return __primitive("array_pointwise_op", a, b); }
pragma "builtin" function |(a : Array, b : Array) { return __primitive("array_pointwise_op", a, b); }
pragma "builtin" function ^(a : Array, b : Array) { return __primitive("array_pointwise_op", a, b); }
pragma "builtin" function ==(a : Array, b : Array) { return __primitive("array_pointwise_op", a, b); }
pragma "builtin" function !=(a : Array, b : Array) { return __primitive("array_pointwise_op", a, b); }
pragma "builtin" function <=(a : Array, b : Array) { return __primitive("array_pointwise_op", a, b); }
pragma "builtin" function >=(a : Array, b : Array) { return __primitive("array_pointwise_op", a, b); }
pragma "builtin" function <(a : Array, b : Array) { return __primitive("array_pointwise_op", a, b); }
pragma "builtin" function >(a : Array, b : Array) { return __primitive("array_pointwise_op", a, b); }
pragma "builtin" function and(a : Array, b : Array) { return __primitive("array_pointwise_op", a, b); }
pragma "builtin" function or(a : Array, b : Array) { return __primitive("array_pointwise_op", a, b); }
pragma "builtin" function **(a : Array, b : Array) { return __primitive("array_pointwise_op", a, b); }

pragma "builtin" function -(a : numeric) { return a; } -- needs to be primitive
pragma "builtin" function +(a : numeric) { return a; } -- needs to be primitive
pragma "builtin" function ~(a : numeric) { return a; } -- needs to be primitive
pragma "builtin" function not(a : numeric) { return a; } -- needs to be primitive

pragma "builtin" function +(a : numeric, b : numeric) { return __primitive(a, "+", b); }
pragma "builtin" function -(a : numeric, b : numeric) { return __primitive(a, "-", b); }
pragma "builtin" function *(a : numeric, b : numeric) { return __primitive(a, "*", b); }
pragma "builtin" function /(a : numeric, b : numeric) { return __primitive(a, "/", b); }
pragma "builtin" function mod(a : numeric, b : numeric) { return __primitive(a, "%", b); }
pragma "builtin" function ==(a : numeric, b : numeric) { return __primitive(a, "==", b); }
pragma "builtin" function !=(a : numeric, b : numeric) { return __primitive(a, "!=", b); }
pragma "builtin" function <=(a : numeric, b : numeric) { return __primitive(a, "<=", b); }
pragma "builtin" function >=(a : numeric, b : numeric) { return __primitive(a, ">=", b); }
pragma "builtin" function <(a : numeric, b : numeric) { return __primitive(a, "<", b); }
pragma "builtin" function >(a : numeric, b : numeric) { return __primitive(a, ">", b); }
pragma "builtin" function &(a : numeric, b : numeric) { return __primitive(a, "&", b); }
pragma "builtin" function |(a : numeric, b : numeric) { return __primitive(a, "|", b); }
pragma "builtin" function ^(a : numeric, b : numeric) { return __primitive(a, "^", b); }
pragma "builtin" function and(a : numeric, b : numeric) { return __primitive(a, "&&", b); }
pragma "builtin" function or(a : numeric, b : numeric) { return __primitive(a, "||", b); }
pragma "builtin" function **(a : numeric, b : numeric) { return __primitive(a, "**", b); }
pragma "builtin" function ==(a : object, b : object) { return __primitive("ptr_eq", a, b); }
pragma "builtin" function !=(a : object, b : object) { return __primitive("ptr_neq", a, b); }

pragma "builtin" function _move(a : any, b : any);

pragma "split unique"
pragma "builtin" function =(a : numeric, b : any) {
  return __primitive("cast", a, b);
}

pragma "builtin" function =(a : string, b : any) {
  return __primitive("pure_return", string);
}

pragma "split unique"
pragma "builtin" function =(a : any, b : any) {
  return b;
}

pragma "rename _chpl_string_index"
function string.this(i : integer) {
  return __primitive("string_op", this, i);
}

pragma "rename _chpl_string_select"
function _chpl_string_select(s : string, low : integer, high : integer) {
  return __primitive("string_op", s, low, high);
}

pragma "rename _chpl_string_strided_select"
function _chpl_string_strided_select(s : string, low : integer, high : integer, stride : integer) {
  return __primitive("string_op", s, low, high, stride);
}

pragma "rename _chpl_string_concat"
function +(a : string, b : string) : string {
  return __primitive("string_op", a, b);
}

pragma "rename _chpl_string_equal"
function ==(a : string, b : string) : boolean {
  return __primitive("pure_return", boolean);
}

pragma "rename _chpl_string_notequal"
function !=(a : string, b : string) : boolean {
  return __primitive("pure_return", boolean);
}

pragma "rename _chpl_string_length"
function length(a : string) : integer {
  return __primitive("coerce", integer, a);
}

pragma "split unique"
pragma "keep types"
pragma "rename _chpl_alloc"
function _chpl_alloc(t, description:string) { return __primitive("chpl_alloc", t); }

function _init_string() { return ""; }

function _INIT_CONFIG(inout v, v_type, chapel_name, module_name);
function _INIT_ARRAY(rank, arr, dom, elt_type);
function _INIT_DOMAIN_DIM(dom, dim, lo, hi, str);

function _ArrayWriteStopgap(x) { }
function _EnumReadStopgap(x) { }
function _DomainWriteStopgap(x) { }

-- END FROM INTERNAL PRELUDE

pragma "no codegen";

class object { }
class value { }

function typeof(x) { }

function sizeof(x) { return __primitive("pure_return", integer); }

// dynamic data block class
pragma "data class"
class _ddata {
  type elt_type;
  var size : integer;
  pragma "data block" var _elt : elt_type;
  pragma "rename _data_get"
  function this(i : integer) : elt_type {
    return _elt;
  }
  pragma "rename _data_set"
  function =this(i : integer, val : elt_type) {
    _elt = val;
  }
}

-- I/O

class CFILEPTR {
}

const _NULLCFILEPTR   : CFILEPTR = CFILEPTR();
const _STDINCFILEPTR  : CFILEPTR = CFILEPTR();
const _STDOUTCFILEPTR : CFILEPTR = CFILEPTR();
const _STDERRCFILEPTR : CFILEPTR = CFILEPTR();

pragma "rename fopen" function _fopen(filename, mode : string) : CFILEPTR {
  return CFILEPTR();
}

pragma "rename fclose" function _fclose(fp : CFILEPTR) : integer;

const errno: integer;
function strerror(errno: integer) : string {
  return "";
}

pragma "rename _chpl_write_linefeed" function writeln() : void {
         __primitive("writeln");
}

function fprintf(fp: CFILEPTR, fmt: string, val) : integer {
         __primitive("write", val);
}

function fscanf(fp: CFILEPTR, fmt: string, inout val) : integer {
         __primitive("read", val);
}

function _chpl_fwrite_float_help(f: CFILEPTR, val: float) : void {
         __primitive("write", val);
}

function _chpl_fread_string_help(f: CFILEPTR, inout val: string) : void {
         __primitive("read", val);
}

pragma "rename _chpl_read_complex" function read(inout x : complex) : void {
         __primitive("read", x);
}

pragma "rename _chpl_tostring_boolean"
function _tostring(x : boolean, format : string) : string {
         return __primitive("coerce", string, x);
}

pragma "rename _chpl_tostring_integer"
function _tostring(x : integer, format : string) : string {
         return __primitive("coerce", string, x);
}

pragma "rename _chpl_tostring_float"
function _tostring(x : float, format : string) : string {
         return __primitive("coerce", string, x);
}

pragma "rename _chpl_tostring_complex"
function _tostring(x : complex, format : string) : string {
         return __primitive("coerce", string, x);
}

-- intrinsic type values

const false: boolean = 0;
const true: boolean = 1;

-- math

function sqrt(x: float): float {}
function abs(x): float {}  -- BLC: should be ": t"  SJD: redo with primitive?
function ceil(x: float): float {}
function min(x, y) {
  if (x < y) {
    return x;
  } else {
    return y;
  }
}
function max(x, y) {
  if (x > y) {
    return x;
  } else {
    return y;
  }
}

-- boundary classes/functions

function wrap() {}

-- reductions

class reduction {
}

class sum {
}

class max {
}

class min {
}

class maxloc {
}

class minloc {
}

-- timers

class timer {
  function start();
  function stop();
  function read(): float;
}

-- exits

pragma "rename _chpl_exit" function exit(status : integer);

function halt() {
  __primitive("halt");
}

function assert() {
  __primitive("assert");
}

-- memory tests (These tests will be moved to a module, once we have modules.)

function _chpl_memtest_printMemTable();
function _chpl_memtest_printMemStat();
function _chpl_memtest_resetMemStat();
function _chpl_memtest_allocAndFree();
function _chpl_memtest_freedMalloc();
function _chpl_memtest_freedWithoutMalloc();
function _chpl_memtest_reallocWithoutMalloc();
function _chpl_memtest_reallocZeroSize();
function _chpl_memtest_mallocOutOfMemory();
function _chpl_memtest_reallocOutOfMemory();

function startTrackingMem();

function _complex_read_hack(inout x) {
  __primitive("read", x);
}

function _complex_tostring_hack(x, format : string) : string {
  return __primitive("coerce", string, x);
}

const numLocales: integer = 1;

-- FROM INTERNAL PRELUDE

record _methodTokenType {
  var _methodTokenTypeFieldDummy : integer;
}

var _methodToken : _methodTokenType;

record _setterTokenType {
  var _setterTokenTypeFieldDummy : integer;
}

var _setterToken : _setterTokenType;

class _seq { -- this is no longer necessary
}

class Array {
  function this(i) {
    return __primitive("array_index", this, i);
  }
  function this(i, j) {
    return __primitive("array_index", this, i, j);
  }
  function this(i, j, k) {
    return __primitive("array_index", this, i, j, k);
  }
  function =this(i, x) {
    return __primitive("array_set", this, i, x);
  }
  function =this(i, j, x) {
    return __primitive("array_set", this, i, j, x);
  }
  function =this(i, j, k, x) {
    return __primitive("array_set", this, i, j, k, x);
  }
}

class Domain {
}

record Tuple {
  var _tuple_dummy_field : integer;
  function this(pragma "clone_for_constants" i) {
    return __primitive("index_object", this, i);
  }
  function =this(pragma "clone_for_constants" i, x) {
    return __primitive("set_index_object", this, i, x);
  }
}

pragma "builtin" function +(a : Array, b : Array) { return __primitive("array_pointwise_op", a, b); }
pragma "builtin" function -(a : Array, b : Array) { return __primitive("array_pointwise_op", a, b); }
pragma "builtin" function *(a : Array, b : Array) { return __primitive("array_pointwise_op", a, b); }
pragma "builtin" function /(a : Array, b : Array) { return __primitive("array_pointwise_op", a, b); }
pragma "builtin" function &(a : Array, b : Array) { return __primitive("array_pointwise_op", a, b); }
pragma "builtin" function |(a : Array, b : Array) { return __primitive("array_pointwise_op", a, b); }
pragma "builtin" function ^(a : Array, b : Array) { return __primitive("array_pointwise_op", a, b); }
pragma "builtin" function ==(a : Array, b : Array) { return __primitive("array_pointwise_op", a, b); }
pragma "builtin" function !=(a : Array, b : Array) { return __primitive("array_pointwise_op", a, b); }
pragma "builtin" function <=(a : Array, b : Array) { return __primitive("array_pointwise_op", a, b); }
pragma "builtin" function >=(a : Array, b : Array) { return __primitive("array_pointwise_op", a, b); }
pragma "builtin" function <(a : Array, b : Array) { return __primitive("array_pointwise_op", a, b); }
pragma "builtin" function >(a : Array, b : Array) { return __primitive("array_pointwise_op", a, b); }
pragma "builtin" function and(a : Array, b : Array) { return __primitive("array_pointwise_op", a, b); }
pragma "builtin" function or(a : Array, b : Array) { return __primitive("array_pointwise_op", a, b); }
pragma "builtin" function **(a : Array, b : Array) { return __primitive("array_pointwise_op", a, b); }

pragma "builtin" function -(a : numeric) { return a; } -- needs to be primitive
pragma "builtin" function +(a : numeric) { return a; } -- needs to be primitive
pragma "builtin" function ~(a : numeric) { return a; } -- needs to be primitive
pragma "builtin" function not(a : numeric) { return a; } -- needs to be primitive

pragma "builtin" function +(a : numeric, b : numeric) { return __primitive(a, "+", b); }
pragma "builtin" function -(a : numeric, b : numeric) { return __primitive(a, "-", b); }
pragma "builtin" function *(a : numeric, b : numeric) { return __primitive(a, "*", b); }
pragma "builtin" function /(a : numeric, b : numeric) { return __primitive(a, "/", b); }
pragma "builtin" function mod(a : numeric, b : numeric) { return __primitive(a, "%", b); }
pragma "builtin" function ==(a : numeric, b : numeric) { return __primitive(a, "==", b); }
pragma "builtin" function !=(a : numeric, b : numeric) { return __primitive(a, "!=", b); }
pragma "builtin" function <=(a : numeric, b : numeric) { return __primitive(a, "<=", b); }
pragma "builtin" function >=(a : numeric, b : numeric) { return __primitive(a, ">=", b); }
pragma "builtin" function <(a : numeric, b : numeric) { return __primitive(a, "<", b); }
pragma "builtin" function >(a : numeric, b : numeric) { return __primitive(a, ">", b); }
pragma "builtin" function &(a : numeric, b : numeric) { return __primitive(a, "&", b); }
pragma "builtin" function |(a : numeric, b : numeric) { return __primitive(a, "|", b); }
pragma "builtin" function ^(a : numeric, b : numeric) { return __primitive(a, "^", b); }
pragma "builtin" function and(a : numeric, b : numeric) { return __primitive(a, "&&", b); }
pragma "builtin" function or(a : numeric, b : numeric) { return __primitive(a, "||", b); }
pragma "builtin" function **(a : numeric, b : numeric) { return __primitive(a, "**", b); }
pragma "builtin" function ==(a : object, b : object) { return __primitive("ptr_eq", a, b); }
pragma "builtin" function !=(a : object, b : object) { return __primitive("ptr_neq", a, b); }

pragma "builtin" function _move(a : any, b : any);

pragma "split unique"
pragma "builtin" function =(a : numeric, b : any) {
  return __primitive("cast", a, b);
}

pragma "builtin" function =(a : string, b : any) {
  return __primitive("pure_return", string);
}

pragma "split unique"
pragma "builtin" function =(a : any, b : any) {
  return b;
}

pragma "rename _chpl_string_index"
function string.this(i : integer) {
  return __primitive("string_op", this, i);
}

pragma "rename _chpl_string_select"
function _chpl_string_select(s : string, low : integer, high : integer) {
  return __primitive("string_op", s, low, high);
}

pragma "rename _chpl_string_strided_select"
function _chpl_string_strided_select(s : string, low : integer, high : integer, stride : integer) {
  return __primitive("string_op", s, low, high, stride);
}

pragma "rename _chpl_string_concat"
function +(a : string, b : string) : string {
  return __primitive("string_op", a, b);
}

pragma "rename _chpl_string_equal"
function ==(a : string, b : string) : boolean { }

pragma "rename _chpl_string_notequal"
function !=(a : string, b : string) : boolean { }

pragma "rename _chpl_string_length"
function length(a : string) : integer {
  return __primitive("coerce", integer, a);
}

pragma "split unique"
pragma "keep types"
pragma "rename _chpl_alloc"
function _chpl_alloc(t, description:string) { return __primitive("chpl_alloc", t); }

function _init_string() { return ""; }

function _INIT_CONFIG(inout v, v_type, chapel_name, module_name);
function _INIT_ARRAY(rank, arr, dom, elt_type);
function _INIT_DOMAIN_DIM(dom, dim, lo, hi, str);

function _ArrayWriteStopgap(x) { }
function _EnumReadStopgap(x) { }
function _DomainWriteStopgap(x) { }

-- END FROM INTERNAL PRELUDE


Change compilerError to runtime halt for _ddata.writeThis

The test classes/diten/deleteobject.chpl regressed from revision 15303. Since
the _ddata class extends object, the call to writeln(obj) in this test includes
_ddata.writeThis as one of the dynamic dispatch candidates, so the error
was issued.

I changed it to a halt so it is only issued if it is actually called.

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

// class file
//
//  chapel-level implementations of read, write, writeln
//  chapel-level implementations of assert, halt

enum FileAccessMode { read, write };

//
// functions on _file primitive type, the C file pointer type
//
pragma "inline" def =(a: _file, b: _file) return b;
pragma "inline" def ==(a: _file, b: _file) return __primitive("==", a, b);
pragma "inline" def !=(a: _file, b: _file) return __primitive("!=", a, b);

pragma "inline" def _readLitChar(fp: _file, val: string, ignoreWhiteSpace: bool)
  return __primitive("_fscan_literal", fp, val, ignoreWhiteSpace);

const stdin  = new file("stdin", FileAccessMode.read, "/dev", __primitive("get_stdin"));
const stdout = new file("stdout", FileAccessMode.write, "/dev", __primitive("get_stdout"));
const stderr = new file("stderr", FileAccessMode.write, "/dev", __primitive("get_stderr"));

class file: Writer {
  var filename : string = "";
  var mode : FileAccessMode = FileAccessMode.read;
  var path : string = ".";
  var _fp : _file;
  var _lock : sync uint(64);    // for serializing output

  def open() {
    on this {
      if this == stdin || this == stdout || this == stderr then
        halt("***Error: It is not necessary to open \"", filename, "\"***");

      var fullFilename = path + "/" + filename;

      var modestring: string;
      select mode {
        when FileAccessMode.read  do modestring = "r";
        when FileAccessMode.write do modestring = "w";
      }
      _fp = __primitive("fopen", filename, modestring);

      if _fp == __primitive("get_nullfile") {
        const err = __primitive("get_errno");
        halt("***Error: Unable to open \"", fullFilename, "\": ", err, "***");
      }
    }
  }

  def _checkFileStateChangeLegality(state) {
    if (isOpen) {
      halt("Cannot change ", state, " of file ", path, "/", filename,
           " while it is open");
    }
  }

  def filename var : string {
    if setter then
      _checkFileStateChangeLegality("filename");
    return filename;
  }

  def path var : string {
    if setter then
      _checkFileStateChangeLegality("path");
    return path;
  }

  def mode var {
    if setter then
      _checkFileStateChangeLegality("mode");
    return mode;
  }

  def isOpen: bool {
    var openStatus: bool = false;
    if (_fp != __primitive("get_nullfile")) {
      openStatus = true;
    }
    return openStatus;
  }

  def close() {
    on this {
      if (this == stdin || this == stdout || this == stderr) {
        halt("***Error: You may not close \"", filename, "\"***");
      }
      if (_fp == __primitive("get_nullfile")) {
        var fullFilename = path + "/" + filename;
        halt("***Error: Trying to close \"", fullFilename,
             "\" which isn't open***");
      }
      var returnVal: int = __primitive("fclose", _fp);
      if (returnVal < 0) {
        var fullFilename = path + "/" + filename;
        const err = __primitive("get_errno");
        halt("***Error: The close of \"", fullFilename, "\" failed: ", err,
             "***");
      }
      _fp = __primitive("get_nullfile");
    }
  }
}

def file.writeThis(f: Writer) {
  f.write("(filename = ",this.filename);
  f.write(", path = ",this.path);
  f.write(", mode = ",this.mode);
  f.write(")");
}

def file.flush() {
  on this do __primitive("fflush", _fp);
}

def _checkOpen(f: file, isRead: bool) {
  if !f.isOpen {
    var fullFilename:string = f.path + "/" + f.filename;
    if isRead {
      halt("***Error: You must open \"", fullFilename,
           "\" before trying to read from it***");
    } else {
      halt("***Error: You must open \"", fullFilename,
           "\" before trying to write to it***");
    }
  }
}

def file.readln() {
  on this {
    if !isOpen then
      _checkOpen(this, isRead=true);
    __primitive("_readToEndOfLine",_fp);
  }
}

def file.readln(inout list ...?n) {
  read((...list));
  on this {
    __primitive("_readToEndOfLine",_fp);
  }
}

def file.readln(type t) {
  var val: t;
  this.readln(val);
  return val;
}

def file.read(inout first, inout rest ...?n) {
  read(first);
  for param i in 1..n do
    read(rest(i));
}

def file.read(inout val: int) {
  if !isOpen then
    _checkOpen(this, isRead=true);
  var x: int;
  on this {
    x = __primitive("_fscan_int32", _fp);
  }
  val = x;
}

def file.read(inout val: uint) {
  if !isOpen then
    _checkOpen(this, isRead=true);
  var x: uint;
  on this {
    x = __primitive("_fscan_uint32", _fp);
  }
  val = x;
}

def file.read(inout val: real) {
  if !isOpen then
    _checkOpen(this, isRead=true);
  var x: real;
  on this {
    x = __primitive("_fscan_real64", _fp);
  }
  val = x;
}

def file.read(inout val: complex) {
  var realPart: real;
  var imagPart: real;
  var imagI: string;
  var matchingCharWasRead: int;
  var isNeg: bool;

  read(realPart);
  on this {
    matchingCharWasRead = _readLitChar(_fp, "+", true);
  }
  if (matchingCharWasRead != 1) {
    on this {
      matchingCharWasRead = _readLitChar(_fp, "-", true);
    }
    if (matchingCharWasRead != 1) {
      halt("***Error: Incorrect format for complex numbers***");
    }
    isNeg = true;
  }

  read(imagPart);
  on this {
    matchingCharWasRead = _readLitChar(_fp, "i", false);
  }
  if (matchingCharWasRead != 1) {
    halt("***Error: Incorrect format for complex numbers***");
  }

  val.re = realPart;
  if (isNeg) {
    val.im = -imagPart;
  } else {
    val.im = imagPart;
  }
}

def file.read(inout val: string) {
  if !isOpen then
    _checkOpen(this, isRead=true);
  var x: string;
  on this {
    x = __primitive("_fscan_string", _fp);
  }
  val = x;
}

def file.read(inout val: bool) {
  var s: string;
  this.read(s);
  if (s == "true") {
    val = true;
  } else if (s == "false") {
    val = false;
  } else {
    halt("read of bool value that is neither true nor false");
  }
}

def file.read(type t) {
  var val: t;
  this.read(val);
  return val;
}

def string.writeThis(f: Writer) {
  f.writeIt(this);
}

def file.writeIt(s: string) {
  if !isOpen then
    _checkOpen(this, isRead = false);
  if mode != FileAccessMode.write then
    halt("***Error: ", path, "/", filename, " not open for writing***");
  var status = __primitive("fprintf", _fp, "%s", s);
  if status < 0 {
    const err = __primitive("get_errno");
    halt("***Error: Write failed: ", err, "***");
  }
}

class StringClass: Writer {
  var s: string;
  def writeIt(s: string) { this.s += s; }
}

pragma "ref this" pragma "dont disable remote value forwarding"
def string.write(args ...?n) {
  var sc = new StringClass(this);
  sc.write((...args));
  this = sc.s;
  delete sc;
}

def file.lockWrite() {
  var me: uint(64) = __primitive("thread_id");
  if _lock.isFull then
    if _lock.readXX() == me then
      return false;
  _lock = me;
  return true;
}

def file.unlockWrite() {
  _lock.reset();
}

class Writer {
  def writeIt(s: string) { }
  def lockWrite() return false;
  def unlockWrite() { }
  def write(args ...?n) {
    def isNilObject(val) {
      def helper(o: object) return o == nil;
      def helper(o)         return false;
      return helper(val);
    }

    on this {
      var need_release: bool;
      need_release = lockWrite();
      for param i in 1..n do
        if isNilObject(args(i)) then
          "nil".writeThis(this);
        else
          args(i).writeThis(this);
      if need_release then
        unlockWrite();
    }
  }
  def writeln(args ...?n) {
    write((...args), "\n");
  }
  def writeln() {
    write("\n");
  }
}

def write(args ...?n) {
  stdout.write((...args));
  stdout.flush();
}

def writeln(args ...?n) {
  stdout.writeln((...args));
}

def writeln() {
  stdout.writeln();
}

def read(inout args ...?n) {
  stdin.read((...args));
}

def readln(inout args ...?n) {
  stdin.readln((...args));
}

def readln() {
  stdin.readln();
}

def readln(type t) {
  return stdin.readln(t);
}

def read(type t)
  return stdin.read(t);

def file.readln(type t ...?numTypes) where numTypes > 1 {
  var tupleVal: t;
  for param i in 1..numTypes-1 do
    tupleVal(i) = this.read(t(i));
  tupleVal(numTypes) = this.readln(t(numTypes));
  return tupleVal;
}

def file.read(type t ...?numTypes) where numTypes > 1 {
  var tupleVal: t;
  for param i in 1..numTypes do
    tupleVal(i) = this.read(t(i));
  return tupleVal;
}

def readln(type t ...?numTypes) where numTypes > 1
  return stdin.readln((...t));

def read(type t ...?numTypes) where numTypes > 1
  return stdin.read((...t));

def _tuple2string(t) {
  var s: string;
  for param i in 1..t.size do
    s.write(t(i));
  return s;
}

def assert(test: bool) {
  if !test then
    __primitive("chpl_error", "assert failed");
}

def assert(test: bool, args ...?numArgs) {
  if !test then
    __primitive("chpl_error", "assert failed - "+_tuple2string(args));
}

def halt() {
  __primitive("chpl_error", "halt reached");
}

def halt(args ...?numArgs) {
  __primitive("chpl_error", "halt reached - "+_tuple2string(args));
}

def _debugWrite(args: string ...?n) {
  for param i in 1..n {
    var status = __primitive("fprintf", __primitive("get_stdout"), "%s", args(i));
    if status < 0 {
      const err = __primitive("get_errno");
      halt("_debugWrite failed with status ", err);
    }
  }
  __primitive("fflush", __primitive("get_stdout"));
}

def _debugWriteln(args: string ...?n) {
  _debugWrite((...args), "\n");
}

def _debugWriteln() {
  _debugWrite("\n");
}

def _ddata.writeThis(f: Writer) {
  halt("cannot write the _ddata class");
}

def format(fmt: string, x:?t) where _isIntegralType(t) || _isFloatType(t) {
  if fmt.substring(1) == "#" {
    var fmt2 = _getoutputformat(fmt);
    if _isImagType(t) then
      return (__primitive("_format", fmt2, _i2r(x))+"i");
    else
      return __primitive("_format", fmt2, x:real);
  } else
    return __primitive("_format", fmt, x);
}

def format(fmt: string, x:?t) where _isComplexType(t) {
  if fmt.substring(1) == "#" {
    var fmt2 = _getoutputformat(fmt);
    return (__primitive("_format", fmt2, x.re)+" + "+ __primitive("_format", fmt2, x.im)+"i");
  } else
    return __primitive("_format", fmt, x);
}

def format(fmt: string, x: ?t) where !(_isIntegralType(t) || _isFloatType(t) || _isComplexType(t)) {
  return __primitive("_format", fmt, x);
}

def _getoutputformat(s: string):string {
  var sn = length(s);
  var afterdot = false;
  var dplaces = 0;
  for i in 1..sn {
    if ((s.substring(i) == '#') & afterdot) then dplaces += 1;
    if (s.substring(i) == '.') then afterdot=true;
  }

  return("%" + sn + "." + dplaces + "f");
}

// class file
//
//  chapel-level implementations of read, write, writeln
//  chapel-level implementations of assert, halt

enum FileAccessMode { read, write };

//
// functions on _file primitive type, the C file pointer type
//
pragma "inline" def =(a: _file, b: _file) return b;
pragma "inline" def ==(a: _file, b: _file) return __primitive("==", a, b);
pragma "inline" def !=(a: _file, b: _file) return __primitive("!=", a, b);

pragma "inline" def _readLitChar(fp: _file, val: string, ignoreWhiteSpace: bool)
  return __primitive("_fscan_literal", fp, val, ignoreWhiteSpace);

const stdin  = new file("stdin", FileAccessMode.read, "/dev", __primitive("get_stdin"));
const stdout = new file("stdout", FileAccessMode.write, "/dev", __primitive("get_stdout"));
const stderr = new file("stderr", FileAccessMode.write, "/dev", __primitive("get_stderr"));

class file: Writer {
  var filename : string = "";
  var mode : FileAccessMode = FileAccessMode.read;
  var path : string = ".";
  var _fp : _file;
  var _lock : sync uint(64);    // for serializing output

  def open() {
    on this {
      if this == stdin || this == stdout || this == stderr then
        halt("***Error: It is not necessary to open \"", filename, "\"***");

      var fullFilename = path + "/" + filename;

      var modestring: string;
      select mode {
        when FileAccessMode.read  do modestring = "r";
        when FileAccessMode.write do modestring = "w";
      }
      _fp = __primitive("fopen", filename, modestring);

      if _fp == __primitive("get_nullfile") {
        const err = __primitive("get_errno");
        halt("***Error: Unable to open \"", fullFilename, "\": ", err, "***");
      }
    }
  }

  def _checkFileStateChangeLegality(state) {
    if (isOpen) {
      halt("Cannot change ", state, " of file ", path, "/", filename,
           " while it is open");
    }
  }

  def filename var : string {
    if setter then
      _checkFileStateChangeLegality("filename");
    return filename;
  }

  def path var : string {
    if setter then
      _checkFileStateChangeLegality("path");
    return path;
  }

  def mode var {
    if setter then
      _checkFileStateChangeLegality("mode");
    return mode;
  }

  def isOpen: bool {
    var openStatus: bool = false;
    if (_fp != __primitive("get_nullfile")) {
      openStatus = true;
    }
    return openStatus;
  }

  def close() {
    on this {
      if (this == stdin || this == stdout || this == stderr) {
        halt("***Error: You may not close \"", filename, "\"***");
      }
      if (_fp == __primitive("get_nullfile")) {
        var fullFilename = path + "/" + filename;
        halt("***Error: Trying to close \"", fullFilename,
             "\" which isn't open***");
      }
      var returnVal: int = __primitive("fclose", _fp);
      if (returnVal < 0) {
        var fullFilename = path + "/" + filename;
        const err = __primitive("get_errno");
        halt("***Error: The close of \"", fullFilename, "\" failed: ", err,
             "***");
      }
      _fp = __primitive("get_nullfile");
    }
  }
}

def file.writeThis(f: Writer) {
  f.write("(filename = ",this.filename);
  f.write(", path = ",this.path);
  f.write(", mode = ",this.mode);
  f.write(")");
}

def file.flush() {
  on this do __primitive("fflush", _fp);
}

def _checkOpen(f: file, isRead: bool) {
  if !f.isOpen {
    var fullFilename:string = f.path + "/" + f.filename;
    if isRead {
      halt("***Error: You must open \"", fullFilename,
           "\" before trying to read from it***");
    } else {
      halt("***Error: You must open \"", fullFilename,
           "\" before trying to write to it***");
    }
  }
}

def file.readln() {
  on this {
    if !isOpen then
      _checkOpen(this, isRead=true);
    __primitive("_readToEndOfLine",_fp);
  }
}

def file.readln(inout list ...?n) {
  read((...list));
  on this {
    __primitive("_readToEndOfLine",_fp);
  }
}

def file.readln(type t) {
  var val: t;
  this.readln(val);
  return val;
}

def file.read(inout first, inout rest ...?n) {
  read(first);
  for param i in 1..n do
    read(rest(i));
}

def file.read(inout val: int) {
  if !isOpen then
    _checkOpen(this, isRead=true);
  var x: int;
  on this {
    x = __primitive("_fscan_int32", _fp);
  }
  val = x;
}

def file.read(inout val: uint) {
  if !isOpen then
    _checkOpen(this, isRead=true);
  var x: uint;
  on this {
    x = __primitive("_fscan_uint32", _fp);
  }
  val = x;
}

def file.read(inout val: real) {
  if !isOpen then
    _checkOpen(this, isRead=true);
  var x: real;
  on this {
    x = __primitive("_fscan_real64", _fp);
  }
  val = x;
}

def file.read(inout val: complex) {
  var realPart: real;
  var imagPart: real;
  var imagI: string;
  var matchingCharWasRead: int;
  var isNeg: bool;

  read(realPart);
  on this {
    matchingCharWasRead = _readLitChar(_fp, "+", true);
  }
  if (matchingCharWasRead != 1) {
    on this {
      matchingCharWasRead = _readLitChar(_fp, "-", true);
    }
    if (matchingCharWasRead != 1) {
      halt("***Error: Incorrect format for complex numbers***");
    }
    isNeg = true;
  }

  read(imagPart);
  on this {
    matchingCharWasRead = _readLitChar(_fp, "i", false);
  }
  if (matchingCharWasRead != 1) {
    halt("***Error: Incorrect format for complex numbers***");
  }

  val.re = realPart;
  if (isNeg) {
    val.im = -imagPart;
  } else {
    val.im = imagPart;
  }
}

def file.read(inout val: string) {
  if !isOpen then
    _checkOpen(this, isRead=true);
  var x: string;
  on this {
    x = __primitive("_fscan_string", _fp);
  }
  val = x;
}

def file.read(inout val: bool) {
  var s: string;
  this.read(s);
  if (s == "true") {
    val = true;
  } else if (s == "false") {
    val = false;
  } else {
    halt("read of bool value that is neither true nor false");
  }
}

def file.read(type t) {
  var val: t;
  this.read(val);
  return val;
}

def string.writeThis(f: Writer) {
  f.writeIt(this);
}

def file.writeIt(s: string) {
  if !isOpen then
    _checkOpen(this, isRead = false);
  if mode != FileAccessMode.write then
    halt("***Error: ", path, "/", filename, " not open for writing***");
  var status = __primitive("fprintf", _fp, "%s", s);
  if status < 0 {
    const err = __primitive("get_errno");
    halt("***Error: Write failed: ", err, "***");
  }
}

class StringClass: Writer {
  var s: string;
  def writeIt(s: string) { this.s += s; }
}

pragma "ref this" pragma "dont disable remote value forwarding"
def string.write(args ...?n) {
  var sc = new StringClass(this);
  sc.write((...args));
  this = sc.s;
  delete sc;
}

def file.lockWrite() {
  var me: uint(64) = __primitive("thread_id");
  if _lock.isFull then
    if _lock.readXX() == me then
      return false;
  _lock = me;
  return true;
}

def file.unlockWrite() {
  _lock.reset();
}

class Writer {
  def writeIt(s: string) { }
  def lockWrite() return false;
  def unlockWrite() { }
  def write(args ...?n) {
    def isNilObject(val) {
      def helper(o: object) return o == nil;
      def helper(o)         return false;
      return helper(val);
    }

    on this {
      var need_release: bool;
      need_release = lockWrite();
      for param i in 1..n do
        if isNilObject(args(i)) then
          "nil".writeThis(this);
        else
          args(i).writeThis(this);
      if need_release then
        unlockWrite();
    }
  }
  def writeln(args ...?n) {
    write((...args), "\n");
  }
  def writeln() {
    write("\n");
  }
}

def write(args ...?n) {
  stdout.write((...args));
  stdout.flush();
}

def writeln(args ...?n) {
  stdout.writeln((...args));
}

def writeln() {
  stdout.writeln();
}

def read(inout args ...?n) {
  stdin.read((...args));
}

def readln(inout args ...?n) {
  stdin.readln((...args));
}

def readln() {
  stdin.readln();
}

def readln(type t) {
  return stdin.readln(t);
}

def read(type t)
  return stdin.read(t);

def file.readln(type t ...?numTypes) where numTypes > 1 {
  var tupleVal: t;
  for param i in 1..numTypes-1 do
    tupleVal(i) = this.read(t(i));
  tupleVal(numTypes) = this.readln(t(numTypes));
  return tupleVal;
}

def file.read(type t ...?numTypes) where numTypes > 1 {
  var tupleVal: t;
  for param i in 1..numTypes do
    tupleVal(i) = this.read(t(i));
  return tupleVal;
}

def readln(type t ...?numTypes) where numTypes > 1
  return stdin.readln((...t));

def read(type t ...?numTypes) where numTypes > 1
  return stdin.read((...t));

def _tuple2string(t) {
  var s: string;
  for param i in 1..t.size do
    s.write(t(i));
  return s;
}

def assert(test: bool) {
  if !test then
    __primitive("chpl_error", "assert failed");
}

def assert(test: bool, args ...?numArgs) {
  if !test then
    __primitive("chpl_error", "assert failed - "+_tuple2string(args));
}

def halt() {
  __primitive("chpl_error", "halt reached");
}

def halt(args ...?numArgs) {
  __primitive("chpl_error", "halt reached - "+_tuple2string(args));
}

def _debugWrite(args: string ...?n) {
  for param i in 1..n {
    var status = __primitive("fprintf", __primitive("get_stdout"), "%s", args(i));
    if status < 0 {
      const err = __primitive("get_errno");
      halt("_debugWrite failed with status ", err);
    }
  }
  __primitive("fflush", __primitive("get_stdout"));
}

def _debugWriteln(args: string ...?n) {
  _debugWrite((...args), "\n");
}

def _debugWriteln() {
  _debugWrite("\n");
}

def _ddata.writeThis(f: Writer) {
  compilerError("cannot write _ddata class");
}

def format(fmt: string, x:?t) where _isIntegralType(t) || _isFloatType(t) {
  if fmt.substring(1) == "#" {
    var fmt2 = _getoutputformat(fmt);
    if _isImagType(t) then
      return (__primitive("_format", fmt2, _i2r(x))+"i");
    else
      return __primitive("_format", fmt2, x:real);
  } else
    return __primitive("_format", fmt, x);
}

def format(fmt: string, x:?t) where _isComplexType(t) {
  if fmt.substring(1) == "#" {
    var fmt2 = _getoutputformat(fmt);
    return (__primitive("_format", fmt2, x.re)+" + "+ __primitive("_format", fmt2, x.im)+"i");
  } else
    return __primitive("_format", fmt, x);
}

def format(fmt: string, x: ?t) where !(_isIntegralType(t) || _isFloatType(t) || _isComplexType(t)) {
  return __primitive("_format", fmt, x);
}

def _getoutputformat(s: string):string {
  var sn = length(s);
  var afterdot = false;
  var dplaces = 0;
  for i in 1..sn {
    if ((s.substring(i) == '#') & afterdot) then dplaces += 1;
    if (s.substring(i) == '.') then afterdot=true;
  }

  return("%" + sn + "." + dplaces + "f");
}