Correct typo "param" --> "return".

Correct typo "param" --> "return".

/*
 * 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 provides wrappers for <cmath> (math.h) numerical constants and
routines.  Its symbols are provided by default; an explicit 'use' statement
is not necessary.

The C Math library is part of the C Language Standard (ISO/IEC 9899), as
described in Section 7.12.  Please consult that standard for an
authoritative description of the expected properties of those constants and
routines.

In general, where the C math library provides a *double* and a *float* version
of a function, the float version has a suffix 'f'.  In the Chapel interface,
the suffix is dropped, and the type of the operand determines which version is
called -- according to the usual function overloading and resolution rules.
Normally, the result has the same precision
as the argument(s).  Please consult the C standard for specifics.

Rounding -- The rounding mode for floating-point addition (subtraction) is
implementation-defined.

Error Handling -- At present, Chapel does not provide control over error
handling in the Math module.  The default behavior is as if the macro
``math_errhandling`` is set to 0: Given erroneous input at run-time,
all math functions will return an implementation-defined value; no
exception will be generated.

*/
module Math {

  //////////////////////////////////////////////////////////////////////////
  // Helper constants and functions (not included in chpldocs).
  //
  pragma "no doc"
  extern proc chpl_macro_INFINITY():real(64);
  pragma "no doc"
  extern proc chpl_macro_NAN():real(64);

  pragma "no doc"
  extern proc chpl_macro_double_isinf(x: real(64)): c_int;
  pragma "no doc"
  extern proc chpl_macro_float_isinf(x: real(32)): c_int;
  pragma "no doc"
  extern proc chpl_macro_double_isfinite(x: real(64)): c_int;
  pragma "no doc"
  extern proc chpl_macro_float_isfinite(x: real(32)): c_int;
  pragma "no doc"
  extern proc chpl_macro_double_isnan(x: real(64)): c_int;
  pragma "no doc"
  extern proc chpl_macro_float_isnan(x: real(32)): c_int;

  pragma "no doc"
  extern proc fabs(x: real(64)): real(64);

  pragma "no doc"
  proc _logBasePow2Help(in val, baseLog2) {
    var result = -1;
    while (val != 0) {
      val >>= baseLog2;
      result += 1;
    }
    return result;
  }

  pragma "no doc"
  proc logBasePow2(in val: int(?w), baseLog2) {
    if (val < 1) {
      halt("Can't take the log() of a non-positive integer");
    }
    return _logBasePow2Help(val, baseLog2);
  }

  pragma "no doc"
  proc logBasePow2(in val: uint(?w), baseLog2) {
    if (val < 1) {
      halt("Can't take the log() of a non-positive integer");
    }
    return _logBasePow2Help(val, baseLog2);
  }
  //
  //////////////////////////////////////////////////////////////////////////

  //////////////////////////////////////////////////////////////////////////
  //
  // Public interface (included in chpldocs).
  //
  // (The entries below are alphabetized (case-insensitively) because chpldocs
  // presents them in declaration order.)
  //

  /* Returns the absolute value of the integer argument.

     :rtype: The type of `i`.
  */
  inline proc abs(i : int(?w)) return if i < 0 then -i else i;

  /* Returns the absolute value of the unsigned integer argument.

     :rtype: The type of `i`.
  */
  inline proc abs(i : uint(?w)) return i;

  /* Returns the absolute value of the integer param argument `i`. */
  proc abs(param i : integral) param return if i < 0 then -i else i;

  /* Returns the magnitude of the real argument `r`. */
  inline proc abs(r : real(64)):real(64) return fabs(r);

  /* Returns the magnitude of the real argument `x`. */
  inline proc abs(x : real(32)): real(32) {
    extern proc fabsf(x: real(32)): real(32);
    return fabsf(x);
  }

  /* Returns the real magnitude of the imaginary argument `im`. */
  inline proc abs(im : imag(64)): real(64) return fabs(_i2r(im));

  /* Returns the real magnitude of the imaginary argument `im`. */
  inline proc abs(im: imag(32)): real(32) {
    extern proc fabsf(x: real(32)): real(32);
    return fabsf(_i2r(im));
  }

  /* Returns the real magnitude of the complex argument `x`.

     :rtype: The type of the real component of the argument (== `w`/2).
  */
  inline proc abs(x : complex(?w)) return sqrt(x.re*x.re + x.im*x.im);

  /* Returns the arc cosine of the argument `x`.

     It is an error if `x` is less than -1 or greater than 1.
  */
  extern proc acos(x: real(64)): real(64);

  /* Returns the arc cosine of the argument `x`.

     It is an error if `x` is less than -1 or greater than 1.
  */
  inline proc acos(x : real(32)): real(32) {
    extern proc acosf(x: real(32)): real(32);
    return acosf(x);
  }

  /* Returns the inverse hyperbolic cosine of the argument `x`.

     It is an error if `x` is less than 1.
  */
  extern proc acosh(x: real(64)): real(64);

  /* Returns the inverse hyperbolic cosine of the argument `x`.

     It is an error if `x` is less than 1.
  */
  inline proc acosh(x : real(32)): real(32) {
    extern proc acoshf(x: real(32)): real(32);
    return acoshf(x);
  }

  /* Returns the arc sine of the argument `x`.

     It is an error if `x` is less than -1 or greater than 1.
  */
  extern proc asin(x: real(64)): real(64);

  /* Returns the arc sine of the argument `x`.

     It is an error if `x` is less than -1 or greater than 1.
  */
  inline proc asin(x : real(32)): real(32) {
    extern proc asinf(x: real(32)): real(32);
    return asinf(x);
  }

  /* Returns the inverse hyperbolic sine of the argument `x`. */
  extern proc asinh(x: real(64)): real(64);

  /* Returns the inverse hyperbolic sine of the argument `x`. */
  inline proc asinh(x : real(32)): real(32) {
    extern proc asinhf(x: real(32)): real(32);
    return asinhf(x);
  }

  /* Returns the arc tangent of the argument `x`. */
  extern proc atan(x: real(64)): real(64);

  /* Returns the arc tangent of the argument `x`. */
  inline proc atan(x : real(32)): real(32) {
    extern proc atanf(x: real(32)): real(32);
    return atanf(x);
  }

  /* Returns the arc tangent of the ratio of the two arguments.

     This is equivalent to
     the arc tangent of `y` / `x` except that the signs of `y`
     and `x` are used to determine the quadrant of the result. */
  extern proc atan2(y: real(64), x: real(64)): real(64);

  /* Returns the arc tangent of the two arguments.

     This is equivalent to
     the arc tangent of `y` / `x` except that the signs of `y`
     and `x` are used to determine the quadrant of the result. */
  inline proc atan2(y : real(32), x: real(32)): real(32) {
    extern proc atan2f(y: real(32), x: real(32)): real(32);
    return atan2f(y, x);
  }

  /* Returns the inverse hyperbolic tangent of the argument `x`.

     It is an error if `x` is less than -1 or greater than 1. */
  extern proc atanh(x: real(64)): real(64);

  /* Returns the inverse hyperbolic tangent of the argument `x`.

     It is an error if `x` is less than -1 or greater than 1. */
  inline proc atanh(x : real(32)): real(32) {
    extern proc atanhf(x: real(32)): real(32);
    return atanhf(x);
  }

  /* Returns the cube root of the argument `x`. */
  extern proc cbrt(x: real(64)): real(64);

  /* Returns the cube root of the argument `x`. */
  inline proc cbrt(x : real(32)): real(32) {
    extern proc cbrtf(x: real(32)): real(32);
    return cbrtf(x);
  }

  /* Returns the value of the argument `x` rounded up to the nearest integer. */
  extern proc ceil(x: real(64)): real(64);

  /* Returns the value of the argument `x` rounded up to the nearest integer. */
  inline proc ceil(x : real(32)): real(32) {
    extern proc ceilf(x: real(32)): real(32);
    return ceilf(x);
  }

  /* Returns the complex conjugate of the argument `a`.

     :rtype: The type of `a`.
  */
  inline proc conjg(a: complex(?w)) : complex(w) return (a.re, -a.im):complex(w);

  /* Returns the cosine of the argument `x`. */
  extern proc cos(x: real(64)): real(64);

  /* Returns the cosine of the argument `x`. */
  inline proc cos(x : real(32)): real(32) {
    extern proc cosf(x: real(32)): real(32);
    return cosf(x);
  }

  /* Returns the hyperbolic cosine of the argument `x`. */
  extern proc cosh(x: real(64)): real(64);

  /* Returns the hyperbolic cosine of the argument `x`. */
  inline proc cosh(x : real(32)): real(32) {
    extern proc coshf(x: real(32)): real(32);
    return coshf(x);
  }

  /* Returns :proc:`ceil`\(`m`/`n`),
     i.e., the fraction `m`/`n` rounded up to the nearest integer.

     If the arguments are of unsigned type, then
     fewer condititionals will be evaluated at run time.
  */
  proc divceil(param m: integral, param n: integral) param return
    if isNonnegative(m) then
      if isNonnegative(n) then (m + n - 1) / n
      else                     m / n
    else
      if isNonnegative(n) then m / n
      else                     (m + n + 1) / n;

  /* Returns :proc:`ceil`\(`m`/`n`),
     i.e., the fraction `m`/`n` rounded up to the nearest integer.

     If the arguments are of unsigned type, then
     fewer condititionals will be evaluated at run time.
  */
  proc divceil(m: integral, n: integral) return
    if isNonnegative(m) then
      if isNonnegative(n) then (m + n - 1) / n
      else                     m / n
    else
      if isNonnegative(n) then m / n
      else                     (m + n + 1) / n;

  /* Returns :proc:`floor`\(`m`/`n`),
     i.e., the fraction `m`/`n` rounded down to the nearest integer.

     If the arguments are of unsigned type, then
     fewer condititionals will be evaluated at run time.
  */
  proc divfloor(param m: integral, param n: integral) param return
    if isNonnegative(m) then
      if isNonnegative(n) then m / n
      else                     (m - n - 1) / n
    else
      if isNonnegative(n) then (m - n + 1) / n
      else                     m / n;

  /* Returns :proc:`floor`\(`m`/`n`),
     i.e., the fraction `m`/`n` rounded down to the nearest integer.

     If the arguments are of unsigned type, then
     fewer condititionals will be evaluated at run time.
  */
  proc divfloor(m: integral, n: integral) return
    if isNonnegative(m) then
      if isNonnegative(n) then m / n
      else                     (m - n - 1) / n
    else
      if isNonnegative(n) then (m - n + 1) / n
      else                     m / n;

  /* Returns the error function of the argument `x`. */
  extern proc erf(x: real(64)): real(64);

  /* Returns the error function of the argument `x`. */
  inline proc erf(x : real(32)): real(32) {
    extern proc erff(x: real(32)): real(32);
    return erff(x);
  }

  /* Returns the complementary error function of the argument.
     This is equivalent to 1.0 - :proc:`erf`\(`x`).
  */
  extern proc erfc(x: real(64)): real(64);

