Remove bits of code that triggered the segfault

// Wrapper for FFTW version 3.
module FFTW {

	use SysCTypes;

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

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

	// Planner functions
	// Complex : 4.3.1
	// NOTE : We pass in arrays using ref
	proc plan_dft(dims, ref in1 : fftw_complex, ref out1 : fftw_complex, sign : c_int, flags :c_uint) : fftw_plan
		where (isHomogeneousTuple(dims))
	{
		extern proc fftw_plan_dft(rank : c_int, const ref n : c_int, in1 : _cxptr, out1 : _cxptr, sign : c_int, flags : c_uint) : fftw_plan;
		// Make sure types are correct
		param ndim : c_int = dims.size;
		return fftw_plan_dft(ndim, dims(1), c_ptrTo(in1) : _cxptr, c_ptrTo(out1) : _cxptr, sign, flags);
	}

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

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

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

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

}

// Wrapper for FFTW version 3.
module FFTW {

	use SysCTypes;

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

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

	// Planner functions
	// Complex : 4.3.1
	// NOTE : We pass in arrays using ref
	proc plan_dft(dims, ref in1 : fftw_complex, ref out1 : fftw_complex, sign : c_int, flags :c_uint) : fftw_plan
		where (isHomogeneousTuple(dims))
	{
		extern proc fftw_plan_dft(rank : c_int, const ref n : c_int, in1 : _cxptr, out1 : _cxptr, sign : c_int, flags : c_uint) : fftw_plan;
		// Make sure types are correct
		param ndim : c_int = dims.size;
		//var dims1 : ndim*c_int = dims;
		//writeln(dims1); //?????
		return fftw_plan_dft(ndim, dims(1), c_ptrTo(in1) : _cxptr, c_ptrTo(out1) : _cxptr, sign, flags);
	}

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

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

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

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

}


Add product() fxn todo.

Add product() fxn todo.

/*
 * Amicable numbers
 */

use MathFunctions;

config const maxNum = 10000,
  printPairs = false;

proc main() {
  var allSums: [{1..maxNum-1}] int,
    sum: atomic int;

  // Calculate all the sumDivisors first.
  forall n in allSums.domain {
    allSums[n] = sumDivisors(n);
  }

  // Iterate over all pairs where a < b. This ensures that duplicates are not
  // added to sum. For example, without this, both 220,284 and 284,220 would be
  // considered.
  // TODO: write a product() iterator and use it here. (thomasvandoren, 2015-06-24)
  forall a in 1..maxNum-1 {
    forall b in a+1..maxNum-1 {
      if allSums[a] == b && allSums[b] == a {
        sum.fetchAdd(a + b);

        if printPairs {
          writef("d(%n) = %n\nd(%n) = %n\n", a, b, b, a);
        }
      }
    }
  }

  writeln(sum.read());
}

// Returns true if a and b are amicable numbers. If sumDivisors(a) == b,
// sumDivisors(b) == a, and a != b, then a and b are amicable.
proc amicable(a, b) {
  return a != b && sumDivisors(a) == b && sumDivisors(b) == a;
}

/*
 * Amicable numbers
 */

use MathFunctions;

config const maxNum = 10000,
  printPairs = false;

proc main() {
  var allSums: [{1..maxNum-1}] int,
    sum: atomic int;

  // Calculate all the sumDivisors first.
  forall n in allSums.domain {
    allSums[n] = sumDivisors(n);
  }

  // Iterate over all pairs where a < b. This ensures that duplicates are not
  // added to sum. For example, without this, both 220,284 and 284,220 would be
  // considered.
  forall a in 1..maxNum-1 {
    forall b in a+1..maxNum-1 {
      if allSums[a] == b && allSums[b] == a {
        sum.fetchAdd(a + b);

        if printPairs {
          writef("d(%n) = %n\nd(%n) = %n\n", a, b, b, a);
        }
      }
    }
  }

  writeln(sum.read());
}

// Returns true if a and b are amicable numbers. If sumDivisors(a) == b,
// sumDivisors(b) == a, and a != b, then a and b are amicable.
proc amicable(a, b) {
  return a != b && sumDivisors(a) == b && sumDivisors(b) == a;
}


Fix a race in studies/jacobi/waynew/example2.chpl

This test had been very rarely generating incorrect output due to failing to
detect that sufficient change had occurred between late passes.  This happened
because the variable used to determine if sufficient change had occurred was
being updated by all running tasks without locking so there was a race.  Since
we don't support atomic |= for booleans, I replaced the boolean with an atomic
integer, and the |= call with atomically adding the old boolean check (so if
the result of comparing the new and old values was above the tolerance for a
change, then an integer representation of true would be added).  After 150 runs,
it appears that this has solved the problem.

// Example of the Jacobi algorithm in Chapel

param M = 4;
param N = 4;
/*
config const THRESHOLD = 0.00001;
// config const THRESHOLD: = 0.00001; // generates "0.0 = 0.0001"
// param MAXDELTAPOSSIBLE:real = 1.0;// error:value not known at compile time?
*/
param THRESHOLD = 0.00001;

// would like to use subdomains for D, northOfD, southOfD, westOfD, eastOfD
var outerD: domain(2) = {0..M+1, 0..N+1};
var D: domain(2) = {1..M, 1..N};
var northOfD: domain(2) = {0..0,     1..N};  // 0..0
var southOfD: domain(2) = {M+1..M+1, 1..N};
var westOfD : domain(2) = {1..M, 0..0};
var eastOfD : domain(2) = {1..M, N+1..N+1};  // N+1..N+1

var World:[D] real;
var Temp:[outerD] real;

// starting conditions
[e in D] Temp(e) = 0.0;
[e in northOfD] Temp(e) = 0.25;
[e in southOfD] Temp(e) = 1.09;
[e in westOfD]  Temp(e) = 0.59;
[e in eastOfD]  Temp(e) = 0.63;

var moving: atomic int;
do {
  moving.write(0);
  forall (i,j) in D do {                       // calc new World
    World(i,j) = (Temp(i-1,j) + Temp(i+1,j) + Temp(i,j-1) + Temp(i,j+1)) / 4.0;
    moving.add(abs( World(i,j) - Temp(i,j)) > THRESHOLD);
  }
  [e in D] Temp(e) = World(e);               // copy back World->Temp
 } while (moving.read());

writeln( World);

// Example of the Jacobi algorithm in Chapel

param M = 4;
param N = 4;
/*
config const THRESHOLD = 0.00001;
// config const THRESHOLD: = 0.00001; // generates "0.0 = 0.0001"
// param MAXDELTAPOSSIBLE:real = 1.0;// error:value not known at compile time?
*/
param THRESHOLD = 0.00001;

// would like to use subdomains for D, northOfD, southOfD, westOfD, eastOfD
var outerD: domain(2) = {0..M+1, 0..N+1};
var D: domain(2) = {1..M, 1..N};
var northOfD: domain(2) = {0..0,     1..N};  // 0..0
var southOfD: domain(2) = {M+1..M+1, 1..N};
var westOfD : domain(2) = {1..M, 0..0};
var eastOfD : domain(2) = {1..M, N+1..N+1};  // N+1..N+1

var World:[D] real;
var Temp:[outerD] real;

// starting conditions
[e in D] Temp(e) = 0.0;
[e in northOfD] Temp(e) = 0.25;
[e in southOfD] Temp(e) = 1.09;
[e in westOfD]  Temp(e) = 0.59;
[e in eastOfD]  Temp(e) = 0.63;

