Changed iterator2 test, removing return type on iterator, so that
test works with more recent versions of the compiler.

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

iterator blockByCol(m,n) {
  for i in 1..n by 2 yield [1..n, i..i+1];
}

const n = 4;
const D = [1..n,1..n];
var A: [D] int;

[ij in D] A(ij) = ij(2);

for block in blockByCol(2,4) {
  writeln("This block:");
  writeln(A(block));
}

iterator blockByCol(m,n): seq of seq of int {
  for i in 1..n by 2 yield [1..n, i..i+1];
}

const n = 4;
const D = [1..n,1..n];
var A: [D] int;

[ij in D] A(ij) = ij(2);

for block in blockByCol(2,4) {
  writeln("This block:");
  writeln(A(block));
}


Extend c_ptrToArr() to support multidimensional arrays

It's never been clear to me why c_ptrToArr() was restricted to only
apply to 1D arrays given that it seems to work for multidimensional
as well.  Quick tests indicate that this is the case.

While here, noted that the error messages for arrays that are not
supported can be significantly improved by pointing up a level of
depth in the compilerError() routine.

In a separate commit, added tests that exercise both of these changes.

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

/* BASIC TYPES */
use SysCTypes;

extern type c_float = real(32);
extern type c_double = real(64);
/*extern type c_wchar_t = uint(32); */
extern type off_t = int(64);
extern type mode_t = uint(32);
extern type socklen_t = int(32);

// C File type
//type c_file = _file;

// stdin/stdout/sterr
//extern proc chpl_cstdin():_file;
extern proc chpl_cstdout():_file;
extern proc chpl_cstderr():_file;
extern proc chpl_cnullfile():_file;

// system error number.
extern type syserr; // = c_int, opaque so we can manually override ==,!=,etc
extern type err_t = c_int;
// When to use syserr and when to use err_t?
// err_t is a system error code (a c_int by a nicer name).
// syserr is an enhanced error that might also include an
// error message. All user-facing Chapel library code,
// or user Chapel code, should generally use syserr.
// When wrapping functions or declaring them in C,
// use err_t to indicate that a function is returning
// an error code.

// system file descriptor.
extern type fd_t = c_int;

// NULL
extern const c_nil:c_void_ptr;
// To generate legal C prototypes, we have to manually instantiate this
// prototype for each pointer type that might be associated with 'x'.
pragma "no prototype"
extern proc is_c_nil(x):bool;

// local C pointer class used in C integration.
// Similar to _ddata from ChapelBase, but differs
// from _ddata because it can never be wide.
pragma "data class"
pragma "no object"
pragma "no default functions"
pragma "no wide class"
class c_ptr {
  type eltType;
  inline proc this(i: integral) ref {
    return __primitive("array_get", this, i);
  }
  inline proc deref() ref {
    return __primitive("array_get", this, 0);
  }
}

inline proc =(ref a:c_ptr, b:c_ptr) { __primitive("=", a, b); }

inline proc =(ref a:c_ptr, b:_nilType) { __primitive("=", a, nil); }

inline proc _cast(type t, x) where t:c_ptr && x:_nilType {
  return __primitive("cast", t, x);
}
inline proc _cast(type t, x) where t:c_ptr && x.type:c_ptr {
  return __primitive("cast", t, x);
}
inline proc _cast(type t, x) where t:c_void_ptr && x.type:c_ptr {
  return __primitive("cast", t, x);
}

inline proc c_calloc(type eltType, size: integral) {
  var ret:c_ptr(eltType);
  __primitive("array_alloc", ret, eltType, size);
  init_elts(ret, size, eltType);
  return ret;
}

inline proc c_free(data: c_ptr) {
  __primitive("array_free", data);
}

inline proc ==(a: c_ptr, b: c_ptr) where a.eltType == b.eltType {
  return __primitive("ptr_eq", a, b);
}
inline proc ==(a: c_ptr, b: c_void_ptr) {
  return __primitive("ptr_eq", a, b);
}
inline proc ==(a: c_void_ptr, b: c_ptr) {
  return __primitive("ptr_eq", a, b);
}
inline proc ==(a: c_ptr, b: _nilType) {
  return __primitive("ptr_eq", a, nil);
}
inline proc ==(a: _nilType, b: c_ptr) {
  return __primitive("ptr_eq", nil, b);
}

inline proc !=(a: c_ptr, b: c_ptr) where a.eltType == b.eltType {
  return __primitive("ptr_neq", a, b);
}
inline proc !=(a: c_ptr, b: c_void_ptr) {
  return __primitive("ptr_neq", a, b);
}
inline proc !=(a: c_void_ptr, b: c_ptr) {
  return __primitive("ptr_neq", a, b);
}
inline proc !=(a: c_ptr, b: _nilType) {
  return __primitive("ptr_neq", a, nil);
}
inline proc !=(a: _nilType, b: c_ptr) {
  return __primitive("ptr_neq", nil, b);
}

inline proc _cond_test(x: c_ptr) return x != c_nil;

inline proc !(x: c_ptr) return x == c_nil;
extern proc c_pointer_return(ref x:?t):c_ptr(t);

inline proc c_ptrTo(arr: []) where isRectangularArr(arr) {
  return c_pointer_return(arr[arr.domain.low]);
}
inline proc c_ptrTo(ref x:?t):c_ptr(t)
{
  if isArrayType(t) then
    compilerError("c_ptrTo unsupported array type", 2);
  if isDomainType(t) then
    compilerError("c_ptrTo domain type not supported", 2);
  // Other cases should be avoided, e.g. sync vars
  return c_pointer_return(x);
}

// error numbers

extern proc qio_err_eq(a:syserr, b:syserr):c_int;
extern proc qio_err_to_int(a:syserr):int(32);
extern proc qio_int_to_err(a:int(32)):syserr;
extern proc qio_err_iserr(a:syserr):c_int;

// No error occurred
inline proc ENOERR return 0:err_t;

// When err_t is no longer just int(32), will need to add cases for err_t too.
inline proc ==(a: syserr, b: syserr) return (qio_err_eq(a,b) != 0:c_int);
inline proc ==(a: syserr, b: int(32)) return (qio_err_to_int(a) == b:int(32));
inline proc ==(a: syserr, b: int(64)) return (qio_err_to_int(a) == b:int(32));
inline proc ==(a: int(32), b: syserr) return (a:int(32) == qio_err_to_int(b));
inline proc ==(a: int(64), b: syserr) return (a:int(32) == qio_err_to_int(b));
inline proc !=(a: syserr, b: syserr) return !(a == b);
inline proc !=(a: syserr, b: int(32)) return !(a == b);
inline proc !=(a: syserr, b: int(64)) return !(a == b);
inline proc !=(a: int(32), b: syserr) return !(a == b);
inline proc !=(a: int(64), b: syserr) return !(a == b);
inline proc !(a: syserr) return (qio_err_iserr(a) == 0:c_int);
inline proc _cond_test(a: syserr) return (qio_err_iserr(a) != 0:c_int);
inline proc _cast(type t, x: syserr) where t == int(32)
  return qio_err_to_int(x);
inline proc _cast(type t, x: syserr) where t == int(64)
  return qio_err_to_int(x):int(64);
inline proc _cast(type t, x: int(32)) where t == syserr
  return qio_int_to_err(x);
inline proc _cast(type t, x: int(64)) where t == syserr
  return qio_int_to_err(x:int(32));
pragma "trivial assignment"
inline proc =(ref ret:syserr, x:syserr) { __primitive("=", ret, x); }
inline proc =(ref ret:syserr, x:int(32))
{ __primitive("=", ret, qio_int_to_err(x)); }
inline proc =(ref ret:syserr, x:int(64))
{ __primitive("=", ret, qio_int_to_err(x:int(32))); }
inline proc =(ref ret:err_t, x:syserr)
{ __primitive("=", ret, qio_err_to_int(x):err_t); }

// end of file
extern proc chpl_macro_int_EEOF():err_t;
inline proc EEOF return chpl_macro_int_EEOF():err_t;
extern proc chpl_macro_int_ESHORT():err_t;
inline proc ESHORT return chpl_macro_int_ESHORT():err_t;
extern proc chpl_macro_int_EFORMAT():err_t;
inline proc EFORMAT return chpl_macro_int_EFORMAT():err_t;