  /* Returns the complementary error function of the argument.
     This is equivalent to 1.0 - :proc:`erf`\(`x`).
  */
  inline proc erfc(x : real(32)): real(32) {
    extern proc erfcf(x: real(32)): real(32);
    return erfcf(x);
  }

  /* Returns the value of the Napierien `e` raised to the power of the argument `x`. */
  extern proc exp(x: real(64)): real(64);

  /* Returns the value of the Napierien `e` raised to the power of the argument. */
  inline proc exp(x : real(32)): real(32) {
    extern proc expf(x: real(32)): real(32);
    return expf(x);
  }

  /* Returns the value of `2` raised to the power of the argument `x`. */
  extern proc exp2(x: real(64)): real(64);

  /* Returns the value of `2` raised to the power of the argument `x`. */
  inline proc exp2(x : real(32)): real(32) {
    extern proc exp2f(x: real(32)): real(32);
    return exp2f(x);
  }

  /* Returns one less than the value of the Napierien `e` raised to the power
     of the argument `x`. */
  extern proc expm1(x: real(64)): real(64);

  /* Returns one less than the value of the Napierien `e` raised to the power
     of the argument `x`. */
  inline proc expm1(x : real(32)): real(32) {
    extern proc expm1f(x: real(32)): real(32);
    return expm1f(x);
  }

  /* Returns the value of the argument `x` rounded down to the nearest integer. */
  extern proc floor(x: real(64)): real(64);

  /* Returns the value of the argument `x` rounded down to the nearest integer. */
  inline proc floor(x : real(32)): real(32) {
    extern proc floorf(x: real(32)): real(32);
    return floorf(x);
  }

  /* Returns a value for which :proc:`isinf` will return `true`. */
  inline proc INFINITY: real(64) return chpl_macro_INFINITY();

  /* Returns `true` if the argument `x` is a representation of a finite value;
     `false` otherwise. */
  inline proc isfinite(x: real(64)): bool return chpl_macro_double_isfinite(x):bool;

  /* Returns `true` if the argument `x` is a representation of a finite value;
     `false` otherwise. */
  inline proc isfinite(x: real(32)): bool return chpl_macro_float_isfinite(x):bool;

  /* Returns `true` if the argument `x` is a representation of *infinity*;
     `false` otherwise. */
  inline proc isinf(x: real(64)): bool return chpl_macro_double_isinf(x):bool;

  /* Returns `true` if the argument `x` is a representation of *infinity*;
     `false` otherwise. */
  inline proc isinf(x: real(32)): bool return chpl_macro_float_isinf(x):bool;

  /* Returns `true` if the argument `x` does not represent a valid number;
     `false` otherwise. */
  inline proc isnan(x: real(64)): bool return chpl_macro_double_isnan(x):bool;

  /* Returns `true` if the argument `x` does not represent a valid number;
     `false` otherwise. */
  inline proc isnan(x: real(32)): bool return chpl_macro_float_isnan(x):bool;

  /* Returns the natural logarithm of the absolute value
     of the gamma function of the argument `x`.
  */
  extern proc lgamma(x: real(64)): real(64);

  /* Returns the natural logarithm of the absolute value
     of the gamma function of the argument `x`.
  */
  inline proc lgamma(x : real(32)): real(32) {
    extern proc lgammaf(x: real(32)): real(32);
    return lgammaf(x);
  }

  /* Returns the natural logarithm of the argument `x`.

     It is an error if `x` is less than or equal to zero.
  */
  extern proc log(x: real(64)): real(64);

  /* Returns the natural logarithm of the argument `x`.

     It is an error if `x` is less than or equal to zero.
  */
  inline proc log(x : real(32)): real(32) {
    extern proc logf(x: real(32)): real(32);
    return logf(x);
  }

  /* Returns the base 10 logarithm of the argument `x`.

     It is an error if `x` is less than or equal to zero.
  */
  extern proc log10(x: real(64)): real(64);

  /* Returns the base 10 logarithm of the argument `x`.

     It is an error if `x` is less than or equal to zero.
  */
  inline proc log10(x : real(32)): real(32) {
    extern proc log10f(x: real(32)): real(32);
    return log10f(x);
  }

  /* Returns the natural logarithm of `x` + 1.

     It is an error if `x` is less than or equal to -1.
  */
  extern proc log1p(x: real(64)): real(64);

  /* Returns the natural logarithm of `x` + 1.

     It is an error if `x` is less than or equal to -1.
  */
  inline proc log1p(x : real(32)): real(32) {
    extern proc log1pf(x: real(32)): real(32);
    return log1pf(x);
  }

  /* Returns the base 2 logarithm of the argument `x`.

     It is an error if `x` is less than or equal to zero.
  */
  extern proc log2(x: real(64)): real(64);

  /* Returns the base 2 logarithm of the argument `x`.

     It is an error if `x` is less than or equal to zero.
  */
  inline proc log2(x : real(32)): real(32) {
    extern proc log2f(x: real(32)): real(32);
    return log2f(x);
  }

  /* Returns the base 2 logarithm of the argument `x`.

     :rtype: `int(64)`

     It is an error if `x` is less than or equal to zero.
  */
  proc log2(in val: int(?w)) {
    return logBasePow2(val, 1);
  }

  /* Returns the base 2 logarithm of the argument `x`.

     :rtype: `int(64)`

     It is an error if `x` is less than or equal to zero.
  */
  proc log2(in val: uint(?w)) {
    return logBasePow2(val, 1);
  }

  /* Computes the mod operator on the two arguments, defined as
     ``mod(x,y) = x - y * floor(x / y)``.
  */
  proc mod(param m: integral, param n: integral) param {
    param temp = m % n;

    // verbatim copy from the other 'mod', to simplify maintenance
    return
      if isNonnegative(n) then
        if isUintType(m.type)
        then temp
        else ( if temp >= 0 then temp else temp + n )
      else
        // n < 0
        ( if temp <= 0 then temp else temp + n );
  }

  /* Computes the mod operator on the two arguments, defined as
     ``mod(x,y) = x - y * floor(x / y)``.

     If the arguments are of unsigned type, then
     fewer condititionals will be evaluated at run time.
  */
  proc mod(m: integral, n: integral) {
    const temp = m % n;

    // eliminate some run-time tests if input(s) is(are) unsigned
    return
      if isNonnegative(n) then
        if isUintType(m.type)
        then temp
        else ( if temp >= 0 then temp else temp + n )
      else
        // n < 0
        ( if temp <= 0 then temp else temp + n );
  }

  /* Computes the mod operator on the two numbers, defined as
     ``mod(x,y) = x - y * floor(x / y)``.

     The return value has the same type as `x`.
  */
  proc mod(x: real(?w), y: real(w)): real(w) {
    // This codes up the standard definition, according to Wikipedia.
    // Is there a more efficient implementation for reals?
    return x - y*floor(x/y);
  }

  /* Returns a value for which :proc:`isnan` will return `true`. */
  inline proc NAN : real(64) return chpl_macro_NAN();

  /* Returns the rounded integral value of the argument `x` determined by the
     current rounding direction.  :proc:`nearbyint` will not raise the "inexact"
     floating-point exception.
  */
  extern proc nearbyint(x: real(64)): real(64);

  /* Returns the rounded integral value of the argument `x` determined by the
     current rounding direction.  :proc:`nearbyint` will not raise the "inexact"
     floating-point exception.
  */
  inline proc nearbyint(x : real(32)): real(32) {
    extern proc nearbyintf(x: real(32)): real(32);
    return nearbyintf(x);
  }

  /* Returns the rounded integral value of the argument `x` determined by the
     current rounding direction.  :proc:`rint` may raise the "inexact" floating-point
     exception.
  */
  extern proc rint(x: real(64)): real(64);

  /* Returns the rounded integral value of the argument `x` determined by the
     current rounding direction.  :proc:`rint` may raise the "inexact" floating-point
     exception.
  */
  inline proc rint(x : real(32)): real(32) {
    extern proc rintf(x: real(32)): real(32);
    return rintf(x);
  }

  /* Returns the rounded integral value of the argument `x`. */
  extern proc round(x: real(64)): real(64);

  /* Returns the rounded integral value of the argument `x`. */
  inline proc round(x : real(32)): real(32) {
    extern proc roundf(x: real(32)): real(32);
    return roundf(x);
  }

  /* Returns the signum function of the integer argument `i`:
     1 if positive, -1 if negative, 0 if zero.
  */
  inline proc sgn(i : int(?w)): int(8)
    return ((i > 0) : int(8) - (i < 0) : int(8)) : int(8);

  /* Returns the signum function of the unsigned integer argument `i`:
     1 if positive, -1 if negative, 0 if zero.
  */
  inline proc sgn(i : uint(?w)): uint(8)
    return (i > 0) : uint(8);

  /* Returns the signum function of the integer param argument `i`:
     1 if positive, -1 if negative, 0 if zero.
  */
  proc sgn(param i : integral) param
    return if i > 0 then 1 else if i == 0 then 0 else -1;

  /* Returns the signum function of the real argument `x`:
     1 if positive, -1 if negative, 0 if zero.
  */
  inline proc sgn(x : real(?w)): int(8)
    return ((x > 0.0) : int(8) - (x < 0.0) : int(8)) : int(8);

  /* Returns the sine of the argument `x`. */
  extern proc sin(x: real(64)): real(64);

  /* Returns the sine of the argument `x`. */
  inline proc sin(x: real(32)): real(32) {
    extern proc sinf(x: real(32)): real(32);
    return sinf(x);
  }

  /* Returns the hyperbolic sine of the argument `x`. */
  extern proc sinh(x: real(64)): real(64);

  /* Returns the hyperbolic sine of the argument `x`. */
  inline proc sinh(x : real(32)): real(32) {
    extern proc sinhf(x: real(32)): real(32);
    return sinhf(x);
  }

  /* Returns the square root of the argument `x`.

     It is an error if the `x` is less than zero.
  */
  extern proc sqrt(x: real(64)): real(64);

  /* Returns the square root of the argument `x`.

     It is an error if  `x` is less than zero.
  */
  inline proc sqrt(x : real(32)): real(32) {
    extern proc sqrtf(x: real(32)): real(32);
    return sqrtf(x);
  }

  /* Returns the tangent of the argument `x`. */
  extern proc tan(x: real(64)): real(64);

  /* Returns the tangent of the argument `x`. */
  inline proc tan(x : real(32)): real(32) {
    extern proc tanf(x: real(32)): real(32);
    return tanf(x);
  }

  /* Returns the hyperbolic tangent of the argument `x`. */
  extern proc tanh(x: real(64)): real(64);

  /* Returns the hyperbolic tangent of the argument `x`. */
  inline proc tanh(x : real(32)): real(32) {
    extern proc tanhf(x: real(32)): real(32);
    return tanhf(x);
  }

  /* Returns the absolute value of the gamma function of the argument `x`. */
  extern proc tgamma(x: real(64)): real(64);

  /* Returns the absolute value of the gamma function of the argument `x`. */
  inline proc tgamma(x : real(32)): real(32) {
    extern proc tgammaf(x: real(32)): real(32);
    return tgammaf(x);
  }