var moving: bool;
do {
  moving = false;
  forall (i,j) in D do {                       // calc new World
    World(i,j) = (Temp(i-1,j) + Temp(i+1,j) + Temp(i,j-1) + Temp(i,j+1)) / 4.0;
    moving |= abs( World(i,j) - Temp(i,j)) > THRESHOLD;
  }
  [e in D] Temp(e) = World(e);               // copy back World->Temp
 } while (moving);

writeln( World);


Minor touch-up of an error message in test/studies/ssca2/graphio.

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

module SSCA2_RMAT_graph_generator

{
  // +=========================================================================+
  // |             RMAT approximate power law graph generator                  |
  // |                                 and                                     |
  // |                           SSCA #2 Kernel 1                              |
  // |                                                                         |
  // |  Generate approximate power law graph                                   |
  // |                                                                         |
  // |  This procedure accepts a generic graph representation which must       |
  // |  provide only the capabilities to:                                      |
  // |    1. add a vertex to a neighbor list for some other vertex             |
  // |    2. assign an integer weight to an entry in an associated weight list |
  // |                                                                         |
  // |  The RMAT procedure implicitly assumes that vertices are integers       |
  // |  in the range [0, 2^SCALE].  So vertices are integers in this           |
  // |  procedure and edges are pairs of integers.                             |
  // |                                                                         |
  // |  This implementation first generates the RMAT graph as a list of        |
  // |  triples, using an array of edges and an associated array of weights.   |
  // |  These are transformed into the Chapel graph representation using       |
  // |  native Chapel syntax for associative and sparse domains and arrays.    |
  // |  That transformation is Kernel 1 of the SSCA #2 benchmark.              |
  // |                                                                         |
  // |  The code uses two auxiliary procedures for clarity and to help the     |
  // |  compiler use more abstract, higher level, code.                        |
  // +=========================================================================+

  use SSCA2_compilation_config_params;

  record directed_vertex_pair {
    var start = 1: int;
    var end   = 1: int;
  }

  proc +(l: directed_vertex_pair, r: directed_vertex_pair)
      return new directed_vertex_pair (l.start + r.start, l.end + r.end);

  // ============================
  // Quadrant selection algorithm
  // ============================

  proc assign_quadrant ( u: real, a: real, b: real, c: real, d : real,
			bit : int ) : directed_vertex_pair
    {
      // ---------------------------------------------------------------------
      // The heart of the RMAT random graph generator is a procedure that
      // assigns a single bit of the edge starting and ending vertex by
      // assigning the edge with specified probability to one of the four
      // quadrants of a 2 x 2 grid.
      //
      // Chapel is able to promote this conditional-based scalar procedure to
      // array operations where it is not able to promote conditional code
      // directly.
      //
      // Determine randomly in which quadrant of the grid a point lies,
      // based on the following picture:
      //
      //     +---------------------------+
      //     | u < a         | u < a+b   |
      //     |-------------+-------------|
      //     | u < a + b + c | otherwise |
      //     +---------------------------+
      //
      // The probability of the edge falling in the upper left quadrant is  a,
      // in the upper right quadrant, b, the lower left quadrant  c
      // and the lower right quadrant  d, where the probabilities are
      // normalized to sum to one.
      // ---------------------------------------------------------------------

      var start_inc = 0;
      var end_inc   = 0;
      var edge : directed_vertex_pair;

      if u <= a then
	{}
      else if u <= a + b then
	{ end_inc = 1;}
      else if u <= a + b + c then
	{ start_inc = 1;}
      else
	{ start_inc = 1; end_inc = 1;};

      edge.start = bit * start_inc;
      edge.end   = bit * end_inc;
      return ( edge );
    }

  // ====================================
  // Main RMAT Graph Generation Procedure
  // ====================================~

  proc Gen_RMAT_graph ( a : real,
		       b : real,
		       c : real,
		       d : real,
		       SCALE :int,
		       N_VERTICES : int,
		       n_raw_edges : int,
		       MAX_EDGE_WEIGHT :int,
		       G )

    { use Random;
      writeln("generating RMAT graph");

      const vertex_range = 1..N_VERTICES,
	    edge_range   = 1..n_raw_edges,
	    rand_range   = 1..n_raw_edges + 1;

      // Random Numbers return in the range [0.0, 1.0)

      var Rand_Gen = if REPRODUCIBLE_PROBLEMS then
	               new RandomStream (seed = 0556707007)
		     else
		       new RandomStream ();

      var   Noisy_a     : [edge_range] real,
	    Noisy_b     : [edge_range] real,
            Noisy_c     : [edge_range] real,
            Noisy_d     : [edge_range] real,
            norm        : [edge_range] real,
	    Unif_Random : [edge_range] real,
	    Edges       = [edge_range] new directed_vertex_pair ();

       // ---------------------------------------------------------------
      // The RMAT algorithm is based on recursively sub-dividing a grid.
      // In this case, the grid is square of order 2^SCALE by 2^SCALE.
      // So exactly "SCALE" steps of recursion will be required and the
      // recursion can be implemented directly by iteration.
      // ---------------------------------------------------------------

      // -----------------------------------------------------------------
      // Note on random number generators -- the RMAT generator creates
      // 5*SCALE vectors of length 2**SCALE.  The dependence on powers
      // of two provides an opportunity to expose statistical correlations
      // in the pseudo-random numbers.  This certainly occurs with the
      // current Chapel Random module.  The "skips" in the random number
      // sequence dramatically change the results.  Without them, the
      // Chapel RMAT matrices are inconsistent with what is seen in
      // other implementations.
      // -----------------------------------------------------------------

      writeln ("Random graph generated by stride of 1 in one random stream",
	       " with skips" );

      var bit = 1 << SCALE;
      var   skip : real;

      for depth in 1..SCALE do {
	  bit >>= 1;

	  // randomize the coefficients, tweaking them by numbers in [-.05, .05)

	  skip = Rand_Gen.getNext ();
	  Rand_Gen.fillRandom (Unif_Random);
	  Noisy_a = a * (0.95 + 0.1 * Unif_Random);

	  skip = Rand_Gen.getNext ();
	  Rand_Gen.fillRandom (Unif_Random);
	  Noisy_b = b * (0.95 + 0.1 * Unif_Random);

	  skip = Rand_Gen.getNext ();
	  Rand_Gen.fillRandom (Unif_Random);
	  Noisy_c = c * (0.95 + 0.1 * Unif_Random);

	  skip = Rand_Gen.getNext ();
	  Rand_Gen.fillRandom (Unif_Random);
	  Noisy_d = d * (0.95 + 0.1 * Unif_Random);

	  norm     = 1.0 / (Noisy_a + Noisy_b + Noisy_c + Noisy_d);
	  Noisy_a *= norm;
	  Noisy_b *= norm;
	  Noisy_c *= norm;
	  Noisy_d *= norm;

	  skip = Rand_Gen.getNext ();
	  Rand_Gen.fillRandom (Unif_Random);

	  Edges += assign_quadrant ( Unif_Random, Noisy_a, Noisy_b,
				     Noisy_c, Noisy_d, bit );

	};

      // ---------------------------------------------------------------------
      // Assign weights to edges randomly, then randomly relabel the vertices
      // to avoid locality from the obvious imbalance that will arise when
      // one of the coefficients is clearly larger than the others
      // ---------------------------------------------------------------------

      var permutation : [vertex_range] int = vertex_range;
      var Edge_Weight : [edge_range] int;

      Rand_Gen.fillRandom ( Unif_Random  );
      Edge_Weight = floor (1 + Unif_Random * MAX_EDGE_WEIGHT) : int;

      Rand_Gen.fillRandom ( Unif_Random (vertex_range) );

      for v in vertex_range do
	{ var new_id : int;
	  new_id = floor (1 + Unif_Random (v) * N_VERTICES) : int;
	  permutation (v) <=> permutation (new_id);
	};

      var node_count : [vertex_range] int = 0;

      //      for e in edge_range do {
      //	Edges(e).start = permutation (Edges(e).start);
      //	Edges(e).end   = permutation (Edges(e).end  );
      //      }
      Edges.start = permutation (Edges.start);
      Edges.end   = permutation (Edges.end  );

      if DEBUG_GRAPH_GENERATOR || DEBUG_WEIGHT_GENERATOR then {
	writeln ();
	for e in edge_range do
	  writeln ("edge (", e, ") : (", Edges(e), ", ",
		   Edge_Weight (e), ")" );
      }

      // --------------------------
      // Graph consistency checking
      // --------------------------

      assert ( Edges.start > 0,
	       "edge start vertices out of low end of range");

      assert ( Edges.end > 0,
	       "edge end vertices out of low end of range");

      assert ( Edges.start <= 2**SCALE,
	       "edge start vertices out of high end of range");

      assert ( Edges.end <= 2**SCALE,
	       "edge end vertices out of high end of range");

      assert ( Edge_Weight > 0,
	       "edge weightd out of low end of range");

      assert ( Edge_Weight <= MAX_EDGE_WEIGHT,
	       "edge weightd out of high end of range");

      writeln (); writeln ("Vertex Set in G:", G.vertices);

      // ----------------------------------------------------------
      // Kernel 1: assemble graph from list of triples.  Include
      // only non-self incident edges.  in case of duplicates, last
      // in wins (+= instead of = works to take sum of weights)
      // ----------------------------------------------------------

      var collisions = 0, self_edges = 0;
      for e in edge_range do {
	var u = Edges (e).start;
	var v = Edges (e).end  ;

	if ( v != u ) then {
	  if G.Neighbors (u).member(v) then {
	    collisions += 1;
	  }
	  else {
	    G.Neighbors (u).add (v);
	    G.Row(u).Weight (v) = Edge_Weight (e);
	  }
	}
	else
	  self_edges += 1;
      }

      writeln ( "# of raw edges generated  ", n_raw_edges );
      writeln ( "# of duplicate edges      ", collisions );
      writeln ( "# of self edges           ", self_edges );
      writeln ( "# of edges in final graph ", graphTotalEdges(G));

      if DEBUG_GRAPH_GENERATOR || DEBUG_WEIGHT_GENERATOR then {
	writeln ();
	writeln ("tuples denote (edge, weight)");
	writeln ();
	for u in G.vertices do {
	  write ( "row ", u, ": [", G.n_Neighbors (u), "] " );
	  for (v,w) in (G .Neighbors (u), G.edge_weight (u) ) do
	    write ( (v, w) );
	  writeln ();
	}
      }

      var max_edges = max reduce [v in vertex_range] G.n_Neighbors (v);

      var edge_count : [0..max_edges] int = 0;

      for v in G.vertices do
	edge_count (G.n_Neighbors (v)) += 1;

      writeln ("histograph of node distributions by number of outgoing edges");
      writeln ( "# edges  # nodes");
      for count in 0..max_edges do
	writeln ( count, "  ", edge_count (count) );

      writeln ();

    }