// system error numbers
extern const E2BIG:err_t;
extern const EACCES:err_t;
extern const EADDRINUSE:err_t;
extern const EADDRNOTAVAIL:err_t;
extern const EAFNOSUPPORT:err_t;
extern const EAGAIN:err_t;
extern const EALREADY:err_t;
extern const EBADE:err_t;
extern const EBADF:err_t;
extern const EBADFD:err_t;
extern const EBADMSG:err_t;
extern const EBADR:err_t;
extern const EBADRQC:err_t;
extern const EBADSLT:err_t;
extern const EBUSY:err_t;
extern const ECANCELED:err_t;
extern const ECHILD:err_t;
extern const ECHRNG:err_t;
extern const ECOMM:err_t;
extern const ECONNABORTED:err_t;
extern const ECONNREFUSED:err_t;
extern const ECONNRESET:err_t;
extern const EDEADLK:err_t;
extern const EDESTADDRREQ:err_t;
extern const EDOM:err_t;
extern const EDQUOT:err_t;
extern const EEXIST:err_t;
extern const EFAULT:err_t;
extern const EFBIG:err_t;
extern const EHOSTDOWN:err_t;
extern const EHOSTUNREACH:err_t;
extern const EIDRM:err_t;
extern const EILSEQ:err_t;
extern const EINPROGRESS:err_t;
extern const EINTR:err_t;
extern const EINVAL:err_t;
extern const EIO:err_t;
extern const EISCONN:err_t;
extern const EISDIR:err_t;
extern const EISNAM:err_t;
extern const EKEYEXPIRED:err_t;
extern const EKEYREJECTED:err_t;
extern const EKEYREVOKED:err_t;
extern const EL2HLT:err_t;
extern const EL2NSYNC:err_t;
extern const EL3HLT:err_t;
extern const EL3RST:err_t;
extern const ELIBACC:err_t;
extern const ELIBBAD:err_t;
extern const ELIBMAX:err_t;
extern const ELIBSCN:err_t;
extern const ELIBEXEC:err_t;
extern const ELOOP:err_t;
extern const EMEDIUMTYPE:err_t;
extern const EMFILE:err_t;
extern const EMLINK:err_t;
extern const EMSGSIZE:err_t;
extern const EMULTIHOP:err_t;
extern const ENAMETOOLONG:err_t;
extern const ENETDOWN:err_t;
extern const ENETRESET:err_t;
extern const ENETUNREACH:err_t;
extern const ENFILE:err_t;
extern const ENOBUFS:err_t;
extern const ENODATA:err_t;
extern const ENODEV:err_t;
extern const ENOENT:err_t;
extern const ENOEXEC:err_t;
extern const ENOKEY:err_t;
extern const ENOLCK:err_t;
extern const ENOLINK:err_t;
extern const ENOMEDIUM:err_t;
extern const ENOMEM:err_t;
extern const ENOMSG:err_t;
extern const ENONET:err_t;
extern const ENOPKG:err_t;
extern const ENOPROTOOPT:err_t;
extern const ENOSPC:err_t;
extern const ENOSR:err_t;
extern const ENOSTR:err_t;
extern const ENOSYS:err_t;
extern const ENOTBLK:err_t;
extern const ENOTCONN:err_t;
extern const ENOTDIR:err_t;
extern const ENOTEMPTY:err_t;
extern const ENOTSOCK:err_t;
extern const ENOTSUP:err_t;
extern const ENOTTY:err_t;
extern const ENOTUNIQ:err_t;
extern const ENXIO:err_t;
extern const EOPNOTSUPP:err_t;
extern const EOVERFLOW:err_t;
extern const EPERM:err_t;
extern const EPFNOSUPPORT:err_t;
extern const EPIPE:err_t;
extern const EPROTO:err_t;
extern const EPROTONOSUPPORT:err_t;
extern const EPROTOTYPE:err_t;
extern const ERANGE:err_t;
extern const EREMCHG:err_t;
extern const EREMOTE:err_t;
extern const EREMOTEIO:err_t;
extern const ERESTART:err_t;
extern const EROFS:err_t;
extern const ESHUTDOWN:err_t;
extern const ESPIPE:err_t;
extern const ESOCKTNOSUPPORT:err_t;
extern const ESRCH:err_t;
extern const ESTALE:err_t;
extern const ESTRPIPE:err_t;
extern const ETIME:err_t;
extern const ETIMEDOUT:err_t;
extern const ETXTBSY:err_t;
extern const EUCLEAN:err_t;
extern const EUNATCH:err_t;
extern const EUSERS:err_t;
extern const EWOULDBLOCK:err_t;
extern const EXDEV:err_t;
extern const EXFULL:err_t;

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

/* BASIC TYPES */
use SysCTypes;

extern type c_float = real(32);
extern type c_double = real(64);
/*extern type c_wchar_t = uint(32); */
extern type off_t = int(64);
extern type mode_t = uint(32);
extern type socklen_t = int(32);

// C File type
//type c_file = _file;

// stdin/stdout/sterr
//extern proc chpl_cstdin():_file;
extern proc chpl_cstdout():_file;
extern proc chpl_cstderr():_file;
extern proc chpl_cnullfile():_file;

// system error number.
extern type syserr; // = c_int, opaque so we can manually override ==,!=,etc
extern type err_t = c_int;
// When to use syserr and when to use err_t?
// err_t is a system error code (a c_int by a nicer name).
// syserr is an enhanced error that might also include an
// error message. All user-facing Chapel library code,
// or user Chapel code, should generally use syserr.
// When wrapping functions or declaring them in C,
// use err_t to indicate that a function is returning
// an error code.

// system file descriptor.
extern type fd_t = c_int;

// NULL
extern const c_nil:c_void_ptr;
// To generate legal C prototypes, we have to manually instantiate this
// prototype for each pointer type that might be associated with 'x'.
pragma "no prototype"
extern proc is_c_nil(x):bool;

// local C pointer class used in C integration.
// Similar to _ddata from ChapelBase, but differs
// from _ddata because it can never be wide.
pragma "data class"
pragma "no object"
pragma "no default functions"
pragma "no wide class"
class c_ptr {
  type eltType;
  inline proc this(i: integral) ref {
    return __primitive("array_get", this, i);
  }
  inline proc deref() ref {
    return __primitive("array_get", this, 0);
  }
}

inline proc =(ref a:c_ptr, b:c_ptr) { __primitive("=", a, b); }

inline proc =(ref a:c_ptr, b:_nilType) { __primitive("=", a, nil); }

inline proc _cast(type t, x) where t:c_ptr && x:_nilType {
  return __primitive("cast", t, x);
}
inline proc _cast(type t, x) where t:c_ptr && x.type:c_ptr {
  return __primitive("cast", t, x);
}
inline proc _cast(type t, x) where t:c_void_ptr && x.type:c_ptr {
  return __primitive("cast", t, x);
}

inline proc c_calloc(type eltType, size: integral) {
  var ret:c_ptr(eltType);
  __primitive("array_alloc", ret, eltType, size);
  init_elts(ret, size, eltType);
  return ret;
}

inline proc c_free(data: c_ptr) {
  __primitive("array_free", data);
}

inline proc ==(a: c_ptr, b: c_ptr) where a.eltType == b.eltType {
  return __primitive("ptr_eq", a, b);
}
inline proc ==(a: c_ptr, b: c_void_ptr) {
  return __primitive("ptr_eq", a, b);
}
inline proc ==(a: c_void_ptr, b: c_ptr) {
  return __primitive("ptr_eq", a, b);
}
inline proc ==(a: c_ptr, b: _nilType) {
  return __primitive("ptr_eq", a, nil);
}
inline proc ==(a: _nilType, b: c_ptr) {
  return __primitive("ptr_eq", nil, b);
}

inline proc !=(a: c_ptr, b: c_ptr) where a.eltType == b.eltType {
  return __primitive("ptr_neq", a, b);
}
inline proc !=(a: c_ptr, b: c_void_ptr) {
  return __primitive("ptr_neq", a, b);
}
inline proc !=(a: c_void_ptr, b: c_ptr) {
  return __primitive("ptr_neq", a, b);
}
inline proc !=(a: c_ptr, b: _nilType) {
  return __primitive("ptr_neq", a, nil);
}
inline proc !=(a: _nilType, b: c_ptr) {
  return __primitive("ptr_neq", nil, b);
}

inline proc _cond_test(x: c_ptr) return x != c_nil;

inline proc !(x: c_ptr) return x == c_nil;
extern proc c_pointer_return(ref x:?t):c_ptr(t);

inline proc c_ptrTo(arr: []) where isRectangularArr(arr) && arr.rank == 1 {
  return c_pointer_return(arr[arr.domain.low]);
}
inline proc c_ptrTo(ref x:?t):c_ptr(t)
{
  if isArrayType(t) then
    compilerError("c_ptrTo unsupported array type");
  if isDomainType(t) then
    compilerError("c_ptrTo domain type not supported");
  // Other cases should be avoided, e.g. sync vars
  return c_pointer_return(x);
}

// error numbers

extern proc qio_err_eq(a:syserr, b:syserr):c_int;
extern proc qio_err_to_int(a:syserr):int(32);
extern proc qio_int_to_err(a:int(32)):syserr;
extern proc qio_err_iserr(a:syserr):c_int;

// No error occurred
inline proc ENOERR return 0:err_t;

// When err_t is no longer just int(32), will need to add cases for err_t too.
inline proc ==(a: syserr, b: syserr) return (qio_err_eq(a,b) != 0:c_int);
inline proc ==(a: syserr, b: int(32)) return (qio_err_to_int(a) == b:int(32));
inline proc ==(a: syserr, b: int(64)) return (qio_err_to_int(a) == b:int(32));
inline proc ==(a: int(32), b: syserr) return (a:int(32) == qio_err_to_int(b));
inline proc ==(a: int(64), b: syserr) return (a:int(32) == qio_err_to_int(b));
inline proc !=(a: syserr, b: syserr) return !(a == b);
inline proc !=(a: syserr, b: int(32)) return !(a == b);
inline proc !=(a: syserr, b: int(64)) return !(a == b);
inline proc !=(a: int(32), b: syserr) return !(a == b);
inline proc !=(a: int(64), b: syserr) return !(a == b);
inline proc !(a: syserr) return (qio_err_iserr(a) == 0:c_int);
inline proc _cond_test(a: syserr) return (qio_err_iserr(a) != 0:c_int);
inline proc _cast(type t, x: syserr) where t == int(32)
  return qio_err_to_int(x);
inline proc _cast(type t, x: syserr) where t == int(64)
  return qio_err_to_int(x):int(64);
inline proc _cast(type t, x: int(32)) where t == syserr
  return qio_int_to_err(x);
inline proc _cast(type t, x: int(64)) where t == syserr
  return qio_int_to_err(x:int(32));
pragma "trivial assignment"
inline proc =(ref ret:syserr, x:syserr) { __primitive("=", ret, x); }
inline proc =(ref ret:syserr, x:int(32))
{ __primitive("=", ret, qio_int_to_err(x)); }
inline proc =(ref ret:syserr, x:int(64))
{ __primitive("=", ret, qio_int_to_err(x:int(32))); }
inline proc =(ref ret:err_t, x:syserr)
{ __primitive("=", ret, qio_err_to_int(x):err_t); }

