Fix errors with error

Fix errors with error

/*
 * 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.
 */
use Error;

/* Change the current working directory of the current locale to the specified
   name. Returns any errors that occurred via an out parameter.
   err: a syserr used to indicate if an error occurred
   name: a string indicating a new directory

   Note: this is not safe within a parallel context.  A chdir call in one task
   will affect the current working directory of all tasks for that locale.
*/
proc locale.chdir(out error: syserr, name: string) {
  extern proc chpl_fs_chdir(name: c_string):syserr;

  on this {
    error = chpl_fs_chdir(name.c_str());
  }
}

/* Change the current working directory of the current locale to the specified
   name. Generates an error message if one occurred.
   name: a string indicating a new directory

   Note: this is not safe within a parallel context.  A chdir call in one task
   will affect the current working directory of all tasks for that locale.
*/
proc locale.chdir(name: string) {
  var err: syserr = ENOERR;
  chdir(err, name);
  if err != ENOERR then ioerror(err, "in chdir", name);
}

/* Set the permissions of the file or directory specified by name to that
   indicated by settings.  Returns any errors that occurred via an out
   parameter.

   :arg err: a syserr used to indicate if an error occurred
   :arg name: the name of the file/directory which should have its permissions
              alterred.
   :arg mode: an integer representing the permissions desired for the file in
              question.  See description of the provided constants for
              potential values.
*/
proc chmod(out error: syserr, name: string, mode: int) {
  extern proc chpl_fs_chmod(name: c_string, mode: int): syserr;

  error = chpl_fs_chmod(name.c_str(), mode);
}

/* Set the permissions of the file or directory specified by name to that
   indicated by settings, and may generate an error message

   :arg name: the name of the file/directory which should have its permissions
              alterred.
   :arg mode: an integer representing the permissions desired for the file
              in question.  See description of the provided constants for potential
              values.
*/
proc chmod(name: string, mode: int){
  var err: syserr = ENOERR;
  chmod(err, name, mode);
  if err != ENOERR then ioerror(err, "in chmod", name);
}

/* Changes one or both of the owner and group id of the named file to the
   specified values.  If uid or gid are -1, the value in question will remain
   unchanged.
   err: a syserr used to indicate if an error occurred
   name: the name of the file to be changed.
   uid: user id to use as new owner, or -1 if it should remain the same.
   gid: group id to use as the new group owner, or -1 if it should remain the same.
*/
proc chown(out error: syserr, name: string, uid: int, gid: int) {
  extern proc chpl_fs_chown(name: c_string, uid: c_int, gid: c_int):syserr;

  error = chpl_fs_chown(name.c_str(), uid:c_int, gid:c_int);
}

/* Changes one or both of the owner and group id of the named file to the
   specified values.  If uid or gid are -1, the value in question will remain
   unchanged. Generates an error message if one occurred.
   name: the name of the file to be changed.
   uid: user id to use as new owner, or -1 if it should remain the same.
   gid: group id to use as the new group owner, or -1 if it should remain the same.
*/
proc chown(name: string, uid: int, gid: int) {
  var err: syserr = ENOERR;
  chown(err, name, uid, gid);
  if err != ENOERR then ioerror(err, "in chown", name);
}

// FUTURE WORK:
// When basename and joinPath are supported, enable dest to be a directory.

/* Copies the contents and permissions of the file indicated by src into
   the file or directory dest.  If dest is a directory, will return an error via
   the out parameter.  If metadata is set to true, will also copy the metadata
   of the file to be copied.  Other errors may also be returned via the out
   parameter.
   err: a syserr used to indicate if an error occurred
   src: the source file whose contents and permissions are to be copied
   dest: the destination file for the contents and permissions.
   metadata: a boolean indicating whether to copy metadata (uid, gid, time of
             last access and time of modification) associated with the source
             file.
*/
proc copy(out error: syserr, src: string, dest: string, metadata: bool = false) {
  var destFile = dest;
  if (isDir(error, destFile)) {
    // destFile = joinPath(destFile, basename(src));
    error = EISDIR;
    // Supporting a destination directory requires getting the basename from
    // the src (because we're using the same name) and joining it with the
    // provided destination directory.  Both of those operations are part of
    // the string portion, so we aren't supporting it just yet.
    return;
  } else {
    if (error == ENOENT) {
      // Destination didn't exist before.  We'd be overwriting it anyways, so
      // we don't care.
      error = ENOERR;
    }
    if error != ENOERR then return;
  }
  copyFile(error, src, destFile);
  if error != ENOERR then return;
  copyMode(error, src, destFile);
  if error != ENOERR then return;

  if (metadata) {
    extern proc chpl_fs_copy_metadata(source: c_string, dest: c_string): syserr;

    // Copies the access time, and time of last modification.
    // Does not copy uid, gid, or mode
    error = chpl_fs_copy_metadata(src.c_str(), dest.c_str());

    // Get uid and gid from src
    var uid = getUID(error, src);
    if error != ENOERR then return;
    var gid = getGID(error, src);
    if error != ENOERR then return;
    // Change uid and gid to that of the src
    chown(error, destFile, uid, gid);
  }
}

/* Copies the contents and permissions of the file indicated by src into
   the file or directory dest.  If dest is a directory, will halt with an error
   message.  If metadata is set to true, will also copy the metadata of the
   file to be copied.  May halt with other error messages.
   src: the source file whose contents and permissions are to be copied
   dest: the destination file for the contents and permissions.
   metadata: a boolean indicating whether to copy metadata (uid, gid, time of
             last access and time of modification) associated with the source
             file.
*/
proc copy(src: string, dest: string, metadata: bool = false) {
  var err: syserr = ENOERR;
  copy(err, src, dest, metadata);
  if err != ENOERR then ioerror(err, "in copy(" + src + ", " + dest + ")");
}

