| 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)