Ilya Zakharevich on Tue, 28 Jan 2003 15:41:28 -0800


[Date Prev] [Date Next] [Thread Prev] [Thread Next] [Date Index] [Thread Index]

[PATCH CVS] subst(x^4,x^2+1,y) etc.


This is a multihead patch:

 a) it implements arbitrary polynomial as the second argument to subst();

 b) it clarifies some usages of mysterious numbers (1..7) in PARI code;

 c) it fixes longjmp() used with reason==0;

It does not fix the following problems:

 1) one cannot rethrow() after catching an error;

 2) fetch_var() may return MAXVARN (should return MAXVARN-1 and down);

 3) there is no way to fetch_var_low_priority() with priority lower
    than any active variable;

 4) Same for _high_priority() [though I do not know yet a situation when
    this may be needed];

 5) When error is catched, critical PARI variables (prec, seriesprec,
    counts for fetch_var() etc.) are not restored.

Enjoy,
Ilya

diff -pru pari/src/basemath/gen3.c pari-my-200201/src/basemath/gen3.c
--- pari/src/basemath/gen3.c	Sun Jan 12 16:32:46 2003
+++ pari-my-200201/src/basemath/gen3.c	Tue Jan 28 13:52:48 2003
@@ -1313,16 +1313,49 @@ gconvsp(GEN x, int flpile)
 }
 
 GEN
+gsubst_expr(GEN pol, GEN from, GEN to)
+{
+  /*
+     subst_poly(pol, from, to) =
+     local(t='subst_poly_t, M);
+     M = from - t;
+     subst(lift(Mod(pol,M), variable(M)),t,to)
+   */
+  pari_sp av = avma;
+  long v = fetch_var();		/* XXX Need fetch_var_low_priority() */
+  GEN tmp = gsub(from, polx[v]);	/* M */
+
+  if (v <= gvar(from))
+      err(talker, "subst: unexpected variable precedence");
+  tmp = gmodulcp(pol, tmp);
+  if (typ(tmp) == t_POLMOD)
+    tmp = (GEN)tmp[2];			/* optimize lift */
+  else					/* Vector? */
+    tmp = lift0(tmp, gvar(from));
+  tmp = gsubst(tmp, v, to);
+  delete_var();
+  return gerepilecopy(av, tmp);
+}
+
+GEN
 gsubst0(GEN x, GEN T, GEN y)
 {
   pari_sp av;
   long d, v;
+  GEN deflated;
+
   if (typ(T) != t_POL || !ismonome(T) || !gcmp1(leading_term(T)))
-    err(talker,"variable number expected in subst");
+    return gsubst_expr(x,T,y);
   d = degpol(T); v = varn(T);
   if (d == 1) return gsubst(x, v, y);
   av = avma;
-  return gerepilecopy(av, gsubst(gdeflate(x, v, d), v, y));
+  CATCH(cant_deflate) {
+    avma = av;
+    return gsubst_expr(x,T,y);      
+  } TRY {
+    deflated = gdeflate(x, v, d);
+  } ENDCATCH
+  return gerepilecopy(av, gsubst(deflated, v, y));
 }
 
 GEN
diff -pru pari/src/basemath/polarit2.c pari-my-200201/src/basemath/polarit2.c
--- pari/src/basemath/polarit2.c	Sun Jan 12 16:32:48 2003
+++ pari-my-200201/src/basemath/polarit2.c	Tue Jan 28 14:06:18 2003
@@ -1629,7 +1629,7 @@ gdeflate(GEN x, long v, long d)
     if (vx > v) return gcopy(x);
     av = avma;
     if (checkdeflate(x) % d != 0)
-      err(talker,"impossible substitution in gdeflate");
+      err(cant_deflate);
     return gerepilecopy(av, poldeflate_i(x,d));
   }
   if (tx == t_RFRAC)
@@ -2073,7 +2073,7 @@ factor(GEN x)
           long killv;
 	  x = dummycopy(x); lx=lgef(x);
           pol = dummycopy(pol);