  //
  // RMAT graph I/O
  //
  // Uses the XMT/KM RMAT graph storage format for SSCA#2.
  //

  config const VE_FILENAME     = "vertex_edge_info.data";
  config const SV2_FILENAME    = "sv2_snapshot.data";
  config const EV2_FILENAME    = "ev2_snapshot.data";
  config const START_FILENAME  = "start_snapshot.data";
  config const WEIGHT_FILENAME = "weight_snapshot.data";
  config type  IONumType       = int(64);

  config const checkOnlyOnRead = false;

  ///////// progress indicator /////////

  config var progressFrequency = 100000;
  var progressCount = 0;
  proc resetProgress() {
    progressCount = 0;
  }
  proc reportProgress() {
    var result = false;
    progressCount -= 1;
    if progressCount <= 0 {
      result = true;
      progressCount = progressFrequency;
    }
    return result;
  }

  ///////// graph helpers /////////

  proc graphTotalEdges(G)  return + reduce [v in G.vertices] G.n_Neighbors(v);
  proc graphNumVertices(G) return G.vertices.numIndices;

  ///////// I/O helpers /////////

  proc createGraphChannel(prefix:string, suffix:string, param forWriting:bool) {
    const f = open(prefix+suffix,
                   if forWriting then iomode.cw else iomode.r,
                   IOHINT_SEQUENTIAL);
    const chan = if forWriting
      then f.writer(iokind.big, false)
      else f.reader(iokind.big, false);
    return chan;
  }

  proc ensureEOFofDataFile(chan, snapshot_prefix, file_suffix): void {
    var err:syserr = ENOERR, temp:IONumType;
    chan.read(temp, error=err);
    // temp==0 is a workaround for unending large files
    if err != EEOF && temp != 0 then
      myerror("did not reach EOF in '", snapshot_prefix, file_suffix,
              "'  the next value is ", temp);
  }

  proc writeNum(ch, num): void { ch.write(num:IONumType); }
  proc readNum(ch): IONumType  return ch.read(IONumType);

  ///////// misc /////////

  proc reportNumVerticesError(G, snapshot_prefix, vCount) {
    const vcountLog2 =
      if vCount <= 0 then -1:int(64) else floor(log2(vCount)):int(64);
    const helpMessage =
      if vCount <= 0 then "Note: got 0 or negative vertex count."
      else if exp2(vcountLog2:real(64)) == vCount:real(64) then
        "Pass --SCALE=" + vcountLog2:string + " to suppress the error."
      else "Note: got a vertex count that is not a power of 2.";

    myerror("inconsistent vertex count: graph ", graphNumVertices(G), " vs. ",
            vCount, " in ", snapshot_prefix, VE_FILENAME, "\n", helpMessage);
  }

  proc interpretDStyle(dstyle:string) {
    const dON   = dstyle != "-";
    const dVerb = dstyle == "summary";
    const dRow  = dstyle == "row";
    // otherwise
    const dEdge = dON && !(dRow || dVerb);

    return (dON, dRow, dEdge);
  }

  //
  // For debugging, we are making these errors non-fatal.
  // Especially usefil with --checkOnlyOnRead.
  //
  proc myerror(args...) {
    stderr.writeln("ERROR: ", (...args));
    stderr.writeln("(proceeding nonetheless)");
  }

  ///////// interface functions: /////////
  ////////   Writeout_RMAT_graph  ////////
  ////////   Readin_RMAT_graph    ////////

