Snapshot of first working version of gmp chudnovsky in Chapel

This checkin contains
- some bug fixes
- some debug printing (some enabled, some commmented out)
- changes to the intents for external star-tuples
  - these changes raise questions about what a blank intent
    ought to mean for an external star-tuple, but I need to
    think about it a bit more before making a statement on
    the topic.

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

/* Pi computation using Chudnovsky's algortithm.

 * Copyright 2002, 2005 Hanhong Xue (macroxue at yahoo dot com)

 * Slightly modified 2005 by Torbjorn Granlund (tege at swox dot com) to allow
   more than 2G digits to be computed.

 * Translated into Chapel by Brad Chamberlain, 2009-2010

 * Redistribution and use in source and binary forms, with or without
 * modification, are permitted provided that the following conditions are met:
 * 1. Redistributions of source code must retain the above copyright notice,
 * this list of conditions and the following disclaimer.
 * 2. Redistributions in binary form must reproduce the above copyright notice,
 * this list of conditions and the following disclaimer in the documentation
 * and/or other materials provided with the distribution.
 *
 * THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR
 * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
 * MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.  IN NO
 * EVENT SHALL THE AUTHORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
 * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
 * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
 * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
 * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
 * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 */

use Time;

param A = 13591409,
      B = 545140134,
      C = 640320,
      D = 12;

param BITS_PER_DIGIT  = 3.32192809488736234787,
      DIGITS_PER_ITER = 14.1816474627254776555,
      DOUBLE_PREC     = 53;

config param HAVE_DIVEXACT_PREINV = false;

config param debugSieve = false;

def CHECK_MEMUSAGE {
  //  writeln("CHECK_MEM_USAGE not implemented yet");
}

////////////////////////////////////////////////////////////////////////////

type  c_int =  int(32),
     c_uint = uint(32),
       long =  int(64),
      c_ulong = uint(64);

_extern type __mpf_struct;
_extern type mpf_t = 1*__mpf_struct;
_extern type __mpz_struct;
_extern type mpz_t = 1*__mpz_struct;

_extern def mpz_init(inout X: mpz_t);
_extern def mpz_set_ui(inout ROP: mpz_t, OP: c_ulong);
_extern def mpz_mul_ui(inout ROP: mpz_t, inout OP1: mpz_t, OP2: c_ulong);
_extern def mpz_add_ui(inout ROP: mpz_t, inout OP1: mpz_t, OP2: c_ulong);
_extern def mpz_mul(inout ROP: mpz_t, inout OP1: mpz_t, OP2: mpz_t);
_extern def mpz_neg(inout ROP: mpz_t, inout OP: mpz_t);
_extern def mpz_clear(inout X: mpz_t);
_extern def mpz_tdiv_q(inout Q: mpz_t, inout N: mpz_t, inout D: mpz_t);
_extern def mpz_add(inout ROP: mpz_t, inout OP1: mpz_t, inout OP2: mpz_t);

_extern type mp_bitcnt_t = c_ulong;
_extern type size_t = int(64);

_extern def mpf_set_default_prec(PREC: mp_bitcnt_t);
_extern def mpz_sizeinbase(inout OP: mpz_t, BASE: c_int): size_t;

_extern def mpz_addmul_ui(inout ROP: mpz_t, inout OP1: mpz_t, OPT2: c_ulong);

_extern type double = real(64);

_extern def mpf_init(inout X: mpf_t);
_extern def mpf_set_z(inout ROP: mpf_t, OP: mpz_t);
_extern def mpf_get_prec(inout OP: mpf_t): mp_bitcnt_t;
_extern def mpf_get_d(inout OP: mpf_t): double;
_extern def mpf_set_d(inout ROP: mpf_t, OP: double);
_extern def mpf_set_prec_raw(inout ROP: mpf_t, PREC: mp_bitcnt_t);
_extern def mpf_ui_div(inout ROP: mpf_t, OP1: c_ulong, inout OP2: mpf_t);
_extern def mpf_mul(inout ROP: mpf_t, inout OP1: mpf_t, inout OP2: mpf_t);
_extern def mpf_ui_sub(inout ROP: mpf_t, OP1: c_ulong, inout OP2: mpf_t);
_extern def mpf_add(inout ROP: mpf_t, inout OP1: mpf_t, inout OP2: mpf_t);
_extern def mpf_sub(inout ROP: mpf_t, inout OP1: mpf_t, inout OP2: mpf_t);
_extern def mpf_mul_ui(inout ROP: mpf_t, inout OP1: mpf_t, OP2: c_ulong);
_extern def mpf_div_2exp(inout ROP: mpf_t, inout OP1: mpf_t, OP2: mp_bitcnt_t);
_extern def mpf_out_str(STREAM: _file, BASE: c_int, N_DIGITS: size_t, inout OP: mpf_t);
_extern def mpf_clear(inout X: mpf_t);

_extern def gmp_printf(fmt: string, arg...);
_extern def gmp_fprintf(fp: _file, fmt: string, arg...);

var t1, t2: mpf_t;

config param do_gcd_time = false;

config const   d: long = 100,
             _out: c_int = 1;

const terms   = (d/DIGITS_PER_ITER): long,
      percent = terms/100.0;

record fac_t {
  var num_facs: long;
  const sdom: domain(1, idxType=long);
  var fac, pow: [sdom] c_ulong;

  def this(i) var {
    return this;
  }
};

record sieve_t {
  var fac, pow, nxt: long;
};