-          v = manage_var(4,NULL);
+          v = manage_var(manage_var_max_avail,NULL);
           for(i=2; i<lx; i++)
           {
             p1=(GEN)x[i];
diff -pru pari/src/headers/paricom.h pari-my-200201/src/headers/paricom.h
--- pari/src/headers/paricom.h	Sun Jan 12 16:32:52 2003
+++ pari-my-200201/src/headers/paricom.h	Tue Jan 28 13:54:14 2003
@@ -37,7 +37,7 @@ Foundation, Inc., 59 Temple Place - Suit
  *   code
  * } ENDCATCH
  * will execute 'code', then 'recovery' if exception 'numer' is thrown
- * [ any exception if numer < 0 ].
+ * [ any exception if numer == CATCH_ALL ].
  * RETRY = as TRY, but execute 'recovery', then 'code' again [still catching] */
 #define CATCH(err) {         \
   VOLATILE long __err = err; \
@@ -56,6 +56,24 @@ Foundation, Inc., 59 Temple Place - Suit
 
 #define CATCH_ALL -1
 /*=====================================================================*/
+/* VOLATILE int errorN;
+ * CATCH_ERR(errorN) {
+ *   code
+ * } ENDCATCH_ERR
+ * executes 'code', setting errorN to the number of exception thrown;
+ * errorN is 0 if no error was thrown. */
+
+#define CATCH_ERR(__err) {  \
+  jmp_buf __env;            \
+  __err = setjmp(__env);    \
+  if (!__err) {		    \
+    void *__catcherr = err_catch(CATCH_ALL, &__env);
+
+#define ENDCATCH_ERR	    \
+    CATCH_RELEASE();	    \
+  }}
+
+/*=====================================================================*/
 
 #define bit_accuracy(x) (((x)-2) << TWOPOTBITS_IN_LONG)
 
@@ -95,6 +113,16 @@ extern const long lontyp[];
 extern void* global_err_data;
 
 extern int new_galois_format;
+
+enum manage_var_t {
+    manage_var_create,			/* 0 */
+    manage_var_delete,			/* 1 */
+    manage_var_init,			/* 2 */
+    manage_var_next,			/* 3 */
+    manage_var_max_avail,		/* 4 */
+    manage_var_pop,			/* 5 */
+};
+
 
 #define MAXITERPOL  10 /* max #of prec increase in polredabs-type operations */
 
diff -pru pari/src/headers/paridecl.h pari-my-200201/src/headers/paridecl.h
--- pari/src/headers/paridecl.h	Sun Jan 12 16:32:52 2003
+++ pari-my-200201/src/headers/paridecl.h	Tue Jan 28 14:05:02 2003
@@ -963,6 +963,7 @@ GEN     gshift(GEN x, long n);
 GEN     gshift3(GEN x, long n, long flag);
 GEN     gsubst(GEN x, long v, GEN y);
 GEN     gsubst0(GEN x, GEN v, GEN y);
+GEN	gsubst_expr(GEN pol, GEN from, GEN to);
 GEN     gtopoly(GEN x, long v);
 GEN     gtopolyrev(GEN x, long v);
 GEN     gtoser(GEN x, long v);