  //
  // Write out the graph to files starting with 'snapshot_prefix'
  // and ending with _FILENAME constants above.
  //
  // 'dstyle' - debug style:
  //   "-"        no debug output, just start/end/summary
  //   "summary"  verbose summary
  //   "row"      DEBUG_GRAPH_GENERATOR-style one line per row
  //   otherwise  one line per edge (enables sorting), prefixed by 'dstyle'
  //
  proc Writeout_RMAT_graph(G, snapshot_prefix:string, dstyle = "-"): void {
    writeln("writing RMAT graph with ", graphNumVertices(G), " vertices, ",
          graphTotalEdges(G), " edges to '", snapshot_prefix, "'*");

    param wri = true;

    const (dON, dRow, dEdge) = interpretDStyle(dstyle);
    // this presently would leak too much string memory
    //proc debugRow(msg...)  { if dRow then write((...msg)); }
    // ... but this is not called in a loop
    proc debug(msg...) { if dON then writeln((...msg)); }

    const veCount = createGraphChannel(snapshot_prefix, VE_FILENAME, wri);
    writeNum(veCount, graphNumVertices(G));
    writeNum(veCount, graphTotalEdges(G));
    veCount.close();

    const sv = createGraphChannel(snapshot_prefix, SV2_FILENAME, wri);
    const ev = createGraphChannel(snapshot_prefix, EV2_FILENAME, wri);
    const ww = createGraphChannel(snapshot_prefix, WEIGHT_FILENAME, wri);
    const sta = createGraphChannel(snapshot_prefix, START_FILENAME, wri);

    // Tracks the starting index for each vertex, 0-based, for START_FILENAME.
    var startIx = 0: IONumType;
    resetProgress();

    // iterate sequentially
    for u in G.vertices {
      if dRow then write("row ", u, ": [", G.n_Neighbors(u), "] ");
      if dEdge then writeln(dstyle, " vertex ", u);
      writeNum(sta, startIx);

      for v in G.Neighbors(u) {
        const w = G.Row(u).Weight(v);
        if dRow then write((v, w));
        if dEdge then writeln(dstyle, " ", u, " ", v, " ", w);
        writeNum(sv, u-1);
        writeNum(ev, v-1);
        writeNum(ww, w);
        startIx += 1;
        if dON && reportProgress() then
          writeln("processing...  vertex ", u, "  edge ", startIx);
      }
      if dRow then writeln();
    }

    const numVertices = G.vertices.numIndices;
    debug("done writing ", numVertices, " vertices, ", startIx, " edges");
    assert(startIx == graphTotalEdges(G));
    const sb = numBytes(IONumType);
    debug("file sizes  ", 2 * sb, "  ", (graphNumVertices(G) + 2) * sb,
          "  ", graphTotalEdges(G) * sb);
    writeNum(sta, startIx);
    writeNum(sta, startIx);

    sv.close();
    ev.close();
    ww.close();
    sta.close();

    write("DONE writing RMAT graph");
    if dON then write(" to '", snapshot_prefix, "'*");
    //else write(" with ", numVertices, " vertices, ", startIx, " edges");
    writeln(); writeln();

  } // Writeout_RMAT_graph()

  //
  // Read in the graph from the files as for Writeout_RMAT_graph().
  // 'dstyle' - debug style, same as for Writeout_RMAT_graph().
  //
  proc Readin_RMAT_graph(G, snapshot_prefix:string, dstyle = "-"): void {
    writeln("reading RMAT graph with ", graphNumVertices(G), " vertices",
            " from '", snapshot_prefix, "'*");

    param rea = false;

    const (dON, dRow, dEdge) = interpretDStyle(dstyle);
    // this presently would leak too much string memory
    //proc debugRow(msg...)  { if dRow then write((...msg)); }
    // ... but this is not called in a loop
    proc debug(msg...) { if dON then writeln((...msg)); }

    const veCount = createGraphChannel(snapshot_prefix, VE_FILENAME, rea);
    const vCount    = readNum(veCount),
          eCount    = readNum(veCount);
    ensureEOFofDataFile(veCount, snapshot_prefix, VE_FILENAME);
    veCount.close();

    debug("files contain  ", vCount, " vertices  ", eCount, " edges");
    const sb = numBytes(IONumType);
    debug("expected file sizes  ", 2*sb, "  ", (vCount+2)*sb, "  ", eCount*sb);

    if vCount != graphNumVertices(G) then
      reportNumVerticesError(G, snapshot_prefix, vCount);

    const sv = createGraphChannel(snapshot_prefix, SV2_FILENAME, rea);
    const ev = createGraphChannel(snapshot_prefix, EV2_FILENAME, rea);
    const ww = createGraphChannel(snapshot_prefix, WEIGHT_FILENAME, rea);
    const sta = createGraphChannel(snapshot_prefix, START_FILENAME, rea);

    // see whether the edges in the data file are ordered, for each edge
    //var outOfOrderCnt = 0, prevEnd = 0:IONumType;

    var startIxCnt = 0:IONumType, startIxData = readNum(sta);
    if startIxCnt != startIxData then
      halt("the first index in ", snapshot_prefix, START_FILENAME,
           " is ", startIxData, " but should be ", startIxCnt);
    resetProgress();
    type VType = index(G.vertices);

    for u in 1..(vCount:VType) {
      startIxData = readNum(sta);
      //prevEnd = min(prevEnd.type);
      const numEdges = startIxData - startIxCnt;
      if dRow then write("row ", u, ": [", numEdges, "] ");
      if dEdge then writeln(dstyle, " vertex ", u);

      for 1..numEdges {
        const curStart = readNum(sv)+1,
              v = (readNum(ev)+1):VType,
              w = readNum(ww):VType;

        // initial reporting
        if dRow then write((v, w));
        if dEdge then writeln(dstyle, " ", u, " ", v, " ", w);

        // sanity checks
        if curStart != u then
          myerror("*** start vertex mismatch: expected ",
                  u, ", got ", curStart);
        if v < 1 || v > vCount then
          myerror("*** illegal end vertex number: ", v);

        // add the edge to the graph
        if !checkOnlyOnRead {
          G.Neighbors (u).add (v);
          G.Row(u).Weight (v) = w;
        }

        // more reporting
        startIxCnt += 1;
        //if v <= prevEnd then
        //  outOfOrderCnt += 1;
        if dON && reportProgress() then
          writeln("processing...  vertex ", u, "  edge ", startIxCnt);
                  //("  outOfOrderCnt ", outOfOrderCnt);
        //prevEnd = v;
      }
      if dRow then writeln();

      // because we run the loop exactly the right number of times
      assert(startIxCnt == startIxData);

    } // for G.vertices

    debug("done reading ", vCount, " vertices, ", startIxData, " edges");
    //debug(if outOfOrderCnt then "outOfOrder edges: " + outOfOrderCnt:string
    //        else "all edges are inOrder");

    // one more entry in 'sta'
    startIxData = readNum(sta);
    if startIxData != startIxCnt then
      myerror("wrong last entry in ", START_FILENAME,
            "  expected ", startIxCnt, "  got ", startIxData);
    if startIxData != eCount then
      myerror(snapshot_prefix, VE_FILENAME, " claimed ", eCount,
            " edges, the other files gave ", startIxData, " edges");

    ensureEOFofDataFile(sv, snapshot_prefix, SV2_FILENAME);
    ensureEOFofDataFile(ev, snapshot_prefix, EV2_FILENAME);
    ensureEOFofDataFile(ww, snapshot_prefix, WEIGHT_FILENAME);
    ensureEOFofDataFile(sta, snapshot_prefix, START_FILENAME);

    sv.close();
    ev.close();
    ww.close();
    sta.close();

    write("DONE reading RMAT graph");
    if dON then write(" from '", snapshot_prefix, "'*");
    else        write(" with ", vCount, " vertices, ", eCount, " edges");
    writeln(); writeln();

  } // Readin_RMAT_graph()
}

module SSCA2_RMAT_graph_generator