  /* Returns the nearest integral value to the argument `x` that is not larger
     than `x` in absolute value. */
  extern proc trunc(x: real(64)): real(64);

  /* Returns the nearest integral value to the argument `x` that is not larger
     than `x` in absolute value. */
  inline proc trunc(x : real(32)): real(32) {
    extern proc truncf(x: real(32)): real(32);
    return truncf(x);
  }

} // end of module Math

// TODO: Consolidate overloaded signatures, to simplify the documentation.

/*
 * 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 provides wrappers for <cmath> (math.h) numerical constants and
routines.  Its symbols are provided by default; an explicit 'use' statement
is not necessary.

The C Math library is part of the C Language Standard (ISO/IEC 9899), as
described in Section 7.12.  Please consult that standard for an
authoritative description of the expected properties of those constants and
routines.

In general, where the C math library provides a *double* and a *float* version
of a function, the float version has a suffix 'f'.  In the Chapel interface,
the suffix is dropped, and the type of the operand determines which version is
called -- according to the usual function overloading and resolution rules.
Normally, the result has the same precision
as the argument(s).  Please consult the C standard for specifics.

Rounding -- The rounding mode for floating-point addition (subtraction) is
implementation-defined.

Error Handling -- At present, Chapel does not provide control over error
handling in the Math module.  The default behavior is as if the macro
``math_errhandling`` is set to 0: Given erroneous input at run-time,
all math functions will return an implementation-defined value; no
exception will be generated.

*/
module Math {

  //////////////////////////////////////////////////////////////////////////
  // Helper constants and functions (not included in chpldocs).
  //
  pragma "no doc"
  extern proc chpl_macro_INFINITY():real(64);
  pragma "no doc"
  extern proc chpl_macro_NAN():real(64);

  pragma "no doc"
  extern proc chpl_macro_double_isinf(x: real(64)): c_int;
  pragma "no doc"
  extern proc chpl_macro_float_isinf(x: real(32)): c_int;
  pragma "no doc"
  extern proc chpl_macro_double_isfinite(x: real(64)): c_int;
  pragma "no doc"
  extern proc chpl_macro_float_isfinite(x: real(32)): c_int;
  pragma "no doc"
  extern proc chpl_macro_double_isnan(x: real(64)): c_int;
  pragma "no doc"
  extern proc chpl_macro_float_isnan(x: real(32)): c_int;

  pragma "no doc"
  extern proc fabs(x: real(64)): real(64);

  pragma "no doc"
  proc _logBasePow2Help(in val, baseLog2) {
    var result = -1;
    while (val != 0) {
      val >>= baseLog2;
      result += 1;
    }
    return result;
  }

  pragma "no doc"
  proc logBasePow2(in val: int(?w), baseLog2) {
    if (val < 1) {
      halt("Can't take the log() of a non-positive integer");
    }
    return _logBasePow2Help(val, baseLog2);
  }

  pragma "no doc"
  proc logBasePow2(in val: uint(?w), baseLog2) {
    if (val < 1) {
      halt("Can't take the log() of a non-positive integer");
    }
    return _logBasePow2Help(val, baseLog2);
  }
  //
  //////////////////////////////////////////////////////////////////////////

  //////////////////////////////////////////////////////////////////////////
  //
  // Public interface (included in chpldocs).
  //
  // (The entries below are alphabetized (case-insensitively) because chpldocs
  // presents them in declaration order.)
  //

  /* Returns the absolute value of the integer argument.

     :rtype: The type of `i`.
  */
  inline proc abs(i : int(?w)) return if i < 0 then -i else i;

  /* Returns the absolute value of the unsigned integer argument.

     :rtype: The type of `i`.
  */
  inline proc abs(i : uint(?w)) return i;

  /* Returns the absolute value of the integer param argument `i`. */
  proc abs(param i : integral) param return if i < 0 then -i else i;

  /* Returns the magnitude of the real argument `r`. */
  inline proc abs(r : real(64)):real(64) return fabs(r);

  /* Returns the magnitude of the real argument `x`. */
  inline proc abs(x : real(32)): real(32) {
    extern proc fabsf(x: real(32)): real(32);
    return fabsf(x);
  }

  /* Returns the real magnitude of the imaginary argument `im`. */
  inline proc abs(im : imag(64)): real(64) return fabs(_i2r(im));

  /* Returns the real magnitude of the imaginary argument `im`. */
  inline proc abs(im: imag(32)): real(32) {
    extern proc fabsf(x: real(32)): real(32);
    return fabsf(_i2r(im));
  }

  /* Returns the real magnitude of the complex argument `x`.

     :rtype: The type of the real component of the argument (== `w`/2).
  */
  inline proc abs(x : complex(?w)) return sqrt(x.re*x.re + x.im*x.im);

  /* Returns the arc cosine of the argument `x`.

     It is an error if `x` is less than -1 or greater than 1.
  */
  extern proc acos(x: real(64)): real(64);

  /* Returns the arc cosine of the argument `x`.

     It is an error if `x` is less than -1 or greater than 1.
  */
  inline proc acos(x : real(32)): real(32) {
    extern proc acosf(x: real(32)): real(32);
    return acosf(x);
  }

  /* Returns the inverse hyperbolic cosine of the argument `x`.

     It is an error if `x` is less than 1.
  */
  extern proc acosh(x: real(64)): real(64);

  /* Returns the inverse hyperbolic cosine of the argument `x`.

     It is an error if `x` is less than 1.
  */
  inline proc acosh(x : real(32)): real(32) {
    extern proc acoshf(x: real(32)): real(32);
    return acoshf(x);
  }

  /* Returns the arc sine of the argument `x`.

     It is an error if `x` is less than -1 or greater than 1.
  */
  extern proc asin(x: real(64)): real(64);

  /* Returns the arc sine of the argument `x`.

     It is an error if `x` is less than -1 or greater than 1.
  */
  inline proc asin(x : real(32)): real(32) {
    extern proc asinf(x: real(32)): real(32);
    return asinf(x);
  }

  /* Returns the inverse hyperbolic sine of the argument `x`. */
  extern proc asinh(x: real(64)): real(64);

  /* Returns the inverse hyperbolic sine of the argument `x`. */
  inline proc asinh(x : real(32)): real(32) {
    extern proc asinhf(x: real(32)): real(32);
    return asinhf(x);
  }

  /* Returns the arc tangent of the argument `x`. */
  extern proc atan(x: real(64)): real(64);

  /* Returns the arc tangent of the argument `x`. */
  inline proc atan(x : real(32)): real(32) {
    extern proc atanf(x: real(32)): real(32);
    return atanf(x);
  }

  /* Returns the arc tangent of the ratio of the two arguments.

     This is equivalent to
     the arc tangent of `y` / `x` except that the signs of `y`
     and `x` are used to determine the quadrant of the result. */
  extern proc atan2(y: real(64), x: real(64)): real(64);

  /* Returns the arc tangent of the two arguments.

     This is equivalent to
     the arc tangent of `y` / `x` except that the signs of `y`
     and `x` are used to determine the quadrant of the result. */
  inline proc atan2(y : real(32), x: real(32)): real(32) {
    extern proc atan2f(y: real(32), x: real(32)): real(32);
    return atan2f(y, x);
  }

  /* Returns the inverse hyperbolic tangent of the argument `x`.

     It is an error if `x` is less than -1 or greater than 1. */
  extern proc atanh(x: real(64)): real(64);

  /* Returns the inverse hyperbolic tangent of the argument `x`.

     It is an error if `x` is less than -1 or greater than 1. */
  inline proc atanh(x : real(32)): real(32) {
    extern proc atanhf(x: real(32)): real(32);
    return atanhf(x);
  }

  /* Returns the cube root of the argument `x`. */
  extern proc cbrt(x: real(64)): real(64);

  /* Returns the cube root of the argument `x`. */
  inline proc cbrt(x : real(32)): real(32) {
    extern proc cbrtf(x: real(32)): real(32);
    return cbrtf(x);
  }

  /* Returns the value of the argument `x` rounded up to the nearest integer. */
  extern proc ceil(x: real(64)): real(64);

  /* Returns the value of the argument `x` rounded up to the nearest integer. */
  inline proc ceil(x : real(32)): real(32) {
    extern proc ceilf(x: real(32)): real(32);
    return ceilf(x);
  }

  /* Returns the complex conjugate of the argument `a`.

     :rtype: The type of `a`.
  */
  inline proc conjg(a: complex(?w)) : complex(w) return (a.re, -a.im):complex(w);

  /* Returns the cosine of the argument `x`. */
  extern proc cos(x: real(64)): real(64);

  /* Returns the cosine of the argument `x`. */
  inline proc cos(x : real(32)): real(32) {
    extern proc cosf(x: real(32)): real(32);
    return cosf(x);
  }

  /* Returns the hyperbolic cosine of the argument `x`. */
  extern proc cosh(x: real(64)): real(64);

  /* Returns the hyperbolic cosine of the argument `x`. */
  inline proc cosh(x : real(32)): real(32) {
    extern proc coshf(x: real(32)): real(32);
    return coshf(x);
  }

  /* Returns :proc:`ceil`\(`m`/`n`),
     i.e., the fraction `m`/`n` rounded up to the nearest integer.

     If the arguments are of unsigned type, then
     fewer condititionals will be evaluated at run time.
  */
  proc divceil(param m: integral, param n: integral) param return
    if isNonnegative(m) then
      if isNonnegative(n) then (m + n - 1) / n
      else                     m / n
    else
      if isNonnegative(n) then m / n
      else                     (m + n + 1) / n;

  /* Returns :proc:`ceil`\(`m`/`n`),
     i.e., the fraction `m`/`n` rounded up to the nearest integer.

     If the arguments are of unsigned type, then
     fewer condititionals will be evaluated at run time.
  */
  proc divceil(m: integral, n: integral) param
    if isNonnegative(m) then
      if isNonnegative(n) then (m + n - 1) / n
      else                     m / n
    else
      if isNonnegative(n) then m / n
      else                     (m + n + 1) / n;

  /* Returns :proc:`floor`\(`m`/`n`),
     i.e., the fraction `m`/`n` rounded down to the nearest integer.

     If the arguments are of unsigned type, then
     fewer condititionals will be evaluated at run time.
  */
  proc divfloor(param m: integral, param n: integral) param return
    if isNonnegative(m) then
      if isNonnegative(n) then m / n
      else                     (m - n - 1) / n
    else
      if isNonnegative(n) then (m - n + 1) / n
      else                     m / n;

  /* Returns :proc:`floor`\(`m`/`n`),
     i.e., the fraction `m`/`n` rounded down to the nearest integer.

     If the arguments are of unsigned type, then
     fewer condititionals will be evaluated at run time.
  */
  proc divfloor(m: integral, n: integral) return
    if isNonnegative(m) then
      if isNonnegative(n) then m / n
      else                     (m - n - 1) / n
    else
      if isNonnegative(n) then (m - n + 1) / n
      else                     m / n;

