| Karim BELABAS on Wed, 19 Mar 2003 21:16:49 +0100 (MET) |
[Date Prev] [Date Next] [Thread Prev] [Thread Next] [Date Index] [Thread Index]
| Re: Another memory leak in Pari/GP 2.2.5 |
On Wed, 19 Mar 2003, Alexander Shumakovitch wrote:
> On Wed, Mar 19, 2003 at 05:56:37PM +0100, Karim BELABAS wrote:
> > There was indeed a memory leak, which is fixed in CVS.
> Yes, I can't reproduce it anymore.
>
> Am I right that the changes are limited to init.c? I'd like to backport
> them to 2.2.5 to avoid (possible) problems of running a CVS version.
There are minor changes in anal.c, trans[12].c and base1.c also.
I have attached a full patch against 2.2.5.
Karim.
P.S: It's a non-trivial patch, it is probably safer to run (and update:-) the
CVS version.
--
Karim Belabas Tel: (+33) (0)1 69 15 57 48
Dép. de Mathématiques, Bât. 425 Fax: (+33) (0)1 69 15 60 19
Université Paris-Sud http://www.math.u-psud.fr/~belabas/
F-91405 Orsay (France) http://www.parigp-home.de/ [PARI/GP]
Index: src/basemath/base1.c
===================================================================
RCS file: /home/megrez/cvsroot/pari/src/basemath/base1.c,v
retrieving revision 1.130
retrieving revision 1.131
diff -u -w -r1.130 -r1.131
--- src/basemath/base1.c 2003/03/17 19:50:03 1.130
+++ src/basemath/base1.c 2003/03/19 16:48:10 1.131
@@ -2387,7 +2387,6 @@
}
nfz[4] = (long) C;
if (DEBUGLEVEL>=2) msgtimer("Cik");
- gunclone(aij);
free((void*)zone); free((void*)zone1); free((void*)zone0);
free((void*)coef); return nfz;
}
Index: src/basemath/trans1.c
===================================================================
RCS file: /home/megrez/cvsroot/pari/src/basemath/trans1.c,v
retrieving revision 1.85
retrieving revision 1.86
diff -u -w -r1.85 -r1.86
--- src/basemath/trans1.c 2003/03/18 10:16:56 1.85
+++ src/basemath/trans1.c 2003/03/19 16:48:10 1.86
@@ -95,7 +95,8 @@
}
p1 = divsr(53360,p1);
mulrrz(p1,mpsqrt(stor(k3,prec)), tmppi);
- gunclone(gpi); avma = av1; gpi = tmppi;
+ if (gpi) gunclone(gpi);
+ avma = av1; gpi = tmppi;
}
GEN
@@ -173,7 +174,8 @@
}
}
divrrz(u,v,tmpeuler);
- gunclone(geuler); avma = av1; geuler = tmpeuler;
+ if (geuler) gunclone(geuler);
+ avma = av1; geuler = tmpeuler;
}
GEN
@@ -1449,8 +1451,8 @@
s = addrr(s, divrs(u,k));
}
setexpo(s, -1); affrr(s, tmplog2);
- gunclone(glog2); glog2 = tmplog2;
- avma = av0; return glog2;
+ if (glog2) gunclone(glog2);
+ glog2 = tmplog2; avma = av0; return glog2;
}
GEN
Index: src/language/anal.c
===================================================================
RCS file: /home/megrez/cvsroot/pari/src/language/anal.c,v
retrieving revision 1.135
retrieving revision 1.136
diff -u -w -r1.135 -r1.136
--- src/language/anal.c 2003/02/17 22:47:29 1.135
+++ src/language/anal.c 2003/03/19 16:48:10 1.136
@@ -30,6 +30,8 @@
typedef GEN (*F2GEN)(GEN,GEN);
typedef GEN (*F1GEN)(GEN);
+extern void killsubblocs(GEN x);
+
static GEN constante();
static GEN expr();
static GEN facteur();
@@ -55,8 +57,6 @@
/* Is the name proper??? */
#define SIZEOF_VAR_POLS (VAR_POLS_LONGS*sizeof(long))
-
-extern void killbloc0(GEN x, int inspect);
extern int term_width(void);
extern GEN addsmulsi(long a, long b, GEN Y);
extern GEN rpowsi(ulong a, GEN n, long prec);
@@ -1452,7 +1452,7 @@
if (typ(res) != t_COL || lg(res) != lg(*pt)) err(caseer2,old,mark.start);
res = gclone(res);
- if (isclone(*pt)) killbloc(*pt);
+ killsubblocs(*pt);
return *pt = res;
}
Index: src/language/init.c
===================================================================
RCS file: /home/megrez/cvsroot/pari/src/language/init.c,v
retrieving revision 1.193
retrieving revision 1.194
diff -u -w -r1.193 -r1.194
--- src/language/init.c 2003/03/18 22:45:28 1.193
+++ src/language/init.c 2003/03/19 16:48:10 1.194
@@ -102,7 +102,8 @@
return a;
}
-void debug_stack(void)
+void
+debug_stack(void)
{
GEN z;
fprintferr("bot=0x%lx\t top=0x%lx\n",bot,top);
@@ -110,14 +111,91 @@
fprintferr("0x%p:\t0x%lx\t%lu\n",z,*z,*z);
}
-#ifdef STACK_CHECK
/*********************************************************************/
/* */
-/* C STACK SIZE CONTROL */
-/* (to avoid core dump on deep recursion) */
+/* BLOCS */
/* */
/*********************************************************************/
+static long next_bloc;
+static GEN cur_bloc=NULL; /* current bloc in bloc list */
+
+/* Return x, where:
+ * x[-3]: adress of next bloc
+ * x[-2]: adress of preceding bloc.
+ * x[-1]: number of allocated blocs.
+ * x[0..n-1]: malloc-ed memory. */
+GEN
+newbloc(long n)
+{
+ long *x = (long *) gpmalloc((n + BL_HEAD)*sizeof(long)) + BL_HEAD;
+
+ bl_next(x) = 0; /* the NULL address */
+ bl_prev(x) = (long)cur_bloc;
+ bl_num(x) = next_bloc++;
+ if (n) *x = 0; /* initialize first cell to 0. See killbloc */
+ if (cur_bloc) bl_next(cur_bloc) = (long)x;
+ if (DEBUGMEM)
+ {
+ if (!n) err(warner,"mallocing NULL object in newbloc");
+ if (DEBUGMEM > 2)
+ fprintferr("new bloc, size %6lu (no %ld): %08lx\n", n, next_bloc-1, x);
+ }
+ return cur_bloc = x;
+}
+
+static void
+free_bloc(GEN x)
+{
+ if (DEBUGMEM > 2)
+ fprintferr("killing bloc (no %ld): %08lx\n", bl_num(x), x);
+ free((void*)bl_base(x));
+}
+
+static void
+delete_from_bloclist(GEN x)
+{
+ if (bl_next(x)) bl_prev(bl_next(x)) = bl_prev(x);
+ else
+ {
+ cur_bloc = (GEN)bl_prev(x);
+ next_bloc = bl_num(x);
+ }
+ if (bl_prev(x)) bl_next(bl_prev(x)) = bl_next(x);
+ free_bloc(x);
+}
+
+/* Recursively look for clones in the container and kill them. Then kill
+ * container if clone. */
+void
+killsubblocs(GEN x)
+{
+ long i, lx;
+ switch(typ(x)) /* HACK: if x is not a GEN, we have typ(x)=0 */
+ {
+ case t_VEC: case t_COL: case t_MAT:
+ lx = lg(x);
+ for (i=1;i<lx;i++) killsubblocs((GEN)x[i]);
+ break;
+ case t_LIST:
+ lx = lgef(x);
+ for (i=2;i<lx;i++) killsubblocs((GEN)x[i]);
+ break;
+ }
+ if (isclone(x)) delete_from_bloclist(x);
+}
+
+/* FIXME: SIGINT should be blocked until killsubblocs() returns */
+void
+killbloc(GEN x) { killsubblocs(x); }
+void
+gunclone(GEN x) { delete_from_bloclist(x); }
+/*********************************************************************/
+/* */
+/* C STACK SIZE CONTROL */
+/* (avoid core dump on deep recursion) */
+/*********************************************************************/
+#ifdef STACK_CHECK
/* adapted from Perl code written by Dominic Dunlop */
void *PARI_stack_limit = NULL;
@@ -161,8 +239,6 @@
/*********************************************************************/
static int var_not_changed; /* altered in reorder() */
static int try_to_recover = 0;
-static long next_bloc;
-static GEN cur_bloc=NULL; /* current bloc in bloc list */
static GEN universal_constants;
#if __MWERKS__
@@ -625,8 +701,7 @@
free((void*)primetab);
free((void*)universal_constants);
- /* set first cell to 0 to inhibit recursion in all cases */
- while (cur_bloc) { *cur_bloc=0; killbloc(cur_bloc); }
+ while (cur_bloc) delete_from_bloclist(cur_bloc);
killallfiles(1);
free((void *)functions_hash);
free((void *)bot);
@@ -656,79 +731,6 @@
x=cgetg(3,t_VEC); x[1]=lstoi(m); x[2]=lstoi(l);
return x;
}
-
-/* Return x, where:
- * x[-3]: adress of next bloc
- * x[-2]: adress of preceding bloc.
- * x[-1]: number of allocated blocs.
- * x[0..n-1]: malloc-ed memory.
- */
-GEN
-newbloc(long n)
-{
- long *x = (long *) gpmalloc((n + BL_HEAD)*sizeof(long)) + BL_HEAD;
-
- bl_next(x) = 0; /* the NULL address */
- bl_prev(x) = (long)cur_bloc;
- bl_num(x) = next_bloc++;
- if (n) *x = 0; /* initialize first cell to 0. See killbloc */
- if (cur_bloc) bl_next(cur_bloc) = (long)x;
- if (DEBUGMEM)
- {
- if (!n) err(warner,"mallocing NULL object in newbloc");
- if (DEBUGMEM > 2)
- fprintferr("new bloc, size %6lu (no %ld): %08lx\n", n, next_bloc-1, x);
- }
- return cur_bloc = x;
-}
-
-/* recursively look for clones in the container and kill them */
-static void
-inspect(GEN x)
-{
- long i, lx;
- switch(typ(x)) /* HACK: if x is not a GEN, we have typ(x)=0 */
- {
- case t_VEC: case t_COL: case t_MAT:
- lx = lg(x);
- for (i=1;i<lx;i++) inspect((GEN)x[i]);
- break;
- case t_LIST:
- lx = lgef(x);
- for (i=2;i<lx;i++) inspect((GEN)x[i]);
- break;
- }
- if (isclone(x)) gunclone(x); /* Don't inspect here! components are dead */
-}
-
-/* If insp is set, recursively inspect x, killing all clones found. The GP
- * expression x[i] = y is implemented as x[i] := gclone(y) and we need to
- * reclaim the memory. Useless to inspect when x does not correspond to a GP
- * variable [not dangerous, though] */
-void
-killbloc0(GEN x, int insp)
-{
- if (!x || isonstack(x)) return;
- if (bl_next(x)) bl_prev(bl_next(x)) = bl_prev(x);
- else
- {
- cur_bloc = (GEN)bl_prev(x);
- next_bloc = bl_num(x);
- }
- if (bl_prev(x)) bl_next(bl_prev(x)) = bl_next(x);
- if (DEBUGMEM > 2)
- fprintferr("killing bloc (no %ld): %08lx\n", bl_num(x), x);
- if (insp)
- { /* FIXME: SIGINT should be blocked until inspect() returns */
- unsetisclone(x); /* important: oo recursion otherwise */
- inspect(x);
- }
- free((void *)bl_base(x));
-}
-void
-killbloc(GEN x) { killbloc0(x,1); }
-void
-gunclone(GEN x) { killbloc0(x,0); }
/********************************************************************/
/** **/