/*
   This file is part of Numerix.  Numerix is free software; you can
   redistribute it and/or modify it under the terms of the GNU General
   Public License as published by the Free Software Foundation; either
   version 2 of the License, or (at your option) any later version.

   This program is distributed in the hope that it will be useful, but
   WITHOUT ANY WARRANTY; without even the implied warranty of
   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
   General Public License for more details.

   You should have received a copy of the GNU General Public License
   along with this program; if not, write to the Free Software
   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
   USA 
*/

/* +------------------------------------------------------------------------+
   |                                                                        |
   |                      Entiers de longueur arbitraire                    |
   |                                                                        |
   |                              Factorielle                               |
   |                                                                        |
   +------------------------------------------------------------------------+ */

/* M. Quercia, 31/01/2001 */

#include "long_int.h"
#include "long_int-s.h"

      /* +--------------------------------------------------+
         |  majorant de la taille de a!, -1 si débordement  |
         +--------------------------------------------------+ */

#ifndef have_sz_size_fact_k
longueur xz(size_fact_k)(unsigned long a) {
  long i,lga;
  chiffre bigp[4];

  /* lg(a!) <= a*lg(a) */
  for (lga=0, i=a; i; i >>= 1, lga++);
  bigp[0] = a;
#ifdef use_dlong
  bigp[1] = 0;
#else
  bigp[1] = a >> HW;
#endif
  xn(mul_2)(bigp,2,(ndouble)lga,bigp);
  xn(quo_2)(bigp,4,HW,bigp);
  xn(inc_1)(bigp,4,1);

#ifdef use_dlong
  return(((bigp[0] & SIGN_m) || (bigp[1]) || (bigp[2]) || (bigp[3])) ?
	 -1 : bigp[0]);
#else
  return(((bigp[1] & SIGN_m) || (bigp[2]) || (bigp[3])) ?
	 -1 : (ndouble) bigp[0] + ((ndouble)bigp[1] << HW));
#endif
}
#endif
  
    /* +------------------------------------------------------+
       |  b <- a!, a >= 0, capacité(b) > lb = size_fact_k(a)  |
       +------------------------------------------------------+ */

#ifndef have_sz_fact_k
void xz(fact_k)(long a, entier *b, longueur lb) {
  chiffre *p, *q, *r;
  longueur lg[kprof];
  unsigned long i,j,k,l,n,pow2;

  /* aiguillage selon a */
  if (a < 0) xn(fatal_err)("\nfact_k, negative argument\n");
  if (a <= 2) {b->hd = 1; b->val[0] = max(a,1); return;}

  /* mémoire de travail */
  p = xn(alloc_tmp)(2*lb + kprof);

  /* accumule les produits des parties impaires */
  for (pow2=1, k=0, l=0, i=3; i <= a; i++) {
    for (j=i; (j&1) == 0; j >>= 1, pow2++);
    if (j > 1) {
#ifdef use_dlong
      *(p++) = j; lg[k++] = 1;
#else
      if (j >= BASE) {*(p++) = j; *(p++) = j >> HW; lg[k++] = 2;}
      else           {*(p++) = j;                   lg[k++] = 1;}
#endif
      l++;
      for (j=1; (j&l) == 0; j <<= 1) {
	q = p - lg[k-1];
	r = q - lg[k-2];
	n = lg[k-1]+lg[k-2];
	xn(mul_k)(q,lg[k-1],r,lg[k-2],p);
	while (p[n-1] == 0) n--;
	xn(move)(r,p,n);
	lg[k-2] = n;
	k--;
	p = r+n;
      }
    }
  }

  /* termine les multiplications en instance */
  while (k > 1) {
    q = p - lg[k-1];
    r = q - lg[k-2];
    n = lg[k-1]+lg[k-2];
    xn(mul_k)(q,lg[k-1],r,lg[k-2],p);
    while (p[n-1] == 0) n--;
    xn(move)(r,p,n);
    lg[k-2] = n;
    k--;
    p = r+n;
  }

  /* incorpore les puissances de 2 */
  p -= lg[0];
  xn(shl)(p,lg[0],pow2,b->val);
  make_head(b,lg[0]+(pow2+HW-1)/HW,0);
  xn(free)(p);
}
#endif