// end of file
extern proc chpl_macro_int_EEOF():err_t;
inline proc EEOF return chpl_macro_int_EEOF():err_t;
extern proc chpl_macro_int_ESHORT():err_t;
inline proc ESHORT return chpl_macro_int_ESHORT():err_t;
extern proc chpl_macro_int_EFORMAT():err_t;
inline proc EFORMAT return chpl_macro_int_EFORMAT():err_t;

// system error numbers
extern const E2BIG:err_t;
extern const EACCES:err_t;
extern const EADDRINUSE:err_t;
extern const EADDRNOTAVAIL:err_t;
extern const EAFNOSUPPORT:err_t;
extern const EAGAIN:err_t;
extern const EALREADY:err_t;
extern const EBADE:err_t;
extern const EBADF:err_t;
extern const EBADFD:err_t;
extern const EBADMSG:err_t;
extern const EBADR:err_t;
extern const EBADRQC:err_t;
extern const EBADSLT:err_t;
extern const EBUSY:err_t;
extern const ECANCELED:err_t;
extern const ECHILD:err_t;
extern const ECHRNG:err_t;
extern const ECOMM:err_t;
extern const ECONNABORTED:err_t;
extern const ECONNREFUSED:err_t;
extern const ECONNRESET:err_t;
extern const EDEADLK:err_t;
extern const EDESTADDRREQ:err_t;
extern const EDOM:err_t;
extern const EDQUOT:err_t;
extern const EEXIST:err_t;
extern const EFAULT:err_t;
extern const EFBIG:err_t;
extern const EHOSTDOWN:err_t;
extern const EHOSTUNREACH:err_t;
extern const EIDRM:err_t;
extern const EILSEQ:err_t;
extern const EINPROGRESS:err_t;
extern const EINTR:err_t;
extern const EINVAL:err_t;
extern const EIO:err_t;
extern const EISCONN:err_t;
extern const EISDIR:err_t;
extern const EISNAM:err_t;
extern const EKEYEXPIRED:err_t;
extern const EKEYREJECTED:err_t;
extern const EKEYREVOKED:err_t;
extern const EL2HLT:err_t;
extern const EL2NSYNC:err_t;
extern const EL3HLT:err_t;
extern const EL3RST:err_t;
extern const ELIBACC:err_t;
extern const ELIBBAD:err_t;
extern const ELIBMAX:err_t;
extern const ELIBSCN:err_t;
extern const ELIBEXEC:err_t;
extern const ELOOP:err_t;
extern const EMEDIUMTYPE:err_t;
extern const EMFILE:err_t;
extern const EMLINK:err_t;
extern const EMSGSIZE:err_t;
extern const EMULTIHOP:err_t;
extern const ENAMETOOLONG:err_t;
extern const ENETDOWN:err_t;
extern const ENETRESET:err_t;
extern const ENETUNREACH:err_t;
extern const ENFILE:err_t;
extern const ENOBUFS:err_t;
extern const ENODATA:err_t;
extern const ENODEV:err_t;
extern const ENOENT:err_t;
extern const ENOEXEC:err_t;
extern const ENOKEY:err_t;
extern const ENOLCK:err_t;
extern const ENOLINK:err_t;
extern const ENOMEDIUM:err_t;
extern const ENOMEM:err_t;
extern const ENOMSG:err_t;
extern const ENONET:err_t;
extern const ENOPKG:err_t;
extern const ENOPROTOOPT:err_t;
extern const ENOSPC:err_t;
extern const ENOSR:err_t;
extern const ENOSTR:err_t;
extern const ENOSYS:err_t;
extern const ENOTBLK:err_t;
extern const ENOTCONN:err_t;
extern const ENOTDIR:err_t;
extern const ENOTEMPTY:err_t;
extern const ENOTSOCK:err_t;
extern const ENOTSUP:err_t;
extern const ENOTTY:err_t;
extern const ENOTUNIQ:err_t;
extern const ENXIO:err_t;
extern const EOPNOTSUPP:err_t;
extern const EOVERFLOW:err_t;
extern const EPERM:err_t;
extern const EPFNOSUPPORT:err_t;
extern const EPIPE:err_t;
extern const EPROTO:err_t;
extern const EPROTONOSUPPORT:err_t;
extern const EPROTOTYPE:err_t;
extern const ERANGE:err_t;
extern const EREMCHG:err_t;
extern const EREMOTE:err_t;
extern const EREMOTEIO:err_t;
extern const ERESTART:err_t;
extern const EROFS:err_t;
extern const ESHUTDOWN:err_t;
extern const ESPIPE:err_t;
extern const ESOCKTNOSUPPORT:err_t;
extern const ESRCH:err_t;
extern const ESTALE:err_t;
extern const ESTRPIPE:err_t;
extern const ETIME:err_t;
extern const ETIMEDOUT:err_t;
extern const ETXTBSY:err_t;
extern const EUCLEAN:err_t;
extern const EUNATCH:err_t;
extern const EUSERS:err_t;
extern const EWOULDBLOCK:err_t;
extern const EXDEV:err_t;
extern const EXFULL:err_t;


Further refactoring/reorganization of chameneos

This is a pretty significant rewrite compared to my previous ones,
mostly from an OOP/design perspective.

