/*
   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                        |
   |                                                                        |
   |                       Allocation mémoire                               |
   |                                                                        |
   +------------------------------------------------------------------------+ */

/* M. Quercia, 22/08/2001 */

/*
 Cont(x)
    entier pointé par la référence x

 Ent(a)
    transtypage value -> (entier *)

 Alloc(x,l)
    alloue l'entier x pour contenir l chiffres

 Alloc_x_y( a1,l1, ..., ax,lx,  b1, ..., by )
    alloue les entiers a1,..,xy pour contenir l1,..,lx chiffres
    b1,..,by pointent vers des valeurs déjà allouées risquant
    d'être déplacées par le GC.

 AllocN_x_y( v,n, a1,l1, ..., ax,lx, b1, ..., by )
    idem mais alloue en plus le vecteur v de longueur n, v est alloué
    en dernier donc on peut assigner ses champs directement.

 Enlarge_x_y( a1,l1 ...,ax,lx, b1, .., by )
    -- vérifie que les entiers référencés par a1,..,ax sont assez grands
    pour recevoir l1,..,lx chiffres et réalloue ceux qui sont trop
    petits (en prenant un chiffre de marge pour limiter les réallocations
    successives).
    -- préserve les liaisons aux valeurs pointées par b1,...,by en cas
    de réorganisation mémoire par le GC
*/


#ifndef use_camllight
#if OCAML_VERSION < 202
#define use_camllight
#endif
#endif

#ifndef use_camllight

                    /* +----------------------+
                       |  Pour Ocaml >= 1.07  |
                       +----------------------+ */


#define Cval(a)      Field(a,0)

#define End_roots1(a)               End_roots()
#define End_roots2(a,b)             End_roots()
#define End_roots3(a,b,c)           End_roots()
#define End_roots4(a,b,c,d)         End_roots()
#define End_roots5(a,b,c,d,e)       End_roots()
#define End_roots7(a,b,c,d,e,f,g)   End_roots(); End_roots()
#define Begin_roots7(a,b,c,d,e,f,g) Begin_roots5(a,b,c,d,e); Begin_roots2(f,g)

#if OCAML_VERSION < 300

#define Capacity(x) (C_of_W(Wosize_val(Cval(x))-1))
#define Ent(a)      ((entier *)(&Field(a,0)))
#define Cont(a)     ((entier *)Field(a,0))

#define Alloc(x,l) {                                    \
  unsigned long alloc_size = W_of_C(l)+1;               \
  if (alloc_size > Max_wosize)                          \
    failwith("create too big a number");                \
   x = alloc(alloc_size,Abstract_tag);                  \
}
#define New(x,n,l) {                                    \
  unsigned long alloc_size = W_of_C(l)+1;               \
  value __x;                                            \
  if (alloc_size > Max_wosize)                          \
    failwith("create too big a number");                \
   __x = alloc(alloc_size,Abstract_tag);                \
   modify(&Field(x,0),__x);                             \
}
#else

                    /* +----------------------+
                       |  Pour Ocaml >= 3.00  |
                       +----------------------+ */

#define Capacity(x) (C_of_W(Wosize_val(Cval(x))-2))
#define Ent(a)      ((entier *)(((value *)(&Field(a,0)))+1))
#define Cont(a)     ((entier *)(((value *)Field(a,0))+1))

#define Alloc(x,l) {                                      \
  unsigned long alloc_size = W_of_C(l)+1;                 \
  if (alloc_size > Max_wosize)                            \
    failwith("create too big a number");                  \
   x = alloc_custom(&xx(ops),alloc_size*sizeof(value),0,1);  \
}
#define New(x,n,l) {                                      \
  unsigned long alloc_size = W_of_C(l)+1;                 \
  value __x;                                              \
  if (alloc_size > Max_wosize)                            \
    failwith("create too big a number");                  \
   __x = alloc_custom(&xx(ops),alloc_size*sizeof(value),0,1);\
   modify(&Field(x,0),__x);                               \
}
#endif

#else /* #ifndef use_camllight */

                 /* +-----------------------------+
                    |  Camllight et Ocaml < 1.07  |
                    +-----------------------------+ */


#define Cval(a)      Field(a,0)
#define Capacity(x)  (C_of_W(Wosize_val(Cval(x))-1))
#define Ent(a)       ((entier *)(&Field(a,0)))
#define Cont(a)      ((entier *)(Field(a,0)))

#define Alloc(x,l) {                         \
  unsigned long alloc_size = W_of_C(l)+1;    \
  if (alloc_size > Max_wosize)               \
    failwith("create too big a number");     \
   x = ((alloc_size <= Max_young_wosize) ?   \
       alloc    (alloc_size,Abstract_tag) :  \
       alloc_shr(alloc_size,Abstract_tag));  \
  }