/* Copies the contents of the file indicated by src into the file indicated
   by dest, replacing dest if it already exists (and is different than src).
   If the dest is not writable or src and dest are the same file, generates
   an error.  Does not copy metadata.
   err: a syserr used to indicate if an error occurred
   src: the source file whose contents are to be copied.
   dest: the destination of the contents.
*/
proc copyFile(out error: syserr, src: string, dest: string) {
  // This implementation is based off of the python implementation for copyfile,
  // with some slight differences.  That implementation was found at:
  // https://bitbucket.org/mirror/cpython/src/c8ce5bca0fcda4307f7ac5d69103ce128a562705/Lib/shutil.py?at=default
  // I did not look at the other functions in that file, except for copyfileobj
  // (which copyfile called).
  if (!exists(src)) {
    error = ENOENT;
    // Source didn't exist, we can't copy it.
    return;
  }
  if (isDir(error, src) || isDir(error, dest)) {
    // If the source is a directory, the user has made a mistake, so return an
    // error.  The same is true if the destination is a directory.
    error = EISDIR;
    return;
  }

  if (error == ENOENT) {
    error = ENOERR;
    // We don't care if dest did not exist before, we'll create or overwrite it
    // anyways.  We already know src exists.
  } else if (sameFile(error, src, dest)) {
    // Check if the files are the same, error if yes

    // Don't need to check if they're the same file when we know dest didn't
    // exist.
    error = EINVAL;
    return;
    // The second argument is invalid if the two arguments are the same.
  }

  // Lydia note (03/04/2014): These enclosing curly braces are to avoid the bug
  // found in test/io/lydia/outArgEarlyExit*.future.  When those futures are
  // resolved, the braces should be removed.
  {
    // Open src for reading, open dest for writing
    var srcFile = open(src, iomode.r);
    var destFile = open(dest, iomode.cw);
    var srcChnl = srcFile.reader(kind=ionative, locking=false);
    var destChnl = destFile.writer(kind=ionative, locking=false);
    // read in, write out.
    var line: [0..1023] uint(8);
    var numRead: int = 0;
    while (srcChnl.readline(line, numRead=numRead, error=error)) {
      // From mppf:
      // If you want it to be faster, we can make it only buffer once (sharing
      // the bytes read into memory between the two channels). To do that you'd
      // do something like this (in a loop):

      // srcReader.mark
      // srcReader.advance( buffer size )
      // srcReader.beginPeekBuffer to get the current buffer (qio_channel_begin_peek_buffer)
      // dstWriter.putBuffer with the buffer we got (qio_channel_put_buffer)
      // srcReader.endPeekBuffer

      // Some of these routines don't exist with Chapel wrappers now

      destChnl.write(line[0..#numRead]);
    }
    if error == EEOF then error = ENOERR;
    destChnl.flush();

    srcFile.close();
    destFile.close();
  }
}

/* Copies the contents of the file indicated by src into the file indicated
   by dest, replacing dest if it already exists (and is different than src).
   If the dest is not writable or src and dest are the same file, halts with
   an error.  Does not copy metadata.  May halt with an error message.
   src: the source file whose contents are to be copied.
   dest: the destination of the contents.
*/
proc copyFile(src: string, dest: string) {
  var err: syserr = ENOERR;
  copyFile(err, src, dest);
  if err != ENOERR then ioerror(err, "in copyFile(" + src + ", " + dest + ")");
}

/* Copies the permissions of the file indicated by src to the file indicated
   by dest, leaving contents, owner and group unaffected.
   err: a syserr used to indicate if an error occurred
   src: the source file whose permissions are to be copied.
   dest: the destination of the permissions.
*/
proc copyMode(out error: syserr, src: string, dest: string) {
  // Gets the mode from the source file.
  var srcMode = getMode(error, src);
  // If any error occurred, we want to be the one reporting it, so as not
  // to bleed implementation details.  If we found one when viewing the
  // source's mode, we should return immediately.
  if error != ENOERR then return;
  // Sets the mode of the destination to the source's mode.
  chmod(error, dest, srcMode);
}

/* Copies the permissions of the file indicated by src to the file indicated
   by dest, leaving contents, owner and group unaffected.  May halt with an
   error message.
   src: the source file whose permissions are to be copied.
   dest: the destination of the permissions.
*/
proc copyMode(src: string, dest: string) {
  var err: syserr = ENOERR;
  copyMode(err, src, dest);
  if err != ENOERR then ioerror(err, "in copyMode " + src, dest);
}

/* Returns the current working directory for the current locale.
   err: a syserr used to indicate if an error occurred

   Note: another task on this locale can change the current working
   directory from underneath this task, so use caution when making use
   of this function in a parallel environment.
*/
proc locale.cwd(out error: syserr): string {
  extern proc chpl_fs_cwd(ref working_dir:c_string_copy):syserr;

  var ret:string;
  on this {
    var tmp:c_string_copy;
    // c_strings and c_string_copy's can't cross on statements.
    error = chpl_fs_cwd(tmp);
    if (error != ENOERR) {
      ret = "";
    } else {
      // This version of toString steals its operand.  No need to free.
      ret = toString(tmp);
    }
  }
  return ret;
}

/* Returns the current working directory for the current locale. Generates an
   error message if one occurred.

   Note: another task on this locale can change the current working
   directory from underneath this task, so use caution when making use
   of this function in a parallel environment.
*/
proc locale.cwd(): string {
  var err: syserr = ENOERR;
  var ret = cwd(err);
  if err != ENOERR then ioerror(err, "in cwd");
  return ret;
}

/* Returns true if the provided filename corresponds to an existing file, false
   otherwise.  Returns false for broken symbolic links.  Returns any errors that
   occurred via an out parameter
   name: a string used to attempt to find the file specified.
*/
proc exists(out error: syserr, name: string): bool {
  extern proc chpl_fs_exists(ref result:c_int, name: c_string): syserr;

  var ret:c_int;
  error = chpl_fs_exists(ret, name.c_str());
  return ret != 0;
}

/* Returns true if the provided filename corresponds to an existing file, false
   otherwise.  Returns false for broken symbolic links.  Generates an error
   message if one occurred.
   name: a string used to attempt to find the file specified.
*/
proc exists(name: string): bool {
  var err: syserr = ENOERR;
  var ret = exists(err, name);
  if err != ENOERR then ioerror(err, "in exists");
  return ret;
}

/* Returns the group id associated with the file or directory specified by
   name.  Returns any errors that occurred via an out parameter.
   err: a syserr used to indicate if an error occurred
   name: a string used to indicate the file in question
*/
proc getGID(out error: syserr, name: string): int {
  extern proc chpl_fs_get_gid(ref result: c_int, filename: c_string): syserr;

  var result: c_int;
  error = chpl_fs_get_gid(result, name.c_str());
  return result;
}

/* Returns the group id associated with the file or directory specified by
   name.  May generate an error message.
   name: a string used to indicate the file in question
*/
proc getGID(name: string): int {
  var err: syserr = ENOERR;
  var ret = getGID(err, name);
  if err != ENOERR then ioerror(err, "in getGID");
  return ret;
}

/* Returns an integer representing the current permissions of the file specified
   by name.  May generate an error message.
   err: a syserr used to indicate if an error occurred during this function
   name: the name of the file that you want to know the permissions of.
*/
proc getMode(out error: syserr, name: string): int {
  extern proc chpl_fs_viewmode(ref result:c_int, name: c_string): syserr;

  var ret:c_int;
  error = chpl_fs_viewmode(ret, name.c_str());
  return ret;
}

/* Returns an integer representing the current permissions of the file specified
   by name.  May generate an error message.
   name: the name of the file that you want to know the permissions of.
*/
proc getMode(name: string): int {
  var err:syserr = ENOERR;
  var result = getMode(err, name);
  if err != ENOERR then ioerror(err, "in getMode", name);
  return result;
}

/* Returns the user id associated with the file or directory specified by
   name.  Returns any errors that occurred via an out parameter.
   err: a syserr used to indicate if an error occurred
   name: a string used to indicate the file in question
*/
proc getUID(out error: syserr, name: string): int {
  extern proc chpl_fs_get_uid(ref result: c_int, filename: c_string): syserr;

  var result: c_int;
  error = chpl_fs_get_uid(result, name.c_str());
  return result;
}

/* Returns the user id associated with the file or directory specified by
   name.  May generate an error message.
   name: a string used to indicate the file in question
*/
proc getUID(name: string): int {
  var err: syserr = ENOERR;
  var ret = getUID(err, name);
  if err != ENOERR then ioerror(err, "in getUID");
  return ret;
}

/* Returns true if the name corresponds to a directory, false otherwise.
   err: a syserr used to indicate if an error occurred
   name: a string that could be the name of a directory.
*/
proc isDir(out error:syserr, name:string):bool {
  extern proc chpl_fs_is_dir(ref result:c_int, name: c_string):syserr;

  var ret:c_int;
  error = chpl_fs_is_dir(ret, name.c_str());
  return ret != 0;
}

/* Returns true if the name corresponds to a directory, false otherwise.
   Generates an error message if one occurs.
   name: a string that could be the name of a directory.
*/
proc isDir(name:string):bool {
  var err:syserr;
  var ret = isDir(err, name);
  if err != ENOERR then ioerror(err, "in isDir", name);
  return ret;
}

/* Returns true if the name corresponds to a file, false otherwise.
   err: a syserr used to indicate if an error occurred
   name: a string that could be the name of a file.
*/
proc isFile(out error:syserr, name:string):bool {
  extern proc chpl_fs_is_file(ref result:c_int, name: c_string):syserr;

  var ret:c_int;
  error = chpl_fs_is_file(ret, name.c_str());
  return ret != 0;
}

/* Returns true if the name corresponds to a file, false otherwise.
   Generates an error message if one occurs.
   name: a string that could be the name of a file.
*/
proc isFile(name:string):bool {
  var err:syserr;
  var ret = isFile(err, name);
  if err != ENOERR then ioerror(err, "in isFile", name);
  return ret;
}

/* Returns true if the name corresponds to a symbolic link, false if not
   or if symbolic links are not supported.
   name: a string that could be the name of a symbolic link.
*/
proc isLink(out error:syserr, name: string): bool {
  extern proc chpl_fs_is_link(ref result:c_int, name: c_string): syserr;

  var ret:c_int;
  error = chpl_fs_is_link(ret, name.c_str());
  return ret != 0;
}

/* Returns true if the name corresponds to a symbolic link, false if not
   or if symbolic links are not supported.  Generates an error message if one
   occurs
   name: a string that could be the name of a symbolic link.
*/
proc isLink(name: string): bool {
  var err:syserr;
  var ret = isLink(err, name);
  if err != ENOERR then ioerror(err, "in isLink", name);
  return ret;
}

/* Returns true if the name corresponds to a mount point, false otherwise.
   err: a syserr used to indicate if an error occurred
   name: a string that could be the name of a mount point.
*/
proc isMount(out error:syserr, name: string): bool {
  extern proc chpl_fs_is_mount(ref result:c_int, name: c_string): syserr;

  if (isFile(name)) {
    // Files aren't mount points.  That would be silly.
    error = ENOERR;
    return false;
  }
  var ret:c_int;
  error = chpl_fs_is_mount(ret, name.c_str());
  return ret != 0;
}

/* Returns true if the name corresponds to a mount point, false otherwise.
   name: a string that could be the name of a mount point.
*/
proc isMount(name: string): bool {
  var err:syserr;
  var ret = isMount(err, name);
  if err != ENOERR then ioerror(err, "in isMount", name);
  return ret;
}

/* These are constant values of the form S_I[R | W | X][USR | GRP | OTH],
   S_IRWX[U | G | O], S_ISUID, S_ISGID, or S_ISVTX, where R corresponds to
   readable, W corresponds to writable, X corresponds to executable, USR and
   U correspond to user, GRP and G correspond to group, OTH and O correspond
   to other, directly tied to the C idea of these constants.  They are intended
   for use with functions that alter the permissions of files or directories.
*/
extern const S_IRUSR: int;
extern const S_IWUSR: int;
extern const S_IXUSR: int;
extern const S_IRWXU: int;

extern const S_IRGRP: int;
extern const S_IWGRP: int;
extern const S_IXGRP: int;
extern const S_IRWXG: int;

extern const S_IROTH: int;
extern const S_IWOTH: int;
extern const S_IXOTH: int;
extern const S_IRWXO: int;

extern const S_ISUID: int;
extern const S_ISGID: int;
extern const S_ISVTX: int;

/* Attempt to create a directory with the given path.  If parents is true,
   will attempt to create any directory in the path that did not previously
   exist.  Returns any errors that occurred via an out parameter

   :arg err: a syserr used to indicate if an error occurred
   :arg name: the name of the directory to be created, fully specified.
   :arg mode: an integer representing the permissions desired for the file in
              question. See description of the provided constants for
              potential values.
   :arg parents: a boolean indicating if parent directories should be created.
                 If set to false, any nonexistent parent will cause an error to
                 occur.

   Important note: In the case where parents is true, there is a potential
   security vulnerability.  Checking whether parent directories exist and
   creating them if not are separate events. So even if parents==true and a
   parent directory didn't exist before this function is called but does exist
   afterward, it's still not necessarily true that this function created that
   parent. Some other concurrent operation could have done so.
*/
proc mkdir(out error: syserr, name: string, mode: int = 0o777,
           parents: bool=false) {
  extern proc chpl_fs_mkdir(name: c_string, mode: int, parents: bool):syserr;

  error = chpl_fs_mkdir(name.c_str(), mode, parents);
}

/* Attempt to create a directory with the given path.  If parents is true,
   will attempt to create any directory in the path that did not previously
   exist.  Generates an error message if one occurred.

   :arg name: the name of the directory to be created, fully specified.
   :arg mode: an integer representing the permissions desired for the file in
              question. See description of the provided constants for
              potential values.
   :arg parents: a boolean indicating if parent directories should be created.
                 If set to false, any nonexistent parent will cause an error to
                 occur.

   Important note: In the case where parents is true, there is a potential
   security vulnerability.  Checking whether parent directories exist and
   creating them if not are separate events. So even if parents==true and a
   parent directory didn't exist before this function is called but does exist
   afterward, it's still not necessarily true that this function created that
   parent. Some other concurrent operation could have done so.
*/
proc mkdir(name: string, mode: int = 0o777, parents: bool=false) {
  var err: syserr = ENOERR;
  mkdir(err, name, mode, parents);
  if err != ENOERR then ioerror(err, "in mkdir", name);
}

/* Renames the file specified by oldname to newname, returning an error
   if one occurred.  The file is not opened during this operation.
   error: a syserr used to indicate if an error occurred during renaming.
   oldname: current name of the file
   newname: name which should refer to the file in the future.*/
proc rename(out error: syserr, oldname, newname: string) {
  extern proc chpl_fs_rename(oldname: c_string, newname: c_string):syserr;

  error = chpl_fs_rename(oldname.c_str(), newname.c_str());
}

/* Renames the file specified by oldname to newname, generating an error message
   if one occurred.  The file is not opened during this operation.
   oldname: current name of the file
   newname: name which should refer to the file in the future.*/
proc rename(oldname, newname: string) {
  var err:syserr = ENOERR;
  rename(err, oldname, newname);
  if err != ENOERR then ioerror(err, "in rename", oldname);
}

/* Removes the file or directory specified by name, returning an error
   if one occurred via an out parameter.
   err: a syserr used to indicate if an error occurred during removal
   name: the name of the file/directory to remove */
proc remove(out error: syserr, name: string) {
  extern proc chpl_fs_remove(name: c_string):syserr;

  error = chpl_fs_remove(name.c_str());
}

/* Removes the file or directory specified by name, generating an error message
   if one occurred.
   name: the name of the file/directory to remove */
proc remove(name: string) {
  var err:syserr = ENOERR;
  remove(err, name);
  if err != ENOERR then ioerror(err, "in remove", name);
}

/* Returns true if both pathnames refer to the same file or directory
   (utilizing operating system operations rather than string ones), returns
   false otherwise.
   err: a syserr used to indicate if an error occurred during comparison
   file1, file2: string representations of paths to be compared.
*/
proc sameFile(out error: syserr, file1: string, file2: string): bool {
  extern proc chpl_fs_samefile_string(ref ret: c_int, file1: c_string, file2: c_string): syserr;

  var ret:c_int;
  error = chpl_fs_samefile_string(ret, file1.c_str(), file2.c_str());
  return ret != 0;
}

/* Returns true if both pathnames refer to the same file or directory
   (utilizing operating system operations rather than string ones), returns
   false otherwise.  May generate an error message.
   file1, file2: string representations of paths to be compared.
*/
proc sameFile(file1: string, file2: string): bool {
  var err:syserr = ENOERR;
  var result = sameFile(err, file1, file2);
  if err != ENOERR then ioerror(err, "in sameFile " + file1, file2);
  return result;
}

/* Same as the above function, but taking file records instead of string
   pathnames as arguments.
*/
proc sameFile(out error: syserr, file1: file, file2: file): bool {
  extern proc chpl_fs_samefile(ref ret: c_int, file1: qio_file_ptr_t,
                               file2: qio_file_ptr_t): syserr;

  var ret:c_int;
  if (is_c_nil(file1._file_internal) || is_c_nil(file2._file_internal)) {
    // Implementation note on program design tradeoffs:
    // I could use file.check() here.  That would not rely on the understanding
    // of file's internals.  However, it would cause this method to either
    // return error messages or halt, depending on the error encountered.
    // This check could be moved to the version w/o the err argument, but if
    // someone called this function w/o going through that, we'd lose the
    // check.  Also, we already must make use of the record internals to do the
    // inner comparison (since the record is a chapel construct), so there's no
    // additional harm.

    // The file is referencing a null file.  We'll get a segfault if we
    // continue.
    error = EBADF;
    return false; // This part isn't as important as the error.
  }

  error = chpl_fs_samefile(ret, file1._file_internal, file2._file_internal);
  return ret != 0;
}

/* Same as the above function, but taking file records instead of string
   pathnames as arguments.  May generate an error message.
*/
proc sameFile(file1: file, file2: file): bool {
  var err:syserr = ENOERR;
  var result = sameFile(err, file1, file2);
  if err != ENOERR then ioerror(err, "in sameFile " + file1.path, file2.path);
  return result;
}

/* Create a symbolic link pointing to oldName named newName.  May generate an
   error message.
   err: a syserr used to indicate if an error occurred during creation
   oldName: the source file to be linked
   newName: the location the symbolic link should live
*/
proc symlink(out error: syserr, oldName: string, newName: string) {
  extern proc chpl_fs_symlink(orig: c_string, linkName: c_string): syserr;

  error = chpl_fs_symlink(oldName.c_str(), newName.c_str());
}

/* Create a symbolic link pointing to oldName named sym.  May generate an error
   message.
   oldName: the source file to be linked
   newName: the location the symbolic link should live
*/
proc symlink(oldName: string, newName: string) {
  var err:syserr = ENOERR;
  symlink(err, oldName, newName);
  if err != ENOERR then ioerror(err, "in symlink " + oldName, newName);
}

/* Sets the file creation mask of the current process to mask, and returns
   the previous value of the file creation mask.
   mask: the file creation mask to use now.
*/
proc umask(mask: int): int {
  extern proc chpl_fs_umask(mask: mode_t): mode_t;

  return chpl_fs_umask(mask.safeCast(mode_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.
 */
use Error;

/* Change the current working directory of the current locale to the specified
   name. Returns any errors that occurred via an out parameter.
   err: a syserr used to indicate if an error occurred
   name: a string indicating a new directory

   Note: this is not safe within a parallel context.  A chdir call in one task
   will affect the current working directory of all tasks for that locale.
*/
proc locale.chdir(out error: syserr, name: string) {
  extern proc chpl_fs_chdir(name: c_string):syserr;

  on this {
    err = chpl_fs_chdir(name.c_str());
  }
}

/* Change the current working directory of the current locale to the specified
   name. Generates an error message if one occurred.
   name: a string indicating a new directory

   Note: this is not safe within a parallel context.  A chdir call in one task
   will affect the current working directory of all tasks for that locale.
*/
proc locale.chdir(name: string) {
  var err: syserr = ENOERR;
  chdir(err, name);
  if err != ENOERR then ioerror(err, "in chdir", name);
}

/* Set the permissions of the file or directory specified by name to that
   indicated by settings.  Returns any errors that occurred via an out
   parameter.

   :arg err: a syserr used to indicate if an error occurred
   :arg name: the name of the file/directory which should have its permissions
              alterred.
   :arg mode: an integer representing the permissions desired for the file in
              question.  See description of the provided constants for
              potential values.
*/
proc chmod(out error: syserr, name: string, mode: int) {
  extern proc chpl_fs_chmod(name: c_string, mode: int): syserr;

  err = chpl_fs_chmod(name.c_str(), mode);
}

/* Set the permissions of the file or directory specified by name to that
   indicated by settings, and may generate an error message

   :arg name: the name of the file/directory which should have its permissions
              alterred.
   :arg mode: an integer representing the permissions desired for the file
              in question.  See description of the provided constants for potential
              values.
*/
proc chmod(name: string, mode: int){
  var err: syserr = ENOERR;
  chmod(err, name, mode);
  if err != ENOERR then ioerror(err, "in chmod", name);
}

/* Changes one or both of the owner and group id of the named file to the
   specified values.  If uid or gid are -1, the value in question will remain
   unchanged.
   err: a syserr used to indicate if an error occurred
   name: the name of the file to be changed.
   uid: user id to use as new owner, or -1 if it should remain the same.
   gid: group id to use as the new group owner, or -1 if it should remain the same.
*/
proc chown(out error: syserr, name: string, uid: int, gid: int) {
  extern proc chpl_fs_chown(name: c_string, uid: c_int, gid: c_int):syserr;

  err = chpl_fs_chown(name.c_str(), uid:c_int, gid:c_int);
}

/* Changes one or both of the owner and group id of the named file to the
   specified values.  If uid or gid are -1, the value in question will remain
   unchanged. Generates an error message if one occurred.
   name: the name of the file to be changed.
   uid: user id to use as new owner, or -1 if it should remain the same.
   gid: group id to use as the new group owner, or -1 if it should remain the same.
*/
proc chown(name: string, uid: int, gid: int) {
  var err: syserr = ENOERR;
  chown(err, name, uid, gid);
  if err != ENOERR then ioerror(err, "in chown", name);
}

// FUTURE WORK:
// When basename and joinPath are supported, enable dest to be a directory.

/* Copies the contents and permissions of the file indicated by src into
   the file or directory dest.  If dest is a directory, will return an error via
   the out parameter.  If metadata is set to true, will also copy the metadata
   of the file to be copied.  Other errors may also be returned via the out
   parameter.
   err: a syserr used to indicate if an error occurred
   src: the source file whose contents and permissions are to be copied
   dest: the destination file for the contents and permissions.
   metadata: a boolean indicating whether to copy metadata (uid, gid, time of
             last access and time of modification) associated with the source
             file.
*/
proc copy(out error: syserr, src: string, dest: string, metadata: bool = false) {
  var destFile = dest;
  if (isDir(err, destFile)) {
    // destFile = joinPath(destFile, basename(src));
    err = EISDIR;
    // Supporting a destination directory requires getting the basename from
    // the src (because we're using the same name) and joining it with the
    // provided destination directory.  Both of those operations are part of
    // the string portion, so we aren't supporting it just yet.
    return;
  } else {
    if (err == ENOENT) {
      // Destination didn't exist before.  We'd be overwriting it anyways, so
      // we don't care.
      err = ENOERR;
    }
    if err != ENOERR then return;
  }
  copyFile(err, src, destFile);
  if err != ENOERR then return;
  copyMode(err, src, destFile);
  if err != ENOERR then return;

  if (metadata) {
    extern proc chpl_fs_copy_metadata(source: c_string, dest: c_string): syserr;

    // Copies the access time, and time of last modification.
    // Does not copy uid, gid, or mode
    err = chpl_fs_copy_metadata(src.c_str(), dest.c_str());

    // Get uid and gid from src
    var uid = getUID(err, src);
    if err != ENOERR then return;
    var gid = getGID(err, src);
    if err != ENOERR then return;
    // Change uid and gid to that of the src
    chown(err, destFile, uid, gid);
  }
}

/* Copies the contents and permissions of the file indicated by src into
   the file or directory dest.  If dest is a directory, will halt with an error
   message.  If metadata is set to true, will also copy the metadata of the
   file to be copied.  May halt with other error messages.
   src: the source file whose contents and permissions are to be copied
   dest: the destination file for the contents and permissions.
   metadata: a boolean indicating whether to copy metadata (uid, gid, time of
             last access and time of modification) associated with the source
             file.
*/
proc copy(src: string, dest: string, metadata: bool = false) {
  var err: syserr = ENOERR;
  copy(err, src, dest, metadata);
  if err != ENOERR then ioerror(err, "in copy(" + src + ", " + dest + ")");
}

/* Copies the contents of the file indicated by src into the file indicated
   by dest, replacing dest if it already exists (and is different than src).
   If the dest is not writable or src and dest are the same file, generates
   an error.  Does not copy metadata.
   err: a syserr used to indicate if an error occurred
   src: the source file whose contents are to be copied.
   dest: the destination of the contents.
*/
proc copyFile(out error: syserr, src: string, dest: string) {
  // This implementation is based off of the python implementation for copyfile,
  // with some slight differences.  That implementation was found at:
  // https://bitbucket.org/mirror/cpython/src/c8ce5bca0fcda4307f7ac5d69103ce128a562705/Lib/shutil.py?at=default
  // I did not look at the other functions in that file, except for copyfileobj
  // (which copyfile called).
  if (!exists(src)) {
    err = ENOENT;
    // Source didn't exist, we can't copy it.
    return;
  }
  if (isDir(err, src) || isDir(err, dest)) {
    // If the source is a directory, the user has made a mistake, so return an
    // error.  The same is true if the destination is a directory.
    err = EISDIR;
    return;
  }

  if (err == ENOENT) {
    err = ENOERR;
    // We don't care if dest did not exist before, we'll create or overwrite it
    // anyways.  We already know src exists.
  } else if (sameFile(err, src, dest)) {
    // Check if the files are the same, error if yes

    // Don't need to check if they're the same file when we know dest didn't
    // exist.
    err = EINVAL;
    return;
    // The second argument is invalid if the two arguments are the same.
  }

  // Lydia note (03/04/2014): These enclosing curly braces are to avoid the bug
  // found in test/io/lydia/outArgEarlyExit*.future.  When those futures are
  // resolved, the braces should be removed.
  {
    // Open src for reading, open dest for writing
    var srcFile = open(src, iomode.r);
    var destFile = open(dest, iomode.cw);
    var srcChnl = srcFile.reader(kind=ionative, locking=false);
    var destChnl = destFile.writer(kind=ionative, locking=false);
    // read in, write out.
    var line: [0..1023] uint(8);
    var numRead: int = 0;
    while (srcChnl.readline(line, numRead=numRead, error=err)) {
      // From mppf:
      // If you want it to be faster, we can make it only buffer once (sharing
      // the bytes read into memory between the two channels). To do that you'd
      // do something like this (in a loop):

      // srcReader.mark
      // srcReader.advance( buffer size )
      // srcReader.beginPeekBuffer to get the current buffer (qio_channel_begin_peek_buffer)
      // dstWriter.putBuffer with the buffer we got (qio_channel_put_buffer)
      // srcReader.endPeekBuffer

      // Some of these routines don't exist with Chapel wrappers now

      destChnl.write(line[0..#numRead]);
    }
    if err == EEOF then err = ENOERR;
    destChnl.flush();

    srcFile.close();
    destFile.close();
  }
}

/* Copies the contents of the file indicated by src into the file indicated
   by dest, replacing dest if it already exists (and is different than src).
   If the dest is not writable or src and dest are the same file, halts with
   an error.  Does not copy metadata.  May halt with an error message.
   src: the source file whose contents are to be copied.
   dest: the destination of the contents.
*/
proc copyFile(src: string, dest: string) {
  var err: syserr = ENOERR;
  copyFile(err, src, dest);
  if err != ENOERR then ioerror(err, "in copyFile(" + src + ", " + dest + ")");
}

/* Copies the permissions of the file indicated by src to the file indicated
   by dest, leaving contents, owner and group unaffected.
   err: a syserr used to indicate if an error occurred
   src: the source file whose permissions are to be copied.
   dest: the destination of the permissions.
*/
proc copyMode(out error: syserr, src: string, dest: string) {
  // Gets the mode from the source file.
  var srcMode = getMode(err, src);
  // If any error occurred, we want to be the one reporting it, so as not
  // to bleed implementation details.  If we found one when viewing the
  // source's mode, we should return immediately.
  if err != ENOERR then return;
  // Sets the mode of the destination to the source's mode.
  chmod(err, dest, srcMode);
}

/* Copies the permissions of the file indicated by src to the file indicated
   by dest, leaving contents, owner and group unaffected.  May halt with an
   error message.
   src: the source file whose permissions are to be copied.
   dest: the destination of the permissions.
*/
proc copyMode(src: string, dest: string) {
  var err: syserr = ENOERR;
  copyMode(err, src, dest);
  if err != ENOERR then ioerror(err, "in copyMode " + src, dest);
}

/* Returns the current working directory for the current locale.
   err: a syserr used to indicate if an error occurred

   Note: another task on this locale can change the current working
   directory from underneath this task, so use caution when making use
   of this function in a parallel environment.
*/
proc locale.cwd(out error: syserr): string {
  extern proc chpl_fs_cwd(ref working_dir:c_string_copy):syserr;

  var ret:string;
  on this {
    var tmp:c_string_copy;
    // c_strings and c_string_copy's can't cross on statements.
    err = chpl_fs_cwd(tmp);
    if (err != ENOERR) {
      ret = "";
    } else {
      // This version of toString steals its operand.  No need to free.
      ret = toString(tmp);
    }
  }
  return ret;
}

/* Returns the current working directory for the current locale. Generates an
   error message if one occurred.

   Note: another task on this locale can change the current working
   directory from underneath this task, so use caution when making use
   of this function in a parallel environment.
*/
proc locale.cwd(): string {
  var err: syserr = ENOERR;
  var ret = cwd(err);
  if err != ENOERR then ioerror(err, "in cwd");
  return ret;
}

/* Returns true if the provided filename corresponds to an existing file, false
   otherwise.  Returns false for broken symbolic links.  Returns any errors that
   occurred via an out parameter
   name: a string used to attempt to find the file specified.
*/
proc exists(out error: syserr, name: string): bool {
  extern proc chpl_fs_exists(ref result:c_int, name: c_string): syserr;

  var ret:c_int;
  err = chpl_fs_exists(ret, name.c_str());
  return ret != 0;
}

/* Returns true if the provided filename corresponds to an existing file, false
   otherwise.  Returns false for broken symbolic links.  Generates an error
   message if one occurred.
   name: a string used to attempt to find the file specified.
*/
proc exists(name: string): bool {
  var err: syserr = ENOERR;
  var ret = exists(err, name);
  if err != ENOERR then ioerror(err, "in exists");
  return ret;
}

/* Returns the group id associated with the file or directory specified by
   name.  Returns any errors that occurred via an out parameter.
   err: a syserr used to indicate if an error occurred
   name: a string used to indicate the file in question
*/
proc getGID(out error: syserr, name: string): int {
  extern proc chpl_fs_get_gid(ref result: c_int, filename: c_string): syserr;

  var result: c_int;
  err = chpl_fs_get_gid(result, name.c_str());
  return result;
}

/* Returns the group id associated with the file or directory specified by
   name.  May generate an error message.
   name: a string used to indicate the file in question
*/
proc getGID(name: string): int {
  var err: syserr = ENOERR;
  var ret = getGID(err, name);
  if err != ENOERR then ioerror(err, "in getGID");
  return ret;
}

/* Returns an integer representing the current permissions of the file specified
   by name.  May generate an error message.
   err: a syserr used to indicate if an error occurred during this function
   name: the name of the file that you want to know the permissions of.
*/
proc getMode(out error: syserr, name: string): int {
  extern proc chpl_fs_viewmode(ref result:c_int, name: c_string): syserr;

  var ret:c_int;
  err = chpl_fs_viewmode(ret, name.c_str());
  return ret;
}

/* Returns an integer representing the current permissions of the file specified
   by name.  May generate an error message.
   name: the name of the file that you want to know the permissions of.
*/
proc getMode(name: string): int {
  var err:syserr = ENOERR;
  var result = getMode(err, name);
  if err != ENOERR then ioerror(err, "in getMode", name);
  return result;
}

/* Returns the user id associated with the file or directory specified by
   name.  Returns any errors that occurred via an out parameter.
   err: a syserr used to indicate if an error occurred
   name: a string used to indicate the file in question
*/
proc getUID(out error: syserr, name: string): int {
  extern proc chpl_fs_get_uid(ref result: c_int, filename: c_string): syserr;

  var result: c_int;
  err = chpl_fs_get_uid(result, name.c_str());
  return result;
}

/* Returns the user id associated with the file or directory specified by
   name.  May generate an error message.
   name: a string used to indicate the file in question
*/
proc getUID(name: string): int {
  var err: syserr = ENOERR;
  var ret = getUID(err, name);
  if err != ENOERR then ioerror(err, "in getUID");
  return ret;
}

/* Returns true if the name corresponds to a directory, false otherwise.
   err: a syserr used to indicate if an error occurred
   name: a string that could be the name of a directory.
*/
proc isDir(out error:syserr, name:string):bool {
  extern proc chpl_fs_is_dir(ref result:c_int, name: c_string):syserr;

  var ret:c_int;
  err = chpl_fs_is_dir(ret, name.c_str());
  return ret != 0;
}

/* Returns true if the name corresponds to a directory, false otherwise.
   Generates an error message if one occurs.
   name: a string that could be the name of a directory.
*/
proc isDir(name:string):bool {
  var err:syserr;
  var ret = isDir(err, name);
  if err != ENOERR then ioerror(err, "in isDir", name);
  return ret;
}

/* Returns true if the name corresponds to a file, false otherwise.
   err: a syserr used to indicate if an error occurred
   name: a string that could be the name of a file.
*/
proc isFile(out error:syserr, name:string):bool {
  extern proc chpl_fs_is_file(ref result:c_int, name: c_string):syserr;

  var ret:c_int;
  err = chpl_fs_is_file(ret, name.c_str());
  return ret != 0;
}

/* Returns true if the name corresponds to a file, false otherwise.
   Generates an error message if one occurs.
   name: a string that could be the name of a file.
*/
proc isFile(name:string):bool {
  var err:syserr;
  var ret = isFile(err, name);
  if err != ENOERR then ioerror(err, "in isFile", name);
  return ret;
}

/* Returns true if the name corresponds to a symbolic link, false if not
   or if symbolic links are not supported.
   name: a string that could be the name of a symbolic link.
*/
proc isLink(out error:syserr, name: string): bool {
  extern proc chpl_fs_is_link(ref result:c_int, name: c_string): syserr;

  var ret:c_int;
  err = chpl_fs_is_link(ret, name.c_str());
  return ret != 0;
}

/* Returns true if the name corresponds to a symbolic link, false if not
   or if symbolic links are not supported.  Generates an error message if one
   occurs
   name: a string that could be the name of a symbolic link.
*/
proc isLink(name: string): bool {
  var err:syserr;
  var ret = isLink(err, name);
  if err != ENOERR then ioerror(err, "in isLink", name);
  return ret;
}

/* Returns true if the name corresponds to a mount point, false otherwise.
   err: a syserr used to indicate if an error occurred
   name: a string that could be the name of a mount point.
*/
proc isMount(out error:syserr, name: string): bool {
  extern proc chpl_fs_is_mount(ref result:c_int, name: c_string): syserr;

  if (isFile(name)) {
    // Files aren't mount points.  That would be silly.
    err = ENOERR;
    return false;
  }
  var ret:c_int;
  err = chpl_fs_is_mount(ret, name.c_str());
  return ret != 0;
}

/* Returns true if the name corresponds to a mount point, false otherwise.
   name: a string that could be the name of a mount point.
*/
proc isMount(name: string): bool {
  var err:syserr;
  var ret = isMount(err, name);
  if err != ENOERR then ioerror(err, "in isMount", name);
  return ret;
}

/* These are constant values of the form S_I[R | W | X][USR | GRP | OTH],
   S_IRWX[U | G | O], S_ISUID, S_ISGID, or S_ISVTX, where R corresponds to
   readable, W corresponds to writable, X corresponds to executable, USR and
   U correspond to user, GRP and G correspond to group, OTH and O correspond
   to other, directly tied to the C idea of these constants.  They are intended
   for use with functions that alter the permissions of files or directories.
*/
extern const S_IRUSR: int;
extern const S_IWUSR: int;
extern const S_IXUSR: int;
extern const S_IRWXU: int;

extern const S_IRGRP: int;
extern const S_IWGRP: int;
extern const S_IXGRP: int;
extern const S_IRWXG: int;

extern const S_IROTH: int;
extern const S_IWOTH: int;
extern const S_IXOTH: int;
extern const S_IRWXO: int;

extern const S_ISUID: int;
extern const S_ISGID: int;
extern const S_ISVTX: int;

/* Attempt to create a directory with the given path.  If parents is true,
   will attempt to create any directory in the path that did not previously
   exist.  Returns any errors that occurred via an out parameter

   :arg err: a syserr used to indicate if an error occurred
   :arg name: the name of the directory to be created, fully specified.
   :arg mode: an integer representing the permissions desired for the file in
              question. See description of the provided constants for
              potential values.
   :arg parents: a boolean indicating if parent directories should be created.
                 If set to false, any nonexistent parent will cause an error to
                 occur.

   Important note: In the case where parents is true, there is a potential
   security vulnerability.  Checking whether parent directories exist and
   creating them if not are separate events. So even if parents==true and a
   parent directory didn't exist before this function is called but does exist
   afterward, it's still not necessarily true that this function created that
   parent. Some other concurrent operation could have done so.
*/
proc mkdir(out error: syserr, name: string, mode: int = 0o777,
           parents: bool=false) {
  extern proc chpl_fs_mkdir(name: c_string, mode: int, parents: bool):syserr;

  err = chpl_fs_mkdir(name.c_str(), mode, parents);
}

/* Attempt to create a directory with the given path.  If parents is true,
   will attempt to create any directory in the path that did not previously
   exist.  Generates an error message if one occurred.

   :arg name: the name of the directory to be created, fully specified.
   :arg mode: an integer representing the permissions desired for the file in
              question. See description of the provided constants for
              potential values.
   :arg parents: a boolean indicating if parent directories should be created.
                 If set to false, any nonexistent parent will cause an error to
                 occur.

   Important note: In the case where parents is true, there is a potential
   security vulnerability.  Checking whether parent directories exist and
   creating them if not are separate events. So even if parents==true and a
   parent directory didn't exist before this function is called but does exist
   afterward, it's still not necessarily true that this function created that
   parent. Some other concurrent operation could have done so.
*/
proc mkdir(name: string, mode: int = 0o777, parents: bool=false) {
  var err: syserr = ENOERR;
  mkdir(err, name, mode, parents);
  if err != ENOERR then ioerror(err, "in mkdir", name);
}

/* Renames the file specified by oldname to newname, returning an error
   if one occurred.  The file is not opened during this operation.
   error: a syserr used to indicate if an error occurred during renaming.
   oldname: current name of the file
   newname: name which should refer to the file in the future.*/
proc rename(out error: syserr, oldname, newname: string) {
  extern proc chpl_fs_rename(oldname: c_string, newname: c_string):syserr;

  error = chpl_fs_rename(oldname.c_str(), newname.c_str());
}

/* Renames the file specified by oldname to newname, generating an error message
   if one occurred.  The file is not opened during this operation.
   oldname: current name of the file
   newname: name which should refer to the file in the future.*/
proc rename(oldname, newname: string) {
  var err:syserr = ENOERR;
  rename(err, oldname, newname);
  if err != ENOERR then ioerror(err, "in rename", oldname);
}

/* Removes the file or directory specified by name, returning an error
   if one occurred via an out parameter.
   err: a syserr used to indicate if an error occurred during removal
   name: the name of the file/directory to remove */
proc remove(out error: syserr, name: string) {
  extern proc chpl_fs_remove(name: c_string):syserr;

  err = chpl_fs_remove(name.c_str());
}

/* Removes the file or directory specified by name, generating an error message
   if one occurred.
   name: the name of the file/directory to remove */
proc remove(name: string) {
  var err:syserr = ENOERR;
  remove(err, name);
  if err != ENOERR then ioerror(err, "in remove", name);
}

/* Returns true if both pathnames refer to the same file or directory
   (utilizing operating system operations rather than string ones), returns
   false otherwise.
   err: a syserr used to indicate if an error occurred during comparison
   file1, file2: string representations of paths to be compared.
*/
proc sameFile(out error: syserr, file1: string, file2: string): bool {
  extern proc chpl_fs_samefile_string(ref ret: c_int, file1: c_string, file2: c_string): syserr;

  var ret:c_int;
  err = chpl_fs_samefile_string(ret, file1.c_str(), file2.c_str());
  return ret != 0;
}

/* Returns true if both pathnames refer to the same file or directory
   (utilizing operating system operations rather than string ones), returns
   false otherwise.  May generate an error message.
   file1, file2: string representations of paths to be compared.
*/
proc sameFile(file1: string, file2: string): bool {
  var err:syserr = ENOERR;
  var result = sameFile(err, file1, file2);
  if err != ENOERR then ioerror(err, "in sameFile " + file1, file2);
  return result;
}

/* Same as the above function, but taking file records instead of string
   pathnames as arguments.
*/
proc sameFile(out error: syserr, file1: file, file2: file): bool {
  extern proc chpl_fs_samefile(ref ret: c_int, file1: qio_file_ptr_t,
                               file2: qio_file_ptr_t): syserr;

  var ret:c_int;
  if (is_c_nil(file1._file_internal) || is_c_nil(file2._file_internal)) {
    // Implementation note on program design tradeoffs:
    // I could use file.check() here.  That would not rely on the understanding
    // of file's internals.  However, it would cause this method to either
    // return error messages or halt, depending on the error encountered.
    // This check could be moved to the version w/o the err argument, but if
    // someone called this function w/o going through that, we'd lose the
    // check.  Also, we already must make use of the record internals to do the
    // inner comparison (since the record is a chapel construct), so there's no
    // additional harm.

    // The file is referencing a null file.  We'll get a segfault if we
    // continue.
    err = EBADF;
    return false; // This part isn't as important as the error.
  }

  err = chpl_fs_samefile(ret, file1._file_internal, file2._file_internal);
  return ret != 0;
}

/* Same as the above function, but taking file records instead of string
   pathnames as arguments.  May generate an error message.
*/
proc sameFile(file1: file, file2: file): bool {
  var err:syserr = ENOERR;
  var result = sameFile(err, file1, file2);
  if err != ENOERR then ioerror(err, "in sameFile " + file1.path, file2.path);
  return result;
}

/* Create a symbolic link pointing to oldName named newName.  May generate an
   error message.
   err: a syserr used to indicate if an error occurred during creation
   oldName: the source file to be linked
   newName: the location the symbolic link should live
*/
proc symlink(out error: syserr, oldName: string, newName: string) {
  extern proc chpl_fs_symlink(orig: c_string, linkName: c_string): syserr;

  err = chpl_fs_symlink(oldName.c_str(), newName.c_str());
}

/* Create a symbolic link pointing to oldName named sym.  May generate an error
   message.
   oldName: the source file to be linked
   newName: the location the symbolic link should live
*/
proc symlink(oldName: string, newName: string) {
  var err:syserr = ENOERR;
  symlink(err, oldName, newName);
  if err != ENOERR then ioerror(err, "in symlink " + oldName, newName);
}

/* Sets the file creation mask of the current process to mask, and returns
   the previous value of the file creation mask.
   mask: the file creation mask to use now.
*/
proc umask(mask: int): int {
  extern proc chpl_fs_umask(mask: mode_t): mode_t;

  return chpl_fs_umask(mask.safeCast(mode_t));
}


Simplifying Math module's use of extern calls

Thanks to Steve's bug fixes for external routines, the Math module has
been greatly simplified now.  In particular, extern routines whose
names match Chapel's no longer need to be wrapped in a Chapel
function.  Thus we can have an external definition of sin() rather
than a Chapel function that wraps the external definition of sin().
For 32-bit versions where we want to support the same overloaded name,
we still have to wrap it in order to (a) expose it using the name
sin() and (b) avoid putting sinf() and the like into the module's
namespace.

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

pragma "inline" def abs(i : int(?w)) return if i < 0 then -i else i;
pragma "inline" def abs(i : uint(?w)) return i;
pragma "inline" def abs(x : complex(?w)) return sqrt(x.re*x.re + x.im*x.im);

pragma "inline" def conjg(a: complex(?w)) return (a.re, -a.im):complex;

_extern def isnan(x: real(64)): bool;
_extern def isnan(x: real(32)): bool;

_extern def acos(x: real(64)): real(64);
_extern def acosh(x: real(64)): real(64);
_extern def asin(x: real(64)): real(64);
_extern def asinh(x: real(64)): real(64);
_extern def atan(x: real(64)): real(64);
_extern def atan2(y: real(64), x: real(64)): real(64);
_extern def atanh(x: real(64)): real(64);
_extern def cbrt(x: real(64)): real(64);
_extern def ceil(x: real(64)): real(64);
_extern def cos(x: real(64)): real(64);
_extern def cosh(x: real(64)): real(64);
_extern def erf(x: real(64)): real(64);
_extern def erfc(x: real(64)): real(64);
_extern def exp(x: real(64)): real(64);
_extern def exp2(x: real(64)): real(64);
_extern def expm1(x: real(64)): real(64);
_extern def fabs(x: real(64)): real(64);
_extern def floor(x: real(64)): real(64);
_extern def lgamma(x: real(64)): real(64);
_extern def log(x: real(64)): real(64);
_extern def log2(x: real(64)): real(64);
_extern def log10(x: real(64)): real(64);
_extern def log1p(x: real(64)): real(64);
_extern def nearbyint(x: real(64)): real(64);
_extern def rint(x: real(64)): real(64);
_extern def round(x: real(64)): real(64);
_extern def sin(x: real(64)): real(64);
_extern def sinh(x: real(64)): real(64);
_extern def sqrt(x: real(64)): real(64);
_extern def tan(x: real(64)): real(64);
_extern def tanh(x: real(64)): real(64);
_extern def tgamma(x: real(64)): real(64);
_extern def trunc(x: real(64)): real(64);

pragma "inline" def acos(x : real(32)) {
  _extern def acosf(x: real(32)): real(32);
  return acosf(x);
}
pragma "inline" def acosh(x : real(32)) {
  _extern def acoshf(x: real(32)): real(32);
  return acoshf(x);
}
pragma "inline" def asin(x : real(32)) {
  _extern def asinf(x: real(32)): real(32);
  return asinf(x);
}
pragma "inline" def asinh(x : real(32)) {
  _extern def asinhf(x: real(32)): real(32);
  return asinhf(x);
}
pragma "inline" def atan(x : real(32)) {
  _extern def atanf(x: real(32)): real(32);
  return atanf(x);
}
pragma "inline" def atan2(y : real(32), x: real(32)) {
  _extern def atan2f(y: real(32), x: real(32)): real(32);
  return atan2f(y, x);
}
pragma "inline" def atanh(x : real(32)) {
  _extern def atanhf(x: real(32)): real(32);
  return atanhf(x);
}
pragma "inline" def cbrt(x : real(32)) {
  _extern def cbrtf(x: real(32)): real(32);
  return cbrtf(x);
}
pragma "inline" def ceil(x : real(32)) {
  _extern def ceilf(x: real(32)): real(32);
  return ceilf(x);
}
pragma "inline" def cos(x : real(32)) {
  _extern def cosf(x: real(32)): real(32);
  return cosf(x);
}
pragma "inline" def cosh(x : real(32)) {
  _extern def coshf(x: real(32)): real(32);
  return coshf(x);
}
pragma "inline" def erf(x : real(32)) {
  _extern def erff(x: real(32)): real(32);
  return erff(x);
}
pragma "inline" def erfc(x : real(32)) {
  _extern def erfcf(x: real(32)): real(32);
  return erfcf(x);
}
pragma "inline" def exp(x : real(32)) {
  _extern def expf(x: real(32)): real(32);
  return expf(x);
}
pragma "inline" def exp2(x : real(32)) {
  _extern def exp2f(x: real(32)): real(32);
  return exp2f(x);
}
pragma "inline" def expm1(x : real(32)) {
  _extern def expm1f(x: real(32)): real(32);
  return expm1f(x);
}
pragma "inline" def abs(x : real(32)) {
  _extern def fabsf(x: real(32)): real(32);
  return fabsf(x);
}
pragma "inline" def floor(x : real(32)) {
  _extern def floorf(x: real(32)): real(32);
  return floorf(x);
}
pragma "inline" def lgamma(x : real(32)) {
  _extern def lgammaf(x: real(32)): real(32);
  return lgammaf(x);
}
pragma "inline" def log(x : real(32)) {
  _extern def logf(x: real(32)): real(32);
  return logf(x);
}
pragma "inline" def log2(x : real(32)) {
  _extern def log2f(x: real(32)): real(32);
  return log2f(x);
}
pragma "inline" def log10(x : real(32)) {
  _extern def log10f(x: real(32)): real(32);
  return log10f(x);
}
pragma "inline" def log1p(x : real(32)) {
  _extern def log1pf(x: real(32)): real(32);
  return log1pf(x);
}
pragma "inline" def nearbyint(x : real(32)) {
  _extern def nearbyintf(x: real(32)): real(32);
  return nearbyintf(x);
}
pragma "inline" def rint(x : real(32)) {
  _extern def rintf(x: real(32)): real(32);
  return rintf(x);
}
pragma "inline" def round(x : real(32)) {
  _extern def roundf(x: real(32)): real(32);
  return roundf(x);
}
pragma "inline" def sin(x: real(32)) {
  _extern def sinf(x: real(32)): real(32);
  return sinf(x);
}
pragma "inline" def sinh(x : real(32)) {
  _extern def sinhf(x: real(32)): real(32);
  return sinhf(x);
}
pragma "inline" def sqrt(x : real(32)): real(32) {
  _extern def sqrtf(x: real(32)): real(32);
  return sqrtf(x);
}
pragma "inline" def tan(x : real(32)) {
  _extern def tanf(x: real(32)): real(32);
  return tanf(x);
}
pragma "inline" def tanh(x : real(32)) {
  _extern def tanhf(x: real(32)): real(32);
  return tanhf(x);
}
pragma "inline" def tgamma(x : real(32)) {
  _extern def tgammaf(x: real(32)): real(32);
  return tgammaf(x);
}
pragma "inline" def trunc(x : real(32)) {
  _extern def truncf(x: real(32)): real(32);
  return truncf(x);
}

def _logBasePow2Help(in val, baseLog2) {
  var result = -1;
  while (val != 0) {
    val >>= baseLog2;
    result += 1;
  }
  return result;
}

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

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

def log2(in val: int(?w)) {
  return logBasePow2(val, 1);
}

def log2(in val: uint(?w)) {
  return logBasePow2(val, 1);
}

pragma "inline" def abs(i : int(?w)) return if i < 0 then -i else i;
pragma "inline" def abs(i : uint(?w)) return i;
pragma "inline" def abs(x : complex(?w)) return sqrt(x.re*x.re + x.im*x.im);

pragma "inline" def conjg(a: complex(?w)) return (a.re, -a.im):complex;

pragma "inline" def isnan(x: real(64)) {
  _extern def isnan(x: real(64)): bool;
  return isnan(x);
}
pragma "inline" def acos(x : real(64)) {
  _extern def acos(x: real(64)): real(64);
  return acos(x);
}
pragma "inline" def acosh(x : real(64)) {
  _extern def acosh(x: real(64)): real(64);
  return acosh(x);
}
pragma "inline" def asin(x : real(64)) {
  _extern def asin(x: real(64)): real(64);
  return asin(x);
}
pragma "inline" def asinh(x : real(64)) {
  _extern def asinh(x: real(64)): real(64);
  return asinh(x);
}
pragma "inline" def atan(x : real(64)) {
  _extern def atan(x: real(64)): real(64);
  return atan(x);
}
pragma "inline" def atan2(y: real(64), x: real(64)) {
  _extern def atan2(y: real(64), x: real(64)): real(64);
  return atan2(y, x);
}
pragma "inline" def atanh(x : real(64)) {
  _extern def atanh(x: real(64)): real(64);
  return atanh(x);
}
pragma "inline" def cbrt(x : real(64)) {
  _extern def cbrt(x: real(64)): real(64);
  return cbrt(x);
}
pragma "inline" def ceil(x : real(64)) {
  _extern def ceil(x: real(64)): real(64);
  return ceil(x);
}
pragma "inline" def cos(x : real(64)) {
  _extern def cos(x: real(64)): real(64);
  return cos(x);
}
pragma "inline" def cosh(x : real(64)) {
  _extern def cosh(x: real(64)): real(64);
  return cosh(x);
}
pragma "inline" def erf(x : real(64)) {
  _extern def erf(x: real(64)): real(64);
  return erf(x);
}
pragma "inline" def erfc(x : real(64)) {
  _extern def erfc(x: real(64)): real(64);
  return erfc(x);
}
pragma "inline" def exp(x : real(64)) {
  _extern def exp(x: real(64)): real(64);
  return exp(x);
}
pragma "inline" def exp2(x : real(64)) {
  _extern def exp2(x: real(64)): real(64);
  return exp2(x);
}
pragma "inline" def expm1(x : real(64)) {
  _extern def expm1(x: real(64)): real(64);
  return expm1(x);
}
pragma "inline" def abs(x : real(64)) {
  _extern def fabs(x: real(64)): real(64);
  return fabs(x);
}
pragma "inline" def floor(x : real(64)) {
  _extern def floor(x: real(64)): real(64);
  return floor(x);
}
pragma "inline" def lgamma(x : real(64)) {
  _extern def lgamma(x: real(64)): real(64);
  return lgamma(x);
}
pragma "inline" def log(x : real(64)) {
  _extern def log(x: real(64)): real(64);
  return log(x);
}
pragma "inline" def log2(x : real(64)) {
  _extern def log2(x: real(64)): real(64);
  return log2(x);
}
pragma "inline" def log10(x : real(64)) {
  _extern def log10(x: real(64)): real(64);
  return log10(x);
}
pragma "inline" def log1p(x : real(64)) {
  _extern def log1p(x: real(64)): real(64);
  return log1p(x);
}
pragma "inline" def nearbyint(x : real(64)) {
  _extern def nearbyint(x: real(64)): real(64);
  return nearbyint(x);
}
pragma "inline" def rint(x : real(64)) {
  _extern def rint(x: real(64)): real(64);
  return rint(x);
}
pragma "inline" def round(x : real(64)) {
  _extern def round(x: real(64)): real(64);
  return round(x);
}
pragma "inline" def sin(x: real(64)) {
  _extern def sin(x: real(64)): real(64);
  return sin(x);
}
pragma "inline" def sinh(x : real(64)) {
  _extern def sinh(x: real(64)): real(64);
  return sinh(x);
}
pragma "inline" def sqrt(x : real(64)) {
  _extern def sqrt(x: real(64)): real(64);
  return sqrt(x);
}
pragma "inline" def tan(x : real(64)) {
  _extern def tan(x: real(64)): real(64);
  return tan(x);
}
pragma "inline" def tanh(x : real(64)) {
  _extern def tanh(x: real(64)): real(64);
  return tanh(x);
}
pragma "inline" def tgamma(x : real(64)) {
  _extern def tgamma(x: real(64)): real(64);
  return tgamma(x);
}
pragma "inline" def trunc(x : real(64)) {
  _extern def trunc(x: real(64)): real(64);
  return trunc(x);
}

pragma "inline" def isnan(x: real(32)) {
  _extern def isnan(x: real(32)): bool;
  return isnan(x);
}
pragma "inline" def acos(x : real(32)) {
  _extern def acosf(x: real(32)): real(32);
  return acosf(x);
}
pragma "inline" def acosh(x : real(32)) {
  _extern def acoshf(x: real(32)): real(32);
  return acoshf(x);
}
pragma "inline" def asin(x : real(32)) {
  _extern def asinf(x: real(32)): real(32);
  return asinf(x);
}
pragma "inline" def asinh(x : real(32)) {
  _extern def asinhf(x: real(32)): real(32);
  return asinhf(x);
}
pragma "inline" def atan(x : real(32)) {
  _extern def atanf(x: real(32)): real(32);
  return atanf(x);
}
pragma "inline" def atan2(y : real(32), x: real(32)) {
  _extern def atan2f(y: real(32), x: real(32)): real(32);
  return atan2f(y, x);
}
pragma "inline" def atanh(x : real(32)) {
  _extern def atanhf(x: real(32)): real(32);
  return atanhf(x);
}
pragma "inline" def cbrt(x : real(32)) {
  _extern def cbrtf(x: real(32)): real(32);
  return cbrtf(x);
}
pragma "inline" def ceil(x : real(32)) {
  _extern def ceilf(x: real(32)): real(32);
  return ceilf(x);
}
pragma "inline" def cos(x : real(32)) {
  _extern def cosf(x: real(32)): real(32);
  return cosf(x);
}
pragma "inline" def cosh(x : real(32)) {
  _extern def coshf(x: real(32)): real(32);
  return coshf(x);
}
pragma "inline" def erf(x : real(32)) {
  _extern def erff(x: real(32)): real(32);
  return erff(x);
}
pragma "inline" def erfc(x : real(32)) {
  _extern def erfcf(x: real(32)): real(32);
  return erfcf(x);
}
pragma "inline" def exp(x : real(32)) {
  _extern def expf(x: real(32)): real(32);
  return expf(x);
}
pragma "inline" def exp2(x : real(32)) {
  _extern def exp2f(x: real(32)): real(32);
  return exp2f(x);
}
pragma "inline" def expm1(x : real(32)) {
  _extern def expm1f(x: real(32)): real(32);
  return expm1f(x);
}
pragma "inline" def abs(x : real(32)) {
  _extern def fabsf(x: real(32)): real(32);
  return fabsf(x);
}
pragma "inline" def floor(x : real(32)) {
  _extern def floorf(x: real(32)): real(32);
  return floorf(x);
}
pragma "inline" def lgamma(x : real(32)) {
  _extern def lgammaf(x: real(32)): real(32);
  return lgammaf(x);
}
pragma "inline" def log(x : real(32)) {
  _extern def logf(x: real(32)): real(32);
  return logf(x);
}
pragma "inline" def log2(x : real(32)) {
  _extern def log2f(x: real(32)): real(32);
  return log2f(x);
}
pragma "inline" def log10(x : real(32)) {
  _extern def log10f(x: real(32)): real(32);
  return log10f(x);
}
pragma "inline" def log1p(x : real(32)) {
  _extern def log1pf(x: real(32)): real(32);
  return log1pf(x);
}
pragma "inline" def nearbyint(x : real(32)) {
  _extern def nearbyintf(x: real(32)): real(32);
  return nearbyintf(x);
}
pragma "inline" def rint(x : real(32)) {
  _extern def rintf(x: real(32)): real(32);
  return rintf(x);
}
pragma "inline" def round(x : real(32)) {
  _extern def roundf(x: real(32)): real(32);
  return roundf(x);
}
pragma "inline" def sin(x: real(32)) {
  _extern def sinf(x: real(32)): real(32);
  return sinf(x);
}
pragma "inline" def sinh(x : real(32)) {
  _extern def sinhf(x: real(32)): real(32);
  return sinhf(x);
}
pragma "inline" def sqrt(x : real(32)) {
  _extern def sqrtf(x: real(32)): real(32);
  return sqrtf(x);
}
pragma "inline" def tan(x : real(32)) {
  _extern def tanf(x: real(32)): real(32);
  return tanf(x);
}
pragma "inline" def tanh(x : real(32)) {
  _extern def tanhf(x: real(32)): real(32);
  return tanhf(x);
}
pragma "inline" def tgamma(x : real(32)) {
  _extern def tgammaf(x: real(32)): real(32);
  return tgammaf(x);
}
pragma "inline" def trunc(x : real(32)) {
  _extern def truncf(x: real(32)): real(32);
  return truncf(x);
}

def _logBasePow2Help(in val, baseLog2) {
  var result = -1;
  while (val != 0) {
    val >>= baseLog2;
    result += 1;
  }
  return result;
}

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

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

def log2(in val: int(?w)) {
  return logBasePow2(val, 1);
}

def log2(in val: uint(?w)) {
  return logBasePow2(val, 1);
}


Added MMIterator to MatrixOps module.  This iterator defines
how the rows and columns of the matrices should be accessed
when multiplying two matrices.  For now, it is defined so
that C = A*B is computed by updating C, a column at a time.
(The indices are yielded by nesting the loops in j, k, i order.)

This iterator is a good example of how rank changing array
slices would be useful.  If the iterator returned one dimension
as a domain slice, then it would be clear how the memory accesses
should be done to compute the matrix multiplication.  (In this
case, if the row dimension was returned as a range spanning all
rows of the matrix, the computation of C(i,j) would clearly be
by column. Each iteration would update the entire jth column of C
by adding to it the jth column of A scaled by the appropriate
element of B.)

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

def *(A:[?D1],B:[?D2]) {
  var x = A(D1.low)*B(D2.low);
  var C:[D1.dim(1),D2.dim(2)] x.type;

  if (D1.dim(2).length != D2.dim(1).length) then
    halt("Matrix multiplication with incompatible matrices");

  for (i,j,k1,k2) in MMIterator(D1, D2) {
    C(i,j) += A(i,k1)*B(k2,j);
  }
  return C;
}

iterator MMIterator(D1, D2) {
  for j in D2.dim(2) do
    for (k1,k2) in (D1.dim(2),D2.dim(1)) do
      for i in D1.dim(1) do
        yield (i,j,k1,k2);
}

def maxIndex(A:[?D]) {
   var (_,ind) = maxloc reduce (A,D);
   return ind;
}

def amaxIndex(A:[?D]) {
   var (_,ind) = maxloc reduce (abs(A),D);
   return ind;
}

def blockLU(x: [?D], piv, blk) where (D.rank != 2) {
// This routine will give a compiler error if blockLU
// is called with an array that is not two dimensional.

  compilerError("blockLU factors a matrix.  The first
input parameter to blockLU must be a two-dimensional array.");
}

def blockLU(A: [?D], piv: [D.dim(1)], blk) where (D.rank == 2){
// Block LU with pivoting.
// In this version, A1D is a range, not a 1D domain.  The iterator,
// IterateByBlocks returns ranges, not subdomains of A1D.  Temporary
// ranges, slice1 and slice2 are used to define what should be
// subdomains sliced by indefinite ranges.

  if (D.dim(1) != D.dim(2)) then
    halt("error: blockLU requires square matrix with same dimensions");

  var A1D = D.dim(1);
  var ind: index(D);

  for (UnfactoredInds,CurrentBlockInds,TrailingBlockInds)
    in IterateByBlocks(A1D,blk) {

    var A1 => A[UnfactoredInds,CurrentBlockInds];
    var A2 => A[UnfactoredInds,TrailingBlockInds];
    var A21 => A[TrailingBlockInds,CurrentBlockInds];
    var A12 => A[CurrentBlockInds,TrailingBlockInds];
    var A22 => A[TrailingBlockInds,TrailingBlockInds];

// LU factorization of A1
    for k in CurrentBlockInds {

      ind = amaxIndex(A(UnfactoredInds(k..),k..k));

      if (ind(1) != k) {
        piv(k) <=> piv(ind(1));
        A(k..k,..) <=> A(ind(1)..ind(1),..);
      }

      if (A1(k,k) != 0.0) {
        forall i in UnfactoredInds(k+1..) {
          A1(i,k) = A1(i,k)/A1(k,k);
        }
        forall (i,j) in [UnfactoredInds(k+1..),CurrentBlockInds(k+1..)] {
          A1(i,j) -= A1(i,k)*A1(k,j);
        }
      }
      else halt("zero pivot encountered");
    }

// Update of A12.
    forall j in TrailingBlockInds {
      for k in CurrentBlockInds {
        forall i in CurrentBlockInds(k+1..) {
          A12(i,j) -= A1(i,k)*A12(k,j);
        }
      }
    }
// Update of A22 -= A21*A12.
    for (i,j,k1,k2) in MMIterator(A21.domain,A12.domain) {
      A22(i,j) -= A21(i,k1)*A12(k2,j);
    }
  }
}

iterator IterateByBlocks(D:range,blksize) {
  var n = D.length;
  var lo,hi: int;

  for i in D by blksize {
    lo = i;
    hi = min(i + blksize-1,n);
    yield (lo..n,i..hi,hi+1..n);
  }
}

def *(A:[?D1],B:[?D2]) {
  var x = A(D1.low)*B(D2.low);
  var C:[D1.dim(1),D2.dim(2)] x.type;

  if (D1.dim(2).length != D2.dim(1).length) then
    halt("Matrix multiplication with incompatible matrices");

  for i in D1.dim(1) {
    for j in D2.dim(2) {
      for (k1,k2) in (D1.dim(2),D2.dim(1)) {
        C(i,j) += A(i,k1)*B(k2,j);
      }
    }
  }
  return C;
}

def maxIndex(A:[?D]) {
   var (_,ind) = maxloc reduce (A,D);
   return ind;
}

def amaxIndex(A:[?D]) {
   var (_,ind) = maxloc reduce (abs(A),D);
   return ind;
}

def blockLU(x: [?D], piv, blk) where (D.rank != 2) {
// This routine will give a compiler error if blockLU
// is called with an array that is not two dimensional.

  compilerError("blockLU factors a matrix.  The first
input parameter to blockLU must be a two-dimensional array.");
}

def blockLU(A: [?D], piv: [D.dim(1)], blk) where (D.rank == 2){
// Block LU with pivoting.
// In this version, A1D is a range, not a 1D domain.  The iterator,
// IterateByBlocks returns ranges, not subdomains of A1D.  Temporary
// ranges, slice1 and slice2 are used to define what should be
// subdomains sliced by indefinite ranges.

  if (D.dim(1) != D.dim(2)) then
    halt("error: blockLU requires square matrix with same dimensions");

  var A1D = D.dim(1);
  var ind: index(D);

  for (UnfactoredInds,CurrentBlockInds,TrailingBlockInds)
    in IterateByBlocks(A1D,blk) {

    var A1 => A[UnfactoredInds,CurrentBlockInds];
    var A2 => A[UnfactoredInds,TrailingBlockInds];
    var A12 => A[CurrentBlockInds,TrailingBlockInds];
    var A22 => A[TrailingBlockInds,TrailingBlockInds];

// LU factorization of A1
    for k in CurrentBlockInds {

      ind = amaxIndex(A(UnfactoredInds(k..),k..k));

      if (ind(1) != k) {
        piv(k) <=> piv(ind(1));
        A(k..k,..) <=> A(ind(1)..ind(1),..);
      }

      if (A1(k,k) != 0.0) {
        forall i in UnfactoredInds(k+1..) {
          A1(i,k) = A1(i,k)/A1(k,k);
        }
        forall (i,j) in [UnfactoredInds(k+1..),CurrentBlockInds(k+1..)] {
          A1(i,j) -= A1(i,k)*A1(k,j);
        }
      }
      else halt("zero pivot encountered");
    }

// Update of A12.
    forall j in TrailingBlockInds {
      for k in CurrentBlockInds {
        forall i in CurrentBlockInds(k+1..) {
          A12(i,j) -= A1(i,k)*A12(k,j);
        }
      }
    }
// Update of A22 -= A12*A21.
    forall (i,j) in [TrailingBlockInds, TrailingBlockInds] {
      for k in CurrentBlockInds {
        A22(i,j) -= A1(i,k)*A12(k,j);
      }
    }
  }
}

iterator IterateByBlocks(D:range,blksize) {
  var n = D.length;
  var lo,hi: int;

  for i in D by blksize {
    lo = i;
    hi = min(i + blksize-1,n);
    yield (lo..n,i..hi,hi+1..n);
  }
}


Comment out brute force code

Comment out brute force code

use Regexp;
use Histogram;
use Time;

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

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

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

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

config const smax=200.0;
config const smax2=smax**2;
config const nmubins=5;
config const nsbins=5;

// Global variables
var gtime1 : Timer;

proc main() {
  doPairs();
}

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

proc countLines(fn : string) : int {
  var ff = open(fn, iomode.r);
  var ipart = 0;
  for iff in ff.lines() do ipart +=1;
  ff.close();
  return ipart;
}

proc readFile(fn : string, pp : []WeightedParticle3D)  {
  const maxcols=25;

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

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

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

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

proc smuAccumulate(hh : UniformBins, p1,p2 : SOA_WeightedParticle3D, d1,d2 : domain(1), scale : real) {
  forall ii in d1 { // Loop over first set of particles

    var x1,y1,z1,w1,r2 : real;
    var sl, s2, l1, s1, l2, mu, wprod : real;
    x1 = p1.x[ii]; y1 = p1.y[ii]; z1 = p1.z[ii]; w1 = p1.w[ii]; r2 = p1.r2[ii];

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

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

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

  return lnpart;
}

class KDNode {
  var lo, hi,npart,id : int;
  var dom : domain(1);
  var xcen : NDIM*real;
  var rcell : real;
  var left, right : KDNode;

  proc isLeaf() : bool {
    return (left==nil) && (right==nil);
  }

  proc ~KDNode() {
    if left then delete left;
    if right then delete right;
  }

}

proc BuildTree(pp : []WeightedParticle3D, scr : []WeightedParticle3D, id : int) : KDNode{
  gtime1.start();
  var me = new KDNode();
  var dom = pp.domain;
  me.lo = dom.low;
  me.hi = dom.high;
  me.dom = {me.lo..me.hi};
  me.id = id;
  me.npart = (me.hi-me.lo)+1;

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

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

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

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

proc TreeAccumulate(hh : UniformBins, p1, p2 : SOA_WeightedParticle3D, node1, node2 : KDNode) {
  // Compute the distance between node1 and node2
  var rr = sqrt (+ reduce(node1.xcen - node2.xcen)**2);
  var rmin = rr - (node1.rcell+node2.rcell);

  // If distance is greater than all cases
  if (rmin > smax) then return;

  // If both nodes are leaves
  if (node1.isLeaf() & node2.isLeaf()) {
    begin smuAccumulate(hh, p1, p2, node1.dom, node2.dom,1);
    return;
  }

  // If one node is a leaf
  if (node1.isLeaf()) {
    TreeAccumulate(hh, p1, p2, node1, node2.left);
    TreeAccumulate(hh, p1, p2, node1, node2.right);
    return;
  }
  if (node2.isLeaf()) {
    TreeAccumulate(hh, p1, p2, node1.left, node2);
    TreeAccumulate(hh, p1, p2, node1.right, node2);
    return;
  }

  // Split the larger case;
  if (node1.npart > node2.npart) {
    TreeAccumulate(hh, p1, p2, node1.left, node2);
    TreeAccumulate(hh, p1, p2, node1.right, node2);
    return;
  } else {
    TreeAccumulate(hh, p1, p2, node1, node2.left);
    TreeAccumulate(hh, p1, p2, node1, node2.right);
    return;
  }

}

// The main code
proc doPairs() {
  var tt : Timer;

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

  // Build the tree
  tt.clear(); tt.start(); gtime1.clear();
  var scr1 : [0.. #nlines1] WeightedParticle3D;
  var root1 = BuildTree(pp1,scr1,0);
  var scr2 : [0.. #nlines2] WeightedParticle3D;
  var root2 = BuildTree(pp2,scr2,0);
  tt.stop();
  if (!isTest) {
    writef("Time to build trees : %r \n", tt.elapsed());
    writef("Time in splitOn : %r \n", gtime1.elapsed());
  }

  // Set up the histogram
  var hh = new UniformBins(2,(nsbins,nmubins), ((0.0,smax),(0.0,1.0+1.e-10)));

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

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

   // Do the paircounts with a tree
  hh.reset();
  tt.clear(); tt.start();
  sync TreeAccumulate(hh, soa1, soa2, root1, root2);
  tt.stop();
  if (!isTest) {
    writef("Time to tree paircount : %r \n", tt.elapsed());
    var ff = openwriter("%s.tree".format(pairfn));
    writeHist(ff,hh);
    ff.close();
  } else {
    hh.set((0,0),0.0);
    writeHist(stdout,hh,"%20.5er ");
  }

  //
  // clean up
  //
  delete soa1;
  delete soa2;
  delete hh;
  delete root1;
  delete root2;
}

use Regexp;
use Histogram;
use Time;

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

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

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

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

config const smax=200.0;
config const smax2=smax**2;
config const nmubins=5;
config const nsbins=5;

// Global variables
var gtime1 : Timer;

proc main() {
  doPairs();
}

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

proc countLines(fn : string) : int {
  var ff = open(fn, iomode.r);
  var ipart = 0;
  for iff in ff.lines() do ipart +=1;
  ff.close();
  return ipart;
}

proc readFile(fn : string, pp : []WeightedParticle3D)  {
  const maxcols=25;

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

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

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

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

proc smuAccumulate(hh : UniformBins, p1,p2 : SOA_WeightedParticle3D, d1,d2 : domain(1), scale : real) {
  forall ii in d1 { // Loop over first set of particles

    var x1,y1,z1,w1,r2 : real;
    var sl, s2, l1, s1, l2, mu, wprod : real;
    x1 = p1.x[ii]; y1 = p1.y[ii]; z1 = p1.z[ii]; w1 = p1.w[ii]; r2 = p1.r2[ii];

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

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

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

  return lnpart;
}

class KDNode {
  var lo, hi,npart,id : int;
  var dom : domain(1);
  var xcen : NDIM*real;
  var rcell : real;
  var left, right : KDNode;

  proc isLeaf() : bool {
    return (left==nil) && (right==nil);
  }

  proc ~KDNode() {
    if left then delete left;
    if right then delete right;
  }

}

proc BuildTree(pp : []WeightedParticle3D, scr : []WeightedParticle3D, id : int) : KDNode{
  gtime1.start();
  var me = new KDNode();
  var dom = pp.domain;
  me.lo = dom.low;
  me.hi = dom.high;
  me.dom = {me.lo..me.hi};
  me.id = id;
  me.npart = (me.hi-me.lo)+1;

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

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

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

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

proc TreeAccumulate(hh : UniformBins, p1, p2 : SOA_WeightedParticle3D, node1, node2 : KDNode) {
  // Compute the distance between node1 and node2
  var rr = sqrt (+ reduce(node1.xcen - node2.xcen)**2);
  var rmin = rr - (node1.rcell+node2.rcell);

  // If distance is greater than all cases
  if (rmin > smax) then return;

  // If both nodes are leaves
  if (node1.isLeaf() & node2.isLeaf()) {
    begin smuAccumulate(hh, p1, p2, node1.dom, node2.dom,1);
    return;
  }

  // If one node is a leaf
  if (node1.isLeaf()) {
    TreeAccumulate(hh, p1, p2, node1, node2.left);
    TreeAccumulate(hh, p1, p2, node1, node2.right);
    return;
  }
  if (node2.isLeaf()) {
    TreeAccumulate(hh, p1, p2, node1.left, node2);
    TreeAccumulate(hh, p1, p2, node1.right, node2);
    return;
  }

  // Split the larger case;
  if (node1.npart > node2.npart) {
    TreeAccumulate(hh, p1, p2, node1.left, node2);
    TreeAccumulate(hh, p1, p2, node1.right, node2);
    return;
  } else {
    TreeAccumulate(hh, p1, p2, node1, node2.left);
    TreeAccumulate(hh, p1, p2, node1, node2.right);
    return;
  }

}

// The main code
proc doPairs() {
  var tt : Timer;

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

  // Build the tree
  tt.clear(); tt.start(); gtime1.clear();
  var scr1 : [0.. #nlines1] WeightedParticle3D;
  var root1 = BuildTree(pp1,scr1,0);
  var scr2 : [0.. #nlines2] WeightedParticle3D;
  var root2 = BuildTree(pp2,scr2,0);
  tt.stop();
  if (!isTest) {
    writef("Time to build trees : %r \n", tt.elapsed());
    writef("Time in splitOn : %r \n", gtime1.elapsed());
  }

  // Set up the histogram
  var hh = new UniformBins(2,(nsbins,nmubins), ((0.0,smax),(0.0,1.0+1.e-10)));

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

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

   // Do the paircounts with a tree
  hh.reset();
  tt.clear(); tt.start();
  sync TreeAccumulate(hh, soa1, soa2, root1, root2);
  tt.stop();
  if (!isTest) {
    writef("Time to tree paircount : %r \n", tt.elapsed());
    var ff = openwriter("%s.tree".format(pairfn));
    writeHist(ff,hh);
    ff.close();
  } else {
    hh.set((0,0),0.0);
    writeHist(stdout,hh,"%20.5er ");
  }

  //
  // clean up
  //
  delete soa1;
  delete soa2;
  delete hh;
  delete root1;
  delete root2;
}