  /* Returns the error function of the argument `x`. */
  extern proc erf(x: real(64)): real(64);

  /* Returns the error function of the argument `x`. */
  inline proc erf(x : real(32)): real(32) {
    extern proc erff(x: real(32)): real(32);
    return erff(x);
  }

  /* Returns the complementary error function of the argument.
     This is equivalent to 1.0 - :proc:`erf`\(`x`).
  */
  extern proc erfc(x: real(64)): real(64);

  /* Returns the complementary error function of the argument.
     This is equivalent to 1.0 - :proc:`erf`\(`x`).
  */
  inline proc erfc(x : real(32)): real(32) {
    extern proc erfcf(x: real(32)): real(32);
    return erfcf(x);
  }

  /* Returns the value of the Napierien `e` raised to the power of the argument `x`. */
  extern proc exp(x: real(64)): real(64);

  /* Returns the value of the Napierien `e` raised to the power of the argument. */
  inline proc exp(x : real(32)): real(32) {
    extern proc expf(x: real(32)): real(32);
    return expf(x);
  }

  /* Returns the value of `2` raised to the power of the argument `x`. */
  extern proc exp2(x: real(64)): real(64);

  /* Returns the value of `2` raised to the power of the argument `x`. */
  inline proc exp2(x : real(32)): real(32) {
    extern proc exp2f(x: real(32)): real(32);
    return exp2f(x);
  }

  /* Returns one less than the value of the Napierien `e` raised to the power
     of the argument `x`. */
  extern proc expm1(x: real(64)): real(64);

  /* Returns one less than the value of the Napierien `e` raised to the power
     of the argument `x`. */
  inline proc expm1(x : real(32)): real(32) {
    extern proc expm1f(x: real(32)): real(32);
    return expm1f(x);
  }

  /* Returns the value of the argument `x` rounded down to the nearest integer. */
  extern proc floor(x: real(64)): real(64);

  /* Returns the value of the argument `x` rounded down to the nearest integer. */
  inline proc floor(x : real(32)): real(32) {
    extern proc floorf(x: real(32)): real(32);
    return floorf(x);
  }

  /* Returns a value for which :proc:`isinf` will return `true`. */
  inline proc INFINITY: real(64) return chpl_macro_INFINITY();

  /* Returns `true` if the argument `x` is a representation of a finite value;
     `false` otherwise. */
  inline proc isfinite(x: real(64)): bool return chpl_macro_double_isfinite(x):bool;

  /* Returns `true` if the argument `x` is a representation of a finite value;
     `false` otherwise. */
  inline proc isfinite(x: real(32)): bool return chpl_macro_float_isfinite(x):bool;

  /* Returns `true` if the argument `x` is a representation of *infinity*;
     `false` otherwise. */
  inline proc isinf(x: real(64)): bool return chpl_macro_double_isinf(x):bool;

  /* Returns `true` if the argument `x` is a representation of *infinity*;
     `false` otherwise. */
  inline proc isinf(x: real(32)): bool return chpl_macro_float_isinf(x):bool;

  /* Returns `true` if the argument `x` does not represent a valid number;
     `false` otherwise. */
  inline proc isnan(x: real(64)): bool return chpl_macro_double_isnan(x):bool;

  /* Returns `true` if the argument `x` does not represent a valid number;
     `false` otherwise. */
  inline proc isnan(x: real(32)): bool return chpl_macro_float_isnan(x):bool;

  /* Returns the natural logarithm of the absolute value
     of the gamma function of the argument `x`.
  */
  extern proc lgamma(x: real(64)): real(64);

  /* Returns the natural logarithm of the absolute value
     of the gamma function of the argument `x`.
  */
  inline proc lgamma(x : real(32)): real(32) {
    extern proc lgammaf(x: real(32)): real(32);
    return lgammaf(x);
  }

  /* Returns the natural logarithm of the argument `x`.

     It is an error if `x` is less than or equal to zero.
  */
  extern proc log(x: real(64)): real(64);

  /* Returns the natural logarithm of the argument `x`.

     It is an error if `x` is less than or equal to zero.
  */
  inline proc log(x : real(32)): real(32) {
    extern proc logf(x: real(32)): real(32);
    return logf(x);
  }

  /* Returns the base 10 logarithm of the argument `x`.

     It is an error if `x` is less than or equal to zero.
  */
  extern proc log10(x: real(64)): real(64);

  /* Returns the base 10 logarithm of the argument `x`.

     It is an error if `x` is less than or equal to zero.
  */
  inline proc log10(x : real(32)): real(32) {
    extern proc log10f(x: real(32)): real(32);
    return log10f(x);
  }

  /* Returns the natural logarithm of `x` + 1.

     It is an error if `x` is less than or equal to -1.
  */
  extern proc log1p(x: real(64)): real(64);

  /* Returns the natural logarithm of `x` + 1.

     It is an error if `x` is less than or equal to -1.
  */
  inline proc log1p(x : real(32)): real(32) {
    extern proc log1pf(x: real(32)): real(32);
    return log1pf(x);
  }

  /* Returns the base 2 logarithm of the argument `x`.

     It is an error if `x` is less than or equal to zero.
  */
  extern proc log2(x: real(64)): real(64);

  /* Returns the base 2 logarithm of the argument `x`.

     It is an error if `x` is less than or equal to zero.
  */
  inline proc log2(x : real(32)): real(32) {
    extern proc log2f(x: real(32)): real(32);
    return log2f(x);
  }

  /* Returns the base 2 logarithm of the argument `x`.

     :rtype: `int(64)`

     It is an error if `x` is less than or equal to zero.
  */
  proc log2(in val: int(?w)) {
    return logBasePow2(val, 1);
  }

  /* Returns the base 2 logarithm of the argument `x`.

     :rtype: `int(64)`

     It is an error if `x` is less than or equal to zero.
  */
  proc log2(in val: uint(?w)) {
    return logBasePow2(val, 1);
  }

  /* Computes the mod operator on the two arguments, defined as
     ``mod(x,y) = x - y * floor(x / y)``.
  */
  proc mod(param m: integral, param n: integral) param {
    param temp = m % n;

    // verbatim copy from the other 'mod', to simplify maintenance
    return
      if isNonnegative(n) then
        if isUintType(m.type)
        then temp
        else ( if temp >= 0 then temp else temp + n )
      else
        // n < 0
        ( if temp <= 0 then temp else temp + n );
  }

  /* Computes the mod operator on the two arguments, defined as
     ``mod(x,y) = x - y * floor(x / y)``.

     If the arguments are of unsigned type, then
     fewer condititionals will be evaluated at run time.
  */
  proc mod(m: integral, n: integral) {
    const temp = m % n;

    // eliminate some run-time tests if input(s) is(are) unsigned
    return
      if isNonnegative(n) then
        if isUintType(m.type)
        then temp
        else ( if temp >= 0 then temp else temp + n )
      else
        // n < 0
        ( if temp <= 0 then temp else temp + n );
  }

  /* Computes the mod operator on the two numbers, defined as
     ``mod(x,y) = x - y * floor(x / y)``.

     The return value has the same type as `x`.
  */
  proc mod(x: real(?w), y: real(w)): real(w) {
    // This codes up the standard definition, according to Wikipedia.
    // Is there a more efficient implementation for reals?
    return x - y*floor(x/y);
  }

  /* Returns a value for which :proc:`isnan` will return `true`. */
  inline proc NAN : real(64) return chpl_macro_NAN();

  /* Returns the rounded integral value of the argument `x` determined by the
     current rounding direction.  :proc:`nearbyint` will not raise the "inexact"
     floating-point exception.
  */
  extern proc nearbyint(x: real(64)): real(64);

  /* Returns the rounded integral value of the argument `x` determined by the
     current rounding direction.  :proc:`nearbyint` will not raise the "inexact"
     floating-point exception.
  */
  inline proc nearbyint(x : real(32)): real(32) {
    extern proc nearbyintf(x: real(32)): real(32);
    return nearbyintf(x);
  }

  /* Returns the rounded integral value of the argument `x` determined by the
     current rounding direction.  :proc:`rint` may raise the "inexact" floating-point
     exception.
  */
  extern proc rint(x: real(64)): real(64);

  /* Returns the rounded integral value of the argument `x` determined by the
     current rounding direction.  :proc:`rint` may raise the "inexact" floating-point
     exception.
  */
  inline proc rint(x : real(32)): real(32) {
    extern proc rintf(x: real(32)): real(32);
    return rintf(x);
  }

  /* Returns the rounded integral value of the argument `x`. */
  extern proc round(x: real(64)): real(64);

  /* Returns the rounded integral value of the argument `x`. */
  inline proc round(x : real(32)): real(32) {
    extern proc roundf(x: real(32)): real(32);
    return roundf(x);
  }

  /* Returns the signum function of the integer argument `i`:
     1 if positive, -1 if negative, 0 if zero.
  */
  inline proc sgn(i : int(?w)): int(8)
    return ((i > 0) : int(8) - (i < 0) : int(8)) : int(8);

  /* Returns the signum function of the unsigned integer argument `i`:
     1 if positive, -1 if negative, 0 if zero.
  */
  inline proc sgn(i : uint(?w)): uint(8)
    return (i > 0) : uint(8);

  /* Returns the signum function of the integer param argument `i`:
     1 if positive, -1 if negative, 0 if zero.
  */
  proc sgn(param i : integral) param
    return if i > 0 then 1 else if i == 0 then 0 else -1;

  /* Returns the signum function of the real argument `x`:
     1 if positive, -1 if negative, 0 if zero.
  */
  inline proc sgn(x : real(?w)): int(8)
    return ((x > 0.0) : int(8) - (x < 0.0) : int(8)) : int(8);

  /* Returns the sine of the argument `x`. */
  extern proc sin(x: real(64)): real(64);

  /* Returns the sine of the argument `x`. */
  inline proc sin(x: real(32)): real(32) {
    extern proc sinf(x: real(32)): real(32);
    return sinf(x);
  }

  /* Returns the hyperbolic sine of the argument `x`. */
  extern proc sinh(x: real(64)): real(64);

  /* Returns the hyperbolic sine of the argument `x`. */
  inline proc sinh(x : real(32)): real(32) {
    extern proc sinhf(x: real(32)): real(32);
    return sinhf(x);
  }

  /* Returns the square root of the argument `x`.

     It is an error if the `x` is less than zero.
  */
  extern proc sqrt(x: real(64)): real(64);

  /* Returns the square root of the argument `x`.

     It is an error if  `x` is less than zero.
  */
  inline proc sqrt(x : real(32)): real(32) {
    extern proc sqrtf(x: real(32)): real(32);
    return sqrtf(x);
  }

  /* Returns the tangent of the argument `x`. */
  extern proc tan(x: real(64)): real(64);

  /* Returns the tangent of the argument `x`. */
  inline proc tan(x : real(32)): real(32) {
    extern proc tanf(x: real(32)): real(32);
    return tanf(x);
  }