#define New(x,n,l) {                         \
  unsigned long alloc_size = W_of_C(l)+1;    \
  value __x;                                 \
  if (alloc_size > Max_wosize)               \
    failwith("create too big a number");     \
   __x = ((alloc_size <= Max_young_wosize) ? \
       alloc    (alloc_size,Abstract_tag) :  \
       alloc_shr(alloc_size,Abstract_tag));  \
   modify(&Field(__v[n],0),__x);             \
  }

#define Begin_roots1(a)                  \
  Push_roots(__v,1);                     \
  __v[0] = a

#define Begin_roots2(a,b)                \
  Push_roots(__v,2);                     \
  __v[0] = a;                            \
  __v[1] = b

#define Begin_roots3(a,b,c)              \
  Push_roots(__v,3);                     \
  __v[0] = a;                            \
  __v[1] = b;                            \
  __v[2] = c

#define Begin_roots4(a,b,c,d)            \
  Push_roots(__v,4);                     \
  __v[0] = a;                            \
  __v[1] = b;                            \
  __v[2] = c;                            \
  __v[3] = d

#define Begin_roots5(a,b,c,d,e)          \
  Push_roots(__v,5);                     \
  __v[0] = a;                            \
  __v[1] = b;                            \
  __v[2] = c;                            \
  __v[3] = d;                            \
  __v[4] = e

#define Begin_roots7(a,b,c,d,e,f,g)      \
  Push_roots(__v,7);                     \
  __v[0] = a;                            \
  __v[1] = b;                            \
  __v[2] = c;                            \
  __v[3] = d;                            \
  __v[4] = e;                            \
  __v[5] = f;                            \
  __v[6] = g

#define End_roots1(a)                    \
  a = __v[0];                            \
  Pop_roots()

#define End_roots2(a,b)                  \
  a = __v[0];                            \
  b = __v[1];                            \
  Pop_roots()

#define End_roots3(a,b,c)                \
  a = __v[0];                            \
  b = __v[1];                            \
  c = __v[2];                            \
  Pop_roots()

#define End_roots4(a,b,c,d)              \
  a = __v[0];                            \
  b = __v[1];                            \
  c = __v[2];                            \
  d = __v[3];                            \
  Pop_roots()

#define End_roots5(a,b,c,d,e)            \
  a = __v[0];                            \
  b = __v[1];                            \
  c = __v[2];                            \
  d = __v[3];                            \
  e = __v[4];                            \
  Pop_roots()

#define End_roots7(a,b,c,d,e,f,g)        \
  a = __v[0];                            \
  b = __v[1];                            \
  c = __v[2];                            \
  d = __v[3];                            \
  e = __v[4];                            \
  f = __v[5];                            \
  g = __v[6];                            \
  Pop_roots()

#endif

                        /* +---------------+
                           |  Code commun  |
                           +---------------+ */

#define Alloc_1_1(a,l,b) {               \
  Begin_roots1(b);                       \
  Alloc(a,l);                            \
  End_roots1(b);                         \
}                                        

#define Alloc_1_2(a,l,b,c) {             \
  Begin_roots2(b,c);                     \
  Alloc(a,l);                            \
  End_roots2(b,c);                       \
}                                        

#define Alloc_1_3(a,l,b,c,d) {           \
  Begin_roots3(b,c,d);                   \
  Alloc(a,l);                            \
  End_roots3(b,c,d);                     \
}                                        

#define Alloc_2_1(a,la,b,lb,c) {         \
  a = Val_unit;                          \
  b = Val_unit;                          \
  Begin_roots3(a,b,c);                   \
  Alloc(a,la);                           \
  Alloc(b,lb);                           \
  End_roots3(a,b,c);                     \
}

#define AllocN_1_1(v,n,a,l,b) {          \
  a = Val_unit;                          \
  { Begin_roots2(a,b);                   \
  Alloc(a,l);                            \
  v = alloc_tuple(n);                    \
  End_roots2(a,b); }                     \
}

#define AllocN_2_1(v,n,a,la,b,lb,c) {    \
  a = Val_unit;                          \
  b = Val_unit;                          \
  { Begin_roots3(a,b,c);                 \
  Alloc(a,la);                           \
  Alloc(b,lb);                           \
  v = alloc_tuple(n);                    \
  End_roots3(a,b,c); }                   \
}

#define AllocN_2_2(v,n,a,la,b,lb,c,d) {  \
  a = Val_unit;                          \
  b = Val_unit;                          \
  { Begin_roots4(a,b,c,d);               \
  Alloc(a,la);                           \
  Alloc(b,lb);                           \
  v = alloc_tuple(n);                    \
  End_roots4(a,b,c,d); }                 \
}