It seemed weird to me to have the chameneos calling routines like CAS
on the MeetingPlace's state value -- which feels like a fairly
encoded/encrypted value whose semantics should be contained within the
meeting place, so I started by moving any routines dealing with the
state into MeetingPlace and out of Chameneos.  For example, I added
methods which convert a (#meetings, chameneos ID) <-> a state value to
keep the encoding of the stack a bit more of a black box.

As part of this, it seemed to make more sense to have the meeting
place host the meetings rather than the chameneos looking over into
the meeting place all the time.  So I moved the parallel loop over the
chameneos population itself into a new method
MeetingPlace.hostMeetings().

Then I put the two actions a chemeneos can take during a meeting --
waiting for it to end or running the meeting -- as methods within
the chameneos itself.

This overall reflects better organization and design to me without
really changing the algorithm at all -- just how it's packaged.  From
what I've seen on my desktop, it doesn't seem to really impact
performance much.  I'm not quite getting my record timings, but close
(and still better than last night's).

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

/* The Computer Language Benchmarks Game
   http://benchmarksgame.alioth.debian.org/

   contributed by Hannah Hemmaplardh
   modified by Lydia Duncan and Brad Chamberlain
*/

//
// the following params indicate the number of bits to use when storing
// IDs in a meeting place's 'state' and the corresponding bitmask
// to use when extracting chameneos IDs, respectively.
//
config param NUM_CHAMENEOS_ID_BITS = 8;
param CHAMENEOS_ID_MASK = (0x1 << NUM_CHAMENEOS_ID_BITS) - 1;

config const n = 100,                // number of meetings to take place
             numChameneos1 = 3,      // size of population 1
             numChameneos2 = 10;     // size of population 2

if (numChameneos1 < 2 || numChameneos2 < 2) then
  halt("There must be at least 2 chameneos");

if (n < 0) then
  halt("the number of meetings must be non-negative");

//
// TODO: We should arguably also check that the number of bits
// devoted to chameneos IDs and meeting IDs are enough to store
// numChameneos1/2 and n, respectively.
//

//
// the colors the chameneos can take on
//
param numColors = 3;
enum Color {blue=0, red, yellow};
//
// TODO: Would be cool to support a param .size query for enums to
// avoid the whole C "declare one extra enum for the number" hack and
// then we could do param numColors = Color.size; (or, if not size,
// some other query function).
//

proc main() {
  //
  // print out the equations that govern chameneos color changes
  //
  printColorEquations();

  //
  // run two simulations for the two different population sizes
  //
  simulate(numChameneos1);
  simulate(numChameneos2);
}

//
// simulate() takes a number of chameneos as input and creates as
// population of that size, then allows them to meet in parallel.
//
proc simulate(numChameneos) {
  //
  // create the population of chameneos
  //
  const chameneos = createChameneos(numChameneos);

  //
  // print the chameneos's initial colors
  //
  for c in chameneos do
    write(" ", c.color);
  writeln();

  //
  // create a meeting place and simulate the interactions
  //
  const meetingPlace = new MeetingPlace(n);
  meetingPlace.hostMeetings(chameneos);

  //
  // print information about the population once we're done
  //
  printInfo(chameneos);
}

//
// This class represents a place for chameneos to meet
//
class MeetingPlace {
  //
  // the 'state' variable packs a chameneos ID in the bottom
  // NUM_CHAMENEOS_ID_BITS bits and the number of meetings in the
  // upper ones, permitting atomic operations to be performed on both
  // values simultaneously.
  //
  var state: atomic int;

  //
  // constructor initializes the number of meetings to take place
  //
  proc MeetingPlace(numMeetings) {
    state.write(numMeetings << NUM_CHAMENEOS_ID_BITS);
  }

  //
  // This method kicks off the execution of all the chameneos in
  // parallel and has them meet with each other in the meeting place.
  //
  proc hostMeetings(chameneos) {
    //
    // fire off a task per chameneos, and have them try to meet
    //
    coforall c in chameneos {
      //
      // each chameneos will try to have meetings with others as
      // long as meetings remain
      //
      do {
        //
        // read the current state, atomically
        //
        const currentState = state.read(memory_order_acquire);

        //
        // extract the number of meetings remaining and the index of a
        // waiting peer (if any) from the state
        //
        const (meetingsLeft, peerID) = stateToVals(currentState);

        //
        // if meetings remain, let's try to get one
        //
        if (meetingsLeft) {
          //
          // We're the first to arrive if there is no peer index in the
          // state
          //
          const firstToArrive = (peerID == 0);

          //
          // We'll try to meet by optimistically building the state
          // that would indicate we were successful in meeting.
          // We decrement the meetingsLeft if we are the second to arrive.
          // If we're the first to arrive, we store our ID; otherwise,
          // we reset the ID to zero.
          //
          const newState = valsToState(meetingsLeft - !firstToArrive,
                                       if firstToArrive then c.id else 0);

          //
          // use a compare-exchange to see if the state remains the
          // same, and to swap in the new state we've computed if it is.
          //
          if (state.compareExchangeStrong(currentState, newState,
                                          memory_order_acq_rel)) {
            //
            // We get to meet!
            //
            if (firstToArrive) {
              //
              // We were the first chameneos in, so we wait for the
              // other to complete the meeting
              //
              c.waitForMeetingToEnd();
            } else {
              //
              // We were the second chameneos in, so we run the meeting
              //
              c.meetWith(chameneos[peerID]);
            }
          }
        }
        //
        // continue looping as long as meetings remain
        //
      } while (meetingsLeft);
    }
  }

  //
  // This method computes a state value from a number of meetings and ID
  //
  inline proc valsToState(numMeetings, chameneosID) {
    return (numMeetings << NUM_CHAMENEOS_ID_BITS) | chameneosID;
  }

  //
  // This method extracts the number of meeting IDs and chameneos ID from
  // a state value
  //
  inline proc stateToVals(state) {
    return (state >> NUM_CHAMENEOS_ID_BITS, state & CHAMENEOS_ID_MASK);
  }
}

//
// a class representing a chameneos
//
class Chameneos {
  const id: int;                       // its unique ID
  var color: Color;                    // its color
  var meetings,                        // the number of meetings it's had
      meetingsWithSelf: int;           // the number of meetings with itself
  var meetingCompleted: atomic bool;   // indicates that a meeting is over

  //
  // This method says how to wait for a meeting to end and is used
  // by the first chameneos to a meeting
  //
  proc waitForMeetingToEnd() {
    //
    // wait for meeting to end
    //
    meetingCompleted.waitFor(true);
    //
    // and then reset our meetingCompleted flag for next time
    //
    meetingCompleted.write(false, memory_order_release);
  }

  //
  // This method computes the meeting between 'this' chameneos and
  // its peer and is used by the second chameneos to a meeting
  //
  proc meetWith(peer) {
    //
    // If we meet with ourself, something's wrong, so check for that
    //
    const metSelf = (peer == this);

    //
    // compute the new color that we'll share as a function of our
    // current colors
    //
    const newColor = getNewColor(color, peer.color);

    //
    // Update our peer's state: store the new color, update its
    // meetings, and then tell it that the meeting's over
    //
    //
    // TODO: abstract the following two assignments into a method to
    // avoid repetition?  Or is that more trouble than it's worth?
    //
    peer.color = newColor;
    peer.meetings += 1;
    peer.meetingsWithSelf += metSelf;
    peer.meetingCompleted.write(true, memory_order_release);

    //
    // Then update ourself similarly
    //
    color = newColor;
    meetings += 1;
    meetingsWithSelf += metSelf;
  }
}

//
// createChameneos() creates an array of chameneos of the given size.
// If the size is 10, it uses the predefined array of colors;
// otherwise, it deals out colors round-robin.
//
//
// TODO: Currently, the compiler prints out an error if we remove the
// return type from here; seems it would be nicer if it just put in
// the array temp?  (unless we think we want to return unevaluated
// iterators, which we may?  But even then, maybe in the meantime, we
// should realize it?)
//
proc createChameneos(size): [1..size] Chameneos {
  //
  // TODO: Really want support for 'use Color' for cases like this
  //
  const colorsFor10 = [Color.blue, Color.red, Color.yellow, Color.red,
                       Color.yellow, Color.blue, Color.red, Color.yellow,
                       Color.red, Color.blue];

  return [i in 1..size] new Chameneos(i, if (size == 10) then colorsFor10[i]
                                                         else ((i-1)%3):Color);
}

//
// getNewColor() returns the complement of two colors; if the two colors
// are the same value, the color stays the same; otherwise, it becomes the
// third color.
//
inline proc getNewColor(myColor, otherColor) {
  select myColor {
    when Color.blue {
      select otherColor {
        when Color.blue do return Color.blue;
        when Color.red  do return Color.yellow;
        otherwise          return Color.red;
      }
    }
    when Color.red {
      select otherColor {
        when Color.blue do return Color.yellow;
        when Color.red  do return Color.red;
        otherwise          return Color.blue;
      }
    }
    otherwise {
      select otherColor {
        when Color.blue do return Color.red;
        when Color.red  do return Color.blue;
        otherwise          return Color.yellow;
      }
    }
  }
}

//
// printColorEquations() prints the result of getNewColor() for all
// pairs of colors
//
proc printColorEquations() {
  const colors = [Color.blue, Color.red, Color.yellow];
  for color1 in colors {
    for color2 in colors {
      writeln(color1, " + ", color2, " -> ", getNewColor(color1, color2));
    }
  }
  writeln();
}

//
// printInfo() prints out information about the population using
// a combination of numbers and English text
//
proc printInfo(chameneos) {
  //
  // for each chameneos, print the number of meetings and spell out
  // the number of self-meetings for each chameneos
  //
  for c in chameneos {
    write(c.meetings);
    spellInt(c.meetingsWithSelf);
  }

  //
  // compute the total number of meetings and spell it out
  //
  const totalMeetings = + reduce chameneos.meetings;
  spellInt(totalMeetings);
  writeln();
}

//
// the base-10 digits
//
// TODO: Would be nice to be able to make this local to spellInt()
//
enum Digit {zero=0, one, two, three, four, five, six, seven, eight, nine};

//
// spellInt() takes out an integer value and prints its digits out
// in English
//
proc spellInt(n) {
  //
  // Cast n to a string so that it's easier (?!) to pick out its characters
  //
  var s = n:string;
  //
  // TODO: would be nice to replace this with a character iterator?
  //
  for i in 1..s.length do
    write(" ", (s.substring(i):int):Digit);
  writeln();
}

/* The Computer Language Benchmarks Game
   http://benchmarksgame.alioth.debian.org/

   contributed by Hannah Hemmaplardh
   modified by Lydia Duncan and Brad Chamberlain
*/

//
// the following params indicate the number of bits to use when storing
// IDs in a meeting place's 'state' and the corresponding bitmask
// to use when extracting chameneos IDs, respectively.
//
config param NUM_CHAMENEOS_ID_BITS = 8;
param CHAMENEOS_ID_MASK = (0x1 << NUM_CHAMENEOS_ID_BITS) - 1;

config const n = 100,                // number of meetings to take place
             numChameneos1 = 3,      // size of population 1
             numChameneos2 = 10;     // size of population 2

if (numChameneos1 < 2 || numChameneos2 < 2) then
  halt("There must be at least 2 chameneos");

if (n < 0) then
  halt("the number of meetings must be non-negative");

//
// TODO: We should arguably also check that the number of bits
// devoted to chameneos IDs and meeting IDs are enough to store
// numChameneos1/2 and n, respectively.
//

//
// the colors the chameneos can take on
//
param numColors = 3;
enum Color {blue=0, red, yellow};
//
// TODO: Would be cool to support a param .size query for enums to
// avoid the whole C "declare one extra enum for the number" hack and
// then we could do param numColors = Color.size; (or, if not size,
// some other query function).
//

proc main() {
  //
  // print out the equations that govern chameneos color changes
  //
  printColorEquations();

  //
  // run two simulations for the two different population sizes
  //
  run(numChameneos1);
  run(numChameneos2);
}

//
// run() takes a number of chameneos as input and creates as
// population of that size, then allows them to meet in parallel.
//
proc run(numChameneos) {
  //
  // create a meeting place
  //
  const meetingPlace = new MeetingPlace(n);

  //
  // create the population of chameneos
  //
  const chameneos = createChameneos(numChameneos);

  //
  // print the chameneos's initial colors
  //
  for c in chameneos do
    write(" ", c.color);
  writeln();

  //
  // fire off a task per chameneos, and have them try to meet
  //
  coforall c in chameneos do
    c.tryToMeet(meetingPlace, chameneos);

  //
  // print information about the run
  //
  printInfo(chameneos);
}

//
// This class represents a place for chameneos to meet
//
class MeetingPlace {
  //
  // the 'state' variable packs a chameneos ID in the bottom
  // NUM_CHAMENEOS_ID_BITS bits and the number of meetings in the
  // upper ones, permitting atomic operations to be performed on both
  // values simultaneously.
  //
  var state: atomic int;

  //
  // constructor initializes the number of meetings to take place
  //
  proc MeetingPlace(numMeetings) {
    state.write(numMeetings << NUM_CHAMENEOS_ID_BITS);
  }
}

//
// createChameneos() creates an array of chameneos of the given size.
// If the size is 10, it uses the predefined array of colors;
// otherwise, it deals out colors round-robin.
//
//
// TODO: Currently, the compiler prints out an error if we remove the
// return type from here; seems it would be nicer if it just put in
// the array temp?  (unless we think we want to return unevaluated
// iterators, which we may?  But even then, maybe in the meantime, we
// should realize it?)
//
proc createChameneos(size): [1..size] Chameneos {
  //
  // TODO: Really want support for 'use Color' for cases like this
  //
  const colorsFor10 = [Color.blue, Color.red, Color.yellow, Color.red,
                       Color.yellow, Color.blue, Color.red, Color.yellow,
                       Color.red, Color.blue];

  return [i in 1..size] new Chameneos(i, if (size == 10) then colorsFor10[i]
                                                         else ((i-1)%3):Color);
}

//
// a class representing a chameneos
//
class Chameneos {
  const id: int;                       // its unique ID
  var color: Color;                    // its color
  var meetings,                        // the number of meetings it's had
      meetingsWithSelf: int;           // the number of meetings with itself
  var meetingCompleted: atomic bool;   // indicates that a meeting is over

  //
  // tryToMeet() tells a chameneos to go to a given MeetingPlace,
  // and try to get involved in meetings with the rest of the
  // population.  If it is first, it can try to wait for another
  // chameneos to arrive; if it is second, it can try to meet with the
  // first chameneos.  The word 'try' is used because other chameneos
  // may be trying to do the same thing simultaneously and beat it to
  // the action.
  //
  proc tryToMeet(meetingPlace, chameneos) {
    //
    // keep trying to meet, as long as there are meetings remaining
    //
    do {
      //
      // grab a copy of the current state
      //
      const currentState = meetingPlace.state.read(memory_order_acquire);

      //
      // if the current state is non-empty, meetings remain
      //
      if (currentState) {
        //
        // extract the number of remaining meetings and the other
        // chameneos's index (if one is present) from the state
        //
        const meetingsLeft = currentState >> NUM_CHAMENEOS_ID_BITS,
              peer_idx = currentState & CHAMENEOS_ID_MASK;

        var newState: int;  // we'll store the new state here

        if (peer_idx) {
          //
          // if another chameneos was waiting in the meeting place, we
          // will hope to meet with it; if we can, the resulting state
          // would have one fewer meetings and no waiting chameneos.
          //
          newState = (meetingsLeft - 1) << NUM_CHAMENEOS_ID_BITS;
        } else {
          //
          // if no other chameneos was waiting, we will hope to enter
          // the meeting place; if we can, the resulting state would
          // have the same number of meetings and our ID stored in the
          // low bits.
          //
          newState = currentState | id;
        }

        //
        // use a CAS to see if the state remains the same, and to swap
        // in the new state we've computed if it is.
        //
        if (meetingPlace.state.compareExchangeStrong(currentState, newState,
                                                     memory_order_acq_rel)) {
          //
          // We get to meet!
          //
          if (peer_idx) {
            //
            // If we were the second chameneos in, we run the meeting
            //
            meetWith(chameneos[peer_idx]);
          } else {
            //
            // If we were the first chameneos in, we wait for the
            // other to complete the meeting
            //
            meetingCompleted.waitFor(true);
            //
            // and then reset our meetingCompleted flag for next time
            //
            meetingCompleted.write(false, memory_order_release);
          }
        }
      }
      //
      // continue looping as long as meetings remain
      //
    } while (currentState);
  }

  //
  // meetWith() computes the meeting between a chameneos ('this')
  // and its peer
  //
  proc meetWith(peer) {
    //
    // If we meet with ourself, something's wrong, so check for that
    //
    const metSelf = (peer == this);

    //
    // compute the new color that we'll share as a function of our
    // current colors
    //
    const newColor = getNewColor(color, peer.color);

    //
    // Update our peer's state: store the new color, update its
    // meetings, and then tell it that the meeting's over
    //
    //
    // TODO: abstract the following two assignments into a method to
    // avoid repetition?  Or is that more trouble than it's worth?
    //
    peer.color = newColor;
    peer.meetings += 1;
    peer.meetingsWithSelf += metSelf;
    peer.meetingCompleted.write(true, memory_order_release);

    //
    // Then update ourself similarly
    //
    color = newColor;
    meetings += 1;
    meetingsWithSelf += metSelf;
  }
}

//
// getNewColor() returns the complement of two colors; if the two colors
// are the same value, the color stays the same; otherwise, it becomes the
// third color.
//
inline proc getNewColor(myColor, otherColor) {
  select myColor {
    when Color.blue {
      select otherColor {
        when Color.blue do return Color.blue;
        when Color.red  do return Color.yellow;
        otherwise          return Color.red;
      }
    }
    when Color.red {
      select otherColor {
        when Color.blue do return Color.yellow;
        when Color.red  do return Color.red;
        otherwise          return Color.blue;
      }
    }
    otherwise {
      select otherColor {
        when Color.blue do return Color.red;
        when Color.red  do return Color.blue;
        otherwise          return Color.yellow;
      }
    }
  }
}

//
// printColorEquations() prints the result of getNewColor() for all
// pairs of colors
//
proc printColorEquations() {
  const colors = [Color.blue, Color.red, Color.yellow];
  for color1 in colors {
    for color2 in colors {
      writeln(color1, " + ", color2, " -> ", getNewColor(color1, color2));
    }
  }
  writeln();
}

//
// printInfo() prints out information about the population using
// a combination of numbers and English text
//
proc printInfo(chameneos) {
  //
  // for each chameneos, print the number of meetings and spell out
  // the number of self-meetings for each chameneos
  //
  for c in chameneos {
    write(c.meetings);
    spellInt(c.meetingsWithSelf);
  }

  //
  // compute the total number of meetings and spell it out
  //
  const totalMeetings = + reduce chameneos.meetings;
  spellInt(totalMeetings);
  writeln();
}

//
// the base-10 digits
//
// TODO: Would be nice to be able to make this local to spellInt()
//
enum Digit {zero=0, one, two, three, four, five, six, seven, eight, nine};

//
// spellInt() takes out an integer value and prints its digits out
// in English
//
proc spellInt(n) {
  //
  // Cast n to a string so that it's easier (?!) to pick out its characters
  //
  var s = n:string;
  //
  // TODO: would be nice to replace this with a character iterator?
  //
  for i in 1..s.length do
    write(" ", (s.substring(i):int):Digit);
  writeln();
}


Specified tasksPerLocale explicitly in test so that output does not depend on
the number of cores (the default setting for tasksPerLocale in Block
distributions).

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

use BlockDist;

var A: [[1..4, 1..4] distributed Block(2,bbox=[1..4,1..4],tasksPerLocale=2)] real;

writeln("Distribution Representation");
writeln();
A.domain.dist.displayRepresentation();

writeln();
writeln("Domain");
writeln();
writeln(A.domain);
writeln();
writeln("Domain Representation");
writeln();
A.domain.displayRepresentation();

writeln();
writeln("Array");
writeln();
writeln(A);
writeln();
writeln("Array Representation");
writeln();
A.displayRepresentation();

use BlockDist;

var A: [[1..4, 1..4] distributed Block(2,bbox=[1..4,1..4])] real;

writeln("Distribution Representation");
writeln();
A.domain.dist.displayRepresentation();

writeln();
writeln("Domain");
writeln();
writeln(A.domain);
writeln();
writeln("Domain Representation");
writeln();
A.domain.displayRepresentation();

writeln();
writeln("Array");
writeln();
writeln(A);
writeln();
writeln("Array Representation");
writeln();
A.displayRepresentation();


Started refactoring a bit

Started refactoring a bit

/*
  Provides a software solution to the problem of applying atomic operations using
  128-bit wide pointers via compression. The algorithm used for compression (and
  decompression) rely on the number locales. In majority of cases where numLocales
  is within a 16 bit range, we can encode it in the upper 16 bits of the address
  as only 2^48 bits of the virtual address space is ever used. In the cases where
  numLocales is between 2^17 and 2^32, we use a novel but simple technique of
  maintaining 'tables' that can be indexed into via a 32-bit integer, allowing the
  other 32-bits to be used for the locale id. The table can be indexed without
  need of synchronization, but as a Chapel array cannot be operated on while it's
  domain is being updated, we use a simple `sync` variable locally and maintain
  32 segments that are allocated on demand. While descriptors are valid, the segment
  being indexed into will be safe to use without synchronization. A simple skip list
  is utilized to efficiently hash objects to their unique index.
*/

use CyclicDist;
use SkipList;

// In the case where you want to use the descriptor table approach for testing or
// because there's some architecture which the assumption that only 48 bits are used
// for the virtual address space is incorrect, you can disable it here.
param const usePointerCompression = true;

// We require this to create a wide pointer after decompression.
extern type wide_ptr_t;
extern type c_nodeid_t;
extern proc chpl_return_wide_ptr_node(c_nodeid_t, c_void_ptr) : wide_ptr_t;

/*
  The core `GlobalAtomicObject` which manages compression and decompression
  for atomic objects. It should be noted that if numLocales >= 2^17, then any
  object being operated on is added to the descriptor table, which will leak data
  if never freed with '_delete' (although if the memory is reused,
  so will the memory managed by this object). The descriptor table will be cleaned
  up automatically when this goes out of scope.
*/
record GlobalAtomicObject {
  type objType;
  var _atomicVar: atomic uint(64);

  // We maintain a SkipList to manage memory (which is built on top of the descriptor
  // table itself). Currently, as the SkipList is not concurrent (requires Hazard Pointers
  // which requires thread-local storage, or task-local storage in this case).
  var perLocaleDomain = LocaleSpace dmapped Cyclic(startIdx=LocaleSpace.low);
  var descriptorTables : [perLocaleDomain] SkipList(objType);
  var descriptorTableLocks : [perLocaleDomain] sync bool;

  /*
    Compresses an object into a descriptor.
  */
  proc compress(obj:objType) : uint {
    if obj == nil then return 0;

    // If we have less than 2^16 locales, we can perform a faster compression
    // by packing the 48 usable bits of the virtual address with 16 bits of the
    // locale/node id.
    if usePointerCompression && (numLocales & 0xFFFF == numLocales) {
      var locId = chpl_nodeFromLocaleID(__primitive("_wide_get_locale", obj)) : uint;
      var addr = __primitive("cast", uint, __primitive("_wide_get_addr", obj));
      return locId << 48 | addr & 0x0000ffffffffffff;
    }

    // Fallback: We use descriptor tables
    var retval : uint;
    on obj {
      descriptorTableLocks[descriptorTableLocks.domain.localSubdomain().first] = true;
      var node = descriptorTables[descriptorTables.domain.localSubdomain().first].insert(obj);
      var localeId = here.id;
      if (localeId & 0xFFFFFFFF) != localeId then halt("LocaleID > 2^32");
      var idx = node.idx;
      if (idx & 0xFFFFFFFF) != idx then halt("Idx > 2^32");
      retval = localeId << 32 | idx;
      descriptorTableLocks[descriptorTableLocks.domain.localSubdomain().first];
    }

    return retval;
  }

  /*
    Decompresses a descriptor into the wide pointer object.
  */
  proc decompress(descr:uint) : objType {
    if descr == 0 then return nil;

    // If we have less than 2^16 locales, then we know we performed the
    // faster compression method so we need to decompress it in the same way...
    if usePointerCompression && (numLocales & 0xFFFF == numLocales) {
      var locId = descr >> 48;
      var addr = descr & 0x0000ffffffffffff;
      var wideptr = chpl_return_wide_ptr_node(locId, __primitive("cast", c_void_ptr, addr));

      // We've created the wide pointer, but unfortunately Chapel does not support
      // the ability to cast it to the actual object, so we have to do some
      // trickery to get it to work. What we do is we allocate a wide pointer on
      // the stack and memcpy our wideptr into the other. This is needed so we
      // have the same type.
      var newObj : objType;
      on Locales[here.id] do newObj = nil;

      // Warning: If this is *not* a wide pointer, it will overwrite part of the stack.
      // If it is, it works. Dangerous, but only way to do so at the moment.
      c_memcpy(c_ptrTo(newObj), c_ptrTo(wideptr), 16);
      return newObj;
    }

    var localeId = descr >> 32;
    var idx = descr & 0xFFFFFFFF;
    return descriptorTables[localeId : int].memPool.access(idx : int).key;
  }

  inline proc read() : objType {
    return decompress(_atomicVar.read());
  }

  inline proc write(obj:objType) {
    _atomicVar.write(compress(obj));
  }

  inline proc exchange(obj:objType) : objType {
    return decompress(_atomicVar.exchange(compress(obj)));
  }

  // TODO: Save time by comparing the actual objects, not just the hash... if both
  // objects are remote, this is a *significant* cost.
  //  var currDescr = _atomicVar.read();
  //  var currObj = decompress(currDescr);
  //  if currObj == expectedObj then _atomicVar.compareExchangeStrong(currDescr, compress(newObj));
  inline proc compareExchange(expectedObj:objType, newObj:objType) : bool {
    return _atomicVar.compareExchangeStrong(compress(expectedObj), compress(newObj));
  }

  /*
    Deletes the object from our table so it may be recycled.
  */
  inline proc _delete(obj:objType) {
    if obj != nil then on obj {
      descriptorTableLocks[descriptorTableLocks.domain.localSubdomain().first] = true;
      descriptorTables[descriptorTables.domain.localSubdomain().first].remove(obj);
      descriptorTableLocks[descriptorTableLocks.domain.localSubdomain().first];
    }
  }
}

proc multiLocaleTest() {
  class D { var d : int; }
  var arr : [{1..100}] D;
  for i in 1 .. 100 {
    on Locales[i % numLocales] do arr[i] = new D(i);
  }

  var x = new GlobalAtomicObject(D);
  x.write(arr[1]);

  for i in 1 .. 99 {
    assert(x.read() == arr[i]);
    var result = x.compareExchange(arr[i], arr[i+1]);
    assert(result);
    delete arr[i];
  }
}

proc singleLocaleTest() {
  class C { var c : int; }
  var a = new C(1);
  var b = new C(2);
  var x = new GlobalAtomicObject(C); // atomic C
  var result : bool;

  x.write(a);
  result = x.compareExchange(a, b);
  assert(result);
  assert(x.read() == b);

  // Note that you can call 'delete' on the object while having it still be present
  // in the descriptor table. This may be okay for most cases where memory is not
  // an issue since reused addresses will hash to the same node and that node will
  // already point to the valid object the user is attempting to insert. However if
  // memory is an issue, one can call '_delete' to ensure that the node itself is removed
  // and can be recycled for later use.
  delete a;
  delete b;

  // Is Safe because we only use the pointer itself. However, in cases where 'a' and 'b'
  // can be reused by the same GlobalAtomicObject, then this could cause undefined behavior
  // where another concurrent task adds the same pointer. In those cases, you should call
  // '_delete' before 'delete'.
  x._delete(a);
  x._delete(b);

  // As well, when GlobalAtomicObject goes out of scope, all nodes it had in use also
  // get deleted...
}

proc main() {
  writeln("Single Locale Test...");
  singleLocaleTest();
  writeln("Passed!");
  writeln("Multi Locale Test...");
  multiLocaleTest();
  writeln("Passed!");
}

use CyclicDist;
use SkipList;

extern type wide_ptr_t;
extern type c_nodeid_t;
extern proc chpl_return_wide_ptr_node(c_nodeid_t, c_void_ptr) : wide_ptr_t;

/*
  Object that allows atomic operations on class instances. Each instance manages
  it's own table which is used to store objects and creates descriptors that refer
  to the index into the table over a 128-bit wide pointer. Currently will only work
  for 2^32 Locales and has enough for 2^32 slots in the table. Only works on class
  instances and is hashed by pointer, not by the value it holds, so each hash value
  is guaranteed to be unique.
*/
record GlobalAtomicObject {
  type objType;
  type atomicType = uint(64);
  var _atomicVar: atomic atomicType;

  var perLocaleDomain = LocaleSpace dmapped Cyclic(startIdx=LocaleSpace.low);
  var descriptorTables : [perLocaleDomain] SkipList(objType);
  var descriptorTableLocks : [perLocaleDomain] sync bool;

  proc compress(obj:objType) : uint {
    if obj == nil then return 0;

    // If we have less than 2^16 locales, we can perform a faster compression
    // by packing the 48 usable bits of the virtual address with 16 bits of the
    // locale/node id.
    if numLocales & 0xFFFF == numLocales {
      var locId = chpl_nodeFromLocaleID(__primitive("_wide_get_locale", obj)) : uint;
      var addr = __primitive("cast", uint, __primitive("_wide_get_addr", obj));
      return locId << 48 | addr & 0x0000ffffffffffff;
    }

    // Fallback: We use descriptor tables
    var retval : uint;
    on obj {
      descriptorTableLocks[descriptorTableLocks.domain.localSubdomain().first] = true;
      var node = descriptorTables[descriptorTables.domain.localSubdomain().first].insert(obj);
      var localeId = here.id;
      if (localeId & 0xFFFFFFFF) != localeId then halt("LocaleID > 2^32");
      var idx = node.idx;
      if (idx & 0xFFFFFFFF) != idx then halt("Idx > 2^32");
      retval = localeId << 32 | idx;
      descriptorTableLocks[descriptorTableLocks.domain.localSubdomain().first];
    }

    return retval;
  }

  proc decompress(descr:uint) : objType {
    if descr == 0 then return nil;

    // If we have less than 2^16 locales, then we know we performed the
    // faster compression method so we need to decompress it in the same way...
    if numLocales & 0xFFFF == numLocales {
      var locId = descr >> 48;
      var addr = descr & 0x0000ffffffffffff;
      var wideptr = chpl_return_wide_ptr_node(locId, __primitive("cast", c_void_ptr, addr));

      // We've created the wide pointer, but unfortunately Chapel does not support
      // the ability to cast it to the actual object, so we have to do some
      // trickery to get it to work. What we do is we allocate a wide pointer
      // the stack and memcpy our wideptr into the actual wide pointer.
      var newObj : objType;
      on Locales[here.id] do newObj = nil;

      // Warning: If this is *not* a wide pointer, it will overwrite part of the stack.
      // If it is, it works. Dangerous, but only way to do so at the moment.
      c_memcpy(c_ptrTo(newObj), c_ptrTo(wideptr), 16);
      return newObj;
    }

    var localeId = descr >> 32;
    var idx = descr & 0xFFFFFFFF;
    return descriptorTables[localeId : int].memPool.access(idx : int).key;
  }

  inline proc read() : objType {
    return decompress(_atomicVar.read());
  }

  inline proc write(obj:objType) {
    _atomicVar.write(compress(obj));
  }

  inline proc exchange(obj:objType) : objType {
    return decompress(_atomicVar.exchange(compress(obj)));
  }

  // TODO: Save time by comparing the actual objects, not just the hash... if both
  // objects are remote, this is a *significant* cost.
  //  var currDescr = _atomicVar.read();
  //  var currObj = decompress(currDescr);
  //  if currObj == expectedObj then _atomicVar.compareExchangeStrong(currDescr, compress(newObj));
  inline proc compareExchange(expectedObj:objType, newObj:objType) : bool {
    return _atomicVar.compareExchangeStrong(compress(expectedObj), compress(newObj));
  }

  inline proc _delete(obj:objType) {
    if obj != nil then on obj {
      descriptorTableLocks[descriptorTableLocks.domain.localSubdomain().first] = true;
      descriptorTables[descriptorTables.domain.localSubdomain().first].remove(obj);
      descriptorTableLocks[descriptorTableLocks.domain.localSubdomain().first];
    }
  }
}

proc multiLocaleTest() {
  class D { var d : int; }
  var arr : [{1..100}] D;
  for i in 1 .. 100 {
    on Locales[i % numLocales] do arr[i] = new D(i);
  }

  var x = new GlobalAtomicObject(D);
  x.write(arr[1]);

  for i in 1 .. 99 {
    assert(x.read() == arr[i]);
    var result = x.compareExchange(arr[i], arr[i+1]);
    assert(result);
    delete arr[i];
  }
}

proc singleLocaleTest() {
  class C { var c : int; }
  var a = new C(1);
  var b = new C(2);
  var x = new GlobalAtomicObject(C); // atomic C
  var result : bool;

  x.write(a);
  result = x.compareExchange(a, b);
  assert(result);
  assert(x.read() == b);

  // Note that you can call 'delete' on the object while having it still be present
  // in the descriptor table. This may be okay for most cases where memory is not
  // an issue since reused addresses will hash to the same node and that node will
  // already point to the valid object the user is attempting to insert. However if
  // memory is an issue, one can call '_delete' to ensure that the node itself is removed
  // and can be recycled for later use.
  delete a;
  delete b;

  // Is Safe because we only use the pointer itself.
  x._delete(a);
  x._delete(b);

  // As well, when GlobalAtomicObject goes out of scope, all nodes it had in use also
  // get deleted...
}

proc main() {
  writeln("Single Locale Test...");
  singleLocaleTest();
  writeln("Passed!");
  writeln("Multi Locale Test...");
  multiLocaleTest();
  writeln("Passed!");
}


Small optimization in the adaptive iterators: moving the global variable
"nVisistedVictims" to control the termination of stealing to task private (as
in the original implementation).

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

config param verbose:bool=false;

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

// Serial iterator

iter dynamic(c:range(?), chunkSize:int, numTasks:int) {

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

  for i in c do yield i;
}

// Parallel iterator

// Leader iterator

iter dynamic(param tag:iterator, c:range(?), chunkSize:int, numTasks:int=0)
where tag == iterator.leader
{
  // Check if the number of tasks is 0, in that case it returns a default value
  const nTasks=defaultNumTasks(numTasks);
  type rType=c.type;
  // Check the size and do it serial if not enough work
  if c.length == 0 then halt("The range is empty");
  if c.length/chunkSize < nTasks then {
    writeln("Dynamic Iterator: serial execution because there is not enough work");
    const totalRange:rType= densify(c,c);
    //yield tuple(c.translate(-c.low)) ;
    yield tuple(totalRange);

  }
  else {
    var remain:rType=c;
    var moreWork=true;
    var splitLock$:sync bool=true;   // sync variables to control the splitting

    coforall tid in 0..#nTasks do {
      while moreWork do {
	  // There is local work in remain
	  splitLock$; // Perform the splitting in a critical section
	  const current:rType=splitChunk(remain, chunkSize, moreWork);
	  splitLock$=true;
	  if current.length !=0 then {
	    const zeroBasedIters:rType= densify(current,c);
	    if verbose then
	      writeln("Parallel dynamic Iterator. Working at tid ", tid, " with range ", current, " yielded as ", zeroBasedIters);

	    yield tuple(zeroBasedIters);}
	}
    }
  }
}

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

//************************* Guided iterator
//Serial iterator
iter guided(c:range(?), numTasks:int) {

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

  for i in c do yield i;
}

// Parallel iterator

// Leader iterator
iter guided(param tag:iterator, c:range(?), numTasks:int=0)
where tag == iterator.leader
{
  // Check if the number of tasks is 0, in that case it returns a default value
  const nTasks=defaultNumTasks(numTasks);
  type rType=c.type;
  // Check the size and do it serial if not enough work
  if c.length == 0 then halt("The range is empty");
  if c.length < nTasks then {
    writeln("Guided Iterator: serial execution because there is not enoguh work");
    const totalRange:rType= densify(c,c);
    yield tuple(totalRange);
  }

  else {
    var remain:rType=c;
    var undone=true;
    const factor=nTasks;
    var splitLock$:sync bool=true;  // synnc variables to control the splitting

    coforall tid in 0..#nTasks do {
      while undone do {
	  // There is local work in remain(tid)
	  splitLock$; // Perform the splitting in a critical section
	  const current:rType=adaptSplit(remain, factor, undone);
	  splitLock$=true;
	  if current.length !=0 then {
	    const zeroBasedIters:rType = densify(current,c);
	    if verbose then
	      writeln("Parallel guided Iterator. Working at tid ", tid, " with range ", current, " yielded as ", zeroBasedIters);

	    yield tuple(zeroBasedIters);}
	}
    }
  }
}