  /* Returns the hyperbolic tangent of the argument `x`. */
  extern proc tanh(x: real(64)): real(64);

  /* Returns the hyperbolic tangent of the argument `x`. */
  inline proc tanh(x : real(32)): real(32) {
    extern proc tanhf(x: real(32)): real(32);
    return tanhf(x);
  }

  /* Returns the absolute value of the gamma function of the argument `x`. */
  extern proc tgamma(x: real(64)): real(64);

  /* Returns the absolute value of the gamma function of the argument `x`. */
  inline proc tgamma(x : real(32)): real(32) {
    extern proc tgammaf(x: real(32)): real(32);
    return tgammaf(x);
  }

  /* Returns the nearest integral value to the argument `x` that is not larger
     than `x` in absolute value. */
  extern proc trunc(x: real(64)): real(64);

  /* Returns the nearest integral value to the argument `x` that is not larger
     than `x` in absolute value. */
  inline proc trunc(x : real(32)): real(32) {
    extern proc truncf(x: real(32)): real(32);
    return truncf(x);
  }

} // end of module Math

// TODO: Consolidate overloaded signatures, to simplify the documentation.


Fixing a stupid typo from r18055

Fixing a stupid typo from r18055

When I was nearly ready to commit r18055 Greg reviewed it and suggested
a name formatting change to the tasking layer's query to get the callstack
size which I adoped.  I re-ran the testing but forgot that new tests
wouldn't show up in my patch and didn't rerun the test manually, so didn't
catch that the new test callStackSize.chpl wouldn't pass.  When I saw the
failures, I assumed that I had done something that revealed different
default values on different platforms and didn't have time to look into it
before the break.  This should fix it for the common case, though I'll
have to make sure there aren't still problems across different OS versions.

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

use DefaultArithmetic;

class locale {
  const myRealm: realm;
  const chpl_id: int;
  const chpl_uid: int;
  const myNumCores: int;

  def locale(r: realm = nil, id = -1, uid = -1,
             numCores = __primitive("chpl_coresPerLocale")) {
    if doneCreatingLocales {
      halt("locales cannot be created");
    }
    myRealm = r;
    chpl_id = id;
    chpl_uid = uid;
    myNumCores = numCores;
  }

  def id {
    return chpl_id;
  }

  def uid {
    return chpl_uid;
  }

  def name {
    var locName: string;
    on this do locName = __primitive("chpl_localeName");
    return locName;
  }

  def callStackSize: uint(64) {
    _extern def chpl_task_callstacksize(): uint(64);
    return chpl_task_callstacksize();
  }

  def writeThis(f: Writer) {
    if (numRealms == 1) {
      f.write("LOCALE", id);
    } else {
      f.write("LOCALE", myRealm.id, "-", id);
    }
  }
}

def chpl_setupLocale(uid) {
  var tmp: locale;
  on __primitive("chpl_on_locale_num", uid) {
    tmp = new locale(uid=uid);
    _here = tmp;
    if (defaultDist._value == nil) {
      defaultDist = new dmap(new DefaultDist());
    }
  }
  return tmp;
}

def locale.numCores {
  return myNumCores;
}

def chpl_int_to_locale(in id) {
  for r in Realms {
    if id < r.numLocales then
      return r.Locales[id];
    id -= r.numLocales;
  }
  halt("id out of range in chpl_int_to_locale()");
  return Realms[0].Locales[0];
}

def locale.totalThreads() {
  var totalThreads: uint;

  on this do totalThreads = __primitive("chpl_numThreads");

  return totalThreads;
}

def locale.idleThreads() {
  var idleThreads: uint;

  on this do idleThreads = __primitive("chpl_numIdleThreads");

  return idleThreads;
}

def locale.queuedTasks() {
  var queuedTasks: uint;

  on this do queuedTasks = __primitive("chpl_numQueuedTasks");

  return queuedTasks;
}

def locale.runningTasks() {
  var numTasks: uint;

  on this do numTasks = __primitive("chpl_numRunningTasks");

  return numTasks;
}

def locale.blockedTasks() {
  var blockedTasks: int;

  on this do blockedTasks = __primitive("chpl_numBlockedTasks");

  return blockedTasks;
}

//
// multi-locale diagnostics/debugging support
//
_extern def chpl_startVerboseComm();
_extern def chpl_stopVerboseComm();
_extern def chpl_startVerboseCommHere();
_extern def chpl_stopVerboseCommHere();
_extern def chpl_startCommDiagnostics();
_extern def chpl_stopCommDiagnostics();
_extern def chpl_startCommDiagnosticsHere();
_extern def chpl_stopCommDiagnosticsHere();

def startVerboseComm() { chpl_startVerboseComm(); }
def stopVerboseComm() { chpl_stopVerboseComm(); }
def startVerboseCommHere() { chpl_startVerboseCommHere(); }
def stopVerboseCommHere() { chpl_stopVerboseCommHere(); }

def startCommDiagnostics() { chpl_startCommDiagnostics(); }
def stopCommDiagnostics() { chpl_stopCommDiagnostics(); }
def startCommDiagnosticsHere() { chpl_startCommDiagnosticsHere(); }
def stopCommDiagnosticsHere() { chpl_stopCommDiagnosticsHere(); }

// TODO: generalize this for multiple realms by returning a manhattan
// array
_extern def chpl_numCommGets(): int(32);
_extern def chpl_numCommPuts(): int(32);
_extern def chpl_numCommForks(): int(32);
_extern def chpl_numCommFastForks(): int(32);
_extern def chpl_numCommNBForks(): int(32);

def getCommDiagnostics(realmID: int(32) = 0) {
  var D: [Realms(realmID).LocaleSpace] 5*int;
  const r = Realms(realmID);
  for loc in r.Locales do on loc {
    const gets = chpl_numCommGets();
    const puts = chpl_numCommPuts();
    const forks = chpl_numCommForks();
    const fforks = chpl_numCommFastForks();
    const nbforks = chpl_numCommNBForks();
    D(loc.id) = (gets, puts, forks, fforks, nbforks);
  }
  return D;
}

config const
  memTrack: bool = false,
  memStats: bool = false,
  memLeaks: bool = false,
  memLeaksTable: bool = false,
  memMax: uint(64) = 0,
  memThreshold: uint(64) = 0,
  memLog: string = "";

pragma "no auto destroy"
config const
  memLeaksLog: string = "";

def chpl_startTrackingMemory() {
  coforall r in Realms {
    if r.Locales(0) == here {
      coforall loc in r.Locales {
        if loc == here {
          __primitive("chpl_setMemFlags", memTrack, memStats, memLeaks, memLeaksTable, memMax, memThreshold, memLog, memLeaksLog);
        } else on loc {
            __primitive("chpl_setMemFlags", memTrack, memStats, memLeaks, memLeaksTable, memMax, memThreshold, memLog, memLeaksLog);
        }
      }
    } else {
      on r {
        coforall loc in r.Locales {
          if loc == here {
            __primitive("chpl_setMemFlags", memTrack, memStats, memLeaks, memLeaksTable, memMax, memThreshold, memLog, memLeaksLog);
          } else on loc {
              __primitive("chpl_setMemFlags", memTrack, memStats, memLeaks, memLeaksTable, memMax, memThreshold, memLog, memLeaksLog);
          }
        }
      }
    }
  }
}

use DefaultArithmetic;

class locale {
  const myRealm: realm;
  const chpl_id: int;
  const chpl_uid: int;
  const myNumCores: int;

  def locale(r: realm = nil, id = -1, uid = -1,
             numCores = __primitive("chpl_coresPerLocale")) {
    if doneCreatingLocales {
      halt("locales cannot be created");
    }
    myRealm = r;
    chpl_id = id;
    chpl_uid = uid;
    myNumCores = numCores;
  }

  def id {
    return chpl_id;
  }

  def uid {
    return chpl_uid;
  }

  def name {
    var locName: string;
    on this do locName = __primitive("chpl_localeName");
    return locName;
  }

  def callStackSize: uint(64) {
    _extern def chpl_task_callstacksize(): uint(64);
    return chpl_taskCallStackSize();
  }

  def writeThis(f: Writer) {
    if (numRealms == 1) {
      f.write("LOCALE", id);
    } else {
      f.write("LOCALE", myRealm.id, "-", id);
    }
  }
}

def chpl_setupLocale(uid) {
  var tmp: locale;
  on __primitive("chpl_on_locale_num", uid) {
    tmp = new locale(uid=uid);
    _here = tmp;
    if (defaultDist._value == nil) {
      defaultDist = new dmap(new DefaultDist());
    }
  }
  return tmp;
}

def locale.numCores {
  return myNumCores;
}

def chpl_int_to_locale(in id) {
  for r in Realms {
    if id < r.numLocales then
      return r.Locales[id];
    id -= r.numLocales;
  }
  halt("id out of range in chpl_int_to_locale()");
  return Realms[0].Locales[0];
}

def locale.totalThreads() {
  var totalThreads: uint;

  on this do totalThreads = __primitive("chpl_numThreads");

  return totalThreads;
}

def locale.idleThreads() {
  var idleThreads: uint;

  on this do idleThreads = __primitive("chpl_numIdleThreads");

  return idleThreads;
}

def locale.queuedTasks() {
  var queuedTasks: uint;

  on this do queuedTasks = __primitive("chpl_numQueuedTasks");

  return queuedTasks;
}

def locale.runningTasks() {
  var numTasks: uint;

  on this do numTasks = __primitive("chpl_numRunningTasks");

  return numTasks;
}

def locale.blockedTasks() {
  var blockedTasks: int;

  on this do blockedTasks = __primitive("chpl_numBlockedTasks");

  return blockedTasks;
}

//
// multi-locale diagnostics/debugging support
//
_extern def chpl_startVerboseComm();
_extern def chpl_stopVerboseComm();
_extern def chpl_startVerboseCommHere();
_extern def chpl_stopVerboseCommHere();
_extern def chpl_startCommDiagnostics();
_extern def chpl_stopCommDiagnostics();
_extern def chpl_startCommDiagnosticsHere();
_extern def chpl_stopCommDiagnosticsHere();

def startVerboseComm() { chpl_startVerboseComm(); }
def stopVerboseComm() { chpl_stopVerboseComm(); }
def startVerboseCommHere() { chpl_startVerboseCommHere(); }
def stopVerboseCommHere() { chpl_stopVerboseCommHere(); }

def startCommDiagnostics() { chpl_startCommDiagnostics(); }
def stopCommDiagnostics() { chpl_stopCommDiagnostics(); }
def startCommDiagnosticsHere() { chpl_startCommDiagnosticsHere(); }
def stopCommDiagnosticsHere() { chpl_stopCommDiagnosticsHere(); }

// TODO: generalize this for multiple realms by returning a manhattan
// array
_extern def chpl_numCommGets(): int(32);
_extern def chpl_numCommPuts(): int(32);
_extern def chpl_numCommForks(): int(32);
_extern def chpl_numCommFastForks(): int(32);
_extern def chpl_numCommNBForks(): int(32);

