| Ilya Zakharevich on Thu, 31 Oct 2002 14:23:53 -0800 |
[Date Prev] [Date Next] [Thread Prev] [Thread Next] [Date Index] [Thread Index]
| [PATCH CVS] type system in PARI |
This patch
a) Adds new extensible PARI type t_EXT; new subtypes of this type
may be added at runtime;
b) Adds minimal possible support of the type t_EXT in the PARI "arithmetic
engine". The amount of support is exactly the same as for the type
t_VECSMALL in CVS a couple of weeks ago.
c) Implements a sample subtype GEN_ext_Wrapped of t_EXT which behaves as
an existing PARI value but has an additional long (subsubtype) attached.
This may be used e.g., for typed array: one can mark a particular value
as being of "type" e.g., "ellinit".
Since vector elements are implemented in "b", one can use this subtype
to make the current ellinit() etc output value to be typed.
d) Fixes a bug in matcell(), which would use a pointer to a C stack position
out of scope - and even could return this position as writable address
to the caller.
Enjoy,
Ilya
P.S. Here is the minimal test suite:
install(new_WRAPPED,"GD0,L,")
a=new_WRAPPED([1.2])
aa=new_WRAPPED([1,2])
a[1]
aa[1]
print([a,aa])
aa[1]=3
print([a,aa])
bb=[17,a,aa,35]
print(bb)
diff -pru pari/src/headers/parigen.h pari-my/src/headers/parigen.h
--- pari/src/headers/parigen.h Wed Oct 23 14:58:24 2002
+++ pari-my/src/headers/parigen.h Thu Oct 31 12:56:32 2002
@@ -154,3 +154,125 @@ typedef int (*QSCOMP)(const void *, cons
#define setvarn(x,s) (((GEN)(x))[1]=\
(((GEN)(x))[1]&(~VARNBITS)) | evalvarn(s))
+
+#define t_UNKNOWN (-1)
+
+/* Several special values which cannot be correct GEN */
+#define NOT_A_GEN ((GEN)errmessage)
+#define NOT_A_GENn(n) (NOT_A_GEN+n) /* Small values of n only */
+
+#define WHOLE_VECTOR NOT_A_GEN
+
+#define LAST_ELT NOT_A_GENn(0)
+#define FIRST_ELT NOT_A_GENn(1)
+#define NEXT_ELT NOT_A_GENn(2)
+
+struct GEN_ext_base;
+typedef struct GEN_ext_base GEN_ext_t;
+typedef GEN_ext_t *GEN_ext;
+struct pariout_t;
+
+enum ext_copy_t {
+ NORMAL_COPY,
+ FORCE_COPY, /* Copy long-term storage (as inmodulus of MODs) too */
+ FORCE_COPY0, /* Same, and use NULL for an exact zero */
+ FRONT_FORCE_COPY, /* The chunk with GEN_ext should be at front */
+};
+
+enum Pext_bin_t {
+ Pext_OP_cmp,
+ Pext_OP_lex,
+ Pext_OP_add,
+ Pext_OP_sub,
+ Pext_OP_mul,
+ Pext_OP_div,
+ Pext_OP_divent,
+ Pext_OP_divround,
+ Pext_OP_mod,
+ Pext_OP_divrem,
+ extOP_FLIPARG = 0x20, /* ORed if arguments are exchanged */
+ extOP_SPECIAL = 0x40, /* OP-specific */
+};
+
+typedef ulong pari_sp;
+
+#define Pext_OP_MASK (~(extOP_FLIPARG|extOP_SPECIAL))
+
+typedef struct {
+ char *name; /* used by GEN_EXT_get_name_generic() */
+ ulong isa_flags; /* public: may be used later in is_vec_t() etc */
+ long data; /* for private use by methods */
+
+ /* Mandatory methods; one should use GEN_EXT_*_generic as placeholders */
+ char * (*get_name)(GEN_ext g);
+ GEN (*get_GEN)(GEN_ext g, enum PARI_type prefer_type); /* t_UNKNOWN: any type */
+ GEN (*sort)(GEN_ext x, int flag, int (*cmp)(GEN,GEN));
+
+ /* These are called with flags, so that the same C subroutine may be used */
+ GEN (*add)(GEN_ext g, GEN g1, enum Pext_bin_t flags);
+ /* May be used for gneg() too (g1 == 0 and extOP_FLIPARG) */
+ GEN (*sub)(GEN_ext g, GEN g1, enum Pext_bin_t flags);
+ GEN (*mul)(GEN_ext g, GEN g1, enum Pext_bin_t flags);
+ /* May be used for ginv() too */
+ GEN (*div)(GEN_ext g, GEN g1, enum Pext_bin_t flags);
+ GEN (*divent)(GEN_ext g, GEN g1, enum Pext_bin_t flags);
+ GEN (*divround)(GEN_ext g, GEN g1, enum Pext_bin_t flags);
+ GEN (*mod)(GEN_ext g, GEN g1, enum Pext_bin_t flags);
+
+ /* flags: extOP_FLIPARG, pow==0 means use lpow (then no FLIPARG);
+ when using lpow one should disregard prec */
+ GEN (*pow)(GEN_ext g, GEN pow, long lpow, enum Pext_bin_t flags, long prec);
+ GEN (*shift)(GEN_ext g, GEN shift, long lshift, enum Pext_bin_t flags, long flag);
+ GEN (*divrem)(GEN_ext g, GEN g1, enum Pext_bin_t flags, long v);
+ long (*cmp)(GEN_ext g, GEN g1, enum Pext_bin_t flags); /* flag&extOP_SPECIAL if +-1 is not needed */
+ long (*lex)(GEN_ext g, GEN g1, enum Pext_bin_t flags);
+ long (*sign)(GEN_ext g);
+
+ /* Vector accessor */
+ GEN (*get_nth)(GEN_ext g, GEN nn, long n); /* nn==0 means use n */
+ /* Returns t_SMALL for the values which fit; elt may be LAST_ELT etc;
+ Returns 0 if the element is not there, or if a particular operation makes no sense */
+ GEN (*get_idx)(GEN_ext g, GEN elt);
+
+ /* The rest is optional */
+
+ /* Copy to/from stack; NULL if memmov()able; memory allocation should be
+ done by decreasing *AVMA; components should be allocated by gcopy()/
+ gcopy_av(), gcopy_av0() depending on the flag. */
+ GEN (*copy)(GEN_ext g, GEN *AVMA, enum ext_copy_t flag); /* as gcopy_av() etc */
+ long (*copy_len)(GEN_ext g, enum ext_copy_t flag); /* as taille0() etc */
+ /* Called after g (+ additional memory as per copy_len()) was memmove()ed;
+ if move_start !=0, then the region between _start and _end is being moved, and
+ the part of it after validend becomes invalid. */
+ void (*shift_address)(GEN_ext g, long delta, pari_sp move_start, pari_sp move_end, pari_sp valid_end);
+ /* This value (on heap) is going to be removed */
+ GEN (*remove)(GEN_ext g); /* as inspect() */
+
+ /* Vector accessors */
+ void (*set_nth)(GEN_ext g, GEN nn, long n, GEN value);
+ /* Probably makes sense with elt==LAST_ELT only... */
+ void (*set_idx)(GEN_ext g, GEN elt, long n, GEN nn); /* nn==0 means use n */
+
+ /* Matrix accessors, nn1 nn2 may be WHOLE_VECTOR */
+ GEN (*get_nth2)(GEN_ext g, GEN nn1, GEN nn2, long n1, long n2); /* likewise */
+ void (*set_nth2)(GEN_ext g, GEN nn1, GEN nn2, long n1, long n2, GEN value);
+
+ void (*get_idx2)(GEN_ext g, GEN elt, GEN *n1, GEN *n2);
+ void (*set_idx2)(GEN_ext g, GEN elt, GEN nn1, GEN nn2, long n1, long n2);
+
+ GEN (*inc)(GEN_ext g, long n); /* n is +1 or -1 */
+
+ GEN (*simplify)(GEN_ext g);
+ void (*dump)(GEN_ext g, long blanks); /* as voir2() */
+ void (*write)(GEN_ext g, struct pariout_t *T, int nosign); /* as bruti()/sori() */
+
+ GEN (*stack_reserve)(long n, void *data); /* Class method, as cgetg() */
+
+} GEN_ext_TYPE;
+
+struct GEN_ext_base {
+ long code;
+ GEN_ext_TYPE *type;
+};
+
+#define GEN_ext_type(g) (((GEN_ext)(g))->type)
diff -pru pari/src/basemath/alglin1.c pari-my/src/basemath/alglin1.c
--- pari/src/basemath/alglin1.c Tue Oct 15 17:33:50 2002
+++ pari-my/src/basemath/alglin1.c Thu Oct 31 01:11:14 2002
@@ -616,6 +616,27 @@ extract(GEN x, GEN l)
}
return y;
}
+ if (tl == t_EXT) {
+ long ll;
+ pari_sp av = avma;
+ GEN last = GEN_ext_type(l)->get_idx((GEN_ext)l, LAST_ELT);
+
+ ll = smalltos(last);
+ if (typ(last) != t_SMALL || ll < 0)
+ err(talker, "incompatible t_EXT array");
+ y=cgetg(ll + 2,tx);
+ for (i=0; i <= ll; i++) {
+ y[i+1] = itos(GEN_ext_type(l)->get_nth((GEN_ext)l,0,i));
+ avma = av;
+ }
+ for (i=0; i <= ll; i++)
+ {
+ j = y[i + 1];
+ if (j>=lx || j<=0) err(talker,"no such component in vecextract");
+ y[i + 1] = lcopy((GEN) x[j]);
+ }
+ return y;
+ }
err(talker,"incorrect mask in vecextract");
return NULL; /* not reached */
}
diff -pru pari/src/basemath/bibli2.c pari-my/src/basemath/bibli2.c
--- pari/src/basemath/bibli2.c Wed Oct 23 14:58:22 2002
+++ pari-my/src/basemath/bibli2.c Tue Oct 29 17:13:18 2002
@@ -1056,7 +1056,11 @@ gen_sort(GEN x, int flag, int (*cmp)(GEN
long i,j,indxt,ir,l,tx=typ(x),lx=lg(x);
GEN q,y,indx;
- if (!is_matvec_t(tx) && tx != t_VECSMALL) err(typeer,"gen_sort");
+ if (!is_matvec_t(tx) && tx != t_VECSMALL) {
+ if (tx == t_EXT)
+ return GEN_ext_type(x)->sort((GEN_ext)x, flag, cmp);
+ err(typeer,"gen_sort");
+ }
if (flag & cmp_C) tx = t_VECSMALL;
else if (flag & cmp_IND) tx = t_VEC;
y = cgetg(lx, tx);
diff -pru pari/src/basemath/gen2.c pari-my/src/basemath/gen2.c
--- pari/src/basemath/gen2.c Tue Oct 15 17:33:58 2002
+++ pari-my/src/basemath/gen2.c Mon Oct 28 22:09:36 2002
@@ -147,6 +147,7 @@ glength(GEN x)
case t_REAL: return signe(x)? lg(x)-2: 0;
case t_STR: return strlen(GSTR(x));
case t_VECSMALL: return lg(x)-1;
+ case t_EXT: err(talker, "t_EXT in glength");
}
return lg(x)-lontyp[typ(x)];
}
@@ -562,6 +563,8 @@ gegal(GEN x, GEN y)
for (i = lg(x)-1; i; i--)
if (x[i] != y[i]) return 0;
return 1;
+ case t_EXT:
+ return 0 == GEN_ext_type(x)->cmp((GEN_ext)x, y, Pext_OP_cmp | extOP_SPECIAL);
}
av = avma; i = gegal_try(x, y);
avma = av; return i;
diff -pru pari/src/basemath/gen3.c pari-my/src/basemath/gen3.c
--- pari/src/basemath/gen3.c Wed Oct 23 14:58:22 2002
+++ pari-my/src/basemath/gen3.c Thu Oct 31 01:50:54 2002
@@ -1275,11 +1275,13 @@ ginv(GEN x)
for (i=1; i<lx; i++)
{
long xi=x[i];
- if (xi<1 || xi>=lx) err(talker,"incorrect permtuation to inverse");
+ if (xi<1 || xi>=lx) err(talker,"incorrect permutation to inverse");
y[xi] = i;
}
return y;
}
+ case t_EXT:
+ return GEN_ext_type(x)->pow((GEN_ext)x, 0, -1, 0, 0);
}
err(typeer,"inverse");
return NULL; /* not reached */
@@ -2404,6 +2406,16 @@ gtovec(GEN x)
return y;
}
if (tx == t_VECSMALL) return small_to_vec(x);
+ if (tx == t_EXT) {
+ pari_sp av = avma, tetpil;
+
+ x = GEN_ext_type(x)->get_GEN((GEN_ext)x, t_VEC);
+ if (tx == t_VEC)
+ return x;
+ tetpil = avma;
+ x = gtovec(x);
+ return gerepile(av,tetpil,x);
+ }
if (!signe(x)) { y=cgetg(2,t_VEC); y[1]=zero; return y; }
lx=lg(x); y=cgetg(lx-1,t_VEC); x++;
for (i=1; i<=lx-2; i++) y[i]=lcopy((GEN)x[i]);
@@ -2425,6 +2437,16 @@ gtovecsmall(GEN x)
u[1] = itos(x); return u;
}
if (tx == t_STR) return str_to_vecsmall(x);
+ if (tx == t_EXT) {
+ pari_sp av = avma, tetpil;
+
+ x = GEN_ext_type(x)->get_GEN((GEN_ext)x, t_VECSMALL);
+ if (tx == t_VECSMALL)
+ return x;
+ tetpil = avma;
+ x = gtovecsmall(x);
+ return gerepile(av,tetpil,x);
+ }
if (!is_vec_t(tx)) err(typeer,"vectosmall");
l = lg(x);
V = cgetg(l,t_VECSMALL);
@@ -2969,6 +2991,11 @@ simplify_i(GEN x)
case t_INT: case t_REAL: case t_FRAC:
case t_INTMOD: case t_PADIC: case t_QFR: case t_QFI:
case t_LIST: case t_STR: case t_VECSMALL:
+ return x;
+
+ case t_EXT:
+ if (GEN_ext_type(x)->simplify)
+ return GEN_ext_type(x)->simplify((GEN_ext)x);
return x;
case t_FRACN:
diff -pru pari/src/basemath/trans1.c pari-my/src/basemath/trans1.c
--- pari/src/basemath/trans1.c Tue Oct 15 17:34:00 2002
+++ pari-my/src/basemath/trans1.c Tue Oct 29 16:54:10 2002
@@ -267,6 +267,8 @@ puiss0(GEN x)
y = cgetg(lx, t_VECSMALL);
for (i=1; i<lx; i++) y[i] = i;
return y;
+ case t_EXT:
+ return GEN_ext_type(x)->pow((GEN_ext)x, 0, 0, 0, 0);
default: err(typeer,"gpowgs");
return NULL; /* not reached */
}
@@ -438,6 +440,10 @@ gpowgs(GEN x, long n)
if (n<0) y=ginv(y); /* let ginv worry about normalizations */
return gerepileupto(av,y);
}
+ case t_EXT:
+ if (GEN_ext_type(x)->pow != GEN_EXT_pow_generic)
+ return GEN_ext_type(x)->pow((GEN_ext)x, 0, n, 0, 0);
+ /* FALL THROUGH */
default:
m = labs(n);
av=avma; y=NULL; lim=stack_lim(av,1);
diff -pru pari/src/gp/highlvl.c pari-my/src/gp/highlvl.c
--- pari/src/gp/highlvl.c Thu Aug 15 03:13:24 2002
+++ pari-my/src/gp/highlvl.c Wed Oct 23 23:25:14 2002
@@ -157,6 +157,7 @@ get_type_num(char *st)
if (!strcmp(st,"COL")) return t_COL;
if (!strcmp(st,"MAT")) return t_MAT;
if (!strcmp(st,"STR")) return t_STR;
+ if (!strcmp(st,"EXT")) return t_EXT;
break;
case 4:
diff -pru pari/src/headers/paricom.h pari-my/src/headers/paricom.h
--- pari/src/headers/paricom.h Tue Oct 15 17:34:02 2002
+++ pari-my/src/headers/paricom.h Thu Oct 31 00:54:14 2002
@@ -30,6 +30,14 @@ Foundation, Inc., 59 Temple Place - Suit
* [ avoid "dangling else" problem in macros ] */
#define STMT_START do
#define STMT_END while (0)
+
+#if defined(STANDARD_C) && defined(I_STDDEF)
+# include <stddef.h>
+# define STRUCT_OFFSET(s,m) offsetof(s,m)
+#else
+# define STRUCT_OFFSET(s,m) ((Size_t)(&(((s *)0)->m)))
+#endif
+
/*=====================================================================*/
/* CATCH(numer) {
* recovery
diff -pru pari/src/headers/paridecl.h pari-my/src/headers/paridecl.h
--- pari/src/headers/paridecl.h Wed Oct 23 14:58:24 2002
+++ pari-my/src/headers/paridecl.h Thu Oct 31 01:22:18 2002
@@ -1053,6 +1053,16 @@ long taille(GEN x);
long taille2(GEN x);
long timer(void);
long timer2(void);
+char * GEN_EXT_get_name_generic(GEN_ext x);
+GEN GEN_EXT_binop_generic(GEN_ext arg, GEN other, enum Pext_bin_t flags);
+GEN GEN_EXT_divrem_generic(GEN_ext arg, GEN other, enum Pext_bin_t flags, long v);
+long GEN_EXT_lbinop_generic(GEN_ext arg, GEN other, enum Pext_bin_t flags);
+GEN GEN_EXT_shift_generic(GEN_ext g, GEN shift, long l_shift, enum Pext_bin_t flags, long flag);
+GEN GEN_EXT_pow_generic(GEN_ext arg, GEN other, long lother, enum Pext_bin_t flags, long prec);
+GEN GEN_EXT_sort_generic(GEN_ext x, int flag, int (*cmp)(GEN,GEN));
+GEN GEN_EXT_get_GEN_generic(GEN_ext g, enum PARI_type prefer_type);
+GEN GEN_EXT_get_nth_generic(GEN_ext g, GEN nn, long n);
+long GEN_EXT_sign_generic(GEN_ext g);
/* mp.c ou mp.s */
diff -pru pari/src/headers/paristio.h pari-my/src/headers/paristio.h
--- pari/src/headers/paristio.h Tue Oct 15 17:34:02 2002
+++ pari-my/src/headers/paristio.h Thu Oct 31 01:26:10 2002
@@ -20,7 +20,7 @@ typedef struct {
} pari_timer;
typedef unsigned char *byteptr;
-typedef ulong pari_sp;
+typedef unsigned long Size_t;
typedef struct stackzone
{
diff -pru pari/src/headers/paritype.h pari-my/src/headers/paritype.h
--- pari/src/headers/paritype.h Tue Mar 19 04:11:48 2002
+++ pari-my/src/headers/paritype.h Thu Oct 24 12:10:28 2002
@@ -18,28 +18,32 @@ Foundation, Inc., 59 Temple Place - Suit
* - lontyp/lontyp2 in gen2.c
* - the assembly file mp.s...
*/
-#define t_SMALL 0
-#define t_INT 1
-#define t_REAL 2
-#define t_INTMOD 3
-#define t_FRAC 4
-#define t_FRACN 5
-#define t_COMPLEX 6
-#define t_PADIC 7
-#define t_QUAD 8
-#define t_POLMOD 9
-#define t_POL 10
-#define t_SER 11
-#define t_RFRAC 13
-#define t_RFRACN 14
-#define t_QFR 15
-#define t_QFI 16
-#define t_VEC 17
-#define t_COL 18
-#define t_MAT 19
-#define t_LIST 20
-#define t_STR 21
-#define t_VECSMALL 22
+enum PARI_type {
+ t_SMALL,
+ t_INT,
+ t_REAL,
+ t_INTMOD,
+ t_FRAC,
+ t_FRACN,
+ t_COMPLEX,
+ t_PADIC,
+ t_QUAD,
+ t_POLMOD,
+ t_POL,
+ t_SER,
+ dummy_t_1,
+ t_RFRAC,
+ t_RFRACN,
+ t_QFR,
+ t_QFI,
+ t_VEC,
+ t_COL,
+ t_MAT,
+ t_LIST,
+ t_STR,
+ t_VECSMALL,
+ t_EXT,
+};
#define is_recursive_t(t) (lontyp[t])
diff -pru pari/src/language/anal.c pari-my/src/language/anal.c
--- pari/src/language/anal.c Wed Oct 23 14:58:26 2002
+++ pari-my/src/language/anal.c Thu Oct 31 14:00:50 2002
@@ -920,7 +920,7 @@ typedef struct matcomp
GEN *ptcell;
GEN parent;
int full_col, full_row;
- void *extra; /* so far used by check_pointers only */
+ GEN oldvalue; /* so far used by check_pointers only */
} matcomp;
/* Return the content of the matrix cell and sets members of corresponding
@@ -988,10 +988,13 @@ matcell(GEN p, matcomp *C)
}
else
{
- GEN p2 = cgetg(lg(p),t_VEC);
+ GEN dummy = cgetg(2,t_VEC), p2;
+
+ p2 = cgetg(lg(p),t_VEC);
full_row = r; /* record row number */
for (c=1; c<lg(p); c++) p2[c] = coeff(p,r,c);
- pt = &p2;
+ dummy[1] = (long)p2;
+ pt = (GEN*)(dummy + 1); /* *pt may be written to later */
}
}
else
@@ -1002,13 +1005,46 @@ matcell(GEN p, matcomp *C)
}
break;
+ case t_EXT:
+ {
+ GEN i, j, p2;
+ GEN dummy = cgetg(2,t_VEC);
+
+ if (*analyseur == ',') /* Whole column */
+ i = WHOLE_VECTOR;
+ else
+ i = expr();
+ if (*analyseur == ',') {
+ analyseur++;
+ if (*analyseur == ']') /* Whole row */
+ j = WHOLE_VECTOR;
+ else
+ j = expr();
+ match(']');
+ if (!GEN_ext_type(p)->get_nth2)
+ err(talker, "t_EXT does not support matrix indexing");
+ p2 = GEN_ext_type(p)->get_nth2((GEN_ext)p,i,j,0,0);
+ full_col = (long)i; /* Keep row/col number */
+ full_row = (long)j;
+ } else {
+ match(']');
+ p2 = GEN_ext_type(p)->get_nth((GEN_ext)p,i,0);
+ full_col = (long)i; /* Keep it */
+ full_row = 0;
+ }
+ dummy[1] = (long)p2;
+ pt = (GEN*)(dummy + 1); /* *pt may be written to later */
+ }
+ break;
+
default:
err(caracer1,analyseur-1,mark.start);
}
} while (*analyseur == '[');
C->full_row = full_row;
C->full_col = full_col;
- C->parent = p; C->ptcell = pt;
+ C->parent = p;
+ C->ptcell = pt;
return (tx == t_VECSMALL)? stoi((long)*pt): *pt;
}
@@ -1262,6 +1298,18 @@ change_compo(matcomp *c, GEN res)
err(talker2,"not a suitable VECSMALL component",old,mark.start);
*pt = (GEN)itos(res); return res;
}
+ if (typ(p) == t_EXT) {
+ if (!full_row) { /* Vector component */
+ if (!GEN_ext_type(p)->set_nth)
+ err(talker, "t_EXT does not support vector assignment");
+ GEN_ext_type(p)->set_nth((GEN_ext)p,(GEN)full_col,0,res);
+ return res;
+ }
+ if (!GEN_ext_type(p)->set_nth2)
+ err(talker, "t_EXT does not support matrix assignment");
+ GEN_ext_type(p)->set_nth2((GEN_ext)p,(GEN)full_col,(GEN)full_row,0,0, res);
+ return res;
+ }
if (full_row)
{
if (typ(res) != t_VEC || lg(res) != lg(p)) err(caseer2,old,mark.start);
@@ -1553,9 +1601,9 @@ check_pointers(unsigned int ptrs, matcom
{
matcomp *c = init[i];
GEN *pt = c->ptcell, x = gclone(*pt);
- if (c->parent == NULL)
+ if (c->parent == NULL) /* pt == (GEN*)&ep->value; */
{
- if (isclone(c->extra)) killbloc((GEN)c->extra);
+ if (isclone(c->oldvalue)) killbloc((GEN)c->oldvalue);
*pt = x;
}
else
@@ -1857,7 +1905,7 @@ identifier(void)
{
c->parent = NULL;
c->ptcell = (GEN*)&ep->value;
- c->extra = (GEN*)ep->value;
+ c->oldvalue = ep->value;
}
has_pointer |= (1 << i);
init[i] = c;
diff -pru pari/src/language/anal.h pari-my/src/language/anal.h
--- pari/src/language/anal.h Sun Aug 25 15:21:40 2002
+++ pari-my/src/language/anal.h Thu Oct 24 02:58:06 2002
@@ -257,7 +257,7 @@ void write1 (char *s, GEN *g);
void writetex(char *s, GEN *g);
/* for output */
-typedef struct {
+typedef struct pariout_t {
char format; /* e,f,g */
long fieldw; /* 0 (ignored) or field width */
long sigd; /* -1 (all) or number of sign. digits printed */
diff -pru pari/src/language/es.c pari-my/src/language/es.c
--- pari/src/language/es.c Wed Oct 23 14:58:26 2002
+++ pari-my/src/language/es.c Mon Oct 28 19:44:34 2002
@@ -983,7 +983,9 @@ voir2(GEN x, long nb, long bl)
vsigne(x), varn(x),lg(x)-2, valp(x));
else if (tx == t_LIST)
pariputsf("(lgef=%ld):", lgef(x));
-
+ else if (tx == t_EXT)
+ pariputsf("(ext_type=%s):", GEN_ext_type(x)->get_name((GEN_ext)x));
+
if (tx == t_POL || tx == t_LIST) lx = lgef(x);
for (i=1; i<lx; i++) sorstring(VOIR_STRING2,x[i]);
bl+=2; pariputc('\n');
@@ -1047,6 +1049,19 @@ voir2(GEN x, long nb, long bl)
blancs(bl); pariputsf("mat(%ld,%ld) = ",i,j);
voir2(gcoeff(x,i,j),nb,bl);
}
+
+ case t_EXT:
+ if (GEN_ext_type(x)->dump)
+ GEN_ext_type(x)->dump((GEN_ext)x, bl);
+ else if (GEN_ext_type(x)->get_GEN) {
+ pari_sp try_av = avma;
+ GEN tmp = GEN_ext_type(x)->get_GEN((GEN_ext)x,t_UNKNOWN);
+
+ if (isonstack(tmp)) blancs(bl); else { blancs(bl-2); pariputs("* "); }
+ pariputs("equivalent_to = ");
+ voir2(tmp,nb,bl);
+ avma = try_av;
+ }
}
}
@@ -1084,6 +1099,7 @@ type_name(long t)
case t_LIST : s="t_LIST"; break;
case t_STR : s="t_STR"; break;
case t_VECSMALL:s="t_VECSMALL";break;
+ case t_EXT : s="t_EXT"; break;
default: err(talker,"unknown type %ld",t);
s = NULL; /* not reached */
}
@@ -1561,6 +1577,19 @@ bruti(GEN g, pariout_t *T, int nosign)
pariputc(']'); if (l==2) pariputc(')');
break;
+ case t_EXT:
+ if (GEN_ext_type(g)->write)
+ GEN_ext_type(g)->write((GEN_ext)g, T, nosign);
+ else if (GEN_ext_type(g)->get_GEN) {
+ pari_sp try_av = avma;
+
+ g = GEN_ext_type(g)->get_GEN((GEN_ext)g,t_UNKNOWN);
+ bruti(g, T, nosign);
+ avma = try_av;
+ break;
+ }
+ /* FALL THROUGH */
+
default: sorstring(VOIR_STRING2,*g);
}
}
@@ -1783,6 +1812,20 @@ sori(GEN g, pariout_t *T)
}
break;
}
+
+ case t_EXT:
+ if (GEN_ext_type(g)->write)
+ GEN_ext_type(g)->write((GEN_ext)g, T, 0);
+ else if (GEN_ext_type(g)->get_GEN) {
+ pari_sp try_av = avma;
+
+ g = GEN_ext_type(g)->get_GEN((GEN_ext)g,t_UNKNOWN);
+ sori(g, T);
+ avma = try_av;
+ break;
+ }
+ /* FALL THROUGH */
+
default: sorstring(VOIR_STRING2,*g);
}
if (close_paren) pariputc(')');
diff -pru pari/src/language/init.c pari-my/src/language/init.c
--- pari/src/language/init.c Wed Oct 23 14:58:26 2002
+++ pari-my/src/language/init.c Thu Oct 31 14:12:10 2002
@@ -671,6 +671,10 @@ inspect(GEN x)
lx = lgef(x);
for (i=2;i<lx;i++) inspect((GEN)x[i]);
break;
+ case t_EXT:
+ if (GEN_ext_type(x)->remove)
+ GEN_ext_type(x)->remove((GEN_ext)x);
+ break;
}
if (isclone(x)) gunclone(x); /* Don't inspect here! components are dead */
}
@@ -1236,12 +1240,15 @@ gcopy(GEN x)
if (tx == t_SMALL) return x;
if (! is_recursive_t(tx))
{
+ word_by_word:
if (tx == t_INT && !signe(x)) return gzero; /* very common case */
lx = lg(x); y = new_chunk(lx);
for (i=lx-1; i>=0; i--) y[i]=x[i];
- }
- else
- {
+ } else if (tx == t_EXT) {
+ if (!GEN_ext_type(x)->copy)
+ goto word_by_word;
+ y = GEN_ext_type(x)->copy((GEN_ext)x, (GEN*)&avma, NORMAL_COPY);
+ } else {
lx = lg(x); y = new_chunk(lx);
if (tx==t_POL || tx==t_LIST) lx = lgef(x);
for (i=0; i<lontyp[tx]; i++) y[i]=x[i];
@@ -1258,11 +1265,16 @@ gcopy_i(GEN x, long lx)
GEN y;
if (tx == t_SMALL) return x;
- y=cgetg(lx,tx);
- if (! is_recursive_t(tx))
+ if (! is_recursive_t(tx)) {
+ word_by_word:
+ y=cgetg(lx,tx);
for (i=lx-1; i>0; i--) y[i]=x[i];
- else
- {
+ } else if (tx == t_EXT) {
+ if (!GEN_ext_type(x)->copy)
+ goto word_by_word;
+ y = GEN_ext_type(x)->copy((GEN_ext)x, (GEN*)&avma, NORMAL_COPY);
+ } else {
+ y=cgetg(lx,tx);
for (i=1; i<lontyp[tx]; i++) y[i]=x[i];
for ( ; i<lontyp2[tx]; i++) copyifstack(x[i],y[i]);
for ( ; i<lx; i++) y[i]=lcopy((GEN)x[i]);
@@ -1279,12 +1291,15 @@ forcecopy(GEN x)
if (tx == t_SMALL) return x;
if (! is_recursive_t(tx))
{
+ word_by_word:
if (tx == t_INT && !signe(x)) return gzero; /* very common case */
lx = lg(x); y = new_chunk(lx);
for (i=lx-1; i>=0; i--) y[i]=x[i];
- }
- else
- {
+ } else if (tx == t_EXT) {
+ if (!GEN_ext_type(x)->copy)
+ goto word_by_word;
+ y = GEN_ext_type(x)->copy((GEN_ext)x, (GEN*)&avma, FORCE_COPY);
+ } else {
lx = lg(x); y = new_chunk(lx);
if (tx==t_POL || tx==t_LIST) lx = lgef(x);
for (i=0; i<lontyp[tx]; i++) y[i]=x[i];
@@ -1321,13 +1336,17 @@ gcopy_av(GEN x, GEN *AVMA)
GEN y;
if (tx == t_SMALL) return x;
- lx = lg(x); *AVMA = y = *AVMA - lx;
if (! is_recursive_t(tx))
{
+ word_by_word:
+ lx = lg(x); *AVMA = y = *AVMA - lx;
for (i=0; i<lx; i++) y[i] = x[i];
- }
- else
- {
+ } else if (tx == t_EXT) {
+ if (!GEN_ext_type(x)->copy)
+ goto word_by_word;
+ y = GEN_ext_type(x)->copy((GEN_ext)x, AVMA, FORCE_COPY);
+ } else {
+ lx = lg(x); *AVMA = y = *AVMA - lx;
if (tx==t_POL || tx==t_LIST) lx = lgef(x);
for (i=0; i<lontyp[tx]; i++) y[i] = x[i];
for ( ; i<lx; i++) y[i] = (long)gcopy_av((GEN)x[i], AVMA);
@@ -1346,11 +1365,14 @@ gcopy_av0(GEN x, GEN *AVMA)
{
if (tx == t_INT && !signe(x)) return NULL; /* special marker */
if (tx == t_SMALL) return x;
+ word_by_word:
lx = lg(x); *AVMA = y = *AVMA - lx;
for (i=0; i<lx; i++) y[i] = x[i];
- }
- else
- {
+ } else if (tx == t_EXT) {
+ if (!GEN_ext_type(x)->copy)
+ goto word_by_word;
+ y = GEN_ext_type(x)->copy((GEN_ext)x, AVMA, FORCE_COPY0);
+ } else {
lx = lg(x); *AVMA = y = *AVMA - lx;
if (tx==t_POL || tx==t_LIST) lx = lgef(x);
for (i=0; i<lontyp[tx]; i++) y[i] = x[i];
@@ -1368,9 +1390,11 @@ taille0(GEN x)
{
if (tx == t_INT && !signe(x)) return 0;
n = lg(x);
- }
- else
- {
+ } else if (tx == t_EXT) {
+ if (!GEN_ext_type(x)->copy_len)
+ return lg(x);
+ return GEN_ext_type(x)->copy_len((GEN_ext)x, FORCE_COPY0);
+ } else {
n = lg(x);
lx = (tx==t_POL || tx==t_LIST)? lgef(x): n;
for (i=lontyp[tx]; i<lx; i++) n += taille0((GEN)x[i]);
@@ -1385,6 +1409,11 @@ taille(GEN x)
n = lg(x);
if (is_recursive_t(tx))
{
+ if (tx == t_EXT) {
+ if (!GEN_ext_type(x)->copy_len)
+ return n;
+ return GEN_ext_type(x)->copy_len((GEN_ext)x, FORCE_COPY);
+ }
lx = (tx==t_POL || tx==t_LIST)? lgef(x): n;
for (i=lontyp[tx]; i<lx; i++) n += taille((GEN)x[i]);
}
@@ -1401,12 +1430,20 @@ gclone(GEN x)
GEN y = newbloc(t);
if (!is_recursive_t(tx))
{
+ word_by_word:
lx = (tx==t_INT)? lgefint(x): lg(x);
for (i=0; i<lx; i++) y[i] = x[i];
- }
- else
- {
+ } else if (tx == t_EXT) {
+ GEN AVMA = y+t, newy;
+
+ if (!GEN_ext_type(x)->copy)
+ goto word_by_word;
+ newy = GEN_ext_type(x)->copy((GEN_ext)x, &AVMA, FRONT_FORCE_COPY);
+ if (y != AVMA || y != newy)
+ err(talker, "t_EXT size mismatch in gclone");
+ } else {
GEN AVMA = y+t;
+
lx = (tx==t_POL || tx==t_LIST)? lgef(x): lg(x);
for (i=0; i<lontyp[tx]; i++) y[i] = x[i];
for ( ; i<lx; i++) y[i] = (long)gcopy_av((GEN)x[i], &AVMA);
@@ -1420,6 +1457,11 @@ shiftaddress(GEN x, long dec)
long i,lx,tx;
tx = typ(x);
+ if (tx == t_EXT) {
+ if (GEN_ext_type(x)->shift_address)
+ GEN_ext_type(x)->shift_address((GEN_ext)x, dec, 0, 0, 0); /* recursive */
+ return;
+ }
if (is_recursive_t(tx))
{
lx = (tx==t_POL || tx==t_LIST)? lgef(x): lg(x);
@@ -1657,7 +1699,13 @@ gerepile(pari_sp av, pari_sp tetpil, GEN
if (! is_recursive_t(tl)) { ll+=lg(ll); continue; }
a = ll+lontyp[tl];
- if (tl==t_POL) { b=ll+lgef(ll); ll+=lg(ll); } else { ll+=lg(ll); b=ll; }
+ if (tl==t_POL) { b=ll+lgef(ll); ll+=lg(ll); }
+ else if (tl == t_EXT) {
+ if (GEN_ext_type(ll)->shift_address)
+ GEN_ext_type(ll)->shift_address((GEN_ext)ll, dec, avma, av, tetpil);
+ ll += lg(ll);
+ b = a; /* Do not correct anything */
+ } else { ll+=lg(ll); b=ll; }
for ( ; a<b; a++)
if ((pari_sp)*a < av && (pari_sp)*a >= avma)
{
@@ -1734,6 +1782,432 @@ fill_stack(void)
{
GEN x = ((GEN)bot);
while (x < (GEN)avma) *x++ = 0xfefefefeUL;
+}
+
+/*******************************************************************/
+/* */
+/* Convenience functions for GEN_ext */
+/* */
+/*******************************************************************/
+
+char *
+GEN_EXT_get_name_generic(GEN_ext x)
+{
+ char *name = GEN_ext_type(x)->name;
+
+ if (!name)
+ name = "t_EXT";
+ return name;
+}
+
+GEN
+GEN_EXT_get_GEN_generic(GEN_ext x, enum PARI_type prefer_type)
+{
+ err(talker, "%s not convertable to GEN",
+ GEN_ext_type(x)->get_name((GEN_ext)x));
+ /* NOT REACHED */
+ return 0;
+}
+
+GEN
+GEN_EXT_sort_generic(GEN_ext l, int flag, int (*cmp)(GEN,GEN))
+{
+ pari_sp av = avma, tetpil;
+ GEN x = GEN_ext_type(l)->get_GEN((GEN_ext)l, t_VEC);
+
+ tetpil = avma;
+ x = gen_sort(x, flag, cmp);
+ return gerepile(av,tetpil,x);
+}
+
+GEN
+GEN_EXT_binop_generic(GEN_ext arg, GEN other, enum Pext_bin_t flags)
+{
+ pari_sp av = avma, tetpil;
+ GEN x = GEN_ext_type(arg)->get_GEN((GEN_ext)arg, t_UNKNOWN);
+
+ tetpil = avma;
+ if (flags & extOP_FLIPARG) {
+ GEN x1 = x;
+
+ x = other; other = x1;
+ }
+ switch (flags & Pext_OP_MASK) {
+ case Pext_OP_add:
+ x = gadd(x,other);
+ break;
+ case Pext_OP_sub:
+ x = gsub(x,other);
+ break;
+ case Pext_OP_mul:
+ x = gmul(x,other);
+ break;
+ case Pext_OP_div:
+ x = gdiv(x,other);
+ break;
+ case Pext_OP_divent:
+ x = gdivent(x,other);
+ break;
+ case Pext_OP_divround:
+ x = gdivround(x,other);
+ break;
+ case Pext_OP_mod:
+ x = gmod(x,other);
+ break;
+ default:
+ err(talker, "panic: binop");
+ }
+ return gerepile(av,tetpil,x);
+}
+
+GEN
+GEN_EXT_divrem_generic(GEN_ext arg, GEN other, enum Pext_bin_t flags, long v)
+{
+ pari_sp av = avma, tetpil;
+ GEN x = GEN_ext_type(arg)->get_GEN((GEN_ext)arg, t_UNKNOWN);
+
+ tetpil = avma;
+ if (flags & extOP_FLIPARG) {
+ GEN x1 = x;
+
+ x = other; other = x1;
+ }
+ x = divrem(x,other,v);
+ return gerepile(av,tetpil,x);
+}
+
+/* Important special cases: lother==-1, lother==0 [how to handle this?] */
+GEN
+GEN_EXT_pow_generic(GEN_ext arg, GEN other, long lother, enum Pext_bin_t flags, long prec)
+{
+ pari_sp av = avma, tetpil;
+ GEN x;
+
+ if (other == 0) { /* Automatically no fliparg */
+ /* prec is not applicable */
+ if (lother == -1)
+ return GEN_ext_type(arg)->div((GEN_ext)arg, gun, Pext_OP_div | extOP_FLIPARG);
+ if (lother) {
+ pari_sp av = avma, tetpil;
+ GEN x = GEN_ext_type(arg)->get_GEN((GEN_ext)arg, t_UNKNOWN);
+
+ tetpil = avma;
+ x = gpowgs(x, lother > 0 ? lother : -lother);
+ if (lother < 0) {
+ tetpil = avma;
+ x = ginv(x);
+ }
+ return gerepile(av,tetpil,x);
+ }
+ other = gnil;
+ }
+
+ x = GEN_ext_type(arg)->get_GEN((GEN_ext)arg, t_UNKNOWN);
+ tetpil = avma;
+ if (flags & extOP_FLIPARG) {
+ GEN x1 = x;
+
+ x = other; other = x1;
+ }
+ x = gpow(x,other,prec);
+ return gerepile(av,tetpil,x);
+}
+
+GEN
+GEN_EXT_shift_generic(GEN_ext g, GEN shift, long l_shift, enum Pext_bin_t flags, long flag)
+{
+ pari_sp av = avma, tetpil;
+ GEN x = (GEN)g;
+
+ if (flags & extOP_FLIPARG) { /* No l_shift... */
+ x = GEN_ext_type(g)->get_GEN((GEN_ext)g, t_INT);
+ if (typ(x) != t_INT)
+ err(talker, "Can't convert t_EXT to int");
+ l_shift = itos(x);
+ x = shift;
+ } else if (shift != 0) {
+ if (typ(shift) != t_INT)
+ err(talker, "Shift should be t_INT");
+ l_shift = itos(shift);
+ x = GEN_ext_type(g)->get_GEN((GEN_ext)g, t_UNKNOWN);
+ }
+ tetpil = avma;
+ x = gshift3(x,l_shift,flag);
+ return gerepile(av,tetpil,x);
+}
+
+long
+GEN_EXT_lbinop_generic(GEN_ext arg, GEN other, enum Pext_bin_t flags)
+{
+ pari_sp av = avma;
+ GEN x = GEN_ext_type(arg)->get_GEN((GEN_ext)arg, t_UNKNOWN), o = other;
+ long out;
+
+ if (flags & extOP_FLIPARG) {
+ GEN x1 = x;
+
+ x = other; other = x1;
+ }
+ switch (flags & Pext_OP_MASK) {
+ case Pext_OP_cmp:
+ if (typ(o) != t_EXT) /* Put t_EXT on top of each other */
+ out = 1;
+ else if (flags & extOP_SPECIAL)
+ out = !gegal(x, GEN_ext_type(o)->get_GEN((GEN_ext)o, t_UNKNOWN));
+ else
+ out = !gcmp(x, GEN_ext_type(o)->get_GEN((GEN_ext)o, t_UNKNOWN));
+ break;
+ case Pext_OP_lex:
+ out = lexcmp(x,other); /* XXXX Probably not very correct... */
+ break;
+ default:
+ err(talker, "panic: binop");
+ }
+ avma = av;
+ if (flags & extOP_FLIPARG)
+ return -out;
+ return out;
+}
+
+GEN
+GEN_EXT_get_nth_generic(GEN_ext g, GEN nn, long n)
+{
+ pari_sp av = avma, tetpil;
+ GEN x = GEN_ext_type(g)->get_GEN((GEN_ext)g, t_VEC);
+
+ if (!is_vec_t(typ(x)))
+ err(talker, "Wrapped GEN is not a vector");
+ if (nn) {
+ if (typ(nn) != t_INT)
+ err(talker, "Can't convert offset to int");
+ n = itos(nn);
+ }
+ if (n <= 0 || n >= lg(x))
+ err(talker, "array index (%ld) out of allowed range", n);
+ tetpil = avma;
+ x = gcopy((GEN)x[n]);
+ return gerepile(av,tetpil,x);
+}
+
+static GEN
+GEN_EXT_get_idx_generic(GEN_ext g, GEN elt)
+{
+ pari_sp av = avma;
+ GEN x = GEN_ext_type(g)->get_GEN((GEN_ext)g, t_VEC);
+ long idx;
+
+ if (!is_vec_t(typ(x)))
+ err(talker, "Wrapped GEN is not a vector");
+ if (elt == LAST_ELT)
+ idx = lg(x);
+ else if (elt == FIRST_ELT)
+ idx = 1;
+ else
+ err(talker, "Wrapped GEN is not indexable");
+ av = avma;
+ return (GEN)(1 | (idx<<1));
+}
+
+long
+GEN_EXT_sign_generic(GEN_ext g)
+{
+ GEN x = GEN_ext_type(g)->get_GEN((GEN_ext)g, t_VEC);
+ long tx = typ(x);
+
+ switch (tx) { /* as in gcmp0() */
+ case t_INT: case t_REAL:
+ return signe(x);
+ }
+ return !gcmp0(x);
+}
+
+/*******************************************************************/
+/* */
+/* Methods for GEN_ext wrapper type */
+/* */
+/*******************************************************************/
+
+struct GEN_ext_Wrapped {
+ struct GEN_ext_base base;
+ long subtype;
+ GEN data[1]; /* Actual size (g)->type->data + 1 */
+};
+
+#define WRAPPED(g) (((struct GEN_ext_Wrapped*)g)->data[(g)->type->data])
+
+/* No need of gcopy() */
+static GEN
+Wrapper_get_nth(GEN_ext g, GEN nn, long n)
+{
+ GEN x = WRAPPED(g);
+
+ if (!is_vec_t(typ(x)))
+ err(talker, "Wrapped GEN is not a vector");
+ if (nn) {
+ if (typ(nn) != t_INT)
+ err(talker, "Can't convert offset to int");
+ n = itos(nn);
+ }
+ if (n <= 0 || n >= lg(x))
+ err(talker, "array index (%ld) out of allowed range", n);
+ return (GEN)(x[n]);
+}
+
+static void
+Wrapper_set_nth(GEN_ext g, GEN nn, long n, GEN value)
+{
+ GEN x = WRAPPED(g);
+
+ if (!is_vec_t(typ(x)))
+ err(talker, "Wrapped GEN is not a vector");
+ if (nn) {
+ if (typ(nn) != t_INT)
+ err(talker, "Can't convert offset to int");
+ n = itos(nn);
+ }
+ if (n <= 0 || n >= lg(x))
+ err(talker, "array index (%ld) out of allowed range", n);
+ if (isclone(x[n]))
+ killbloc((GEN)x[n]);
+ if (!isonstack(g) && !isclone(value))
+ value = gclone(value);
+ x[n] = (long)value;
+}
+
+ /* Returns t_SMALL for the values which fit; elt may be LAST_ELT etc;
+ Returns 0 if the element is not there, or if a particular operation makes no sense */
+static GEN
+Wrapper_get_GEN(GEN_ext g, enum PARI_type prefer_type)
+{
+ return WRAPPED(g);
+}
+
+static GEN
+Wrapper_copy(GEN_ext g, GEN *AVMA, enum ext_copy_t flag)
+{
+ GEN x = (GEN)g;
+ GEN w = WRAPPED(g);
+ GEN y, ret;
+
+ if (flag != FRONT_FORCE_COPY) {
+ GEN end = *AVMA;
+
+ *AVMA -= lg(x);
+ ret = y = *AVMA;
+ while (y < end - 1)
+ *y++ = *x++;
+ }
+ switch (flag) {
+ case NORMAL_COPY:
+ *y = lcopy(w);
+ break;
+ case FORCE_COPY:
+ *y = (long)gcopy_av(w, AVMA);
+ break;
+ case FRONT_FORCE_COPY:
+ {
+ GEN kid = gcopy_av(w, AVMA);
+ GEN end = *AVMA;
+
+ *AVMA -= lg(x);
+ ret = y = *AVMA;
+ while (y < end - 1)
+ *y++ = *x++;
+ *y = (long)kid;
+ break;
+ }
+ case FORCE_COPY0:
+ *y = (long)gcopy_av0(w, AVMA);
+ break;
+ }
+ return ret;
+}
+
+long
+Wrapper_copy_len(GEN_ext g, enum ext_copy_t flag) /* as taille0() etc */
+{
+ GEN x = WRAPPED(g);
+ long delta = lg((GEN)g);
+
+ switch (flag) {
+ case NORMAL_COPY:
+ case FRONT_FORCE_COPY:
+ err(talker, "panic: copy_len");
+ case FORCE_COPY:
+ return delta + taille(x);
+ case FORCE_COPY0:
+ return delta + taille0(x);
+ }
+ /* NOT REACHED */
+ return 0;
+}
+
+/* Called after g (+ additional memory as per copy_len()) was memcopy()ed: */
+void
+Wrapper_shift_address(GEN_ext g, long delta, pari_sp move_start, pari_sp move_end, pari_sp valid_end)
+{
+ GEN *px = &WRAPPED(g);
+
+ *px += delta;
+ if (!move_start) /* Recursive */
+ shiftaddress(*px, delta);
+}
+
+GEN_ext_TYPE GEN_ext_wrapper = {
+ "t_EXT_wrapper", /* char *name; */ /* used by GEN_EXT_get_name_generic() */
+ 0, /* ulong isa_flags; */ /* public: may be used later in is_vec_t() etc */
+ 0, /* offset of the wrapped GEN - increasing this may put extra words */
+
+ /* Mandatory methods; one should use GEN_EXT_*_generic as placeholders */
+ &GEN_EXT_get_name_generic,
+ &Wrapper_get_GEN, /* &GEN_EXT_get_GEN_generic, */
+ &GEN_EXT_sort_generic,
+
+ /* These are called with flags, so that the same C subroutine may be used */
+ &GEN_EXT_binop_generic,
+ /* May be used for gneg() too (g1 == 0 and extOP_FLIPARG) */
+ &GEN_EXT_binop_generic,
+ &GEN_EXT_binop_generic,
+ /* May be used for ginv() too */
+ &GEN_EXT_binop_generic,
+ &GEN_EXT_binop_generic,
+ &GEN_EXT_binop_generic,
+ &GEN_EXT_binop_generic,
+
+ /* flags: extOP_FLIPARG, pow==0 means use lpow (then no FLIPARG);
+ when using lpow one should disregard prec */
+ &GEN_EXT_pow_generic,
+ &GEN_EXT_shift_generic,
+ &GEN_EXT_divrem_generic,
+ &GEN_EXT_lbinop_generic,
+ &GEN_EXT_lbinop_generic,
+ &GEN_EXT_sign_generic,
+ &Wrapper_get_nth,
+ &GEN_EXT_get_idx_generic,
+
+ /* Copy to/from stack; NULL if relocatable */
+ &Wrapper_copy,
+ &Wrapper_copy_len,
+ &Wrapper_shift_address,
+ 0, /* remove() */
+
+ /* Vector accessors */
+ &Wrapper_set_nth,
+};
+
+GEN_ext
+new_WRAPPED(GEN w, long t)
+{
+ long l = STRUCT_OFFSET(struct GEN_ext_Wrapped, data)/sizeof(long)
+ + GEN_ext_wrapper.data + 1;
+ GEN y = new_chunk(l);
+ struct GEN_ext_Wrapped* g = (struct GEN_ext_Wrapped *)y;
+
+ g->base.code = evaltyp(t_EXT) | evallg(l);
+ g->base.type = &GEN_ext_wrapper;
+ g->subtype = t;
+ g->data[GEN_ext_wrapper.data] = gcopy(w);
+ return (GEN_ext)g;
}
/*******************************************************************/