#define AllocN_3_2(v,n,a,la,b,lb,c,lc,d,e) {  \
  a = Val_unit;                          \
  b = Val_unit;                          \
  c = Val_unit;                          \
  { Begin_roots5(a,b,c,d,e);             \
  Alloc(a,la);                           \
  Alloc(b,lb);                           \
  Alloc(c,lc);                           \
  v = alloc_tuple(n);                    \
  End_roots5(a,b,c,d,e); }               \
}

#define AllocN_5_2(v,n,a,la,b,lb,c,lc,d,ld,e,le,f,g) {  \
  a = Val_unit;                          \
  b = Val_unit;                          \
  c = Val_unit;                          \
  d = Val_unit;                          \
  e = Val_unit;                          \
  { Begin_roots7(a,b,c,d,e,f,g);         \
  Alloc(a,la);                           \
  Alloc(b,lb);                           \
  Alloc(c,lc);                           \
  Alloc(d,ld);                           \
  Alloc(e,le);                           \
  v = alloc_tuple(n);                    \
  End_roots7(a,b,c,d,e,f,g); }           \
}

#define Enlarge(a,l) {                   \
  if (Capacity(a) < (l)) {               \
    Begin_roots1(a);                     \
    New(a,0,2*(l)+1);                    \
    End_roots1(a);                       \
  }                                      \
}                                        

#define Enlarge_1_1(a,l,b) {             \
  if (Capacity(a) < (l)) {               \
    Begin_roots2(a,b);                   \
    New(a,0,2*(l)+1);                    \
    End_roots2(a,b);                     \
  }                                      \
}                                        

#define Enlarge_1_2(a,l,b,c) {           \
  if (Capacity(a) < (l)) {               \
    Begin_roots3(a,b,c);                 \
    New(a,0,2*(l)+1);                    \
    End_roots3(a,b,c);                   \
  }                                      \
}

#define Enlarge_1_3(a,l,b,c,d) {         \
  if (Capacity(a) < (l)) {               \
    Begin_roots4(a,b,c,d);               \
    New(a,0,2*(l)+1);                    \
    End_roots4(a,b,c,d);                 \
  }                                      \
}

#define Enlarge_2_1(a,la,b,lb,c) {       \
  int small_a = (Capacity(a) < (la));    \
  int small_b = (Capacity(b) < (lb));    \
  if (small_a || small_b) {              \
    Begin_roots3(a,b,c);                 \
    if (small_a) {New(a,0,2*(la)+1);}    \
    if (small_b) {New(b,1,2*(lb)+1);}    \
    End_roots3(a,b,c);                   \
  }                                      \
}                                        
                                         
#define Enlarge_2_2(a,la,b,lb,c,d) {     \
  int small_a = (Capacity(a) < (la));    \
  int small_b = (Capacity(b) < (lb));    \
  if (small_a || small_b) {              \
    Begin_roots4(a,b,c,d);               \
    if (small_a) {New(a,0,2*(la)+1);}    \
    if (small_b) {New(b,1,2*(lb)+1);}    \
    End_roots4(a,b,c,d);                 \
  }                                      \
}

#define Enlarge_3_2(c,lc,d,ld,e,le,f,g) {\
  int small_c = (Capacity(c) < (lc));    \
  int small_d = (Capacity(d) < (ld));    \
  int small_e = (Capacity(e) < (le));    \
  if (small_c || small_d || small_e) {   \
    Begin_roots5(c,d,e,f,g);             \
    if (small_c) {New(c,0,2*(lc)+1);}    \
    if (small_d) {New(d,1,2*(ld)+1);}    \
    if (small_e) {New(e,2,2*(le)+1);}    \
    End_roots5(c,d,e,f,g);               \
  }                                      \
}

#define Enlarge_5_2(a,la,b,lb,c,lc,d,ld,e,le,f,g) {\
  int small_a = (Capacity(a) < (la));    \
  int small_b = (Capacity(b) < (lb));    \
  int small_c = (Capacity(c) < (lc));    \
  int small_d = (Capacity(d) < (ld));    \
  int small_e = (Capacity(e) < (le));    \
  if (small_a || small_b || small_c || small_d || small_e) {\
    Begin_roots7(a,b,c,d,e,f,g);         \
    if (small_a) {New(a,0,2*(la)+1);}    \
    if (small_b) {New(b,1,2*(lb)+1);}    \
    if (small_c) {New(c,2,2*(lc)+1);}    \
    if (small_d) {New(d,3,2*(ld)+1);}    \
    if (small_e) {New(e,4,2*(le)+1);}    \
    End_roots7(a,b,c,d,e,f,g);           \
  }                                      \
}