def getCommDiagnostics(realmID: int(32) = 0) {
  var D: [Realms(realmID).LocaleSpace] 5*int;
  const r = Realms(realmID);
  for loc in r.Locales do on loc {
    const gets = chpl_numCommGets();
    const puts = chpl_numCommPuts();
    const forks = chpl_numCommForks();
    const fforks = chpl_numCommFastForks();
    const nbforks = chpl_numCommNBForks();
    D(loc.id) = (gets, puts, forks, fforks, nbforks);
  }
  return D;
}

config const
  memTrack: bool = false,
  memStats: bool = false,
  memLeaks: bool = false,
  memLeaksTable: bool = false,
  memMax: uint(64) = 0,
  memThreshold: uint(64) = 0,
  memLog: string = "";

pragma "no auto destroy"
config const
  memLeaksLog: string = "";

def chpl_startTrackingMemory() {
  coforall r in Realms {
    if r.Locales(0) == here {
      coforall loc in r.Locales {
        if loc == here {
          __primitive("chpl_setMemFlags", memTrack, memStats, memLeaks, memLeaksTable, memMax, memThreshold, memLog, memLeaksLog);
        } else on loc {
            __primitive("chpl_setMemFlags", memTrack, memStats, memLeaks, memLeaksTable, memMax, memThreshold, memLog, memLeaksLog);
        }
      }
    } else {
      on r {
        coforall loc in r.Locales {
          if loc == here {
            __primitive("chpl_setMemFlags", memTrack, memStats, memLeaks, memLeaksTable, memMax, memThreshold, memLog, memLeaksLog);
          } else on loc {
              __primitive("chpl_setMemFlags", memTrack, memStats, memLeaks, memLeaksTable, memMax, memThreshold, memLog, memLeaksLog);
          }
        }
      }
    }
  }
}


Fix a race condition and increase problem size.