{
  // +=========================================================================+
  // |             RMAT approximate power law graph generator                  |
  // |                                 and                                     |
  // |                           SSCA #2 Kernel 1                              |
  // |                                                                         |
  // |  Generate approximate power law graph                                   |
  // |                                                                         |
  // |  This procedure accepts a generic graph representation which must       |
  // |  provide only the capabilities to:                                      |
  // |    1. add a vertex to a neighbor list for some other vertex             |
  // |    2. assign an integer weight to an entry in an associated weight list |
  // |                                                                         |
  // |  The RMAT procedure implicitly assumes that vertices are integers       |
  // |  in the range [0, 2^SCALE].  So vertices are integers in this           |
  // |  procedure and edges are pairs of integers.                             |
  // |                                                                         |
  // |  This implementation first generates the RMAT graph as a list of        |
  // |  triples, using an array of edges and an associated array of weights.   |
  // |  These are transformed into the Chapel graph representation using       |
  // |  native Chapel syntax for associative and sparse domains and arrays.    |
  // |  That transformation is Kernel 1 of the SSCA #2 benchmark.              |
  // |                                                                         |
  // |  The code uses two auxiliary procedures for clarity and to help the     |
  // |  compiler use more abstract, higher level, code.                        |
  // +=========================================================================+

  use SSCA2_compilation_config_params;

  record directed_vertex_pair {
    var start = 1: int;
    var end   = 1: int;
  }

  proc +(l: directed_vertex_pair, r: directed_vertex_pair)
      return new directed_vertex_pair (l.start + r.start, l.end + r.end);

  // ============================
  // Quadrant selection algorithm
  // ============================

  proc assign_quadrant ( u: real, a: real, b: real, c: real, d : real,
			bit : int ) : directed_vertex_pair
    {
      // ---------------------------------------------------------------------
      // The heart of the RMAT random graph generator is a procedure that
      // assigns a single bit of the edge starting and ending vertex by
      // assigning the edge with specified probability to one of the four
      // quadrants of a 2 x 2 grid.
      //
      // Chapel is able to promote this conditional-based scalar procedure to
      // array operations where it is not able to promote conditional code
      // directly.
      //
      // Determine randomly in which quadrant of the grid a point lies,
      // based on the following picture:
      //
      //     +---------------------------+
      //     | u < a         | u < a+b   |
      //     |-------------+-------------|
      //     | u < a + b + c | otherwise |
      //     +---------------------------+
      //
      // The probability of the edge falling in the upper left quadrant is  a,
      // in the upper right quadrant, b, the lower left quadrant  c
      // and the lower right quadrant  d, where the probabilities are
      // normalized to sum to one.
      // ---------------------------------------------------------------------

      var start_inc = 0;
      var end_inc   = 0;
      var edge : directed_vertex_pair;

      if u <= a then
	{}
      else if u <= a + b then
	{ end_inc = 1;}
      else if u <= a + b + c then
	{ start_inc = 1;}
      else
	{ start_inc = 1; end_inc = 1;};

      edge.start = bit * start_inc;
      edge.end   = bit * end_inc;
      return ( edge );
    }

  // ====================================
  // Main RMAT Graph Generation Procedure
  // ====================================~

  proc Gen_RMAT_graph ( a : real,
		       b : real,
		       c : real,
		       d : real,
		       SCALE :int,
		       N_VERTICES : int,
		       n_raw_edges : int,
		       MAX_EDGE_WEIGHT :int,
		       G )

    { use Random;
      writeln("generating RMAT graph");

      const vertex_range = 1..N_VERTICES,
	    edge_range   = 1..n_raw_edges,
	    rand_range   = 1..n_raw_edges + 1;

      // Random Numbers return in the range [0.0, 1.0)

      var Rand_Gen = if REPRODUCIBLE_PROBLEMS then
	               new RandomStream (seed = 0556707007)
		     else
		       new RandomStream ();

      var   Noisy_a     : [edge_range] real,
	    Noisy_b     : [edge_range] real,
            Noisy_c     : [edge_range] real,
            Noisy_d     : [edge_range] real,
            norm        : [edge_range] real,
	    Unif_Random : [edge_range] real,
	    Edges       = [edge_range] new directed_vertex_pair ();

       // ---------------------------------------------------------------
      // The RMAT algorithm is based on recursively sub-dividing a grid.
      // In this case, the grid is square of order 2^SCALE by 2^SCALE.
      // So exactly "SCALE" steps of recursion will be required and the
      // recursion can be implemented directly by iteration.
      // ---------------------------------------------------------------

      // -----------------------------------------------------------------
      // Note on random number generators -- the RMAT generator creates
      // 5*SCALE vectors of length 2**SCALE.  The dependence on powers
      // of two provides an opportunity to expose statistical correlations
      // in the pseudo-random numbers.  This certainly occurs with the
      // current Chapel Random module.  The "skips" in the random number
      // sequence dramatically change the results.  Without them, the
      // Chapel RMAT matrices are inconsistent with what is seen in
      // other implementations.
      // -----------------------------------------------------------------

      writeln ("Random graph generated by stride of 1 in one random stream",
	       " with skips" );

      var bit = 1 << SCALE;
      var   skip : real;

      for depth in 1..SCALE do {
	  bit >>= 1;

	  // randomize the coefficients, tweaking them by numbers in [-.05, .05)

	  skip = Rand_Gen.getNext ();
	  Rand_Gen.fillRandom (Unif_Random);
	  Noisy_a = a * (0.95 + 0.1 * Unif_Random);

	  skip = Rand_Gen.getNext ();
	  Rand_Gen.fillRandom (Unif_Random);
	  Noisy_b = b * (0.95 + 0.1 * Unif_Random);

	  skip = Rand_Gen.getNext ();
	  Rand_Gen.fillRandom (Unif_Random);
	  Noisy_c = c * (0.95 + 0.1 * Unif_Random);

	  skip = Rand_Gen.getNext ();
	  Rand_Gen.fillRandom (Unif_Random);
	  Noisy_d = d * (0.95 + 0.1 * Unif_Random);

	  norm     = 1.0 / (Noisy_a + Noisy_b + Noisy_c + Noisy_d);
	  Noisy_a *= norm;
	  Noisy_b *= norm;
	  Noisy_c *= norm;
	  Noisy_d *= norm;

	  skip = Rand_Gen.getNext ();
	  Rand_Gen.fillRandom (Unif_Random);

	  Edges += assign_quadrant ( Unif_Random, Noisy_a, Noisy_b,
				     Noisy_c, Noisy_d, bit );

	};

      // ---------------------------------------------------------------------
      // Assign weights to edges randomly, then randomly relabel the vertices
      // to avoid locality from the obvious imbalance that will arise when
      // one of the coefficients is clearly larger than the others
      // ---------------------------------------------------------------------

      var permutation : [vertex_range] int = vertex_range;
      var Edge_Weight : [edge_range] int;

      Rand_Gen.fillRandom ( Unif_Random  );
      Edge_Weight = floor (1 + Unif_Random * MAX_EDGE_WEIGHT) : int;

      Rand_Gen.fillRandom ( Unif_Random (vertex_range) );

      for v in vertex_range do
	{ var new_id : int;
	  new_id = floor (1 + Unif_Random (v) * N_VERTICES) : int;
	  permutation (v) <=> permutation (new_id);
	};

      var node_count : [vertex_range] int = 0;

      //      for e in edge_range do {
      //	Edges(e).start = permutation (Edges(e).start);
      //	Edges(e).end   = permutation (Edges(e).end  );
      //      }
      Edges.start = permutation (Edges.start);
      Edges.end   = permutation (Edges.end  );

      if DEBUG_GRAPH_GENERATOR || DEBUG_WEIGHT_GENERATOR then {
	writeln ();
	for e in edge_range do
	  writeln ("edge (", e, ") : (", Edges(e), ", ",
		   Edge_Weight (e), ")" );
      }

      // --------------------------
      // Graph consistency checking
      // --------------------------

      assert ( Edges.start > 0,
	       "edge start vertices out of low end of range");

      assert ( Edges.end > 0,
	       "edge end vertices out of low end of range");

      assert ( Edges.start <= 2**SCALE,
	       "edge start vertices out of high end of range");

      assert ( Edges.end <= 2**SCALE,
	       "edge end vertices out of high end of range");

      assert ( Edge_Weight > 0,
	       "edge weightd out of low end of range");

      assert ( Edge_Weight <= MAX_EDGE_WEIGHT,
	       "edge weightd out of high end of range");

      writeln (); writeln ("Vertex Set in G:", G.vertices);

      // ----------------------------------------------------------
      // Kernel 1: assemble graph from list of triples.  Include
      // only non-self incident edges.  in case of duplicates, last
      // in wins (+= instead of = works to take sum of weights)
      // ----------------------------------------------------------

      var collisions = 0, self_edges = 0;
      for e in edge_range do {
	var u = Edges (e).start;
	var v = Edges (e).end  ;

	if ( v != u ) then {
	  if G.Neighbors (u).member(v) then {
	    collisions += 1;
	  }
	  else {
	    G.Neighbors (u).add (v);
	    G.Row(u).Weight (v) = Edge_Weight (e);
	  }
	}
	else
	  self_edges += 1;
      }

      writeln ( "# of raw edges generated  ", n_raw_edges );
      writeln ( "# of duplicate edges      ", collisions );
      writeln ( "# of self edges           ", self_edges );
      writeln ( "# of edges in final graph ", graphTotalEdges(G));

      if DEBUG_GRAPH_GENERATOR || DEBUG_WEIGHT_GENERATOR then {
	writeln ();
	writeln ("tuples denote (edge, weight)");
	writeln ();
	for u in G.vertices do {
	  write ( "row ", u, ": [", G.n_Neighbors (u), "] " );
	  for (v,w) in (G .Neighbors (u), G.edge_weight (u) ) do
	    write ( (v, w) );
	  writeln ();
	}
      }

      var max_edges = max reduce [v in vertex_range] G.n_Neighbors (v);

      var edge_count : [0..max_edges] int = 0;

      for v in G.vertices do
	edge_count (G.n_Neighbors (v)) += 1;

      writeln ("histograph of node distributions by number of outgoing edges");
      writeln ( "# edges  # nodes");
      for count in 0..max_edges do
	writeln ( count, "  ", edge_count (count) );

      writeln ();

    }