diff -pru pari/src/headers/parierr.h pari-my-200201/src/headers/parierr.h
--- pari/src/headers/parierr.h	Tue Oct 15 17:34:02 2002
+++ pari-my-200201/src/headers/parierr.h	Tue Jan 28 14:07:42 2003
@@ -14,6 +14,12 @@ with the package; see the file 'COPYING'
 Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */
 
 enum {
+  no_error,					/* Force errors into non-0 */
+
+  cant_deflate,
+
+/* Always catched up to this point */
+
   caracer1, caseer, caseer2, member, nparamer1,
   paramer1, varer1, obsoler, openfiler, talker2,
 
diff -pru pari/src/language/anal.c pari-my-200201/src/language/anal.c
--- pari/src/language/anal.c	Sun Jan 12 16:32:56 2003
+++ pari-my-200201/src/language/anal.c	Mon Jan 13 19:55:32 2003
@@ -48,9 +48,14 @@ static void   skipseq();
 static void   skipstring();
 static void   skiptruc();
 static entree *entry();
-static entree *installep(void *f,char *name,int l,int v,int add,entree **table);
 static entree *skipentry(void);
 
+static entree *installep(void *f,char *name,int l,int v,int add,entree **table);
+#define VAR_POLS_LONGS		7	/* 4 words for polx, 3 for polun */
+/* 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);
@@ -2382,31 +2387,29 @@ installep(void *f, char *name, int len, 
 long
 manage_var(long n, entree *ep)
 {
-  static long max_avail = MAXVARN; /* first user variable not yet used */
+  static long max_avail = MAXVARN; /* max variable not yet used */
   static long nvar; /* first GP free variable */
   long var;
   GEN p;
 
-  if (n) /* special behaviour */
-  {
-    switch(n)
-    {
-      case 2: return nvar=0;
-      case 3: return nvar;
-      case 4: return max_avail;
-      case 5:
+  switch(n) {
+      case manage_var_init: return nvar=0;
+      case manage_var_next: return nvar;
+      case manage_var_max_avail: return max_avail;
+      case manage_var_pop:
       {
         long v = (long)ep;
         if (v != nvar-1) err(talker,"can't pop gp variable");
         setlg(polvar, nvar);
         return --nvar;
       }
-    }
-
-    /* user wants to delete one of his/her/its variables */
-    if (max_avail == MAXVARN-1) return 0; /* nothing to delete */
-    free(polx[++max_avail]); /* frees both polun and polx */
-    return max_avail+1;
+      case manage_var_delete:
+	/* user wants to delete one of his/her/its variables */
+	if (max_avail == MAXVARN-1) return 0; /* nothing to delete */
+	free(polx[++max_avail]); /* frees both polun and polx */
+	return max_avail+1;
+      case manage_var_create: break;
+      default: err(talker, "panic");
   }
 
   if (nvar == max_avail) err(talker2,"no more variables available",
@@ -2418,7 +2421,7 @@ manage_var(long n, entree *ep)
   }
   else
   {
-    p = (GEN) gpmalloc(7*sizeof(long));
+    p = (GEN) gpmalloc(SIZEOF_VAR_POLS);
     var=max_avail--;
   }
 
@@ -2443,7 +2446,7 @@ manage_var(long n, entree *ep)
 long
 fetch_var(void)
 {
-  return manage_var(0,NULL);
+  return manage_var(manage_var_create,NULL);
 }
 
 entree *
@@ -2455,9 +2458,9 @@ fetch_named_var(char *s, int doerr)
     if (doerr) err(talker,"identifier already in use: %s", s);
     return ep;
   }
-  ep = installep(NULL,s,strlen(s),EpVAR, 7*sizeof(long),
+  ep = installep(NULL,s,strlen(s),EpVAR, SIZEOF_VAR_POLS,
                  functions_hash + hashvalue(s));
-  (void)manage_var(0,ep); return ep;
+  (void)manage_var(manage_var_create,ep); return ep;
 }
 
 long
@@ -2483,14 +2486,14 @@ fetch_user_var(char *s)
 void
 delete_named_var(entree *ep)
 {
-  (void)manage_var(5, (entree*)varn(initial_value(ep)));
+  (void)manage_var(manage_var_pop, (entree*)varn(initial_value(ep)));
   kill0(ep);
 }
 
 long
 delete_var(void)
 {
-  return manage_var(1,NULL);
+  return manage_var(manage_var_delete,NULL);
 }
 
 void
@@ -2499,7 +2502,7 @@ name_var(long n, char *s)
   entree *ep;
   char *u;
 
-  if (n < manage_var(3,NULL))
+  if (n < manage_var(manage_var_next,NULL))
     err(talker, "renaming a GP variable is forbidden");
   if (n > (long)MAXVARN)
     err(talker, "variable number too big");
@@ -2532,10 +2535,10 @@ entry(void)
   if (*analyseur == '(')
     { n=0; val=EpNEW; }
   else
-    { n=7*sizeof(long); val=EpVAR; }
+    { n=SIZEOF_VAR_POLS; val=EpVAR; }
   ep = installep(NULL,old,len,val,n, functions_hash + hash);
 
-  if (n) (void)manage_var(0,ep); /* Variable */
+  if (n) (void)manage_var(manage_var_create, ep); /* Variable */
   return ep;
 }
 