Fixed a race condition in the way task private variables are assigned.
Increased the problem size to increase the chance of running into such
issues (hopefully they don't exist anymore!)

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

// An example of how to create task private variables.
//
// This example should work for forall loop iterating over default
// arrays/domains (you could drop the dmap), as well as Block, Cyclic,
// and probably BlockCyclic arrays/domains.
//
use BlockDist, PrivateDist;

record taskPrivateData {
  var inUse: bool = false;
  var x: int;
  var y: [0..#numLocales] real;
};

class localePrivateData {
  type myStuff;
  // assumes numCores is the same across all locales
  const numTasks = if dataParTasksPerLocale==0 then here.numCores
    else dataParTasksPerLocale;
  var tid: sync int = 0;
  var r = [0..#numTasks];
  var temps: [r] myStuff;
  proc gettid() {
    var mytid = tid;
    while temps[mytid%numTasks].inUse do mytid += 1;
    temps[mytid%numTasks].inUse = true;
    tid = mytid+1;
    return mytid%numTasks;
  }
  proc freetid(mytid) {
    tid; // just use as a lock
    temps[mytid].inUse = false;
    tid = mytid+1;
  }
}

var localePrivate: [PrivateSpace] localePrivateData(taskPrivateData);
forall l in localePrivate do l = new localePrivateData(taskPrivateData);

// an example use
config param nPerLocale = 100;
config const printTemps = false;
const D = [0..#nPerLocale*numLocales] dmapped Block(boundingBox=[0..#nPerLocale*numLocales]);
forall d in D {
  // my copy of the task private vars
  var lp = localePrivate[here.id];

  // int-fetch-add
  var tid = lp.gettid();

  lp.temps[tid].x += 1;
  lp.temps[tid].y += 1;

  lp.freetid(tid);
}

if printTemps then writeln(localePrivate.temps);

const numTasks = if dataParTasksPerLocale==0 then here.numCores
  else dataParTasksPerLocale;
for l in 0..#numLocales {
  var lp = localePrivate[l];
  var x = 0;
  var y: [D] real = 0.0;
  for tid in 0..#numTasks {
    x += lp.temps[tid].x;
    for i in 0..#numLocales do y[i] += lp.temps[tid].y[i];
  }
  if x != nPerLocale {
    for tid in 0..#numTasks do writeln(lp.temps[tid].x);
    halt("localePrivate[",l,"].temps[].x value is incorrect!");
  }
  for i in 0..#numLocales {
    if y[i] != nPerLocale {
      for tid in 0..#numTasks do writeln(lp.temps[tid].y);
      halt("localePrivate[",l,"].temps[].y values are incorrect!");
    }
  }
}

// An example of how to create task private variables.
//
// This example should work for forall loop iterating over default
// arrays/domains (you could drop the dmap), as well as Block, Cyclic,
// and probably BlockCyclic arrays/domains.
//
use BlockDist;

record taskPrivateData {
  var x: int;
  var y: [0..#numLocales] real;
};

class localePrivateData {
  type myStuff;
  var tid: sync int = 0;
  var r: domain(1);
  var temps: [r] myStuff;
}

const myD = [LocaleSpace] dmapped Block(boundingBox=[LocaleSpace]);
var localePrivate: [myD] localePrivateData(taskPrivateData);

forall l in localePrivate do l = new localePrivateData(taskPrivateData);

// assumes numCores is the same across all locales (prolly should use max)
var numTasks = if dataParTasksPerLocale==0 then here.numCores
  else dataParTasksPerLocale;
localePrivate.r = [0..#numTasks];

// an example use
config param nPerLocale = 8;
config const printTemps = false;
const D = [0..#nPerLocale*numLocales] dmapped Block(boundingBox=[0..#nPerLocale*numLocales]);
forall d in D {
  // my copy of the task private vars
  var lp = localePrivate[here.id];

  // int-fetch-add
  var tid = lp.tid;
  lp.tid = tid+1;

  tid = tid % numTasks;

  lp.temps[tid].x += tid+1;
  lp.temps[tid].y[here.id] += 1;
}

if printTemps then writeln(localePrivate.temps);

for l in 0..#numLocales {
  var lp = localePrivate[l];
  var y =  0.0;
  for tid in 0..#numTasks {
    y += + reduce lp.temps[tid].y;
    for l2 in 0..#numLocales {
      if l != l2 {
        if lp.temps[tid].y[l2] != 0.0 then
          halt("localePrivate[",l,"].temps[",tid,"].y[", l2, "] is not 0.0!");
      }
    }
  }
  if y != nPerLocale then
    halt("localePrivate[",l,"].temps[].y value is incorrect!");
}


Add test for cosineDistance

Add test for cosineDistance

/*
 Designed to test the Modified Adsoprtion routine
 */
use NumSuch,
    MatrixMarket;

var X = Matrix(
  [3.0, 0.2, 0.0, 0.7, 0.1],
  [0.2, 2.0, 0.3, 0.0, 0.0],
  [0.0, 0.3, 3.0, 0.9, 0.6],
  [0.7, 0.0, 0.9, 2.0, 0.0],
  [0.1, 0.0, 0.6, 0.0, 2.0]
);

var y = Matrix(
  [1,0,0],
  [0,1,0],
  [0,0,1],
  [1,0,1],
  [0,0,0]
  );

var labelFile = "data/webkb_labels.txt";
var vectorFile = "data/webkb_vectors.mtx";
//var L = new LabelMatrix();
//L.readFromFile(fn=labelFile, addDummy=true);
//writeln(L.names);

var W = mmread(real, vectorFile);
// this takes 5 hours on my laptop, holy cow.
var V = cosineDistance(W);

/*
var model = new ModifiedAdsorptionModel();
model.fit(data=X, labels=y);
writeln(model.A);
 */

/*
 Designed to test the Modified Adsoprtion routine
 */
use NumSuch,
    MatrixMarket;

var X = Matrix(
  [3.0, 0.2, 0.0, 0.7, 0.1],
  [0.2, 2.0, 0.3, 0.0, 0.0],
  [0.0, 0.3, 3.0, 0.9, 0.6],
  [0.7, 0.0, 0.9, 2.0, 0.0],
  [0.1, 0.0, 0.6, 0.0, 2.0]
);

var y = Matrix(
  [1,0,0],
  [0,1,0],
  [0,0,1],
  [1,0,1],
  [0,0,0]
  );

var labelFile = "data/webkb_labels.txt";
var vectorFile = "data/webkb_vectors.mtx";
var L = new LabelMatrix();
L.readFromFile(fn=labelFile, addDummy=true);
//writeln(L.names);

//var W = mmread(real, vectorFile);
// this takes 5 hours on my laptop, holy cow.
//var V = vectorsToAdjacency(W);

/*
var model = new ModifiedAdsorptionModel();
model.fit(data=X, labels=y);
writeln(model.A);
 */


Get chpl__readXX() calls out of generated code (a 5-minute fix (TM))

[reviewed by Lydia]

Reviewing some generated code with Lydia today, we were seeing some calls to
chpl_readXX() for basic types in the generated output, which suprised me -- I
thought they'd disappear before codegen time.  These were due to the
following overload:

        proc chpl__readXX(x) return x;

The history here is that, to get the sync/single var initialization semantics
that we want/expect, we wrap all initializing expressions when both a type
and an initializer are provided with chpl__readXX(), but then make that
function a no-op for types that are not sync/single.

Because it's a no-op, I was expecting not to see it in the generated code,
but in retrospect that was naive.  Marking the routine as 'inline' improves
things.  Where the declaration:

  var a, b, c: int;

used to result in:

        /* ChapelSyncvar.chpl:10 */
        static int64_t chpl__readXX(int64_t x) {
          return x;
        }

          call_tmp = chpl__readXX(a);

it now simply results in:

          call_tmp = a;

resulting in a minor reduction in generated code size and complexity.

While here, I also made the sync/single versions inline since they
essentially just forward to the readXX methods.

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

// ChapelSyncvar.chpl
//
// Sync and single variables.
//

pragma "no use ChapelStandard"
module ChapelSyncvar {
  inline proc chpl__readXX(x: sync) return x.readXX();
  inline proc chpl__readXX(x: single) return x.readXX();
  inline proc chpl__readXX(x) return x;

  pragma "sync"
    pragma "no object" // Optimize out the object base pointer.
    pragma "no default functions"
    class _syncvar {
      type base_type;
      var  value: base_type;       // actual data - may need to be declared specially on some targets!
      pragma "omit from constructor" var sync_aux: _sync_aux_t; // data structure for locking, signaling, etc.
      // Ideally, the definition of this class should be target and base_type dependent,
      // since not all targets need to have a sync_aux field if base_type is sufficiently simple.

      proc ~_syncvar() { __primitive("sync_destroy", this); }

      proc initialize() {
        __primitive("sync_init", this);
      }
    }

  proc _isSyncType(type t) param
    return __primitive("is sync type", t);

  proc _isSync(x: sync) param return true;
  proc _isSync(x) param return false;

  // The operations are:
  //  readFE - wait for full, leave empty
  //  readFF - wait for full, leave full
  //  readXX - ignore F/E, leave F/E unchanged
  //  = (i.e., write_wait_empty_leave_full)
  //  writeEF  - wait for empty, leave full (same as =)
  //  writeFF  - wait for full, leave full
  //  writeXF  - ignore F/E, leave full
  //  reset - ignore F/E, write zero, leave empty
  //  isFull - query whether it is full

  // This is the default read on sync vars. Wait for full, set and signal empty.
  proc _syncvar.readFE(): base_type {
    var ret: base_type;
    on this {
      var localRet: base_type;
      __primitive("sync_wait_full_and_lock", this);
      localRet = value;
      __primitive("sync_mark_and_signal_empty", this);
      ret = localRet;
    }
    return ret;
  }

  // Wait for full, set and signal full.
  proc _syncvar.readFF() {
    var ret: base_type;
    on this {
      var localRet: base_type;
      __primitive("sync_wait_full_and_lock", this);
      localRet = value;
      __primitive("sync_mark_and_signal_full", this); // in case others are waiting
      ret = localRet;
    }
    return ret;
  }

  // Ignore F/E.  Read value.  No state change or signals.
  proc _syncvar.readXX() {
    var ret: base_type;
    on this {
      var localRet: base_type;
      __primitive("sync_lock", this);
      localRet = value;
      __primitive("sync_unlock", this);
      ret = localRet;
    }
    return ret;
  }

  // This is the default write on sync vars. Wait for empty, set and signal full.
  proc _syncvar.writeEF(val:base_type) {
    on this {
      __primitive("sync_wait_empty_and_lock", this);
      value = val;
      __primitive("sync_mark_and_signal_full", this);
    }
  }

  proc =(ref sv: sync, val:sv.base_type) {
    sv.writeEF(val);
  }

  // Wait for full, set and signal full.
  proc _syncvar.writeFF(val:base_type) {
    on this {
      __primitive("sync_wait_full_and_lock", this);
      value = val;
      __primitive("sync_mark_and_signal_full", this);
    }
  }

  // Ignore F/E, set and signal full.
  proc _syncvar.writeXF(val:base_type) {
    on this {
      __primitive("sync_lock", this);
      value = val;
      __primitive("sync_mark_and_signal_full", this);

    }
  }

  // Ignore F/E, set to zero or default value and signal empty.
  proc _syncvar.reset() {
    on this {
      const default_value: base_type;
      __primitive("sync_lock", this);
      value = default_value;
      __primitive("sync_mark_and_signal_empty", this);
    }
  }

  proc _syncvar.isFull {
    var b: bool;
    on this {
      b = __primitive("sync_is_full", this);
    }
    return b;
  }

  // single variable support
  pragma "sync"
    pragma "single"
    pragma "no object" // Optimize out the object base pointer.
    pragma "no default functions"
    class _singlevar {
      type base_type;
      var  value: base_type;     // actual data - may need to be declared specially on some targets!
      pragma "omit from constructor" var single_aux: _single_aux_t; // data structure for locking, signaling, etc.
      // Ideally, the definition of this class should be target and base_type dependent,
      // since not all targets need to have a single_aux field if base_type is sufficiently simple.

      proc ~_singlevar() { __primitive("single_destroy", this); }

      proc initialize() {
        __primitive("single_init", this);
      }
    }

  proc _isSingleType(type t) param
    return __primitive("is single type", t);

  proc _isSingle(x: single) param return true;
  proc _isSingle(x) param return false;

  // Wait for full. Set and signal full.
  proc _singlevar.readFF() {
    var ret: base_type;
    on this {
      var localRet: base_type;
      if this.isFull then
        localRet = value;
      else {
        __primitive("single_wait_full", this);
        localRet = value;
        __primitive("single_mark_and_signal_full", this); // in case others are waiting
      }
      ret = localRet;
    }
    return ret;
  }

  // Ignore F/E.  Read value.  No state change or signals.
  proc _singlevar.readXX() {
    var ret: base_type;
    on this {
      var localRet: base_type;
      if this.isFull then
        localRet = value;
      else {
        __primitive("single_lock", this);
        localRet = value;
        __primitive("single_unlock", this);
      }
      ret = localRet;
    }
    return ret;
  }

  // Can only write once.  Otherwise, it is an error.
  proc _singlevar.writeEF(val:base_type) {
    on this {
      __primitive("single_lock", this);
      if this.isFull then
        halt("single var already defined");
      value = val;
      __primitive("single_mark_and_signal_full", this);
    }
  }

  proc =(ref sv: single, value:sv.base_type) {
    sv.writeEF(value);
  }

  proc _singlevar.isFull {
    var b: bool;
    on this {
      b = __primitive("single_is_full", this);
    }
    return b;
  }

  pragma "dont disable remote value forwarding"
  inline proc _createFieldDefault(type t, init: sync) {
    return init;
  }

  pragma "dont disable remote value forwarding"
  inline proc _createFieldDefault(type t, init: single) {
    return init;
  }

  pragma "init copy fn"
  inline proc chpl__initCopy(sv: sync) {
    return sv.readFE();
  }

  pragma "init copy fn"
  inline proc chpl__initCopy(sv: single) {
    return sv.readFF();
  }

  pragma "dont disable remote value forwarding"
  pragma "donor fn"
  pragma "auto copy fn"
  inline proc chpl__autoCopy(x: sync) return x;

  pragma "dont disable remote value forwarding"
  pragma "donor fn"
  pragma "auto copy fn"
  inline proc chpl__autoCopy(x: single) return x;

  // Be explicit about whether syncs and singles are auto-destroyed.
  inline proc chpl__maybeAutoDestroyed(x: _syncvar) param return true;
  inline proc chpl__maybeAutoDestroyed(x: _singlevar) param return true;

  pragma "auto destroy fn"
  pragma "auto destroy fn sync"
  inline proc chpl__autoDestroy(x: _syncvar) {
    delete x;
  }
  pragma "auto destroy fn"
  pragma "auto destroy fn sync"
  inline proc chpl__autoDestroy(x: _singlevar) {
    delete x;
  }

  proc chpl__syncBaseType(s) type {
    var x = s;
    return x.type;
  }

  /* op= for sync variables */
  inline proc  +=(ref lhs:sync, rhs:chpl__syncBaseType(lhs)) { lhs = lhs  + rhs; }
  inline proc  -=(ref lhs:sync, rhs:chpl__syncBaseType(lhs)) { lhs = lhs  - rhs; }
  inline proc  *=(ref lhs:sync, rhs:chpl__syncBaseType(lhs)) { lhs = lhs  * rhs; }
  inline proc  /=(ref lhs:sync, rhs:chpl__syncBaseType(lhs)) { lhs = lhs  / rhs; }
  inline proc  %=(ref lhs:sync, rhs:chpl__syncBaseType(lhs)) { lhs = lhs  % rhs; }
  inline proc **=(ref lhs:sync, rhs:chpl__syncBaseType(lhs)) { lhs = lhs ** rhs; }
  inline proc  &=(ref lhs:sync, rhs:chpl__syncBaseType(lhs)) { lhs = lhs  & rhs; }
  inline proc  |=(ref lhs:sync, rhs:chpl__syncBaseType(lhs)) { lhs = lhs  | rhs; }
  inline proc  ^=(ref lhs:sync, rhs:chpl__syncBaseType(lhs)) { lhs = lhs  ^ rhs; }
  inline proc >>=(ref lhs:sync, rhs:chpl__syncBaseType(lhs)) { lhs = lhs >> rhs; }
  inline proc <<=(ref lhs:sync, rhs:chpl__syncBaseType(lhs)) { lhs = lhs << rhs; }

  inline proc <=>(lhs: sync, ref rhs) {
    const tmp = lhs;
    lhs = rhs;
    rhs = tmp;
  }

  inline proc <=>(ref lhs, rhs: sync) {
    const tmp = lhs;
    lhs = rhs;
    rhs = tmp;
  }

  inline proc <=>(lhs: sync, rhs: sync) {
    const tmp = lhs;
    lhs = rhs;
    rhs = tmp;
  }

}

// ChapelSyncvar.chpl
//
// Sync and single variables.
//

pragma "no use ChapelStandard"
module ChapelSyncvar {
  proc chpl__readXX(x: sync) return x.readXX();
  proc chpl__readXX(x: single) return x.readXX();
  proc chpl__readXX(x) return x;

  pragma "sync"
    pragma "no object" // Optimize out the object base pointer.
    pragma "no default functions"
    class _syncvar {
      type base_type;
      var  value: base_type;       // actual data - may need to be declared specially on some targets!
      pragma "omit from constructor" var sync_aux: _sync_aux_t; // data structure for locking, signaling, etc.
      // Ideally, the definition of this class should be target and base_type dependent,
      // since not all targets need to have a sync_aux field if base_type is sufficiently simple.

      proc ~_syncvar() { __primitive("sync_destroy", this); }

      proc initialize() {
        __primitive("sync_init", this);
      }
    }

  proc _isSyncType(type t) param
    return __primitive("is sync type", t);

  proc _isSync(x: sync) param return true;
  proc _isSync(x) param return false;

  // The operations are:
  //  readFE - wait for full, leave empty
  //  readFF - wait for full, leave full
  //  readXX - ignore F/E, leave F/E unchanged
  //  = (i.e., write_wait_empty_leave_full)
  //  writeEF  - wait for empty, leave full (same as =)
  //  writeFF  - wait for full, leave full
  //  writeXF  - ignore F/E, leave full
  //  reset - ignore F/E, write zero, leave empty
  //  isFull - query whether it is full

  // This is the default read on sync vars. Wait for full, set and signal empty.
  proc _syncvar.readFE(): base_type {
    var ret: base_type;
    on this {
      var localRet: base_type;
      __primitive("sync_wait_full_and_lock", this);
      localRet = value;
      __primitive("sync_mark_and_signal_empty", this);
      ret = localRet;
    }
    return ret;
  }

  // Wait for full, set and signal full.
  proc _syncvar.readFF() {
    var ret: base_type;
    on this {
      var localRet: base_type;
      __primitive("sync_wait_full_and_lock", this);
      localRet = value;
      __primitive("sync_mark_and_signal_full", this); // in case others are waiting
      ret = localRet;
    }
    return ret;
  }

  // Ignore F/E.  Read value.  No state change or signals.
  proc _syncvar.readXX() {
    var ret: base_type;
    on this {
      var localRet: base_type;
      __primitive("sync_lock", this);
      localRet = value;
      __primitive("sync_unlock", this);
      ret = localRet;
    }
    return ret;
  }

  // This is the default write on sync vars. Wait for empty, set and signal full.
  proc _syncvar.writeEF(val:base_type) {
    on this {
      __primitive("sync_wait_empty_and_lock", this);
      value = val;
      __primitive("sync_mark_and_signal_full", this);
    }
  }

  proc =(ref sv: sync, val:sv.base_type) {
    sv.writeEF(val);
  }

  // Wait for full, set and signal full.
  proc _syncvar.writeFF(val:base_type) {
    on this {
      __primitive("sync_wait_full_and_lock", this);
      value = val;
      __primitive("sync_mark_and_signal_full", this);
    }
  }

  // Ignore F/E, set and signal full.
  proc _syncvar.writeXF(val:base_type) {
    on this {
      __primitive("sync_lock", this);
      value = val;
      __primitive("sync_mark_and_signal_full", this);

    }
  }

  // Ignore F/E, set to zero or default value and signal empty.
  proc _syncvar.reset() {
    on this {
      const default_value: base_type;
      __primitive("sync_lock", this);
      value = default_value;
      __primitive("sync_mark_and_signal_empty", this);
    }
  }

  proc _syncvar.isFull {
    var b: bool;
    on this {
      b = __primitive("sync_is_full", this);
    }
    return b;
  }

  // single variable support
  pragma "sync"
    pragma "single"
    pragma "no object" // Optimize out the object base pointer.
    pragma "no default functions"
    class _singlevar {
      type base_type;
      var  value: base_type;     // actual data - may need to be declared specially on some targets!
      pragma "omit from constructor" var single_aux: _single_aux_t; // data structure for locking, signaling, etc.
      // Ideally, the definition of this class should be target and base_type dependent,
      // since not all targets need to have a single_aux field if base_type is sufficiently simple.

      proc ~_singlevar() { __primitive("single_destroy", this); }

      proc initialize() {
        __primitive("single_init", this);
      }
    }

  proc _isSingleType(type t) param
    return __primitive("is single type", t);

  proc _isSingle(x: single) param return true;
  proc _isSingle(x) param return false;

  // Wait for full. Set and signal full.
  proc _singlevar.readFF() {
    var ret: base_type;
    on this {
      var localRet: base_type;
      if this.isFull then
        localRet = value;
      else {
        __primitive("single_wait_full", this);
        localRet = value;
        __primitive("single_mark_and_signal_full", this); // in case others are waiting
      }
      ret = localRet;
    }
    return ret;
  }

  // Ignore F/E.  Read value.  No state change or signals.
  proc _singlevar.readXX() {
    var ret: base_type;
    on this {
      var localRet: base_type;
      if this.isFull then
        localRet = value;
      else {
        __primitive("single_lock", this);
        localRet = value;
        __primitive("single_unlock", this);
      }
      ret = localRet;
    }
    return ret;
  }

  // Can only write once.  Otherwise, it is an error.
  proc _singlevar.writeEF(val:base_type) {
    on this {
      __primitive("single_lock", this);
      if this.isFull then
        halt("single var already defined");
      value = val;
      __primitive("single_mark_and_signal_full", this);
    }
  }

  proc =(ref sv: single, value:sv.base_type) {
    sv.writeEF(value);
  }

  proc _singlevar.isFull {
    var b: bool;
    on this {
      b = __primitive("single_is_full", this);
    }
    return b;
  }

  pragma "dont disable remote value forwarding"
  inline proc _createFieldDefault(type t, init: sync) {
    return init;
  }

  pragma "dont disable remote value forwarding"
  inline proc _createFieldDefault(type t, init: single) {
    return init;
  }

  pragma "init copy fn"
  inline proc chpl__initCopy(sv: sync) {
    return sv.readFE();
  }

  pragma "init copy fn"
  inline proc chpl__initCopy(sv: single) {
    return sv.readFF();
  }

  pragma "dont disable remote value forwarding"
  pragma "donor fn"
  pragma "auto copy fn"
  inline proc chpl__autoCopy(x: sync) return x;

  pragma "dont disable remote value forwarding"
  pragma "donor fn"
  pragma "auto copy fn"
  inline proc chpl__autoCopy(x: single) return x;

  // Be explicit about whether syncs and singles are auto-destroyed.
  inline proc chpl__maybeAutoDestroyed(x: _syncvar) param return true;
  inline proc chpl__maybeAutoDestroyed(x: _singlevar) param return true;

  pragma "auto destroy fn"
  pragma "auto destroy fn sync"
  inline proc chpl__autoDestroy(x: _syncvar) {
    delete x;
  }
  pragma "auto destroy fn"
  pragma "auto destroy fn sync"
  inline proc chpl__autoDestroy(x: _singlevar) {
    delete x;
  }

  proc chpl__syncBaseType(s) type {
    var x = s;
    return x.type;
  }

  /* op= for sync variables */
  inline proc  +=(ref lhs:sync, rhs:chpl__syncBaseType(lhs)) { lhs = lhs  + rhs; }
  inline proc  -=(ref lhs:sync, rhs:chpl__syncBaseType(lhs)) { lhs = lhs  - rhs; }
  inline proc  *=(ref lhs:sync, rhs:chpl__syncBaseType(lhs)) { lhs = lhs  * rhs; }
  inline proc  /=(ref lhs:sync, rhs:chpl__syncBaseType(lhs)) { lhs = lhs  / rhs; }
  inline proc  %=(ref lhs:sync, rhs:chpl__syncBaseType(lhs)) { lhs = lhs  % rhs; }
  inline proc **=(ref lhs:sync, rhs:chpl__syncBaseType(lhs)) { lhs = lhs ** rhs; }
  inline proc  &=(ref lhs:sync, rhs:chpl__syncBaseType(lhs)) { lhs = lhs  & rhs; }
  inline proc  |=(ref lhs:sync, rhs:chpl__syncBaseType(lhs)) { lhs = lhs  | rhs; }
  inline proc  ^=(ref lhs:sync, rhs:chpl__syncBaseType(lhs)) { lhs = lhs  ^ rhs; }
  inline proc >>=(ref lhs:sync, rhs:chpl__syncBaseType(lhs)) { lhs = lhs >> rhs; }
  inline proc <<=(ref lhs:sync, rhs:chpl__syncBaseType(lhs)) { lhs = lhs << rhs; }

  inline proc <=>(lhs: sync, ref rhs) {
    const tmp = lhs;
    lhs = rhs;
    rhs = tmp;
  }

  inline proc <=>(ref lhs, rhs: sync) {
    const tmp = lhs;
    lhs = rhs;
    rhs = tmp;
  }

  inline proc <=>(lhs: sync, rhs: sync) {
    const tmp = lhs;
    lhs = rhs;
    rhs = tmp;
  }

}


Minor comment edits

Minor comment edits

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

//
// Task Parallel Primer
//
// This primer illustrates Chapel's parallel tasking features,
// namely the begin, cobegin, and coforall statements.

config const n = 10;

writeln("1: ### The begin statement ###");

// The begin statement spawns a thread of execution that is independent
// of the current (main) thread of execution.
begin writeln("1: output from spawned task");

// The main thread of execution continues on to the next statement.
// There is no guarantee as to which statement will execute first.
writeln("1: output from main task");

writeln("2: ### The cobegin statement ###");

// For more structured behavior, the cobegin statement can be used to
// spawn a block of tasks, one for each statement.  Control continues
// after the cobegin block, but only after all the tasks within the
// cobegin block have completed.
cobegin {
  writeln("2: output from spawned task 1");
  writeln("2: output from spawned task 2");
}

// The output from within the cobegin statement will always precede the
// following output from the main thread of execution.
writeln("2: output from main task");

writeln("3: ### The cobegin statement with nested begin statements ###");

// If any begin statements are used within a cobegin statement,
// the thread of execution does not wait for those begin statements
// to complete.
cobegin {
  begin writeln("3: output from spawned task 1");
  begin writeln("3: output from spawned task 2");
}

// The order of the output is again undefined because the begin
// statements in the above cobegin statment are not guaranteed to
// have been executed before control reaches the following statement.
writeln("3: output from main task");

writeln("4: ### The coforall statement ###");

// Another more structured form of task parallelism is the coforall
// statement.  The coforall statement is a loop variant of the cobegin
// statement where each iteration of the loop is a separate task.
// Similar to the cobegin statement, every iteration of the coforall
// loop is a separate task and the main thread of execution does not
// continue until every iteration is complete.
coforall i in 1..n {
  writeln("4: output from spawned task 1 (iteration ", i, ")");
  writeln("4: output from spawned task 2 (iteration ", i, ")");
}

// While the order of output within an iteration is deterministic ("1"
// executes before "2"), the order of output relative to other
// iterations is not defined.  As with the cobegin statement, the output
// from within the coforall statement will always precede the following
// output.
writeln("4: output from main task");

writeln("5: ### The coforall statement with nested begin statements ###");
// As with the cobegin statement, any begin statements spawned within
// a coforall loop are not guaranteed to be complete before the main
// thread of execution continues.
coforall i in 1..n {
  begin writeln("5: output from spawned task 1 (iteration ", i, ")");
  begin writeln("5: output from spawned task 2 (iteration ", i, ")");
}
// The order of output is undefined.
writeln("5: output from main task");

//
// Task Parallel Primer
//
// This primer illustrates Chapel's parallel tasking features,
// namely the begin, cobegin, and coforall statements.

config const n = 10;

writeln("1: ### The begin statement ###");

// The begin statement spawns a thread of execution that is independent
// of the current (main) thread of execution.
begin writeln("1: output from spawned task");

// The main thread of execution continues on to the next statement.
// There is no guarantee as to which statment will execute first.
writeln("1: output from main task");

writeln("2: ### The cobegin statement ###");

// For more structured behavior, the cobegin statement can be used to
// spawn a block of tasks, one for each statement.  Control continues
// after the cobegin block, but only after all the tasks within the
// cobegin block have completed.
cobegin {
  writeln("2: output from spawned task 1");
  writeln("2: output from spawned task 2");
}

// The output from within the cobegin statement will always precede the
// following output from the main thread of execution.
writeln("2: output from main task");

writeln("3: ### The cobegin statement with nested begin statements ###");

// If any begin statements are used within a cobegin statement,
// the thread of execution does not a wait for those begin statements
// to complete.
cobegin {
  begin writeln("3: output from spawned task 1");
  begin writeln("3: output from spawned task 2");
}

// The order of the output is again undefined because the begin
// statements in the above cobegin statment are not guaranteed to
// have been executed before control reaches the following statement.
writeln("3: output from main task");

writeln("4: ### The coforall statement ###");

// Another more structured form of task parallelism is the coforall
// statement.  The coforall statement is a loop variant of the cobegin
// statement where each iteration of the loop is a separate task.
// Similar to the cobegin statement, every iteration of the coforall
// loop is a separate task and the main thread of execution does not
// continue until every iteration is complete.
coforall i in 1..n {
  writeln("4: output from spawned task 1 (iteration ", i, ")");
  writeln("4: output from spawned task 2 (iteration ", i, ")");
}

// While the order of output within an iteration is deterministic ("1"
// executes before "2"), the order of output relative to other
// iterations is not defined.  As with the cobegin statement, the output
// from within the coforall statement will always precede the following
// output.
writeln("4: output from main task");

writeln("5: ### The coforall statement with nested begin statements ###");
// As with the cobegin statement, any begin statements spawned within
// a coforall loop are not guaranteed to be complete before the main
// thread of execution continues.
coforall i in 1..n {
  begin writeln("5: output from spawned task 1 (iteration ", i, ")");
  begin writeln("5: output from spawned task 2 (iteration ", i, ")");
}
// The order of output is undefined.
writeln("5: output from main task");