  //
  // RMAT graph I/O
  //
  // Uses the XMT/KM RMAT graph storage format for SSCA#2.
  //

  config const VE_FILENAME     = "vertex_edge_info.data";
  config const SV2_FILENAME    = "sv2_snapshot.data";
  config const EV2_FILENAME    = "ev2_snapshot.data";
  config const START_FILENAME  = "start_snapshot.data";
  config const WEIGHT_FILENAME = "weight_snapshot.data";
  config type  IONumType       = int(64);

  config const checkOnlyOnRead = false;

  ///////// progress indicator /////////

  config var progressFrequency = 100000;
  var progressCount = 0;
  proc resetProgress() {
    progressCount = 0;
  }
  proc reportProgress() {
    var result = false;
    progressCount -= 1;
    if progressCount <= 0 {
      result = true;
      progressCount = progressFrequency;
    }
    return result;
  }

  ///////// graph helpers /////////

  proc graphTotalEdges(G)  return + reduce [v in G.vertices] G.n_Neighbors(v);
  proc graphNumVertices(G) return G.vertices.numIndices;

  ///////// I/O helpers /////////

  proc createGraphChannel(prefix:string, suffix:string, param forWriting:bool) {
    const f = open(prefix+suffix,
                   if forWriting then iomode.cw else iomode.r,
                   IOHINT_SEQUENTIAL);
    const chan = if forWriting
      then f.writer(iokind.big, false)
      else f.reader(iokind.big, false);
    return chan;
  }

  proc ensureEOFofDataFile(chan, snapshot_prefix, file_suffix): void {
    var err:syserr = ENOERR, temp:IONumType;
    chan.read(temp, error=err);
    // temp==0 is a workaround for unending large files
    if err != EEOF && temp != 0 then
      myerror("did not reach EOF in '", snapshot_prefix, file_suffix,
              "'  the next value is ", temp);
  }

  proc writeNum(ch, num): void { ch.write(num:IONumType); }
  proc readNum(ch): IONumType  return ch.read(IONumType);

  ///////// misc /////////

  proc reportNumVerticesError(G, snapshot_prefix, vCount) {
    const vcountLog2 =
      if vCount <= 0 then -1:int(64) else floor(log2(vCount)):int(64);
    const helpMessage =
      if vCount <= 0 then "Note: got 0 or negative vertex count."
      else if exp2(vcountLog2:real(64)) == vCount:real(64) then
        "Pass --SCALE=" + vcountLog2:string + " to suppress the error."
      else "Note: got a vertex count that is not a power of 2.";

    myerror("inconsistent vertex count: graph ", graphNumVertices(G), " vs. ",
            snapshot_prefix, VE_FILENAME, " ", vCount, "\n", helpMessage);
  }

  proc interpretDStyle(dstyle:string) {
    const dON   = dstyle != "-";
    const dVerb = dstyle == "summary";
    const dRow  = dstyle == "row";
    // otherwise
    const dEdge = dON && !(dRow || dVerb);

    return (dON, dRow, dEdge);
  }

  //
  // For debugging, we are making these errors non-fatal.
  // Especially usefil with --checkOnlyOnRead.
  //
  proc myerror(args...) {
    stderr.writeln("ERROR: ", (...args));
    stderr.writeln("(proceeding nonetheless)");
  }

  ///////// interface functions: /////////
  ////////   Writeout_RMAT_graph  ////////
  ////////   Readin_RMAT_graph    ////////

  //
  // Write out the graph to files starting with 'snapshot_prefix'
  // and ending with _FILENAME constants above.
  //
  // 'dstyle' - debug style:
  //   "-"        no debug output, just start/end/summary
  //   "summary"  verbose summary
  //   "row"      DEBUG_GRAPH_GENERATOR-style one line per row
  //   otherwise  one line per edge (enables sorting), prefixed by 'dstyle'
  //
  proc Writeout_RMAT_graph(G, snapshot_prefix:string, dstyle = "-"): void {
    writeln("writing RMAT graph with ", graphNumVertices(G), " vertices, ",
          graphTotalEdges(G), " edges to '", snapshot_prefix, "'*");

    param wri = true;

    const (dON, dRow, dEdge) = interpretDStyle(dstyle);
    // this presently would leak too much string memory
    //proc debugRow(msg...)  { if dRow then write((...msg)); }
    // ... but this is not called in a loop
    proc debug(msg...) { if dON then writeln((...msg)); }

    const veCount = createGraphChannel(snapshot_prefix, VE_FILENAME, wri);
    writeNum(veCount, graphNumVertices(G));
    writeNum(veCount, graphTotalEdges(G));
    veCount.close();

    const sv = createGraphChannel(snapshot_prefix, SV2_FILENAME, wri);
    const ev = createGraphChannel(snapshot_prefix, EV2_FILENAME, wri);
    const ww = createGraphChannel(snapshot_prefix, WEIGHT_FILENAME, wri);
    const sta = createGraphChannel(snapshot_prefix, START_FILENAME, wri);

    // Tracks the starting index for each vertex, 0-based, for START_FILENAME.
    var startIx = 0: IONumType;
    resetProgress();

    // iterate sequentially
    for u in G.vertices {
      if dRow then write("row ", u, ": [", G.n_Neighbors(u), "] ");
      if dEdge then writeln(dstyle, " vertex ", u);
      writeNum(sta, startIx);

      for v in G.Neighbors(u) {
        const w = G.Row(u).Weight(v);
        if dRow then write((v, w));
        if dEdge then writeln(dstyle, " ", u, " ", v, " ", w);
        writeNum(sv, u-1);
        writeNum(ev, v-1);
        writeNum(ww, w);
        startIx += 1;
        if dON && reportProgress() then
          writeln("processing...  vertex ", u, "  edge ", startIx);
      }
      if dRow then writeln();
    }

    const numVertices = G.vertices.numIndices;
    debug("done writing ", numVertices, " vertices, ", startIx, " edges");
    assert(startIx == graphTotalEdges(G));
    const sb = numBytes(IONumType);
    debug("file sizes  ", 2 * sb, "  ", (graphNumVertices(G) + 2) * sb,
          "  ", graphTotalEdges(G) * sb);
    writeNum(sta, startIx);
    writeNum(sta, startIx);

    sv.close();
    ev.close();
    ww.close();
    sta.close();

    write("DONE writing RMAT graph");
    if dON then write(" to '", snapshot_prefix, "'*");
    //else write(" with ", numVertices, " vertices, ", startIx, " edges");
    writeln(); writeln();

  } // Writeout_RMAT_graph()