diff -pru pari/src/language/errmsg.c pari-my-200201/src/language/errmsg.c
--- pari/src/language/errmsg.c	Tue Oct 15 17:34:04 2002
+++ pari-my-200201/src/language/errmsg.c	Tue Jan 28 14:07:48 2003
@@ -15,6 +15,14 @@ Foundation, Inc., 59 Temple Place - Suit
 
 char *errmessage[]=
 {
+/* no_error */
+  "bug in error-handling code",
+
+/* cant_deflate */
+  "can't deflate",
+
+/* Always catched up to this point */
+
 /* caracer1 */
   "unexpected character",
 /* caseer */
diff -pru pari/src/language/es.c pari-my-200201/src/language/es.c
--- pari/src/language/es.c	Sun Jan 12 16:32:58 2003
+++ pari-my-200201/src/language/es.c	Mon Jan 13 19:37:56 2003
@@ -1266,7 +1266,7 @@ etatpile(unsigned int n)
                  itos((GEN)adr[1]), itos((GEN)adr[2]));
   avma=av;
 
-  pariputsf(" %ld variable names used out of %d\n\n",manage_var(3,NULL),MAXVARN);
+  pariputsf(" %ld variable names used out of %d\n\n",manage_var(manage_var_next,NULL),MAXVARN);
   if (!n) return;
 
   if (n > (ulong)nu) n = nu;
@@ -3082,7 +3082,7 @@ writebin(char *name, GEN x)
   if (x) writeGEN(x,f);
   else
   {
-    long v, maxv = manage_var(3,NULL);
+    long v, maxv = manage_var(manage_var_next,NULL);
     for (v=0; v<maxv; v++)
     {
       entree *ep = varentries[v];
diff -pru pari/src/language/init.c pari-my-200201/src/language/init.c
--- pari/src/language/init.c	Sun Jan 12 16:32:58 2003
+++ pari-my-200201/src/language/init.c	Tue Jan 28 14:11:20 2003
@@ -567,7 +567,7 @@ pari_init(size_t parisize, ulong maxprim
   reset_traps();
   default_exception_handler = NULL;
 
-  (void)manage_var(2,NULL); /* init nvar */
+  (void)manage_var(manage_var_init,NULL); /* init nvar */
   var_not_changed = 1; (void)fetch_named_var("x", 0);
   try_to_recover=1;
 }
@@ -790,7 +790,7 @@ changevar(GEN x, GEN y)
 GEN
 reorder(GEN x)
 {
-  long tx,lx,i,n, nvar = manage_var(3,NULL);
+  long tx,lx,i,n, nvar = manage_var(manage_var_next,NULL);
   int *var,*varsort,*t1;
 
   if (!x) return polvar;
@@ -1069,7 +1069,12 @@ err(long numerr, ...)
   pariflush(); pariOut = pariErr;
   pariflush(); term_color(c_ERR);
 
-  if (numerr < talker)
+  if (numerr <= cant_deflate)
+  {
+    pariputsf("  ***   Bug in PARI, please report.  Uncatched error: %s",
+	      errmessage[numerr]);
+  }
+  else if (numerr < talker)
   {
     strcpy(s, errmessage[numerr]);
     switch (numerr)