const sieve_size = max(3*5*23*29+1, terms*6): long;
var sievedom = [0: long..#(sieve_size/2)];
var sieve: [sievedom] sieve_t;

var ftmp, fmul: fac_t;

param INIT_FACS = 32;

var gcd_time: long;

var gcd, mgcd: mpz_t;

var depth: long = 1;
while ((1<<depth) < terms) do
  depth += 1;
depth += 1;

var stackdom1 = [0..#depth],
    stackdom2 = stackdom1;

var gstack: [stackdom1] mpz_t,
    fpstack, fgstack: [stackdom1] fac_t,
    pstack, qstack: [stackdom2] mpz_t;

var top: long = 0;

def main() {

  writeln("#terms=", terms, ", depth=", depth);

  const start = getCurrentTime();
  write("sieve   ");

  build_sieve(sieve);
  if debugSieve {
    writeln("sieve is: ");
    for s in sieve do
      writeln(s);
  }

  const mid0 = getCurrentTime() - start;
  writeln("time = ", mid0);

  for i in 0..#depth {
    mpz_init(pstack[i]);
    mpz_init(qstack[i]);
    mpz_init(gstack[i]);
    fac_init(fpstack[i]);
    fac_init(fgstack[i]);
  }
  mpz_init(gcd);

  if HAVE_DIVEXACT_PREINV then
    mpz_init(mgcd);

  fac_init(ftmp);
  fac_init(fmul);

  /* begin binary splitting process */
  if (terms <= 0) {
    mpz_set_ui(p2,1);
    mpz_set_ui(q2,0);
    mpz_set_ui(g2,1);
  } else {
    bs(0, terms: c_ulong, 0, 0);
  }

  const mid1 = getCurrentTime() - mid0;
  writeln("\nbs      time = ", mid1);
  writeln("   gcd  time = ", gcd_time);

  //writeln("misc    ");

  //  writeln("top = ", top);

  //  gmp_printf("p1 = %Zd\n", p1);
  //  gmp_printf("q1 = %Zd\n", q1);

  /* free some resources */
  sievedom = [0..-1: long];

  if HAVE_DIVEXACT_PREINV then
    mpz_clear(mgcd);

  mpz_clear(gcd);
  fac_clear(ftmp);
  fac_clear(fmul);

  //  writeln("Entering loop");
  for i in 1..depth-1 {
    mpz_clear(pstack[i]);
    mpz_clear(qstack[i]);
    mpz_clear(gstack[i]);
    fac_clear(fpstack[i]);
    fac_clear(fgstack[i]);
  }
  //  writeln("Exiting loop");

  mpz_clear(gstack[0]);
  fac_clear(fpstack[0]);
  fac_clear(fgstack[0]);

  stackdom1 = [0..-1: long];

  /* prepare to convert integers to floats */
  mpf_set_default_prec((d*BITS_PER_DIGIT+16): mp_bitcnt_t);

  /*
	  p*(C/D)*sqrt(C)
    pi = -----------------
	     (q+A*p)
  */

  //  gmp_printf("p1 = %Zd\n", p1);
  //  gmp_printf("q1 = %Zd\n", q1);
  const psize = mpz_sizeinbase(p1,10),
        qsize = mpz_sizeinbase(q1,10);

  gmp_printf("p1 = %Zd\n", p1);
  gmp_printf("q1 = %Zd\n", q1);
  writeln("A is: ", A);
  mpz_addmul_ui(q1, p1, A);
  gmp_printf("q1 = %Zd\n", q1);
  mpz_mul_ui(p1, p1, C/D);

  var pi, qi: mpf_t;

  mpf_init(pi);
  mpf_set_z(pi, p1);
  mpz_clear(p1);

  mpf_init(qi);
  gmp_printf("q1 = %Zd\n", q1);
  mpf_set_z(qi, q1);
  mpz_clear(q1);
  gmp_printf("pi = %Ff\n", pi);
  gmp_printf("qi = %Ff\n", qi);

  stackdom2 = [0..-1: long];

  const mid2 = getCurrentTime() - mid1;
  //writeln("time = ", mid2);

  /* initialize temp float variables for sqrt & div */
  mpf_init(t1);
  mpf_init(t2);
  //mpf_set_prec_raw(t1, mpf_get_prec(pi));

  /* final step */
  write("div     ");
  gmp_printf("pi = %Ff\n", pi);
  gmp_printf("qi = %Ff\n", qi);
  my_div(qi, pi, qi);
  const mid3 = getCurrentTime() - mid2;
  writeln("time = ", mid3);

  write("sqrt    ");
  my_sqrt_ui(pi, C);
  const mid4 = getCurrentTime() - mid3;
  writeln("time = ", mid4);

  write("mul     ");
  gmp_printf("pi = %Ff\n", pi);
  gmp_printf("qi = %Ff\n", qi);
  mpf_mul(qi, qi, pi);
  const end = getCurrentTime();
  writeln("time = ", end - mid4);

  writeln("total   time = ", end - start);

  writeln("   P size=", psize, " digits (", format("%f", psize:real/d), ")\n",
          "   Q size=", qsize, " digits (", format("%f", qsize:real/d), ")");

  /* output Pi and timing statistics */
  gmp_printf("qi = %Ff\n", qi);
  if (_out&1)  {
    writeln("pi(0,", terms, ")=");
    mpf_out_str(stdout._fp, 10, d+2, qi);
    writeln();
  }

  /* free float resources */
  mpf_clear(pi);
  mpf_clear(qi);

  mpf_clear(t1);
  mpf_clear(t2);
}

def build_sieve(s: [] sieve_t) {
  const n = s.numElements*2,
        m = sqrt(n): long;

  s[1/2].fac = 1;
  s[1/2].pow = 1;

  for i in 3..n by 2 {
    if (s[i/2].fac == 0) {
      //      writeln("writing to s[", i/2, "]");
      s[i/2].fac = i;
      s[i/2].pow = 1;
      if (i<=m) {
        for (j,k) in (i*i..n by i+i, i/2..) {
          //          writeln("writing to s[", j/2, "]");
	  if (s[j/2].fac==0) {
	    s[j/2].fac = i;
	    if (s[k].fac == i) {
	      s[j/2].pow = s[k].pow + 1;
	      s[j/2].nxt = s[k].nxt;
	    } else {
	      s[j/2].pow = 1;
	      s[j/2].nxt = k;
	    }
	  }
	}
      }
    }
  }
}

def my_sqrt_ui(inout r: mpf_t, x: c_ulong) {
  const prec0 = mpf_get_prec(r);

  if (prec0 <= DOUBLE_PREC) {
    mpf_set_d(r, sqrt(x));
    return;
  }

  var bits: c_ulong = 0,
      prec = prec0;
  while (prec > DOUBLE_PREC) {
    const bit = prec&1;
    prec = (prec+bit)/2;
    bits = bits*2+bit;
  }

  mpf_set_prec_raw(t1, DOUBLE_PREC);
  mpf_set_d(t1, 1/sqrt(x));

  while (prec < prec0) {
    prec *= 2;
    if (prec < prec0) {
      /* t1 = t1+t1*(1-x*t1*t1)/2; */
      mpf_set_prec_raw(t2, prec);
      mpf_mul(t2, t1, t1);         // half x half -> full
      mpf_mul_ui(t2, t2, x);
      mpf_ui_sub(t2, 1, t2);
      mpf_set_prec_raw(t2, prec/2);
      mpf_div_2exp(t2, t2, 1);
      mpf_mul(t2, t2, t1);         // half x half -> half
      mpf_set_prec_raw(t1, prec);
      mpf_add(t1, t1, t2);
    } else {
      prec = prec0;
      /* t2=x*t1, t1 = t2+t1*(x-t2*t2)/2; */
      mpf_set_prec_raw(t2, prec/2);
      mpf_mul_ui(t2, t1, x);
      mpf_mul(r, t2, t2);          // half x half -> full
      mpf_ui_sub(r, x, r);
      mpf_mul(t1, t1, r);          // half x half -> half
      mpf_div_2exp(t1, t1, 1);
      mpf_add(r, t1, t2);
      break;
    }
    prec -= (bits&1);
    bits /=2;
  }
}

// r = y/x   WARNING: r cannot be the same as y.
def my_div(inout r: mpf_t, inout y: mpf_t, in x: mpf_t) {
  const prec0 = mpf_get_prec(r);

  if (prec0<=DOUBLE_PREC) {
    mpf_set_d(r, mpf_get_d(y)/mpf_get_d(x));
    return;
  }

  var bits: c_ulong = 0,
      prec = prec0;
  while (prec > DOUBLE_PREC) {
    const bit = prec&1;
    prec = (prec+bit)/2;
    bits = bits*2 + bit;
  }

  mpf_set_prec_raw(t1, DOUBLE_PREC);
  mpf_ui_div(t1, 1, x);

  while (prec < prec0) {
    prec *= 2;
    if (prec < prec0) {
      /* t1 = t1+t1*(1-x*t1); */
      mpf_set_prec_raw(t2, prec);
      mpf_mul(t2, x, t1);          // full x half -> full
      mpf_ui_sub(t2, 1, t2);
      mpf_set_prec_raw(t2, prec/2);
      mpf_mul(t2, t2, t1);         // half x half -> half
      mpf_set_prec_raw(t1, prec);
      mpf_add(t1, t1, t2);
    } else {
      prec = prec0;
      /* t2=y*t1, t1 = t2+t1*(y-x*t2); */
      mpf_set_prec_raw(t2, prec/2);
      mpf_mul(t2, t1, y);          // half x half -> half
      mpf_mul(r, x, t2);           // full x half -> full
      mpf_sub(r, y, r);
      mpf_mul(t1, t1, r);          // half x half -> half
      mpf_add(r, t1, t2);
      break;
    }
    prec -= (bits&1);
    bits /=2;
  }
}

def fac_show(f: fac_t) {
  for i in 0..#f[0].num_facs do
    if (f[0].pow[i]==1) then
      write(f[0].fac[i], " ");
    else
      write(f[0].fac[i], "^", f[0].pow[i], " ");
  writeln();
}

def fac_reset(inout f: fac_t) {
  f[0].num_facs = 0;
}

def fac_init_size(inout f: fac_t, in s: long) {
  if (s<INIT_FACS) then
    s=INIT_FACS;

  f[0].sdom = [0..#s];

  fac_reset(f);
}

def fac_init(inout f: fac_t) {
  fac_init_size(f, INIT_FACS);
}

def fac_clear(inout f: fac_t) {
  f.sdom = [0..-1:long];
}

def fac_resize(inout f: fac_t, s: long)
{
  if (f[0].sdom.numIndices < s) {
    fac_clear(f);
    fac_init_size(f, s);
  }
}

// BLC: unfortunate -- original GMP took advantage of long/ulong conversions
def fac_set_bp(inout f: fac_t, base: c_ulong, pow: long) {
  assert (base < max(long): c_ulong);
  fac_set_bp(f, base: long, pow: long);
}

// f = base^pow
def fac_set_bp(inout f: fac_t, in base: long, pow: long) {
  assert(base < sieve_size);
  //  write("fac_set_bp = ");
  //  fac_show(f);
  var i: long;
  base /= 2;
  while (base > 0) {
    f[0].fac[i] = (sieve[base].fac): c_ulong;
    f[0].pow[i] = (sieve[base].pow*pow): c_ulong;
    base = sieve[base].nxt;
    i += 1;
  }
  f[0].num_facs = i;
  //  write("fac_set_bp (out) = ");
  //  fac_show(f);
  assert(i<=f[0].sdom.numIndices);
}

// r = f*g
def fac_mul2(inout r: fac_t, f: fac_t, g: fac_t) {

  var i, j, k: long;
  //  writeln("f[0].num_facs = ", f[0].num_facs, ", g[0].num_facs = ", g[0].num_facs);
  while (i<f[0].num_facs & j<g[0].num_facs) {
    if (f[0].fac[i] == g[0].fac[j]) {
      r[0].fac[k] = f[0].fac[i];
      r[0].pow[k] = f[0].pow[i] + g[0].pow[j];
      i += 1; j += 1;
    } else if (f[0].fac[i] < g[0].fac[j]) {
      r[0].fac[k] = f[0].fac[i];
      r[0].pow[k] = f[0].pow[i];
      i += 1;
    } else {
      r[0].fac[k] = g[0].fac[j];
      r[0].pow[k] = g[0].pow[j];
      j += 1;
    }
    k += 1;
    //    write("r is: ");
    //    fac_show(r);
  }
  while (i < f[0].num_facs) {
    r[0].fac[k] = f[0].fac[i];
    r[0].pow[k] = f[0].pow[i];
    i += 1;
    k += 1;
    //    write("r (2) is: ");
    //    fac_show(r);
  }
  while (j < g[0].num_facs) {
    r[0].fac[k] = g[0].fac[j];
    r[0].pow[k] = g[0].pow[j];
    j += 1;
    k += 1;
    //    write("r (3) is: ");
    //    fac_show(r);
  }
  r[0].num_facs = k;
  assert(k<=r[0].sdom.numIndices);
}

// f *= g
def fac_mul(inout f: fac_t, g: fac_t) {
  var tmp: fac_t;
  fac_resize(fmul, f[0].num_facs + g[0].num_facs);
  //  write("fmul: ");
  //  fac_show(fmul);
  //  write("f: ");
  //  fac_show(f);
  //  write("g: ");
  //  fac_show(g);
  fac_mul2(fmul, f, g);
  //  write("fmul: ");
  //  fac_show(fmul);
  // BLC: use swap?
  tmp[0]  = f[0];
  f[0]    = fmul[0];
  fmul[0] = tmp[0];
}

// BLC: unfortunate -- original GMP took advantage of long/ulong conversions
def fac_mul_bp(inout f: fac_t, base: c_ulong, pow: long) {
  assert (base < max(long): c_ulong);
  fac_mul_bp(f, base:long, pow);
}

// f *= base^pow
def fac_mul_bp(inout f: fac_t, base: long, pow: long) {
  //  write("f (0): ");
  //  fac_show(f);
  fac_set_bp(ftmp, base, pow);
  //  write("ftmp: ");
  //  fac_show(ftmp);
  fac_mul(f, ftmp);
  //  write("f: ");
  //  fac_show(f);
}

// remove factors of power 0
def fac_compact(inout f: fac_t) {
  var j: long;
  for i in 0..f[0].num_facs {
    if (f[0].pow[i]>0) {
      if (j<i) {
	f[0].fac[j] = f[0].fac[i];
	f[0].pow[j] = f[0].pow[i];
      }
      j += 1;
    }
  }
  f[0].num_facs = j;
}

// convert factorized form to number
def bs_mul(inout r: mpz_t, a: long, b: long) {
  if (b-a <= 32) {
    mpz_set_ui(r, 1);
    for i in a..b-1 do
      for j in 0..fmul[0].pow[i] do
	mpz_mul_ui(r, r, fmul[0].fac[i]);
  } else {
    var r2: mpz_t;
    mpz_init(r2);
    bs_mul(r2, a, (a+b)/2);
    bs_mul(r, (a+b)/2, b);
    mpz_mul(r, r, r2);
    mpz_clear(r2);
  }
}

//#if HAVE_DIVEXACT_PREINV
//void mpz_invert_mod_2exp (mpz_ptr, mpz_srcptr);
//void mpz_divexact_pre (mpz_ptr, mpz_srcptr, mpz_srcptr, mpz_srcptr);
//
//#endif

// f /= gcd(f,g), g /= gcd(f,g)
def fac_remove_gcd(inout p: mpz_t, inout fp: fac_t, inout g: mpz_t, inout fg: fac_t) {
  var i, j, k: long;
  var c: c_ulong;
  fac_resize(fmul, min(fp.num_facs, fg.num_facs));
  while (i < fp.num_facs && j < fg.num_facs) {
    if (fp.fac[i] == fg.fac[j]) {
      c = min(fp.pow[i], fg.pow[j]);
      fp.pow[i] -= c;
      fg.pow[j] -= c;
      fmul.fac[k] = fp.fac[i];
      fmul.pow[k] = c;
      i += 1; j += 1; k += 1;
    } else if (fp.fac[i] < fg.fac[j]) {
      i += 1;
    } else {
      j += 1;
    }
  }
  fmul.num_facs = k;
  assert(k <= fmul.sdom.numIndices);

  if (fmul.num_facs) {
    bs_mul(gcd, 0, fmul.num_facs);
    if HAVE_DIVEXACT_PREINV {
      mpz_invert_mod_2exp (mgcd, gcd);
      mpz_divexact_pre (p, p, gcd, mgcd);
      mpz_divexact_pre (g, g, gcd, mgcd);
    } else {
      mpz_tdiv_q(p, p, gcd);
      mpz_tdiv_q(g, g, gcd);
    }
    fac_compact(fp);
    fac_compact(fg);
  }
}

def p1  var return  pstack[top];
def q1  var return  qstack[top];
def g1  var return  gstack[top];
def fp1 var return fpstack[top];
def fg1 var return fgstack[top];

def p2  var return  pstack[top+1];
def q2  var return  qstack[top+1];
def g2  var return  gstack[top+1];
def fp2 var return fpstack[top+1];
def fg2 var return fgstack[top+1];

//////////////////////////////////////////////////////////////////////
//////

var progress = 0.0;

/*
def mpz_t.writeThis(f) {
  var outfile = f: file;
    gmp_fprintf(outfile._fp, "%Zd", this);
  if (outfile) then
}
*/

// binary splitting
def bs(a: c_ulong, b: c_ulong, gflag: c_uint, level: long) {
  //  writeln("In bs(", a, ", ", b, ", ", gflag, ", ", level, ")");
  if (b-a==1) {
    //    gmp_printf("...p1 = %Zd\n", p1);
    //    gmp_printf("...g1 = %Zd\n", g1);
    //    gmp_printf("...q1 = %Zd\n", q1);
    //    write("fp1 = ");
    //    fac_show(fp1);
    //    write("fg1 = ");
    //    fac_show(fg1);
    /*
      g(b-1,b) = (6b-5)(2b-1)(6b-1)
      p(b-1,b) = b^3 * C^3 / 24
      q(b-1,b) = (-1)^b*g(b-1,b)*(A+Bb).
    */
    mpz_set_ui(p1, b);
    mpz_mul_ui(p1, p1, b);
    mpz_mul_ui(p1, p1, b);
    mpz_mul_ui(p1, p1, (C/24)*(C/24));
    mpz_mul_ui(p1, p1, C*24);

    mpz_set_ui(g1, 2*b-1);
    mpz_mul_ui(g1, g1, 6*b-1);
    mpz_mul_ui(g1, g1, 6*b-5);

    mpz_set_ui(q1, b);
    mpz_mul_ui(q1, q1, B);
    mpz_add_ui(q1, q1, A);
    mpz_mul   (q1, q1, g1);
    if (b%2) then
      mpz_neg(q1, q1);

    var i = b;
    while ((i&1)==0) do i>>=1;
    fac_set_bp(fp1, i, 3);    // b^3
    //    write("fp1 = ");
    //    fac_show(fp1);
    //    writeln("i = ", i);
    //    writeln("b = ", b);
    fac_mul_bp(fp1, 3*5*23*29, 3);
    fp1[0].pow[0]-=1;

    fac_set_bp(fg1, 2*b-1, 1);   // 2b-1
    //    write("fg1 (*) = ");
    //    fac_show(fg1);
    fac_mul_bp(fg1, 6*b-1, 1);   // 6b-1
    //    write("fg1 = ");
    //    fac_show(fg1);
    fac_mul_bp(fg1, 6*b-5, 1);   // 6b-5
    //    write("fg1 = ");
    //    fac_show(fg1);

    if (b > (progress:c_ulong)) {
      write(".");
      progress += percent*2;
    }

    //    gmp_printf("...p1 = %Zd\n", p1);
    //    gmp_printf("...g1 = %Zd\n", g1);
    //    gmp_printf("...q1 = %Zd\n", q1);
    //    write("fp1 = ");
    //    fac_show(fp1);
    //    write("fg1 = ");
    //    fac_show(fg1);
    //    writeln();
  } else {
    /*
      p(a,b) = p(a,m) * p(m,b)
      g(a,b) = g(a,m) * g(m,b)
      q(a,b) = q(a,m) * p(m,b) + q(m,b) * g(a,m)
    */
    const mid = (a+(b-a)*0.5224): c_ulong;     // tuning parameter
    bs(a, mid, 1, level+1);

    top += 1;
    bs(mid, b, gflag, level+1);
    top -= 1;

    if (level == 0) then
      write("");

    const ccc = level == 0;

    if (ccc) then CHECK_MEMUSAGE;

    if (level>=4) {           // tuning parameter
      if do_gcd_time {
        const t = getCurrentTime();
        fac_remove_gcd(p2, fp2, g1, fg1);
        gcd_time += getCurrentTime() - t;
      } else {
        fac_remove_gcd(p2, fp2, g1, fg1);
      }
    }

    if (ccc) then CHECK_MEMUSAGE;
    mpz_mul(p1, p1, p2);

    gmp_printf("p2 = %Zd\n", p2);
    if (ccc) then CHECK_MEMUSAGE;
    mpz_mul(q1, q1, p2);
    gmp_printf("q1 = %Zd\n", q1);

    if (ccc) then CHECK_MEMUSAGE;
    mpz_mul(q2, q2, g1);

    writeln("top = ", top);
    gmp_printf("q1 = %Zd\n", q1);
    gmp_printf("q2 = %Zd\n", q2);
    if (ccc) then CHECK_MEMUSAGE;
    mpz_add(q1, q1, q2);
    gmp_printf("q1 (*) = %Zd\n", q1);
    gmp_printf("q2 = %Zd\n", q2);

    if (ccc) then CHECK_MEMUSAGE;
    fac_mul(fp1, fp2);

    if (gflag) {
      mpz_mul(g1, g1, g2);
      fac_mul(fg1, fg2);
    }
  }

  if (_out&2) {
    write("p(", a, ",", b, ")=");
    fac_show(fp1);
    if (gflag) then
      write("g(", a, ",", b, ")=");
    fac_show(fg1);
  }
}

/* Pi computation using Chudnovsky's algortithm.

 * Copyright 2002, 2005 Hanhong Xue (macroxue at yahoo dot com)

 * Slightly modified 2005 by Torbjorn Granlund (tege at swox dot com) to allow
   more than 2G digits to be computed.

 * Translated into Chapel by Brad Chamberlain, 2009-2010

 * Redistribution and use in source and binary forms, with or without
 * modification, are permitted provided that the following conditions are met:
 * 1. Redistributions of source code must retain the above copyright notice,
 * this list of conditions and the following disclaimer.
 * 2. Redistributions in binary form must reproduce the above copyright notice,
 * this list of conditions and the following disclaimer in the documentation
 * and/or other materials provided with the distribution.
 *
 * THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR
 * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
 * MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.  IN NO
 * EVENT SHALL THE AUTHORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
 * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
 * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
 * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
 * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
 * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 */

use Time;

param A = 13591409,
      B = 545140134,
      C = 640320,
      D = 12;

param BITS_PER_DIGIT  = 3.32192809488736234787,
      DIGITS_PER_ITER = 14.1816474627254776555,
      DOUBLE_PREC     = 53;

config param HAVE_DIVEXACT_PREINV = false;

def CHECK_MEMUSAGE {
  writeln("CHECK_MEM_USAGE not implemented yet");
}

////////////////////////////////////////////////////////////////////////////

type  c_int =  int(32),
     c_uint = uint(32),
       long =  int(64),
      c_ulong = uint(64);

_extern type __mpf_struct;
_extern type mpf_t = 1*__mpf_struct;
_extern type __mpz_struct;
_extern type mpz_t = 1*__mpz_struct;

_extern def mpz_init(inout X: mpz_t);
_extern def mpz_set_ui(inout ROP: mpz_t, OP: c_ulong);
_extern def mpz_mul_ui(inout ROP: mpz_t, OP1: mpz_t, OP2: c_ulong);
_extern def mpz_add_ui(inout ROP: mpz_t, OP1: mpz_t, OP2: c_ulong);
_extern def mpz_mul(inout ROP: mpz_t, OP1: mpz_t, OP2: mpz_t);
_extern def mpz_neg(inout ROP: mpz_t, OP: mpz_t);
_extern def mpz_clear(X: mpz_t);
_extern def mpz_tdiv_q(inout Q: mpz_t, N: mpz_t, D: mpz_t);
_extern def mpz_add(inout ROP: mpz_t, OP1: mpz_t, OP2: mpz_t);

_extern type mp_bitcnt_t = c_ulong;
_extern type size_t = int(64);

_extern def mpf_set_default_prec(PREC: mp_bitcnt_t);
_extern def mpz_sizeinbase(OP: mpz_t, BASE: c_int): size_t;

_extern def mpz_addmul_ui(ROP: mpz_t, OP1: mpz_t, OPT2: c_ulong);

_extern type double = real(64);

_extern def mpf_init(inout X: mpf_t);
_extern def mpf_set_z(inout ROP: mpf_t, OP: mpz_t);
_extern def mpf_get_prec(OP: mpf_t): mp_bitcnt_t;
_extern def mpf_get_d(OP: mpf_t): double;
_extern def mpf_set_d(inout ROP: mpf_t, OP: double);
_extern def mpf_set_prec_raw(inout ROP: mpf_t, PREC: mp_bitcnt_t);
_extern def mpf_ui_div(inout ROP: mpf_t, OP1: c_ulong, OP2: mpf_t);
_extern def mpf_mul(inout ROP: mpf_t, OP1: mpf_t, OP2: mpf_t);
_extern def mpf_ui_sub(inout ROP: mpf_t, OP1: c_ulong, OP2: mpf_t);
_extern def mpf_add(inout ROP: mpf_t, OP1: mpf_t, OP2: mpf_t);
_extern def mpf_sub(inout ROP: mpf_t, OP1: mpf_t, OP2: mpf_t);
_extern def mpf_mul_ui(inout ROP: mpf_t, OP1: mpf_t, OP2: c_ulong);
_extern def mpf_div_2exp(inout ROP: mpf_t, OP1: mpf_t, OP2: mp_bitcnt_t);
_extern def mpf_out_str(STREAM: _file, BASE: c_int, N_DIGITS: size_t, OP: mpf_t);
_extern def mpf_clear(X: mpf_t);

_extern def gmp_printf(fmt: string, arg: mpz_t);

var t1, t2: mpf_t;

config param do_gcd_time = false;

config const   d: long = 100,
             _out: c_int = 0;

const terms   = (d/DIGITS_PER_ITER): long,
      percent = terms/100.0;

record fac_t {
  var num_facs: long;
  const sdom: domain(1, idxType=long);
  var fac, pow: [sdom] c_ulong;

  def this(i) var {
    return this;
  }
};

record sieve_t {
  var fac, pow, nxt: long;
};

const sieve_size = max(3*5*23*29+1, terms*6): long;
var sievedom = [0: long..#sieve_size];
var sieve: [sievedom] sieve_t;

var ftmp, fmul: fac_t;

param INIT_FACS = 32;

var gcd_time: long;

var gcd, mgcd: mpz_t;

var depth: long = 1;
while ((1<<depth) < terms) do
  depth += 1;
depth += 1;

var stackdom1 = [0..#depth],
    stackdom2 = stackdom1;

var gstack: [stackdom1] mpz_t,
    fpstack, fgstack: [stackdom1] fac_t,
    pstack, qstack: [stackdom2] mpz_t;

def main() {

  writeln("#terms=", terms, ", depth=", depth);

  const start = getCurrentTime();
  writeln("sieve   ");

  build_sieve(sieve);

  const mid0 = getCurrentTime() - start;
  writeln("time = ", mid0);

  for i in 0..#depth {
    mpz_init(pstack[i]);
    mpz_init(qstack[i]);
    mpz_init(gstack[i]);
    fac_init(fpstack[i]);
    fac_init(fgstack[i]);
  }
  mpz_init(gcd);

  if HAVE_DIVEXACT_PREINV then
    mpz_init(mgcd);

  fac_init(ftmp);
  fac_init(fmul);

  /* begin binary splitting process */
  if (terms <= 0) {
    mpz_set_ui(p2,1);
    mpz_set_ui(q2,0);
    mpz_set_ui(g2,1);
  } else {
    bs(0, terms: c_ulong, 0, 0);
  }

  const mid1 = getCurrentTime() - mid0;
  writeln("\nbs      time = ", mid1);
  writeln("   gcd  time = ", gcd_time);

  //writeln("misc    ");

  /* free some resources */
  sievedom = [0..-1: long];

  if HAVE_DIVEXACT_PREINV then
    mpz_clear(mgcd);
  mpz_clear(gcd);
  fac_clear(ftmp);
  fac_clear(fmul);

  for i in 1..depth {
    mpz_clear(pstack[i]);
    mpz_clear(qstack[i]);
    mpz_clear(gstack[i]);
    fac_clear(fpstack[i]);
    fac_clear(fgstack[i]);
  }

  mpz_clear(gstack[0]);
  fac_clear(fpstack[0]);
  fac_clear(fgstack[0]);

  stackdom1 = [0..-1: long];

  /* prepare to convert integers to floats */
  mpf_set_default_prec((d*BITS_PER_DIGIT+16): mp_bitcnt_t);

  /*
	  p*(C/D)*sqrt(C)
    pi = -----------------
	     (q+A*p)
  */

  const psize = mpz_sizeinbase(p1,10),
        qsize = mpz_sizeinbase(q1,10);

  mpz_addmul_ui(q1, p1, A);
  mpz_mul_ui(p1, p1, C/D);

  var pi, qi: mpf_t;

  mpf_init(pi);
  mpf_set_z(pi, p1);
  mpz_clear(p1);

  mpf_init(qi);
  mpf_set_z(qi, q1);
  mpz_clear(q1);

  stackdom2 = [0..-1: long];

  const mid2 = getCurrentTime() - mid1;
  //writeln("time = ", mid2);

  /* initialize temp float variables for sqrt & div */
  mpf_init(t1);
  mpf_init(t2);
  //mpf_set_prec_raw(t1, mpf_get_prec(pi));

  /* final step */
  writeln("div     ");
  my_div(qi, pi, qi);
  const mid3 = getCurrentTime() - mid2;
  writeln("time = ", mid3);

  writeln("sqrt    ");
  my_sqrt_ui(pi, C);
  const mid4 = getCurrentTime() - mid3;
  writeln("time = ", mid4);

  writeln("mul     ");
  mpf_mul(qi, qi, pi);
  const end = getCurrentTime();
  writeln("time = ", end - mid4);

  writeln("total   time = ", end - start);

  writeln("   P size = ", psize, " digits (", psize:real/d, ")\n",
          "   Q size = ", qsize, " digits (", qsize:real/d, ")");

  /* output Pi and timing statistics */
  if (_out&1)  {
    writeln("pi(0,", terms, ")=");
    mpf_out_str(stdout._fp, 10, d+2, qi);
    writeln();
  }

  /* free float resources */
  mpf_clear(pi);
  mpf_clear(qi);

  mpf_clear(t1);
  mpf_clear(t2);
}

def build_sieve(s) {
  const n = s.numElements,
        m = sqrt(n): long;

  s[1/2].fac = 1;
  s[1/2].pow = 1;

  for i in 3..n by 2 {
    if (s[i/2].fac == 0) {
      s[i/2].fac = i;
      s[i/2].pow = 1;
      if (i<=m) {
        for (j,k) in (i*i..n by i+i, i/2..) {
	  if (s[j/2].fac==0) {
	    s[j/2].fac = i;
	    if (s[k].fac == i) {
	      s[j/2].pow = s[k].pow + 1;
	      s[j/2].nxt = s[k].nxt;
	    } else {
	      s[j/2].pow = 1;
	      s[j/2].nxt = k;
	    }
	  }
	}
      }
    }
  }
}

def my_sqrt_ui(inout r: mpf_t, x: c_ulong) {
  const prec0 = mpf_get_prec(r);

  if (prec0 <= DOUBLE_PREC) {
    mpf_set_d(r, sqrt(x));
    return;
  }

  var bits: c_ulong = 0,
      prec = prec0;
  while (prec > DOUBLE_PREC) {
    const bit = prec&1;
    prec = (prec+bit)/2;
    bits = bits*2+bit;
  }

  mpf_set_prec_raw(t1, DOUBLE_PREC);
  mpf_set_d(t1, 1/sqrt(x));

  while (prec < prec0) {
    prec *= 2;
    if (prec < prec0) {
      /* t1 = t1+t1*(1-x*t1*t1)/2; */
      mpf_set_prec_raw(t2, prec);
      mpf_mul(t2, t1, t1);         // half x half -> full
      mpf_mul_ui(t2, t2, x);
      mpf_ui_sub(t2, 1, t2);
      mpf_set_prec_raw(t2, prec/2);
      mpf_div_2exp(t2, t2, 1);
      mpf_mul(t2, t2, t1);         // half x half -> half
      mpf_set_prec_raw(t1, prec);
      mpf_add(t1, t1, t2);
    } else {
      prec = prec0;
      /* t2=x*t1, t1 = t2+t1*(x-t2*t2)/2; */
      mpf_set_prec_raw(t2, prec/2);
      mpf_mul_ui(t2, t1, x);
      mpf_mul(r, t2, t2);          // half x half -> full
      mpf_ui_sub(r, x, r);
      mpf_mul(t1, t1, r);          // half x half -> half
      mpf_div_2exp(t1, t1, 1);
      mpf_add(r, t1, t2);
      break;
    }
    prec -= (bits&1);
    bits /=2;
  }
}

// r = y/x   WARNING: r cannot be the same as y.
def my_div(inout r, y, x: mpf_t) {
  const prec0 = mpf_get_prec(r);

  if (prec0<=DOUBLE_PREC) {
    mpf_set_d(r, mpf_get_d(y)/mpf_get_d(x));
    return;
  }

  var bits: c_ulong = 0,
      prec = prec0;
  while (prec > DOUBLE_PREC) {
    const bit = prec&1;
    prec = (prec+bit)/2;
    bits = bits*2 + bit;
  }

  mpf_set_prec_raw(t1, DOUBLE_PREC);
  mpf_ui_div(t1, 1, x);

  while (prec < prec0) {
    prec *= 2;
    if (prec < prec0) {
      /* t1 = t1+t1*(1-x*t1); */
      mpf_set_prec_raw(t2, prec);
      mpf_mul(t2, x, t1);          // full x half -> full
      mpf_ui_sub(t2, 1, t2);
      mpf_set_prec_raw(t2, prec/2);
      mpf_mul(t2, t2, t1);         // half x half -> half
      mpf_set_prec_raw(t1, prec);
      mpf_add(t1, t1, t2);
    } else {
      prec = prec0;
      /* t2=y*t1, t1 = t2+t1*(y-x*t2); */
      mpf_set_prec_raw(t2, prec/2);
      mpf_mul(t2, t1, y);          // half x half -> half
      mpf_mul(r, x, t2);           // full x half -> full
      mpf_sub(r, y, r);
      mpf_mul(t1, t1, r);          // half x half -> half
      mpf_add(r, t1, t2);
      break;
    }
    prec -= (bits&1);
    bits /=2;
  }
}

def fac_show(f: fac_t) {
  for i in 0..f[0].num_facs do
    if (f[0].pow[i]==1) then
      write(f[0].fac[i], " ");
    else
      write(f[0].fac[i], "^", f[0].pow[i]);
  writeln();
}

def fac_reset(f: fac_t) {
  f[0].num_facs = 0;
}

def fac_init_size(f: fac_t, in s: long) {
  if (s<INIT_FACS) then
    s=INIT_FACS;

  f[0].sdom = [0..#s];

  fac_reset(f);
}

def fac_init(f: fac_t) {
  fac_init_size(f, INIT_FACS);
}

def fac_clear(f: fac_t) {
  f.sdom = [0..-1:long];
}

def fac_resize(f: fac_t, s: long)
{
  if (f[0].sdom.numIndices < s) {
    fac_clear(f);
    fac_init_size(f, s);
  }
}

// BLC: unfortunate -- original GMP took advantage of long/ulong conversions
def fac_set_bp(f: fac_t, base: c_ulong, pow: long) {
  assert (base < max(long): c_ulong);
  fac_set_bp(f, base: long, pow: long);
}

// f = base^pow
def fac_set_bp(f: fac_t, in base: long, pow: long) {
  assert(base < sieve_size);
  var i: long;
  base /= 2;
  while (base > 0) {
    f[0].fac[i] = (sieve[base].fac): c_ulong;
    f[0].pow[i] = (sieve[base].pow*pow): c_ulong;
    base = sieve[base].nxt;
    i += 1;
  }
  f[0].num_facs = i;
  assert(i<=f[0].sdom.numIndices);
}

// r = f*g
def fac_mul2(r: fac_t, f: fac_t, g: fac_t) {

  var i, j, k: long;
  while (i<f[0].num_facs & j<g[0].num_facs) {
    if (f[0].fac[i] == g[0].fac[j]) {
      r[0].fac[k] = f[0].fac[i];
      r[0].pow[k] = f[0].pow[i] + g[0].pow[j];
      i += 1; j += 1;
    } else if (f[0].fac[i] < g[0].fac[j]) {
      r[0].fac[k] = f[0].fac[i];
      r[0].pow[k] = f[0].pow[i];
      i += 1;
    } else {
      r[0].fac[k] = g[0].fac[j];
      r[0].pow[k] = g[0].pow[j];
      j += 1;
    }
    k += 1;
  }
  while (i < f[0].num_facs) {
    r[0].fac[k] = f[0].fac[i];
    r[0].pow[k] = f[0].pow[i];
    i += 1;
    k += 1;
  }
  while (j < g[0].num_facs) {
    r[0].fac[k] = g[0].fac[j];
    r[0].pow[k] = g[0].pow[j];
    j += 1;
    k += 1;
  }
  r[0].num_facs = k;
  assert(k<=r[0].sdom.numIndices);
}

// f *= g
def fac_mul(f: fac_t, g: fac_t) {
  var tmp: fac_t;
  fac_resize(fmul, f[0].num_facs + g[0].num_facs);
  fac_mul2(fmul, f, g);
  tmp[0]  = f[0];
  f[0]    = fmul[0];
  fmul[0] = tmp[0];
}

// BLC: unfortunate -- original GMP took advantage of long/ulong conversions
def fac_mul_bp(f: fac_t, base: c_ulong, pow: long) {
  assert (base < max(long): c_ulong);
  fac_mul_bp(ftmp, base:long, pow);
}

// f *= base^pow
def fac_mul_bp(f: fac_t, base: long, pow: long) {
  fac_set_bp(ftmp, base, pow);
  fac_mul(f, ftmp);
}

// remove factors of power 0
def fac_compact(f: fac_t) {
  var j: long;
  for i in 0..f[0].num_facs {
    if (f[0].pow[i]>0) {
      if (j<i) {
	f[0].fac[j] = f[0].fac[i];
	f[0].pow[j] = f[0].pow[i];
      }
      j += 1;
    }
  }
  f[0].num_facs = j;
}

// convert factorized form to number
def bs_mul(inout r: mpz_t, a: long, b: long) {
  if (b-a <= 32) {
    mpz_set_ui(r, 1);
    for i in a..b-1 do
      for j in 0..fmul[0].pow[i] do
	mpz_mul_ui(r, r, fmul[0].fac[i]);
  } else {
    var r2: mpz_t;
    mpz_init(r2);
    bs_mul(r2, a, (a+b)/2);
    bs_mul(r, (a+b)/2, b);
    mpz_mul(r, r, r2);
    mpz_clear(r2);
  }
}

//#if HAVE_DIVEXACT_PREINV
//void mpz_invert_mod_2exp (mpz_ptr, mpz_srcptr);
//void mpz_divexact_pre (mpz_ptr, mpz_srcptr, mpz_srcptr, mpz_srcptr);
//
//#endif

// f /= gcd(f,g), g /= gcd(f,g)
def fac_remove_gcd(inout p: mpz_t, fp: fac_t, inout g: mpz_t, fg: fac_t) {
  var i, j, k: long;
  var c: c_ulong;
  fac_resize(fmul, min(fp.num_facs, fg.num_facs));
  while (i < fp.num_facs && j < fg.num_facs) {
    if (fp.fac[i] == fg.fac[j]) {
      c = min(fp.pow[i], fg.pow[j]);
      fp.pow[i] -= c;
      fg.pow[j] -= c;
      fmul.fac[k] = fp.fac[i];
      fmul.pow[k] = c;
      i += 1; j += 1; k += 1;
    } else if (fp.fac[i] < fg.fac[j]) {
      i += 1;
    } else {
      j += 1;
    }
  }
  fmul.num_facs = k;
  assert(k <= fmul.sdom.numIndices);

  if (fmul.num_facs) {
    bs_mul(gcd, 0, fmul.num_facs);
    if HAVE_DIVEXACT_PREINV {
      mpz_invert_mod_2exp (mgcd, gcd);
      mpz_divexact_pre (p, p, gcd, mgcd);
      mpz_divexact_pre (g, g, gcd, mgcd);
    } else {
      mpz_tdiv_q(p, p, gcd);
      mpz_tdiv_q(g, g, gcd);
    }
    fac_compact(fp);
    fac_compact(fg);
  }
}

var top: long = 0;

def p1  var return  pstack[top];
def q1  var return  qstack[top];
def g1  var return  gstack[top];
def fp1 var return fpstack[top];
def fg1 var return fgstack[top];

def p2  var return  pstack[top+1];
def q2  var return  qstack[top+1];
def g2  var return  gstack[top+1];
def fp2 var return fpstack[top+1];
def fg2 var return fgstack[top+1];

//////////////////////////////////////////////////////////////////////
//////

var progress = 0.0;

// binary splitting
def bs(a: c_ulong, b: c_ulong, gflag: c_uint, level: long) {
  if (b-a==1) {
    /*
      g(b-1,b) = (6b-5)(2b-1)(6b-1)
      p(b-1,b) = b^3 * C^3 / 24
      q(b-1,b) = (-1)^b*g(b-1,b)*(A+Bb).
    */
    mpz_set_ui(p1, b);
    mpz_mul_ui(p1, p1, b);
    mpz_mul_ui(p1, p1, b);
    mpz_mul_ui(p1, p1, (C/24)*(C/24));
    mpz_mul_ui(p1, p1, C*24);

    mpz_set_ui(g1, 2*b-1);
    mpz_mul_ui(g1, g1, 6*b-1);
    mpz_mul_ui(g1, g1, 6*b-5);

    mpz_set_ui(q1, b);
    mpz_mul_ui(q1, q1, B);
    mpz_add_ui(q1, q1, A);
    mpz_mul   (q1, q1, g1);
    if (b%2) then
      mpz_neg(q1, q1);

    var i = b;
    while ((i&1)==0) do i>>=1;
    fac_set_bp(fp1, i, 3);    // b^3
    fac_mul_bp(fp1, 3*5*23*29, 3);
    fp1[0].pow[0]-=1;

    fac_set_bp(fg1, 2*b-1, 1);   // 2b-1
    fac_mul_bp(fg1, 6*b-1, 1);   // 6b-1
    fac_mul_bp(fg1, 6*b-5, 1);   // 6b-5

    if (b > (progress:c_ulong)) {
      write(".");
      progress += percent*2;
    }

  } else {
    /*
      p(a,b) = p(a,m) * p(m,b)
      g(a,b) = g(a,m) * g(m,b)
      q(a,b) = q(a,m) * p(m,b) + q(m,b) * g(a,m)
    */
    const mid = (a+(b-a)*0.5224): c_ulong;     // tuning parameter
    bs(a, mid, 1, level+1);

    top += 1;
    bs(mid, b, gflag, level+1);
    top -= 1;

    if (level == 0) then
      write("");

    const ccc = level == 0;

    if (ccc) then CHECK_MEMUSAGE;

    if (level>=4) {           // tuning parameter
      if do_gcd_time {
        const t = getCurrentTime();
        fac_remove_gcd(p2, fp2, g1, fg1);
        gcd_time += getCurrentTime() - t;
      } else {
        fac_remove_gcd(p2, fp2, g1, fg1);
      }
    }

    if (ccc) then CHECK_MEMUSAGE;
    mpz_mul(p1, p1, p2);

    if (ccc) then CHECK_MEMUSAGE;
    mpz_mul(q1, q1, p2);

    if (ccc) then CHECK_MEMUSAGE;
    mpz_mul(q2, q2, g1);

    if (ccc) then CHECK_MEMUSAGE;
    mpz_add(q1, q1, q2);

    if (ccc) then CHECK_MEMUSAGE;
    fac_mul(fp1, fp2);

    if (gflag) {
      mpz_mul(g1, g1, g2);
      fac_mul(fg1, fg2);
    }
  }

  if (_out&2) {
    write("p(", a, ",", b, ")=");
    fac_show(fp1);
    if (gflag) {
      write("g(", a, ",", b, ")=");
      fac_show(fg1);
    }
  }
}


Same fix as to release/examples/blockLU test discussed in previous checkin.

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

/* This file contains a right-looking block-LU solver function named
 * rightBlockLU() along with its supporting functions and iterators,
 * and a solve routine that takes the LU factors to solve Ax=b.
 *
 * This rightBlockLU function is written for a single locale.  It uses an
 * iterator to define blocks of indices that make expressing the block
 * algorithm easier and less error-prone.  Array aliases are defined
 * with these block indices at each iteration, so that the submatrices
 * involved in the block factorization and in the subsequent updates
 * are easily referenced and modified.
 */

// rightBlockLU: Computes block-LU with pivoting.  The arguments are as follows:
//   A: the input array to be factored.  It must be 2D and of size
//      n by n+1.  A = [Asquare | b] on entry and [L U y] on exit.
//
//   blk: the blocking factor, which must be positive and less than or
//        equal to A's size.
//**** Need to modify routine to delay row swaps until after panel
//     factorization

def rightBlockLU(A: [?D], blk) where (D.rank == 2) {

  // Test that 0 < blk <= n, where n = length of one dimension of A.
  if (blk <= 0) || (blk > D.dim(1).length) then
    halt(blk," is an invalid block size passed to blockLU");

  var piv: [D.dim(1)] int;
  [i in D.dim(1)] piv(i) = i;    // initialize the pivot vector

  // Main loop of block LU uses an iterator to compute four sets of
  // index ranges -- those that are unfactored, divided into those
  // currently being factored and those that remain.  The row and
  // column indices of the remaining submatrix are specified separately
  // to accomodate the rectangular input matrix A.

  for (UnfactoredInds, CurrentPanelInds, TrailingRows, TrailingCols)
        in generateBlockLURanges(D, blk) {

    // Create array aliases for various submatrices of current block
    // iteration as follows:
    //
    //     |Factored    |   |Factored   |   |Factored   |
    //     |  _ _ _ _ _ |   |    _ _ _ _|   |    _ _ _ _|
    // A = | |Unfactored| = |   |A1 | A2| = |   |A11 A12|
    //     | |          |   |   |   |   |   |   |A21 A22|
    //
    // where A1 = |A11|
    //            |A21| is the current rectangular block that
    //                  is factored in this iteration
    //
    //       A2 = |A12|
    //            |A22| is updated after the LU factorization
    //                  of A1

    var A1  => A[UnfactoredInds, CurrentPanelInds],
        A2  => A[UnfactoredInds, TrailingCols],
        A11 => A[CurrentPanelInds, CurrentPanelInds],
        A21 => A[TrailingRows, CurrentPanelInds],
        A12 => A[CurrentPanelInds, TrailingCols],
        A22 => A[TrailingRows, TrailingCols];

    // First compute the LU factorization of A1...
    //
    // We loop over the rows of A11, but we eliminate the
    // the full rectangular A1 block.

    // This is the panel factorization.  Need to add alternative
    // factorization options.  Also, need to add pipelining of
    // panel factorization.  Instead of CurrentPanelInds, have
    // CurrentPanelInds and NextPanelInds for a lookahead of one
    // (or is that two? need to check).
    for k in CurrentPanelInds {

      // Find pivot for kth column:
      //   identify largest magnitude element in kth column
      //   (pivot), from the diagonal element downward
      //   through all rows of A1

      // Was not able to replace k..k with k here.  Why?
      const pivotRow = computePivotRow(A1[k.., k..k]),
            pivot = A1[pivotRow, k];

      // If kth row is not row of pivot, swap rows:
      if (pivotRow != k) {

        // store row permutation in piv array
        piv(k) <=> piv(pivotRow);

        // swap values in rows k and pivotRow of the full
        // matrix A
        //** swap only in panel and save remainder of swaps for
        // for update later
        A[k, ..] <=> A[pivotRow, ..];
      }

      // If pivot is zero, halt.  Matrix is singular and
      // cannot be factored.
      if (pivot == 0) then halt("zero pivot encountered");

      // Compute the k-th elimination step:
      //   store multipliers...
      if k+1 <= A1.domain.high(1) then
        A1[k+1.., k] /= pivot;

      //   ..and subtract scaled kth row from remaining
      //   unfactored rows of A1

      forall (i,j) in [UnfactoredInds(k+1..), CurrentPanelInds(k+1..)] do
        A1(i,j) -= A1(i,k) * A1(k,j);
    }

    // ... and now update A2.
    // First update A12.

    // Add loop to update NextPanel first so that lookahead factorization
    // could occur.  Maybe use sync vars to do this?

    // Delay of row swaps needs to be incorporated into the next two
    // loop nests.  Rows of A need to be swapped with rows of U.

    // Communication of A1 to other processors occurs before this
    // step.  There are options for communication that need to be reflected
    // here or in distribution.
    // A1 (nb x nb) is broadcast across processors in process row.
    var U => A11; // Want each processor in process row to have local copy of A1.
    forall columnblk in blkIter(TrailingCols,blk) {
      var Ublk => A12[CurrentPanelInds,columnblk];
      //On processor that owns Ublk, do the following update:
      forall j in columnblk do
        for k in CurrentPanelInds do
          forall i in CurrentPanelInds(k+1..) do
            Ublk(i,j) -= U(i,k) * Ublk(k,j);
    }

    // And then update A22 -= A21*A12.
    //
    // All process columns and rows are involved in this step.
    // Blocks of L (nb x nb blocks of A21) are broadcast across
    //   processors in process row.
    // Blocks of U (nb x nb blocks of A21) are broadcast across
    //   processors in process column.
    // Computation occurs on processor that contains Ablk (nb x nb).
    for (rowblk, columnblk) in blkIter2D(TrailingRows,TrailingCols,blk) {
      var Lblk => A21[rowblk,CurrentPanelInds];
      var Ublk => A12[CurrentPanelInds,columnblk];
      var Ablk => A22[rowblk,columnblk];
      // On processor that owns Ablk, do the following computation:
      for (i,j) in [rowblk, columnblk] do
        for k in CurrentPanelInds do
          Ablk(i,j) -= Lblk(i,k) * Ublk(k,j);
      }
    }

}

// The generateBlockLURanges iterator returns a 4-tuple of
// the ranges to be used in each iteration of block LU:
//   (UnfactoredInds, CurrentPanelInds, TrailingRows, TrailingCols).
// By defining these ranges, the blockLU code is cleaner. It
// eliminates the need to test for the last iteration where a full-sized
// block may not be possible and only the factorization step (and not
// the update step) is required.
//
// The range UnfactoredInds is equivalent to the range
// CurrentPanelInds concatenated with the range TrailingRows.
//
// The range CurrentPanelInds has the length of blksize, except
// for the end case when the last block may not be of full size.
// This iterator takes care of this end case so that testing for
//  it is not necessary in the blockLU code itself.
//
// The range TrailingRows will be an empty range for the
// the last block iteration.  When it is empty, the loops in
// the blockLU code will not execute, so testing for this case is
// not necessary.

def generateBlockLURanges(D:domain(2), blksize) {
  const end = D.dim(1).high;
  const endcol = D.dim(2).high;

  for i in D.dim(1) by blksize {
    const hi = min(i + blksize-1, end);
    yield (i..end, i..hi, hi+1..end, hi+1..endcol);
  }
}

def blkIter(indRange, blksize) {
  const end = indRange.high;

  for i in indRange by blksize {
    const hi = min(i+blksize-1, end);
    yield i..hi;
  }
}

def blkIter2D(rowRange, colRange, blksize) {
  const rowEnd = rowRange.high;
  const colEnd = colRange.high;

  for i in rowRange by blksize {
    const rowhi = min(i+blksize-1, rowEnd);
    for j in colRange by blksize {
      const colhi = min(j+blksize-1, colEnd);
      yield (i..rowhi, j..colhi);
    }
  }
}

// This function computes the pivot row for an LU pivoting operation
// by using Chapel's maxloc reduction on the absolute values in the
// matrix, dropping the maximum value on the floor using the
// underscore operator, and returning the row of the resulting index.

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

//  The LU solve routine takes A = [L U y] and solves for x.
def LUSolve (A: [?ADom], x: [?xDom]) {

   var n = ADom.dim(1).length;
   var AD1 = ADom.dim(1);
   var b => A(.., n+1);

   x = b;
   for j in (2..n) by -1 {
     x(j) /= A(j,j);
     for (i1, i2) in (xDom(1..j-1), AD1(1..j-1)) {
       x(i1) -= x(j)*A(i2, j);
     }
   }

   x(1) /= A(1,1);

}

/* This file contains a right-looking block-LU solver function named
 * rightBlockLU() along with its supporting functions and iterators,
 * and a solve routine that takes the LU factors to solve Ax=b.
 *
 * This rightBlockLU function is written for a single locale.  It uses an
 * iterator to define blocks of indices that make expressing the block
 * algorithm easier and less error-prone.  Array aliases are defined
 * with these block indices at each iteration, so that the submatrices
 * involved in the block factorization and in the subsequent updates
 * are easily referenced and modified.
 */

// rightBlockLU: Computes block-LU with pivoting.  The arguments are as follows:
//   A: the input array to be factored.  It must be 2D and of size
//      n by n+1.  A = [Asquare | b] on entry and [L U y] on exit.
//
//   blk: the blocking factor, which must be positive and less than or
//        equal to A's size.
//**** Need to modify routine to delay row swaps until after panel
//     factorization

def rightBlockLU(A: [?D], blk) where (D.rank == 2) {

  // Test that 0 < blk <= n, where n = length of one dimension of A.
  if (blk <= 0) || (blk > D.dim(1).length) then
    halt(blk," is an invalid block size passed to blockLU");

  var piv: [D.dim(1)] int;
  [i in D.dim(1)] piv(i) = i;    // initialize the pivot vector

  // Main loop of block LU uses an iterator to compute four sets of
  // index ranges -- those that are unfactored, divided into those
  // currently being factored and those that remain.  The row and
  // column indices of the remaining submatrix are specified separately
  // to accomodate the rectangular input matrix A.

  for (UnfactoredInds, CurrentPanelInds, TrailingRows, TrailingCols)
        in generateBlockLURanges(D, blk) {

    // Create array aliases for various submatrices of current block
    // iteration as follows:
    //
    //     |Factored    |   |Factored   |   |Factored   |
    //     |  _ _ _ _ _ |   |    _ _ _ _|   |    _ _ _ _|
    // A = | |Unfactored| = |   |A1 | A2| = |   |A11 A12|
    //     | |          |   |   |   |   |   |   |A21 A22|
    //
    // where A1 = |A11|
    //            |A21| is the current rectangular block that
    //                  is factored in this iteration
    //
    //       A2 = |A12|
    //            |A22| is updated after the LU factorization
    //                  of A1

    var A1  => A[UnfactoredInds, CurrentPanelInds],
        A2  => A[UnfactoredInds, TrailingCols],
        A11 => A[CurrentPanelInds, CurrentPanelInds],
        A21 => A[TrailingRows, CurrentPanelInds],
        A12 => A[CurrentPanelInds, TrailingCols],
        A22 => A[TrailingRows, TrailingCols];

    // First compute the LU factorization of A1...
    //
    // We loop over the rows of A11, but we eliminate the
    // the full rectangular A1 block.

    // This is the panel factorization.  Need to add alternative
    // factorization options.  Also, need to add pipelining of
    // panel factorization.  Instead of CurrentPanelInds, have
    // CurrentPanelInds and NextPanelInds for a lookahead of one
    // (or is that two? need to check).
    for k in CurrentPanelInds {

      // Find pivot for kth column:
      //   identify largest magnitude element in kth column
      //   (pivot), from the diagonal element downward
      //   through all rows of A1

      // Was not able to replace k..k with k here.  Why?
      const pivotRow = computePivotRow(A1[k.., k..k]),
            pivot = A1[pivotRow, k];

      // If kth row is not row of pivot, swap rows:
      if (pivotRow != k) {

        // store row permutation in piv array
        piv(k) <=> piv(pivotRow);

        // swap values in rows k and pivotRow of the full
        // matrix A
        //** swap only in panel and save remainder of swaps for
        // for update later
        A[k, ..] <=> A[pivotRow, ..];
      }

      // If pivot is zero, halt.  Matrix is singular and
      // cannot be factored.
      if (pivot == 0) then halt("zero pivot encountered");

      // Compute the k-th elimination step:
      //   store multipliers...
      A1[k+1.., k] /= pivot;

      //   ..and subtract scaled kth row from remaining
      //   unfactored rows of A1

      forall (i,j) in [UnfactoredInds(k+1..), CurrentPanelInds(k+1..)] do
        A1(i,j) -= A1(i,k) * A1(k,j);
    }

    // ... and now update A2.
    // First update A12.

    // Add loop to update NextPanel first so that lookahead factorization
    // could occur.  Maybe use sync vars to do this?

    // Delay of row swaps needs to be incorporated into the next two
    // loop nests.  Rows of A need to be swapped with rows of U.

    // Communication of A1 to other processors occurs before this
    // step.  There are options for communication that need to be reflected
    // here or in distribution.
    // A1 (nb x nb) is broadcast across processors in process row.
    var U => A11; // Want each processor in process row to have local copy of A1.
    forall columnblk in blkIter(TrailingCols,blk) {
      var Ublk => A12[CurrentPanelInds,columnblk];
      //On processor that owns Ublk, do the following update:
      forall j in columnblk do
        for k in CurrentPanelInds do
          forall i in CurrentPanelInds(k+1..) do
            Ublk(i,j) -= U(i,k) * Ublk(k,j);
    }

    // And then update A22 -= A21*A12.
    //
    // All process columns and rows are involved in this step.
    // Blocks of L (nb x nb blocks of A21) are broadcast across
    //   processors in process row.
    // Blocks of U (nb x nb blocks of A21) are broadcast across
    //   processors in process column.
    // Computation occurs on processor that contains Ablk (nb x nb).
    for (rowblk, columnblk) in blkIter2D(TrailingRows,TrailingCols,blk) {
      var Lblk => A21[rowblk,CurrentPanelInds];
      var Ublk => A12[CurrentPanelInds,columnblk];
      var Ablk => A22[rowblk,columnblk];
      // On processor that owns Ablk, do the following computation:
      for (i,j) in [rowblk, columnblk] do
        for k in CurrentPanelInds do
          Ablk(i,j) -= Lblk(i,k) * Ublk(k,j);
      }
    }

}

// The generateBlockLURanges iterator returns a 4-tuple of
// the ranges to be used in each iteration of block LU:
//   (UnfactoredInds, CurrentPanelInds, TrailingRows, TrailingCols).
// By defining these ranges, the blockLU code is cleaner. It
// eliminates the need to test for the last iteration where a full-sized
// block may not be possible and only the factorization step (and not
// the update step) is required.
//
// The range UnfactoredInds is equivalent to the range
// CurrentPanelInds concatenated with the range TrailingRows.
//
// The range CurrentPanelInds has the length of blksize, except
// for the end case when the last block may not be of full size.
// This iterator takes care of this end case so that testing for
//  it is not necessary in the blockLU code itself.
//
// The range TrailingRows will be an empty range for the
// the last block iteration.  When it is empty, the loops in
// the blockLU code will not execute, so testing for this case is
// not necessary.

def generateBlockLURanges(D:domain(2), blksize) {
  const end = D.dim(1).high;
  const endcol = D.dim(2).high;

  for i in D.dim(1) by blksize {
    const hi = min(i + blksize-1, end);
    yield (i..end, i..hi, hi+1..end, hi+1..endcol);
  }
}

def blkIter(indRange, blksize) {
  const end = indRange.high;

  for i in indRange by blksize {
    const hi = min(i+blksize-1, end);
    yield i..hi;
  }
}

def blkIter2D(rowRange, colRange, blksize) {
  const rowEnd = rowRange.high;
  const colEnd = colRange.high;

  for i in rowRange by blksize {
    const rowhi = min(i+blksize-1, rowEnd);
    for j in colRange by blksize {
      const colhi = min(j+blksize-1, colEnd);
      yield (i..rowhi, j..colhi);
    }
  }
}

// This function computes the pivot row for an LU pivoting operation
// by using Chapel's maxloc reduction on the absolute values in the
// matrix, dropping the maximum value on the floor using the
// underscore operator, and returning the row of the resulting index.

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

//  The LU solve routine takes A = [L U y] and solves for x.
def LUSolve (A: [?ADom], x: [?xDom]) {

   var n = ADom.dim(1).length;
   var AD1 = ADom.dim(1);
   var b => A(.., n+1);

   x = b;
   for j in (2..n) by -1 {
     x(j) /= A(j,j);
     for (i1, i2) in (xDom(1..j-1), AD1(1..j-1)) {
       x(i1) -= x(j)*A(i2, j);
     }
   }

   x(1) /= A(1,1);

}


Add test to exercise submodule no doc regression.

module Foo {
  pragma "no doc"
  config var blah: int; // No comment, should have nothing printed out

  /* This config var has a comment before it. */
  pragma "no doc"
  config var blah2: int;

  pragma "no doc"
    /* This config var has a comment after the pragma */
  config var blah3: int;

  config var blah4: int; // Should be printed, but without comment

  pragma "no doc"
  proc a () {  }

  /* This function has a comment before it. */
  pragma "no doc"
  proc b () {  }

  pragma "no doc"
  /* This function has a comment after the pragma. */
  proc c () {  }

  proc d() {
    // Should be printed, but without comment
  }

  pragma "no doc"
  class alsoIgnoreMe {
    type t;
    var b: t;
  }

  pragma "no doc"
    /* This class has a comment after the pragma */
  class alsoIgnoreMe2 {
    type t;
    var b: t;
  }

  /* This class has a comment before the pragma */
  pragma "no doc"
  class alsoIgnoreMe3 {
    type t;
    var b: t;
  }

  class bar {
    // No class comment.  Should not grab previous class comment.

    pragma "no doc"
    var ignoreMe: bool;

    /* This field has a comment before it */
    pragma "no doc"
    var ignoreMe2: bool;

    pragma "no doc"
    /* This field has a comment after the pragma */
    var ignoreMe3: bool;

    var showMe: bool;
    // This is the only field that should be printed
  }

  /* This is an undocumented module. */
  pragma "no doc"
  module invisible {

    /* This class is undocumented, since its module is undocumented. */
    class MyC {}
  }
}

pragma "no doc"
module toBeIgnored {

  class otherwiseSeen {
    var andAField: string;
  }
}

module Foo {
  pragma "no doc"
  config var blah: int; // No comment, should have nothing printed out

  /* This config var has a comment before it. */
  pragma "no doc"
  config var blah2: int;

  pragma "no doc"
    /* This config var has a comment after the pragma */
  config var blah3: int;

  config var blah4: int; // Should be printed, but without comment

  pragma "no doc"
  proc a () {  }

  /* This function has a comment before it. */
  pragma "no doc"
  proc b () {  }

  pragma "no doc"
  /* This function has a comment after the pragma. */
  proc c () {  }

  proc d() {
    // Should be printed, but without comment
  }

  pragma "no doc"
  class alsoIgnoreMe {
    type t;
    var b: t;
  }

  pragma "no doc"
    /* This class has a comment after the pragma */
  class alsoIgnoreMe2 {
    type t;
    var b: t;
  }

  /* This class has a comment before the pragma */
  pragma "no doc"
  class alsoIgnoreMe3 {
    type t;
    var b: t;
  }

  class bar {
    // No class comment.  Should not grab previous class comment.

    pragma "no doc"
    var ignoreMe: bool;

    /* This field has a comment before it */
    pragma "no doc"
    var ignoreMe2: bool;

    pragma "no doc"
    /* This field has a comment after the pragma */
    var ignoreMe3: bool;

    var showMe: bool;
    // This is the only field that should be printed
  }
}

pragma "no doc"
module toBeIgnored {

  class otherwiseSeen {
    var andAField: string;
  }
}


Convinced myself on the way home that the cleanup radix-4 butterflies
at the end could use the same localSlice + butterfly technique that
all the rest do.  David am I missing something?

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

/* This implementation of the FFT benchmark uses radix-4 butterflies
   and is divided into two main phases: one which uses a Block
   distribution and the second which uses a Cyclic distribution.  When
   run on 4**k locales, this guarantees that each butterfly will only
   access local data.  In an optimized implementation, this should
   cause most of the communication to occur when copying the vector
   between Block and Cyclic storage formats.
*/

//
// Use standard modules for Bit operations, Random numbers, Timing, and
// Block and Cyclic distributions
//
use BitOps, Random, Time, BlockDist, CyclicDist;

//
// Use shared user module for computing HPCC problem sizes
//
use HPCCProblemSize;

const radix = 4;               // the radix of this FFT implementation

const numVectors = 2;          // the number of vectors to be stored
type elemType = complex(128);  // the element type of the vectors
type idxType = int(64);        // the index type of the vectors

//
// A configuration constant defining log2(problem size) -- n -- and a
// constant defining the problem size itself -- m
//
config const n = computeProblemSize(numVectors, elemType, returnLog2 = true);
const m = 2**n;

//
// The number of tasks to use per Chapel locale in parallel loops
//
config const tasksPerLocale = here.numCores;

//
// Configuration constants defining the epsilon and threshold values
// used to verify the result
//
config const epsilon = 2.0 ** -51.0,
             threshold = 16.0;

//
// Configuration constants to indicate whether or not to use a
// pseudo-random seed (based on the clock) or a fixed seed; and to
// specify the fixed seed explicitly
//
config const useRandomSeed = true,
             seed = if useRandomSeed then SeedGenerator.clockMS else 314159265;

//
// Configuration constants to control what's printed -- benchmark
// parameters, input and output arrays, and/or statistics
//
config const printParams = true,
             printArrays = false,
             printStats = true;

//
// The program entry point
//
def main() {
  printConfiguration();          // print the problem size

  //
  // This implementation assumes 4**k locales due to its assertion that
  // all butterflies are local to a given locale
  //
  assert(4**log4(numLocales) == numLocales,
         "numLocales must be a power of 4 for this fft implementation");

  //
  // TwiddleDom describes the index set used to define the vector of
  // twiddle values and is a 1D domain indexed by 64-bit ints from 0
  // to m/4-1 stored using the block distribution TwiddleDist.
  // Twiddles is the vector of twiddle values.
  //
  const TwiddleDist = distributionValue(new Block(1, idxType, bbox=[0..m/4-1]));
  const TwiddleDom: domain(1, idxType) distributed TwiddleDist = [0..m/4-1];
  var Twiddles: [TwiddleDom] elemType;

  //
  // ProblemSpace describes the abstract problem space used for the
  // FFT benchmark: the indices 0..m-1
  //
  const ProblemSpace = [0..m-1];

  //
  // BlkDist describes the problem space as distributed in a Block
  // manner between the Locales where ProblemSpace defines the
  // bounding box used to compute the blocking.  BlkDom defines the
  // Block-distributed problem space and is used to define the vectors
  // z (used to store the input vector) and ZBlk (used for the first
  // half of the FFT phases).
  //
  const BlkDist = distributionValue(new Block(1, idxType, bbox=ProblemSpace,
                                              tasksPerLocale=tasksPerLocale));
  const BlkDom: domain(1, idxType) distributed BlkDist = ProblemSpace;
  var Zblk, z: [BlkDom] elemType;

  //
  // CycDist describes the problem space as distributed in a Cyclic
  // manner between the Locales where locale #0 stores element 0.
  // CycDom defines the Cyclic-distributed problem space and is used
  // to define the Zcyc vector, used for the second half of the FFT
  // phases.
  //
  const CycDist = distributionValue(new Cyclic(1, idxType,
                                               tasksPerLocale=tasksPerLocale));
  const CycDom: domain(1, idxType) distributed CycDist = ProblemSpace;
  var Zcyc: [CycDom] elemType;

  initVectors(Twiddles, z);            // initialize twiddles and input vector z

  const startTime = getCurrentTime();  // capture the start time

  Zblk = conjg(z);                        // store the conjugate of z in Zblk
  bitReverseShuffle(Zblk);                // permute Zblk

  dfft(Zblk, Twiddles, cyclicPhase=false); // compute the DFFT, block phases

  forall (b, c) in (Zblk, Zcyc) do       // copy vector to Cyclic storage
    c = b;

  dfft(Zcyc, Twiddles, cyclicPhase=true); // compute the DFFT, cyclic phases

  forall (b, c) in (Zblk, Zcyc) do        // copy vector back to Block storage
    b = c;

  const execTime = getCurrentTime() - startTime;     // store the elapsed time

  const validAnswer = verifyResults(z, Zblk, Zcyc, Twiddles); // validate answer
  printResults(validAnswer, execTime);               // print the results
}

//
// compute the discrete fast Fourier transform of a vector A declared
// over domain ADom using twiddle vector W
//
def dfft(A: [?ADom], W, cyclicPhase) {
  const numElements = A.numElements;
  //
  // loop over the phases of the DFT sequentially using custom
  // iterator genDFTStrideSpan that yields the stride and span for
  // each bank of butterfly calculations
  //
  for (str, span) in genDFTStrideSpan(numElements, cyclicPhase) {
    //
    // loop in parallel over each of the banks of butterflies with
    // shared twiddle factors, zippering with the unbounded range
    // 0.. to get the base twiddle indices
    //
    forall (bankStart, twidIndex) in (ADom by 2*span, 0..) {
      //
      // compute the first set of multipliers for the low bank
      //
      var wk2 = W(twidIndex),
          wk1 = W(2*twidIndex),
          wk3 = (wk1.re - 2 * wk2.im * wk1.im,
                 2 * wk2.im * wk1.re - wk1.im):elemType;
      //
      // loop in parallel over the low bank, computing butterflies
      // Note: lo..#num         == lo, lo+1, lo+2, ..., lo+num-1
      //       lo.. by str #num == lo, lo+str, lo+2*str, ... lo+(num-1)*str
      //
      forall lo in bankStart..#str do
        on ADom.dist.ind2loc(lo) do
          local butterfly(wk1, wk2, wk3, A.localSlice(lo..by str #radix));

      //
      // update the multipliers for the high bank
      //
      wk1 = W(2*twidIndex+1);
      wk3 = (wk1.re - 2 * wk2.re * wk1.im,
             2 * wk2.re * wk1.re - wk1.im):elemType;
      wk2 *= 1.0i;

      //
      // loop in parallel over the high bank, computing butterflies
      //
      forall lo in bankStart+span..#str do
        on ADom.dist.ind2loc(lo) do
          local butterfly(wk1, wk2, wk3, A.localSlice(lo.. by str #radix));
    }
  }

  if cyclicPhase {
    //
    // Do the last set of butterflies...
    //
    const str = radix**log4(numElements-1);
    //
    // ...using the radix-4 butterflies with 1.0 multipliers if the
    // problem size is a power of 4
    //
    if (str*radix == numElements) {
      writeln("looping over ", 0..#str, "; slice = lo.. by ", str, " # ", radix);
      forall lo in 0..#str do
        on ADom.dist.ind2loc(lo) do
          local butterfly(1.0, 1.0, 1.0, A.localSlice(lo.. by str # radix));
    }
    //
    // ...otherwise using a simple radix-2 butterfly scheme
    //
    else
      forall lo in 0..#str {
        const a = A(lo),
              b = A(lo+str);
        A(lo)     = a + b;
        A(lo+str) = a - b;
      }
  }
}

//
// this is the radix-4 butterfly routine that takes multipliers wk1,
// wk2, and wk3 and a 4-element array (slice) A.
//
def butterfly(wk1, wk2, wk3, X:[0..3]) {
  var x0 = X(0) + X(1),
      x1 = X(0) - X(1),
      x2 = X(2) + X(3),
      x3rot = (X(2) - X(3))*1.0i;

  X(0) = x0 + x2;                   // compute the butterfly in-place on X
  x0 -= x2;
  X(2) = wk2 * x0;
  x0 = x1 + x3rot;
  X(1) = wk1 * x0;
  x0 = x1 - x3rot;
  X(3) = wk3 * x0;
}

//
// this iterator generates the stride and span values for the phases
// of the DFFT simply by yielding tuples: (radix**i, radix**(i+1))
//
def genDFTStrideSpan(numElements, cyclicPhase) {
  const (start, end) = if !cyclicPhase then (1, numLocales:idxType)
                                       else (numLocales, numElements-1);
  var stride = start;
  for i in log4(start)+1..log4(end):int {
    const span = stride * radix;
    yield (stride, span);
    stride = span;
  }
}

//
// Print the problem size
//
def printConfiguration() {
  if (printParams) {
    if (printStats) then printLocalesTasks(tasksPerLocale=tasksPerLocale);
    printProblemSize(elemType, numVectors, m);
  }
}

//
// Initialize the twiddle vector and random input vector and
// optionally print them to the console
//
def initVectors(Twiddles, z) {
  computeTwiddles(Twiddles);
  bitReverseShuffle(Twiddles);

  fillRandom(z, seed);

  if (printArrays) {
    writeln("After initialization, Twiddles is: ", Twiddles, "\n");
    writeln("z is: ", z, "\n");
  }
}

//
// Compute the twiddle vector values
//
def computeTwiddles(Twiddles) {
  const numTwdls = Twiddles.numElements,
        delta = 2.0 * atan(1.0) / numTwdls;

  Twiddles(0) = 1.0;
  Twiddles(numTwdls/2) = let x = cos(delta * numTwdls/2)
                          in (x, x): elemType;
  forall i in 1..numTwdls/2-1 {
    const x = cos(delta*i),
          y = sin(delta*i);
    Twiddles(i)            = (x, y): elemType;
    Twiddles(numTwdls - i) = (y, x): elemType;
  }
}

//
// Perform a permutation of the argument vector by reversing the bits
// of the indices
//
def bitReverseShuffle(Vect: [?Dom]) {
  const numBits = log2(Vect.numElements),
        Perm: [i in Dom] Vect.eltType = Vect(bitReverse(i, revBits=numBits));
  Vect = Perm;
}

//
// Reverse the low revBits bits of val
//
def bitReverse(val: ?valType, revBits = 64) {
  param mask = 0x0102040810204080;
  const valReverse64 = bitMatMultOr(mask, bitMatMultOr(val:uint(64), mask)),
        valReverse = bitRotLeft(valReverse64, revBits);
  return valReverse: valType;
}

//
// Compute the log base 4 of x
//
def log4(x) return logBasePow2(x, 2);

//
// verify that the results are correct by reapplying the dfft and then
// calculating the maximum error, comparing against epsilon
//
def verifyResults(z, Zblk, Zcyc, Twiddles) {
  if (printArrays) then writeln("After FFT, Z is: ", Zblk, "\n");

  Zblk = conjg(Zblk) / m;
  bitReverseShuffle(Zblk);
  dfft(Zblk, Twiddles, cyclicPhase=false);
  forall (b, c) in (Zblk, Zcyc) do
    c = b;
  dfft(Zcyc, Twiddles, true);
  forall (b, c) in (Zblk, Zcyc) do
    b = c;

  if (printArrays) then writeln("After inverse FFT, Z is: ", Zblk, "\n");

  var maxerr = max reduce sqrt((z.re - Zblk.re)**2 + (z.im - Zblk.im)**2);
  maxerr /= (epsilon * n);
  if (printStats) then writeln("error = ", maxerr);

  return (maxerr < threshold);
}

//
// print out sucess/failure, the timing, and the Gflop/s value
//
def printResults(successful, execTime) {
  writeln("Validation: ", if successful then "SUCCESS" else "FAILURE");
  if (printStats) {
    writeln("Execution time = ", execTime);
    writeln("Performance (Gflop/s) = ", 5 * (m * n / execTime) * 1e-9);
  }
}

/* This implementation of the FFT benchmark uses radix-4 butterflies
   and is divided into two main phases: one which uses a Block
   distribution and the second which uses a Cyclic distribution.  When
   run on 4**k locales, this guarantees that each butterfly will only
   access local data.  In an optimized implementation, this should
   cause most of the communication to occur when copying the vector
   between Block and Cyclic storage formats.
*/

//
// Use standard modules for Bit operations, Random numbers, Timing, and
// Block and Cyclic distributions
//
use BitOps, Random, Time, BlockDist, CyclicDist;

//
// Use shared user module for computing HPCC problem sizes
//
use HPCCProblemSize;

const radix = 4;               // the radix of this FFT implementation

const numVectors = 2;          // the number of vectors to be stored
type elemType = complex(128);  // the element type of the vectors
type idxType = int(64);        // the index type of the vectors

//
// A configuration constant defining log2(problem size) -- n -- and a
// constant defining the problem size itself -- m
//
config const n = computeProblemSize(numVectors, elemType, returnLog2 = true);
const m = 2**n;

//
// The number of tasks to use per Chapel locale in parallel loops
//
config const tasksPerLocale = here.numCores;

//
// Configuration constants defining the epsilon and threshold values
// used to verify the result
//
config const epsilon = 2.0 ** -51.0,
             threshold = 16.0;

//
// Configuration constants to indicate whether or not to use a
// pseudo-random seed (based on the clock) or a fixed seed; and to
// specify the fixed seed explicitly
//
config const useRandomSeed = true,
             seed = if useRandomSeed then SeedGenerator.clockMS else 314159265;

//
// Configuration constants to control what's printed -- benchmark
// parameters, input and output arrays, and/or statistics
//
config const printParams = true,
             printArrays = false,
             printStats = true;

//
// The program entry point
//
def main() {
  printConfiguration();          // print the problem size

  //
  // This implementation assumes 4**k locales due to its assertion that
  // all butterflies are local to a given locale
  //
  assert(4**log4(numLocales) == numLocales,
         "numLocales must be a power of 4 for this fft implementation");

  //
  // TwiddleDom describes the index set used to define the vector of
  // twiddle values and is a 1D domain indexed by 64-bit ints from 0
  // to m/4-1 stored using the block distribution TwiddleDist.
  // Twiddles is the vector of twiddle values.
  //
  const TwiddleDist = distributionValue(new Block(1, idxType, bbox=[0..m/4-1]));
  const TwiddleDom: domain(1, idxType) distributed TwiddleDist = [0..m/4-1];
  var Twiddles: [TwiddleDom] elemType;

  //
  // ProblemSpace describes the abstract problem space used for the
  // FFT benchmark: the indices 0..m-1
  //
  const ProblemSpace = [0..m-1];

  //
  // BlkDist describes the problem space as distributed in a Block
  // manner between the Locales where ProblemSpace defines the
  // bounding box used to compute the blocking.  BlkDom defines the
  // Block-distributed problem space and is used to define the vectors
  // z (used to store the input vector) and ZBlk (used for the first
  // half of the FFT phases).
  //
  const BlkDist = distributionValue(new Block(1, idxType, bbox=ProblemSpace,
                                              tasksPerLocale=tasksPerLocale));
  const BlkDom: domain(1, idxType) distributed BlkDist = ProblemSpace;
  var Zblk, z: [BlkDom] elemType;

  //
  // CycDist describes the problem space as distributed in a Cyclic
  // manner between the Locales where locale #0 stores element 0.
  // CycDom defines the Cyclic-distributed problem space and is used
  // to define the Zcyc vector, used for the second half of the FFT
  // phases.
  //
  const CycDist = distributionValue(new Cyclic(1, idxType,
                                               tasksPerLocale=tasksPerLocale));
  const CycDom: domain(1, idxType) distributed CycDist = ProblemSpace;
  var Zcyc: [CycDom] elemType;

  initVectors(Twiddles, z);            // initialize twiddles and input vector z

  const startTime = getCurrentTime();  // capture the start time

  Zblk = conjg(z);                        // store the conjugate of z in Zblk
  bitReverseShuffle(Zblk);                // permute Zblk

  dfft(Zblk, Twiddles, cyclicPhase=false); // compute the DFFT, block phases

  forall (b, c) in (Zblk, Zcyc) do       // copy vector to Cyclic storage
    c = b;

  dfft(Zcyc, Twiddles, cyclicPhase=true); // compute the DFFT, cyclic phases

  forall (b, c) in (Zblk, Zcyc) do        // copy vector back to Block storage
    b = c;

  const execTime = getCurrentTime() - startTime;     // store the elapsed time

  const validAnswer = verifyResults(z, Zblk, Zcyc, Twiddles); // validate answer
  printResults(validAnswer, execTime);               // print the results
}

//
// compute the discrete fast Fourier transform of a vector A declared
// over domain ADom using twiddle vector W
//
def dfft(A: [?ADom], W, cyclicPhase) {
  const numElements = A.numElements;
  //
  // loop over the phases of the DFT sequentially using custom
  // iterator genDFTStrideSpan that yields the stride and span for
  // each bank of butterfly calculations
  //
  for (str, span) in genDFTStrideSpan(numElements, cyclicPhase) {
    //
    // loop in parallel over each of the banks of butterflies with
    // shared twiddle factors, zippering with the unbounded range
    // 0.. to get the base twiddle indices
    //
    forall (bankStart, twidIndex) in (ADom by 2*span, 0..) {
      //
      // compute the first set of multipliers for the low bank
      //
      var wk2 = W(twidIndex),
          wk1 = W(2*twidIndex),
          wk3 = (wk1.re - 2 * wk2.im * wk1.im,
                 2 * wk2.im * wk1.re - wk1.im):elemType;
      //
      // loop in parallel over the low bank, computing butterflies
      // Note: lo..#num         == lo, lo+1, lo+2, ..., lo+num-1
      //       lo.. by str #num == lo, lo+str, lo+2*str, ... lo+(num-1)*str
      //
      forall lo in bankStart..#str do
        on ADom.dist.ind2loc(lo) do
          local butterfly(wk1, wk2, wk3, A.localSlice(lo..by str #radix));

      //
      // update the multipliers for the high bank
      //
      wk1 = W(2*twidIndex+1);
      wk3 = (wk1.re - 2 * wk2.re * wk1.im,
             2 * wk2.re * wk1.re - wk1.im):elemType;
      wk2 *= 1.0i;

      //
      // loop in parallel over the high bank, computing butterflies
      //
      forall lo in bankStart+span..#str do
        on ADom.dist.ind2loc(lo) do
          local butterfly(wk1, wk2, wk3, A.localSlice(lo.. by str #radix));
    }
  }

  if cyclicPhase {
    //
    // Do the last set of butterflies...
    //
    const str = radix**log4(numElements-1);
    //
    // ...using the radix-4 butterflies with 1.0 multipliers if the
    // problem size is a power of 4
    //
    if (str*radix == numElements) then
      forall lo in 0..#str {
        // We need to use a temporary array X here because our Cyclic
        // distribution doesn't yet support the reindex operator.
        var X: [0..radix] complex = A[lo.. by str #radix];
        local butterfly(1.0, 1.0, 1.0, X);
        A[lo.. by str #radix] = X;
      }
    //
    // ...otherwise using a simple radix-2 butterfly scheme
    //
    else
      forall lo in 0..#str {
        const a = A(lo),
              b = A(lo+str);
        A(lo)     = a + b;
        A(lo+str) = a - b;
      }
  }
}

//
// this is the radix-4 butterfly routine that takes multipliers wk1,
// wk2, and wk3 and a 4-element array (slice) A.
//
def butterfly(wk1, wk2, wk3, X:[0..3]) {
  var x0 = X(0) + X(1),
      x1 = X(0) - X(1),
      x2 = X(2) + X(3),
      x3rot = (X(2) - X(3))*1.0i;

  X(0) = x0 + x2;                   // compute the butterfly in-place on X
  x0 -= x2;
  X(2) = wk2 * x0;
  x0 = x1 + x3rot;
  X(1) = wk1 * x0;
  x0 = x1 - x3rot;
  X(3) = wk3 * x0;
}

//
// this iterator generates the stride and span values for the phases
// of the DFFT simply by yielding tuples: (radix**i, radix**(i+1))
//
def genDFTStrideSpan(numElements, cyclicPhase) {
  const (start, end) = if !cyclicPhase then (1, numLocales:idxType)
                                       else (numLocales, numElements-1);
  var stride = start;
  for i in log4(start)+1..log4(end):int {
    const span = stride * radix;
    yield (stride, span);
    stride = span;
  }
}

//
// Print the problem size
//
def printConfiguration() {
  if (printParams) {
    if (printStats) then printLocalesTasks(tasksPerLocale=tasksPerLocale);
    printProblemSize(elemType, numVectors, m);
  }
}

//
// Initialize the twiddle vector and random input vector and
// optionally print them to the console
//
def initVectors(Twiddles, z) {
  computeTwiddles(Twiddles);
  bitReverseShuffle(Twiddles);

  fillRandom(z, seed);

  if (printArrays) {
    writeln("After initialization, Twiddles is: ", Twiddles, "\n");
    writeln("z is: ", z, "\n");
  }
}

//
// Compute the twiddle vector values
//
def computeTwiddles(Twiddles) {
  const numTwdls = Twiddles.numElements,
        delta = 2.0 * atan(1.0) / numTwdls;

  Twiddles(0) = 1.0;
  Twiddles(numTwdls/2) = let x = cos(delta * numTwdls/2)
                          in (x, x): elemType;
  forall i in 1..numTwdls/2-1 {
    const x = cos(delta*i),
          y = sin(delta*i);
    Twiddles(i)            = (x, y): elemType;
    Twiddles(numTwdls - i) = (y, x): elemType;
  }
}

//
// Perform a permutation of the argument vector by reversing the bits
// of the indices
//
def bitReverseShuffle(Vect: [?Dom]) {
  const numBits = log2(Vect.numElements),
        Perm: [i in Dom] Vect.eltType = Vect(bitReverse(i, revBits=numBits));
  Vect = Perm;
}

//
// Reverse the low revBits bits of val
//
def bitReverse(val: ?valType, revBits = 64) {
  param mask = 0x0102040810204080;
  const valReverse64 = bitMatMultOr(mask, bitMatMultOr(val:uint(64), mask)),
        valReverse = bitRotLeft(valReverse64, revBits);
  return valReverse: valType;
}

//
// Compute the log base 4 of x
//
def log4(x) return logBasePow2(x, 2);

//
// verify that the results are correct by reapplying the dfft and then
// calculating the maximum error, comparing against epsilon
//
def verifyResults(z, Zblk, Zcyc, Twiddles) {
  if (printArrays) then writeln("After FFT, Z is: ", Zblk, "\n");

  Zblk = conjg(Zblk) / m;
  bitReverseShuffle(Zblk);
  dfft(Zblk, Twiddles, cyclicPhase=false);
  forall (b, c) in (Zblk, Zcyc) do
    c = b;
  dfft(Zcyc, Twiddles, true);
  forall (b, c) in (Zblk, Zcyc) do
    b = c;

  if (printArrays) then writeln("After inverse FFT, Z is: ", Zblk, "\n");

  var maxerr = max reduce sqrt((z.re - Zblk.re)**2 + (z.im - Zblk.im)**2);
  maxerr /= (epsilon * n);
  if (printStats) then writeln("error = ", maxerr);

  return (maxerr < threshold);
}

//
// print out sucess/failure, the timing, and the Gflop/s value
//
def printResults(successful, execTime) {
  writeln("Validation: ", if successful then "SUCCESS" else "FAILURE");
  if (printStats) {
    writeln("Execution time = ", execTime);
    writeln("Performance (Gflop/s) = ", 5 * (m * n / execTime) * 1e-9);
  }
}