  //
  // Read in the graph from the files as for Writeout_RMAT_graph().
  // 'dstyle' - debug style, same as for Writeout_RMAT_graph().
  //
  proc Readin_RMAT_graph(G, snapshot_prefix:string, dstyle = "-"): void {
    writeln("reading RMAT graph with ", graphNumVertices(G), " vertices",
            " from '", snapshot_prefix, "'*");

    param rea = false;

    const (dON, dRow, dEdge) = interpretDStyle(dstyle);
    // this presently would leak too much string memory
    //proc debugRow(msg...)  { if dRow then write((...msg)); }
    // ... but this is not called in a loop
    proc debug(msg...) { if dON then writeln((...msg)); }

    const veCount = createGraphChannel(snapshot_prefix, VE_FILENAME, rea);
    const vCount    = readNum(veCount),
          eCount    = readNum(veCount);
    ensureEOFofDataFile(veCount, snapshot_prefix, VE_FILENAME);
    veCount.close();

    debug("files contain  ", vCount, " vertices  ", eCount, " edges");
    const sb = numBytes(IONumType);
    debug("expected file sizes  ", 2*sb, "  ", (vCount+2)*sb, "  ", eCount*sb);

    if vCount != graphNumVertices(G) then
      reportNumVerticesError(G, snapshot_prefix, vCount);

    const sv = createGraphChannel(snapshot_prefix, SV2_FILENAME, rea);
    const ev = createGraphChannel(snapshot_prefix, EV2_FILENAME, rea);
    const ww = createGraphChannel(snapshot_prefix, WEIGHT_FILENAME, rea);
    const sta = createGraphChannel(snapshot_prefix, START_FILENAME, rea);

    // see whether the edges in the data file are ordered, for each edge
    //var outOfOrderCnt = 0, prevEnd = 0:IONumType;

    var startIxCnt = 0:IONumType, startIxData = readNum(sta);
    if startIxCnt != startIxData then
      halt("the first index in ", snapshot_prefix, START_FILENAME,
           " is ", startIxData, " but should be ", startIxCnt);
    resetProgress();
    type VType = index(G.vertices);

    for u in 1..(vCount:VType) {
      startIxData = readNum(sta);
      //prevEnd = min(prevEnd.type);
      const numEdges = startIxData - startIxCnt;
      if dRow then write("row ", u, ": [", numEdges, "] ");
      if dEdge then writeln(dstyle, " vertex ", u);

      for 1..numEdges {
        const curStart = readNum(sv)+1,
              v = (readNum(ev)+1):VType,
              w = readNum(ww):VType;

        // initial reporting
        if dRow then write((v, w));
        if dEdge then writeln(dstyle, " ", u, " ", v, " ", w);

        // sanity checks
        if curStart != u then
          myerror("*** start vertex mismatch: expected ",
                  u, ", got ", curStart);
        if v < 1 || v > vCount then
          myerror("*** illegal end vertex number: ", v);

        // add the edge to the graph
        if !checkOnlyOnRead {
          G.Neighbors (u).add (v);
          G.Row(u).Weight (v) = w;
        }

        // more reporting
        startIxCnt += 1;
        //if v <= prevEnd then
        //  outOfOrderCnt += 1;
        if dON && reportProgress() then
          writeln("processing...  vertex ", u, "  edge ", startIxCnt);
                  //("  outOfOrderCnt ", outOfOrderCnt);
        //prevEnd = v;
      }
      if dRow then writeln();

      // because we run the loop exactly the right number of times
      assert(startIxCnt == startIxData);

    } // for G.vertices

    debug("done reading ", vCount, " vertices, ", startIxData, " edges");
    //debug(if outOfOrderCnt then "outOfOrder edges: " + outOfOrderCnt:string
    //        else "all edges are inOrder");

    // one more entry in 'sta'
    startIxData = readNum(sta);
    if startIxData != startIxCnt then
      myerror("wrong last entry in ", START_FILENAME,
            "  expected ", startIxCnt, "  got ", startIxData);
    if startIxData != eCount then
      myerror(snapshot_prefix, VE_FILENAME, " claimed ", eCount,
            " edges, the other files gave ", startIxData, " edges");

    ensureEOFofDataFile(sv, snapshot_prefix, SV2_FILENAME);
    ensureEOFofDataFile(ev, snapshot_prefix, EV2_FILENAME);
    ensureEOFofDataFile(ww, snapshot_prefix, WEIGHT_FILENAME);
    ensureEOFofDataFile(sta, snapshot_prefix, START_FILENAME);

    sv.close();
    ev.close();
    ww.close();
    sta.close();

    write("DONE reading RMAT graph");
    if dON then write(" from '", snapshot_prefix, "'*");
    else        write(" with ", vCount, " vertices, ", eCount, " edges");
    writeln(); writeln();

  } // Readin_RMAT_graph()
}


Update to gmp-chudnovsky.chpl

Update to gmp-chudnovsky.chpl