// Follower
iter guided(param tag:iterator, c:range(?), numTasks:int, follower)
where tag == iterator.follower

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

//************************* Adaptive work-stealing iterator
//Serial iterator
iter adaptive(c:range(?), numTasks:int) {

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

  for i in c do yield i;

}

// Parallel iterator

config param methodStealing:int=0;

// Leader iterator
iter adaptive(param tag:iterator, c:range(?), numTasks:int=0)
where tag == iterator.leader

{
  if (methodStealing > 2 || methodStealing < 0) then
    halt("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=defaultNumTasks(numTasks);
  type rType=c.type;
  // Check the size and do it serial if not enough work
  if c.length == 0 then halt("The range is empty");
  if c.length < nTasks then {
    writeln("Adaptive work-stealing Iterator: serial execution because there is not enough work");
    const totalRange:rType = densify(c,c);
    yield tuple(totalRange);

  }
  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 splitLock$:[SpaceThreads] sync bool=true; // 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 barrierCount$:sync int=0;
    var wait$:single bool;

    // Start the parallel work
    coforall tid in 0..#nTasks do {

      // Step 1: Initial range per Thread/Task

      localWork[tid]=splitRange(r,tid);  // Initial Local range in localWork[tid]
      if verbose 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;

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

      while moreLocalWork[tid] do {
	  // There is local work
	  const zeroBasedIters:rType=splitWork(tid); // The current range we get after splitting locally
	  if zeroBasedIters.length !=0 then {
	    if verbose then
	      writeln("Parallel adaptive Iterator. Working locally at tid ", tid, " with range yielded as ", zeroBasedIters);
	    yield tuple(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 verbose 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

	  select methodStealing {
	    when 0 do { // Steals from the victim until it exhausts its range

	      while moreLocalWork[victim] do {
		  // There is work in victim
		  const zeroBasedIters2:rType=splitWork(victim); // The current range we get
		                                        //after splitting from a victim range
		  if zeroBasedIters2.length !=0 then {
		    if verbose then
		      writeln("Range stealed at victim ", victim," yielded as ", zeroBasedIters2," by tid ", tid);
		    yield tuple(zeroBasedIters2);}
		}
	    }

	    when 1 do { // Steals once from victim. If it has sucess on the stealing,
	                // it chooses another victim and tries to steal again.

	      if moreLocalWork[victim] then {
		// There is work in victim
		const zeroBasedIters2:rType=splitWork(victim); // The current range we get
		                                   //after splitting from a victim range
		if zeroBasedIters2.length !=0 then {
		  if verbose then
		    writeln("Range stealed at victim ", victim," yielded as ", zeroBasedIters2," by tid ", tid);
		  yield tuple(zeroBasedIters2);}
	      }
	      else {
		stealFailed=true;
	      }
	    }
	    otherwise { // Tt steals from the victim, but now splitting
	                //from the tail of the victim's range

	      while moreLocalWork[victim] do {
		  // There is work in victim
		  const zeroBasedIters2:rType=splitWork(victim, true); // The current range we get
		                        // after splitting from a victim range:
		                       // now we set splitTatil to true (second parameter in the call)
		  if zeroBasedIters2.length !=0 then {
		    if verbose then
		      writeln("Range stealed at victim ", victim," yielded as ", zeroBasedIters2," by tid ", tid);
		    yield tuple(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==0 || methodStealing==2 || (methodStealing==1 && stealFailed)) then {
	    nVisitedVictims += 1; // Signal that there is no more work in victim
	    if verbose then
	      writeln("Failed Stealing intent at tid ", tid," with victim ", victim, " and total no. of visited victims ", nVisitedVictims);
	    stealFailed=false;
	  }
	  // 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==1 then
	      if victim==tid then victim=(victim+1) % nTasks;
	  }
	}
    }

    proc splitRange(c:range(?),tid:int)
  {
    const size= c.length/nTasks;
    var rLocal:rType=(c+tid*size)#size;
    if tid==nTasks-1 then
      rLocal=c#(size*(nTasks-1)-c.length);
    return rLocal;
  }

  proc barrier
  {
    var tmp=barrierCount$;
    barrierCount$=tmp+1;
    if tmp+1==nTasks then wait$=true;
    wait$;
  }

    proc splitWork(taskid:int, splitTail:bool=false)
  {
    if splitTail then { // Splitting from the tail of the remaining range (method 2)
      splitLock$[taskid]; // Perform the splitting in a critical section
      const current:rType=adaptSplit(localWork[taskid], factorSteal, moreLocalWork[taskid], splitTail);
      splitLock$[taskid]=true;
      const zeroBasedCurrent3:rType=current;
      return zeroBasedCurrent3;
    }
    else { // Splitting from the head of the remaining range (methods 0 and 1)
      splitLock$[taskid]; // Perform the splitting in a critical section
      const current:rType=adaptSplit(localWork[taskid], factorSteal, moreLocalWork[taskid]);
      splitLock$[taskid]=true;
      const zeroBasedCurrent:rType=current;
      return zeroBasedCurrent;
      }

  }
  }
}

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

//************************* Helper functions
proc defaultNumTasks(nTasks:int)
{
  var dnTasks=nTasks;
  if nTasks==0 then {
    if dataParTasksPerLocale==0 then dnTasks=here.numCores;
      else dnTasks=dataParTasksPerLocale;
  }
  return dnTasks;
}

proc splitChunk(inout rangeToSplit:range(?), chunkSize:int, inout itLeft:bool)
{
  type rType=rangeToSplit.type;
  type lenType=rangeToSplit.length.type;
  var totLen, size:lenType;

  totLen=rangeToSplit.length;
  size=chunkSize;
  if totLen <= size then
    {
    size=totLen;
    itLeft=false;
    }
  const firstRange:rType=rangeToSplit#size;
  rangeToSplit=rangeToSplit#(size-totLen);
  return firstRange;
}

proc adaptSplit(inout rangeToSplit:range(?), splitFactor:int, inout itLeft:bool, splitTail:bool=false)
{
  type rType=rangeToSplit.type;
  type lenType=rangeToSplit.length.type;
  var totLen, size:lenType;
  var direction: int;
  const profThreshold=1;

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

config param verbose:bool=false;

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

// Serial iterator

iter dynamic(c:range(?), chunkSize:int, numTasks:int) {

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

  for i in c do yield i;
}

// Parallel iterator

// Leader iterator

iter dynamic(param tag:iterator, c:range(?), chunkSize:int, numTasks:int=0)
where tag == iterator.leader
{
  // Check if the number of tasks is 0, in that case it returns a default value
  const nTasks=defaultNumTasks(numTasks);
  type rType=c.type;
  // Check the size and do it serial if not enough work
  if c.length == 0 then halt("The range is empty");
  if c.length/chunkSize < nTasks then {
    writeln("Dynamic Iterator: serial execution because there is not enough work");
    const totalRange:rType= densify(c,c);
    //yield tuple(c.translate(-c.low)) ;
    yield tuple(totalRange);

  }
  else {
    var remain:rType=c;
    var moreWork=true;
    var splitLock$:sync bool=true;   // sync variables to control the splitting

    coforall tid in 0..#nTasks do {
      while moreWork do {
	  // There is local work in remain
	  splitLock$; // Perform the splitting in a critical section
	  const current:rType=splitChunk(remain, chunkSize, moreWork);
	  splitLock$=true;
	  if current.length !=0 then {
	    const zeroBasedIters:rType= densify(current,c);
	    if verbose then
	      writeln("Parallel dynamic Iterator. Working at tid ", tid, " with range ", current, " yielded as ", zeroBasedIters);

	    yield tuple(zeroBasedIters);}
	}
    }
  }
}

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

//************************* Guided iterator
//Serial iterator
iter guided(c:range(?), numTasks:int) {

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

  for i in c do yield i;
}

// Parallel iterator

// Leader iterator
iter guided(param tag:iterator, c:range(?), numTasks:int=0)
where tag == iterator.leader
{
  // Check if the number of tasks is 0, in that case it returns a default value
  const nTasks=defaultNumTasks(numTasks);
  type rType=c.type;
  // Check the size and do it serial if not enough work
  if c.length == 0 then halt("The range is empty");
  if c.length < nTasks then {
    writeln("Guided Iterator: serial execution because there is not enoguh work");
    const totalRange:rType= densify(c,c);
    yield tuple(totalRange);
  }

  else {
    var remain:rType=c;
    var undone=true;
    const factor=nTasks;
    var splitLock$:sync bool=true;  // synnc variables to control the splitting

    coforall tid in 0..#nTasks do {
      while undone do {
	  // There is local work in remain(tid)
	  splitLock$; // Perform the splitting in a critical section
	  const current:rType=adaptSplit(remain, factor, undone);
	  splitLock$=true;
	  if current.length !=0 then {
	    const zeroBasedIters:rType = densify(current,c);
	    if verbose then
	      writeln("Parallel guided Iterator. Working at tid ", tid, " with range ", current, " yielded as ", zeroBasedIters);

	    yield tuple(zeroBasedIters);}
	}
    }
  }
}

// Follower
iter guided(param tag:iterator, c:range(?), numTasks:int, follower)
where tag == iterator.follower

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

//************************* Adaptive work-stealing iterator
//Serial iterator
iter adaptive(c:range(?), numTasks:int) {

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

  for i in c do yield i;

}

// Parallel iterator

config param methodStealing:int=0;

// Leader iterator
iter adaptive(param tag:iterator, c:range(?), numTasks:int=0)
where tag == iterator.leader

{
  if (methodStealing > 2 || methodStealing < 0) then
    halt("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=defaultNumTasks(numTasks);
  type rType=c.type;
  // Check the size and do it serial if not enough work
  if c.length == 0 then halt("The range is empty");
  if c.length < nTasks then {
    writeln("Adaptive work-stealing Iterator: serial execution because there is not enough work");
    const totalRange:rType = densify(c,c);
    yield tuple(totalRange);

  }
  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 splitLock$:[SpaceThreads] sync bool=true; // 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
    var nVisitedVictims: int=0;

    // Variables to put a barrier to ensure the initial range is computed on each Thread
    var barrierCount$:sync int=0;
    var wait$:single bool;

    // Start the parallel work
    coforall tid in 0..#nTasks do {

      // Step 1: Initial range per Thread/Task

      localWork[tid]=splitRange(r,tid);  // Initial Local range in localWork[tid]
      if verbose 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;

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

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

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

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

      while moreWork do {
	  if verbose 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

	  select methodStealing {
	    when 0 do { // Steals from the victim until it exhausts its range

	      while moreLocalWork[victim] do {
		  // There is work in victim
		  const zeroBasedIters2:rType=splitWork(victim); // The current range we get
		                                        //after splitting from a victim range
		  if zeroBasedIters2.length !=0 then {
		    if verbose then
		      writeln("Range stealed at victim ", victim," yielded as ", zeroBasedIters2," by tid ", tid);
		    yield tuple(zeroBasedIters2);}
		}
	    }

	    when 1 do { // Steals once from victim. If it has sucess on the stealing,
	                // it chooses another victim and tries to steal again.

	      if moreLocalWork[victim] then {
		// There is work in victim
		const zeroBasedIters2:rType=splitWork(victim); // The current range we get
		                                   //after splitting from a victim range
		if zeroBasedIters2.length !=0 then {
		  if verbose then
		    writeln("Range stealed at victim ", victim," yielded as ", zeroBasedIters2," by tid ", tid);
		  yield tuple(zeroBasedIters2);}
	      }
	      else {
		stealFailed=true;
	      }
	    }
	    otherwise { // Tt steals from the victim, but now splitting
	                //from the tail of the victim's range

	      while moreLocalWork[victim] do {
		  // There is work in victim
		  const zeroBasedIters2:rType=splitWork(victim, true); // The current range we get
		                        // after splitting from a victim range:
		                       // now we set splitTatil to true (second parameter in the call)
		  if zeroBasedIters2.length !=0 then {
		    if verbose then
		      writeln("Range stealed at victim ", victim," yielded as ", zeroBasedIters2," by tid ", tid);
		    yield tuple(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==0 || methodStealing==2 || methodStealing==1 && stealFailed) then {
	    nVisitedVictims += 1; // Signal that there is no more work in victim
	    if verbose then
	      writeln("Failed Stealing intent at tid ", tid," with victim ", victim, " and total no. of visited victims ", nVisitedVictims);
	    stealFailed=false;
	  }
	  // 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==1 then
	      if victim==tid then victim=(victim+1) % nTasks;
	  }
	}
    }

    proc splitRange(c:range(?),tid:int)
  {
    const size= c.length/nTasks;
    var rLocal:rType=(c+tid*size)#size;
    if tid==nTasks-1 then
      rLocal=c#(size*(nTasks-1)-c.length);
    return rLocal;
  }

  proc barrier
  {
    var tmp=barrierCount$;
    barrierCount$=tmp+1;
    if tmp+1==nTasks then wait$=true;
    wait$;
  }

    proc splitWork(taskid:int, splitTail:bool=false)
  {
    if splitTail then { // Splitting from the tail of the remaining range (method 2)
      splitLock$[taskid]; // Perform the splitting in a critical section
      const current:rType=adaptSplit(localWork[taskid], factorSteal, moreLocalWork[taskid], splitTail);
      splitLock$[taskid]=true;
      const zeroBasedCurrent3:rType=current;
      return zeroBasedCurrent3;
    }
    else { // Splitting from the head of the remaining range (methods 0 and 1)
      splitLock$[taskid]; // Perform the splitting in a critical section
      const current:rType=adaptSplit(localWork[taskid], factorSteal, moreLocalWork[taskid]);
      splitLock$[taskid]=true;
      const zeroBasedCurrent:rType=current;
      return zeroBasedCurrent;
      }

  }
  }
}

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

//************************* Helper functions
proc defaultNumTasks(nTasks:int)
{
  var dnTasks=nTasks;
  if nTasks==0 then {
    if dataParTasksPerLocale==0 then dnTasks=here.numCores;
      else dnTasks=dataParTasksPerLocale;
  }
  return dnTasks;
}

proc splitChunk(inout rangeToSplit:range(?), chunkSize:int, inout itLeft:bool)
{
  type rType=rangeToSplit.type;
  type lenType=rangeToSplit.length.type;
  var totLen, size:lenType;

  totLen=rangeToSplit.length;
  size=chunkSize;
  if totLen <= size then
    {
    size=totLen;
    itLeft=false;
    }
  const firstRange:rType=rangeToSplit#size;
  rangeToSplit=rangeToSplit#(size-totLen);
  return firstRange;
}

proc adaptSplit(inout rangeToSplit:range(?), splitFactor:int, inout itLeft:bool, splitTail:bool=false)
{
  type rType=rangeToSplit.type;
  type lenType=rangeToSplit.length.type;
  var totLen, size:lenType;
  var direction: int;
  const profThreshold=1;

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