[ok'ed with Brad]

- Make sdom field var instead of const (yay record const checking!)
- Replace inout with ref intent

git-svn-id: 88467cb1fb04b8a755be7e1ee1026be4190196ef@23023 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 GMP, 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 printTimings = true;

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

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

// TODO:
// Can variables be moved in to tighter scopes?
// Can casts between ulong and long be avoided/minimized?
// Can writeln be used to wrap gmp_printf and the like?
// Would we want to overload operators on these types?
// Refactor timing code into a routine
// Implement memory checks
// Fix timings -- currently they're bogus in some cases
// Use classes rather than records for fac_t and/or sieve_t?

var t1, t2: mpf_t;

config param do_gcd_time = false;

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

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

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

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

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

var ftmp, fmul: fac_t;

param INIT_FACS = 32;

var gcd_time: c_long;

var gcd, mgcd: mpz_t;

var depth: c_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: c_long = 0;

proc main() {
  writeln("#terms=", terms, ", depth=", depth);

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

  build_sieve(sieve);

  const mid0 = getCurrentTime();
  if (printTimings) then
    writeln("time = ", mid0-start);
  else
    writeln();

  mpz_init(pstack);
  mpz_init(qstack);
  mpz_init(gstack);
  fac_init(fpstack);
  fac_init(fgstack);
  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();
  write("\nbs      ");
  if (printTimings) then
    writeln("time = ", mid1-mid0);
  else
    writeln();
  write("   gcd  ");
  if (printTimings) then
    writeln("time = ", gcd_time);
  else
    writeln();

  //writeln("misc    ");

  /* free some resources */
  sievedom.clear();

  if HAVE_DIVEXACT_PREINV then
    mpz_clear(mgcd);

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

  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]);
  }

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

  stackdom1.clear();

  /* 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.clear();

  const mid2 = getCurrentTime();

  /* 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     ");
  my_div(qi, pi, qi);
  const mid3 = getCurrentTime();
  if (printTimings) then
    writeln("time = ", mid3-mid2);
  else
    writeln();

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

  write("mul     ");
  mpf_mul(qi, qi, pi);
  const end = getCurrentTime();
  if (printTimings) then
    writeln("time = ", end - mid4);
  else
    writeln();

  if (printTimings) then
    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 */
  if (_out&1)  {
    writeln("pi(0,", terms, ")=");
    mpf_out_str(chpl_cstdout(), 10:c_int, (d+2):size_t, qi);
    writeln();
  }

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

  mpf_clear(t1);
  mpf_clear(t2);
}

proc build_sieve(s: [] sieve_t) {
  const n = s.numElements*2,
        m = sqrt(n): c_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 zip(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;
	    }
	  }
	}
      }
    }
  }
}

proc my_sqrt_ui(ref 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.
proc my_div(ref r: mpf_t, ref 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;
  }
}

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

proc fac_reset(ref f: fac_t) {
  f.num_facs = 0;
}

proc fac_init_size(ref f: fac_t, in s: c_long) {
  if (s<INIT_FACS) then
    s=INIT_FACS;

  f.sdom = {0..#s};

  fac_reset(f);
}

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

proc fac_clear(ref f: fac_t) {
  f.sdom.clear();
}

proc fac_resize(ref f: fac_t, s: c_long)
{
  if (f.sdom.numIndices < s) {
    fac_clear(f);
    fac_init_size(f, s);
  }
}

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

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

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

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

// f *= g
proc fac_mul(ref f: fac_t, g: fac_t) {
  fac_resize(fmul, f.num_facs + g.num_facs);
  fac_mul2(fmul, f, g);
  f <=> fmul;
}

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

// f *= base^pow
proc fac_mul_bp(ref f: fac_t, base: c_long, pow: c_long) {
  fac_set_bp(ftmp, base, pow);
  fac_mul(f, ftmp);
}

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

// convert factorized form to number
proc bs_mul(ref r: mpz_t, a: c_long, b: c_long) {
  if (b-a <= 32) {
    mpz_set_ui(r, 1);
    for i in a..b-1 do
      for j in 0..fmul.pow[i]-1 do  // BLC: would like to use # here
	mpz_mul_ui(r, r, fmul.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)
proc fac_remove_gcd(ref p: mpz_t, ref fp: fac_t, ref g: mpz_t, ref fg: fac_t) {
  var i, j, k: c_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);
  }
}

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

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

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

var progress = 0.0;

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

// binary splitting
proc bs(a: c_ulong, b: c_ulong, gflag: c_uint, level: c_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.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) 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 GMP, 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 printTimings = true;

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

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

// TODO:
// Can variables be moved in to tighter scopes?
// Can casts between ulong and long be avoided/minimized?
// Can writeln be used to wrap gmp_printf and the like?
// Would we want to overload operators on these types?
// Refactor timing code into a routine
// Implement memory checks
// Fix timings -- currently they're bogus in some cases
// Use classes rather than records for fac_t and/or sieve_t?

var t1, t2: mpf_t;

config param do_gcd_time = false;

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

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

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

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

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

var ftmp, fmul: fac_t;

param INIT_FACS = 32;

var gcd_time: c_long;

var gcd, mgcd: mpz_t;

var depth: c_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: c_long = 0;

proc main() {
  writeln("#terms=", terms, ", depth=", depth);

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

  build_sieve(sieve);

  const mid0 = getCurrentTime();
  if (printTimings) then
    writeln("time = ", mid0-start);
  else
    writeln();

  mpz_init(pstack);
  mpz_init(qstack);
  mpz_init(gstack);
  fac_init(fpstack);
  fac_init(fgstack);
  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();
  write("\nbs      ");
  if (printTimings) then
    writeln("time = ", mid1-mid0);
  else
    writeln();
  write("   gcd  ");
  if (printTimings) then
    writeln("time = ", gcd_time);
  else
    writeln();

  //writeln("misc    ");

  /* free some resources */
  sievedom.clear();

  if HAVE_DIVEXACT_PREINV then
    mpz_clear(mgcd);

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

  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]);
  }

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

  stackdom1.clear();

  /* 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.clear();

  const mid2 = getCurrentTime();

  /* 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     ");
  my_div(qi, pi, qi);
  const mid3 = getCurrentTime();
  if (printTimings) then
    writeln("time = ", mid3-mid2);
  else
    writeln();

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

  write("mul     ");
  mpf_mul(qi, qi, pi);
  const end = getCurrentTime();
  if (printTimings) then
    writeln("time = ", end - mid4);
  else
    writeln();

  if (printTimings) then
    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 */
  if (_out&1)  {
    writeln("pi(0,", terms, ")=");
    mpf_out_str(chpl_cstdout(), 10:c_int, (d+2):size_t, qi);
    writeln();
  }

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

  mpf_clear(t1);
  mpf_clear(t2);
}

proc build_sieve(s: [] sieve_t) {
  const n = s.numElements*2,
        m = sqrt(n): c_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 zip(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;
	    }
	  }
	}
      }
    }
  }
}

proc 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.
proc 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;
  }
}

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

proc fac_reset(inout f: fac_t) {
  f.num_facs = 0;
}

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

  f.sdom = {0..#s};

  fac_reset(f);
}

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

proc fac_clear(inout f: fac_t) {
  f.sdom.clear();
}

proc fac_resize(inout f: fac_t, s: c_long)
{
  if (f.sdom.numIndices < s) {
    fac_clear(f);
    fac_init_size(f, s);
  }
}

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

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

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

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

// f *= g
proc fac_mul(inout f: fac_t, g: fac_t) {
  fac_resize(fmul, f.num_facs + g.num_facs);
  fac_mul2(fmul, f, g);
  f <=> fmul;
}

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

// f *= base^pow
proc fac_mul_bp(inout f: fac_t, base: c_long, pow: c_long) {
  fac_set_bp(ftmp, base, pow);
  fac_mul(f, ftmp);
}

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

// convert factorized form to number
proc bs_mul(inout r: mpz_t, a: c_long, b: c_long) {
  if (b-a <= 32) {
    mpz_set_ui(r, 1);
    for i in a..b-1 do
      for j in 0..fmul.pow[i]-1 do  // BLC: would like to use # here
	mpz_mul_ui(r, r, fmul.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)
proc fac_remove_gcd(inout p: mpz_t, inout fp: fac_t, inout g: mpz_t, inout fg: fac_t) {
  var i, j, k: c_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);
  }
}

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

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

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

var progress = 0.0;

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

// binary splitting
proc bs(a: c_ulong, b: c_ulong, gflag: c_uint, level: c_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.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) then
      write("g(", a, ",", b, ")=");
    fac_show(fg1);
  }
}