OpenXM_contrib/pari-2.2/src/language/es.c - diff

Return to es.c CVS log

Up to [local] / OpenXM_contrib / pari-2.2 / src / language

Diff for /OpenXM_contrib/pari-2.2/src/language/Attic/es.c between version 1.1 and 1.2

version 1.1, 2001/10/02 11:17:10

version 1.2, 2002/09/11 07:27:03

Line 22 Foundation, Inc., 59 Temple Place - Suite 330, Boston,

#include "anal.h"

extern GEN confrac(GEN x); /* should be static here, but use hiremainder */

extern GEN convi(GEN x);

static void bruti(GEN g, long n);

static void texi(GEN g, long nosign);

static void sori(GEN g);

char * type_name(long t);

static char format;

static long decimals, chmp, initial;

/* output a space or do nothing depending on original caller */

static void (*sp)();

void

hit_return()

hit_return(void)

{

int c;

if (under_texmacs || under_emacs) return;

if (GP_DATA && (GP_DATA->flags & (EMACS|TEXMACS))) return;

pariputs("---- (type RETURN to continue) ----");

/* if called from a readline callback, may be in a funny TTY mode, */

do c = fgetc(stdin); while (c >= 0 && c != '\n' && c != '\r' && c != ' ');

Line 48 hit_return()

Line 40 hit_return()

/** INPUT FILTER **/

/** **/

/********************************************************************/

#define ONE_LINE_COMMENT 2

#define MULTI_LINE_COMMENT 1

/* Filter s into t. If flag is a query, return s (yes) / NULL (no)

/* Filter F->s into F->t */

* Otherwise, if t == NULL, allocate enough room, filter then return t.

* if not return pointer to ending '\0' in t.

char *

filtre(char *s0, char *t0, int flag)

filtre0(filtre_t *F)

{

static int in_string, in_comment = 0;

const int downcase = F->downcase;

char c, *s, *t;

char c, *s = F->s, *t;

int downcase, return_end;

if (flag & f_INIT) in_string = 0;

if (!F->t) F->t = gpmalloc(strlen(s)+1);

switch(flag)

t = F->t;

if (F->more_input == 1) F->more_input = 0;

if (! F->in_comment)

{

case f_ENDFILE:

while (isspace((int)*s)) s++; /* Skip space */

if (in_string)

if (*s == LBRACE) { s++; F->more_input = 2; F->wait_for_brace = 1; }

{

err(warner,"run-away string. Closing it");

in_string = 0;

}

if (in_comment)

{

err(warner,"run-away comment. Closing it");

in_comment = 0;

} /* fall through */

case f_INIT: case f_COMMENT:

return in_comment? s0: NULL;

}

downcase = ((flag & f_KEEPCASE) == 0 && compatible == OLDALL);

s = s0; return_end = (t0 != NULL);

if (!t0) t0 = gpmalloc(strlen(s)+1);

t = t0;

while ((c = *s++))

{

if (in_string) *t++ = c; /* copy verbatim */

if (F->in_string)

else if (in_comment)

{

if (in_comment == MULTI_LINE_COMMENT)

*t++ = c; /* copy verbatim */

switch(c)

{

case '\\': /* in strings, \ is the escape character */

if (*s) *t++ = *s++;

break;

case '"': F->in_string = 0;

}

continue;

}

if (F->in_comment)

{ /* look for comment's end */

if (F->in_comment == MULTI_LINE_COMMENT)

{

while (c != '*' || *s != '/')

{

if (!*s) goto END;

if (!*s)

{

if (!F->more_input) F->more_input = 1;

goto END;

}

c = *s++;

}

s++;

}

else

while (c != '\n')

while (c != '\n' && *s) c = *s++;

{

F->in_comment = 0;

if (!*s) { in_comment=0; goto END; }

continue;

c = *s++;

}

in_comment=0; continue;

}

else

{ /* weed out comments and spaces */

/* weed out comments and spaces */

if (c=='\\' && *s=='\\') { in_comment = ONE_LINE_COMMENT; continue; }

if (c=='\\' && *s=='\\') { F->in_comment = ONE_LINE_COMMENT; continue; }

if (isspace((int)c)) continue;

*t++ = downcase? tolower(c): c;

}

switch(c)

{

case '/':

if (*s != '*' || in_string) break;

if (*s == '*') { t--; F->in_comment = MULTI_LINE_COMMENT; }

/* start multi-line comment */

break;

t--; in_comment = MULTI_LINE_COMMENT; break;

case '\\':

if (!in_string) break;

if (!*s) {

if (!*s) goto END; /* this will result in an error */

if (t[-2] == '?') break; /* '?\' */

*t++ = *s++; break; /* in strings, \ is the escape character */

t--;

/* \" does not end a string. But \\" does */

if (!F->more_input) F->more_input = 1;

goto END;

}

if (*s == '\n') {

if (t[-2] == '?') break; /* '?\' */

t--; s++;

if (!*s)

{

if (!F->more_input) F->more_input = 1;

goto END;

}

} /* skip \<CR> */

break;

case '"':

case '"': F->in_string = 1;

in_string = !in_string;

}

if (t != F->t) /* non empty input */

{

c = t[-1]; /* = last input char */

if (c == '=') F->more_input = 2;

else if (! F->wait_for_brace) F->more_input = 0;

else if (c == RBRACE) { F->more_input = 0; t--; }

}

END:

*t = 0; return return_end? t: t0;

F->end = t; *t = 0; return F->t;

}

#undef ONE_LINE_COMMENT

#undef MULTI_LINE_COMMENT

char *

filtre(char *s, int downcase)

{

filtre_t T;

T.s = s; T.in_string = 0; T.more_input = 0;

T.t = NULL; T.in_comment= 0; T.wait_for_brace = 0;

T.downcase = downcase;

return filtre0(&T);

}

GEN

lisGEN(FILE *fi)

{

Line 149 lisGEN(FILE *fi)

Line 167 lisGEN(FILE *fi)

GEN x = flisexpr(buf);

free(buf); return x;

}

buf = gprealloc(buf, size<<1, size);

buf = gprealloc(buf, size<<1);

s = buf + (size-1); n = size+1; size <<= 1;

}

#if defined(UNIX) || defined(__EMX__)

Line 227 pariflush(void) { pariOut->flush(); }

Line 245 pariflush(void) { pariOut->flush(); }

void

flusherr(void) { pariErr->flush(); }

/* format is standard printf format, except %Z is a GEN (cast to long) */

/* format is standard printf format, except %Z is a GEN */

void

vpariputs(char* format, va_list args)

{

char buf[1024], str[1024], *f = format, *s = str;

long nb = 0, bufsize = 1023;

long nb = 0;

char *buf, *str, *s, *f = format;

/* replace each %Z (2 chars) by braced address format (8 chars) */

s = str = gpmalloc(strlen(format)*4 + 1);

while (*f)

{

if (*f != '%') *s++ = *f++;

Line 247 vpariputs(char* format, va_list args)

Line 267 vpariputs(char* format, va_list args)

}

*s = 0; vsprintf(buf,str,args); s = buf;

*s = 0;

#ifdef HAS_VSNPRINTF

for(;;)

{

int l;

buf = gpmalloc(bufsize);

l = vsnprintf(buf,bufsize,str,args);

if (l < 0) l = bufsize<<1; else if (l < bufsize) break;

free(buf); bufsize++;

}

buf[bufsize] = 0; /* just in case */

#else

buf = gpmalloc(bufsize);

(void)vsprintf(buf,str,args); /* pray it does fit */

#endif

f = s = buf;

if (nb)

for (f=s; *f; f++)

while ( *f )

{

if (*f == '\003' && f[21] == '\003')

{

*f = 0; f[21] = 0; /* remove the bracing chars */

pariOut->puts(s); bruteall((GEN)atol(f+1),'g',-1,1);

f += 22; s = f;

nb--; if (!nb) break;

if (!--nb) break;

}

pariOut->puts(s);

else

f++;

}

pariOut->puts(s); free(buf); free(str);

}

void

Line 326 static int col_index, lin_index, max_width, max_lin;

Line 365 static int col_index, lin_index, max_width, max_lin;

#endif

static int

term_width_intern()

term_width_intern(void)

{

#ifdef HAS_TIOCGWINSZ

{

struct winsize s;

if (!under_emacs && !under_texmacs && !ioctl(0, TIOCGWINSZ, &s))

if (!(GP_DATA && (GP_DATA->flags & (EMACS|TEXMACS)))

return s.ws_col;

&& !ioctl(0, TIOCGWINSZ, &s)) return s.ws_col;

}

#endif

#ifdef UNIX

Line 351 term_width_intern()

Line 390 term_width_intern()

}

static int

term_height_intern()

term_height_intern(void)

{

#ifdef HAS_TIOCGWINSZ

{

struct winsize s;

if (!under_emacs && !under_texmacs && !ioctl(0, TIOCGWINSZ, &s))

if (!(GP_DATA && (GP_DATA->flags & (EMACS|TEXMACS)))

return s.ws_row;

&& !ioctl(0, TIOCGWINSZ, &s)) return s.ws_row;

}

#endif

#ifdef UNIX

Line 379 term_height_intern()

Line 418 term_height_intern()

#define DFT_TERM_HEIGHT 20

int

term_width()

term_width(void)

{

int n = term_width_intern();

return (n>1)? n: DFT_TERM_WIDTH;

}

int

term_height()

term_height(void)

{

int n = term_height_intern();

return (n>1)? n: DFT_TERM_HEIGHT;

Line 410 puts80(char *s)

Line 449 puts80(char *s)

}

PariOUT pariOut80= {putc80, puts80, normalOutF, NULL};

void

static void

init80(long n)

{

col_index = n; pariOut = &pariOut80;

Line 448 puts_lim_lines(char *s)

Line 487 puts_lim_lines(char *s)

PariOUT pariOut_lim_lines= {putc_lim_lines, puts_lim_lines, normalOutF, NULL};

/* s = prefix already printed (print up to max lines) */

/* n = length of prefix already printed (print up to max lines) */

void

init_lim_lines(char *s, long max)

lim_lines_output(GEN z, pariout_t *fmt, long n, long max)

{

if (!max) return;

PariOUT *tmp = pariOut;

if (!s) { pariOut = &defaultOut; return; }

max_width = term_width();

max_lin = max;

lin_index = 1; col_index = strlen(s);

lin_index = 1;

col_index = n;

pariOut = &pariOut_lim_lines;

gen_output(z, fmt);

pariOut = tmp;

}

#define is_blank_or_null(c) (!(c) || is_blank(c))

Line 566 static outString *OutStr, *ErrStr = NULL;

Line 607 static outString *OutStr, *ErrStr = NULL;

#define check_output_length(str,l) { \

const ulong s = str->size; \

if (str->len + l >= s) { \

ulong t = s + l + STEPSIZE; \

str->size = s + l + STEPSIZE; \

str->string = gprealloc(str->string, t, s); \

str->string = gprealloc(str->string, str->size); \

str->size = t; \

} \

}

Line 608 pari_strdup(char *s)

Line 648 pari_strdup(char *s)

/* returns a malloc-ed string, which should be freed after usage */

char *

GENtostr0(GEN x, void(*do_out)(GEN))

GENtostr0(GEN x, pariout_t *T, void (*do_out)(GEN, pariout_t*))

{

PariOUT *tmp = pariOut;

outString *tmps = OutStr, newStr;

if (typ(x) == t_STR) return pari_strdup(GSTR(x));

pariOut = &pariOut2Str; OutStr = &newStr;

pariOut = &pariOut2Str;

OutStr->len = 0; OutStr->size=0; OutStr->string=NULL;

newStr.len = 0;

do_out(x); OutStr->string[OutStr->len] = 0;

newStr.size = 0;

newStr.string= NULL; OutStr = &newStr;

do_out(x, T);

OutStr->string[OutStr->len] = 0;

pariOut = tmp; OutStr = tmps; return newStr.string;

}

char *

GENtostr(GEN x) { return GENtostr0(x,outbrute); }

GENtostr(GEN x) { return GENtostr0(x, NULL, &gen_output); }

/********************************************************************/

/** **/

/** WRITE AN INTEGER **/

/** **/

/********************************************************************/

#define putsigne_nosp(x) pariputc((x>0)? '+' : '-')

#define putsigne(x) pariputs((x>0)? " + " : " - ")

#define sp_sign_sp(x) sp(), pariputc(x>0? '+': '-'), sp()

#define sp_sign_sp(T,x) ((T)->sp? putsigne(x): putsigne_nosp(x))

#define sp_plus_sp() sp(), pariputc('+'), sp()

#define sp(T) do { if ((T)->sp) pariputc(' '); } while(0);

#define comma_sp() pariputc(','), sp()

#define comma_sp(T) ((T)->sp? pariputs(", "): pariputc(','))

static void wr_space() {pariputc(' ');}

static void no_space() {}

static void

blancs(long nb) { while (nb-- > 0) pariputc(' '); }

Line 653 coinit(long x)

Line 694 coinit(long x)

pariputs(p); return 9 - (p - cha);

}

/* as above, printing leading 0s, return # significant digits printed */

/* as above, printing leading 0s, return # significant digits printed

* print at most dec significant digits */

static long

coinit2(long x)

coinit2(long x, long dec)

{

char cha[10], *p = cha + 9;

int i = 0;

for (*p = 0; p > cha; x /= 10) *--p = x%10 + '0';

while (cha[i] == '0') i++;

pariputs(cha); return 9 - i;

i = 9-i; /* # significant digits to print */

if (i > dec) { i = dec; cha[dec] = 0; }

pariputs(cha); return i;

}

static void

comilieu(long x)

{

Line 702 nbdch(long l)

Line 745 nbdch(long l)

return 10; /* not reached */

}

/* write an int. fw = field width (pad with ' ') */

/* write int x > 0 */

static void

wr_int(GEN x, long fw, long nosign)

wr_intpos(GEN x)

{

long *res,*re,i, sx=signe(x);

long *res = convi(x);

(void)coinit(*--res); while (*--res >= 0) comilieu(*res);

}

if (!sx) { blancs(fw-1); pariputc('0'); return; }

/* write int. T->fieldw: field width (pad with ' ') */

setsigne(x,1); re = res = convi(x);

static void

setsigne(x,sx);

wr_int(pariout_t *T, GEN x, int nosign)

{

long *res,*re,i, sx = signe(x);

int minus;

if (!sx) { blancs(T->fieldw - 1); pariputc('0'); return; }

re = res = convi(x);

i = nbdch(*--re); while (*--re >= 0) i+=9;

if (nosign || sx>0) blancs(fw-i);

minus = (sx < 0 && !nosign);

else

if (minus) i++;

{ i++; blancs(fw-i); pariputc('-'); }

coinit(*--res); while (*--res >= 0) comilieu(*res);

blancs(T->fieldw - i);

if (minus) pariputc('-');

(void)coinit(*--res); while (*--res >= 0) comilieu(*res);

}

static void

wr_vecsmall(GEN g)

wr_vecsmall(pariout_t *T, GEN g)

{

long i,l;

pariputc('['); l = lg(g);

pariputs("Vecsmall(["); l = lg(g);

for (i=1; i<l; i++)

{

pariputsf("%ld", g[i]);

if (i<l-1) comma_sp();

if (i<l-1) comma_sp(T);

}

pariputc(']');

pariputs("])");

}

/********************************************************************/

/** **/

/** WRITE A REAL NUMBER **/

/** **/

/********************************************************************/

static void wr_exp(GEN x);

static void wr_exp(pariout_t *T, GEN x);

/* assume x != 0 and print |x| in floating point format */

static void

wr_float(GEN x)

wr_float(pariout_t *T, GEN x)

{

long *res, ex,s,d,e,decmax, dec = decimals;

long *res, ex,s,d,e,decmax, dec = T->sigd;

GEN p1;

if (dec>0) /* round if needed */

{

GEN arrondi = cgetr(3);

arrondi[1] = (long) (x[1]-((double)BITS_IN_LONG/pariK)*dec-2);

ex = expo(x) - (long)((((double)BITS_IN_LONG)/pariK)*dec+2);

arrondi[1] = evalsigne(1)|evalexpo(ex);

arrondi[2] = x[2]; x = addrr(x,arrondi);

}

ex = expo(x); e = bit_accuracy(lg(x)); /* significant bits */

if (ex >= e) { wr_exp(x); return; }

if (ex >= e) { wr_exp(T,x); return; }

decmax = (long) (e * L2SL10); /* significant digits */

if ((ulong)decmax < (ulong)dec) dec = decmax; /* Hack: includes dec < 0 */

Line 778 wr_float(GEN x)

Line 832 wr_float(GEN x)

if (!s)

{

while (!*res) { res++; pariputs("000000000"); }

d = coinit2(*res++);

d = coinit2(*res++, dec);

}

/* d = # significant digits already printed */

Line 789 wr_float(GEN x)

Line 843 wr_float(GEN x)

/* as above in exponential format */

static void

wr_exp(GEN x)

wr_exp(pariout_t *T, GEN x)

{

GEN dix = cgetr(lg(x)+1);

GEN dix = stor(10, lg(x)+1);

long ex = expo(x);

long e = expo(x);

ex = (ex>=0)? (long)(ex*L2SL10): (long)(-(-ex*L2SL10)-1);

e = (e>=0)? (long)(e*L2SL10): (long)(-(-e*L2SL10)-1);

affsr(10,dix); if (ex) x = mulrr(x,gpuigs(dix,-ex));

if (e) x = mulrr(x, gpowgs(dix,-e));

if (absr_cmp(x, dix) >= 0) { x=divrr(x,dix); ex++; }

if (absr_cmp(x, dix) >= 0) { x = divrr(x,dix); e++; }

wr_float(x); sp(); pariputsf("E%ld",ex);

wr_float(T,x); sp(T); pariputsf("E%ld",e);

}

/* Write real number x.

* format: e (exponential), f (floating point), g (as f unless x too small)

* if format isn't correct (one of the above) act as e.

* decimals: number of decimals to print (all if <0).

* sigd: number of sigd to print (all if <0).

static void

wr_real(GEN x, long nosign)

wr_real(pariout_t *T, GEN x, int nosign)

{

long ltop, sx = signe(x), ex = expo(x);

gpmem_t ltop;

long sx = signe(x), ex = expo(x);

if (!sx) /* real 0 */

{

if (format == 'f')

if (T->format == 'f')

{

if (decimals<0)

long d, dec = T->sigd;

if (dec < 0)

{

long d = 1+((-ex)>>TWOPOTBITS_IN_LONG);

d = 1+((-ex)>>TWOPOTBITS_IN_LONG);

if (d < 0) d = 0;

decimals=(long)(pariK*d);

dec = (long)(pariK*d);

}

pariputs("0."); zeros(decimals);

pariputs("0."); zeros(dec);

}

else

{

Line 831 wr_real(GEN x, long nosign)

Line 887 wr_real(GEN x, long nosign)

}

if (!nosign && sx < 0) pariputc('-'); /* print sign if needed */

ltop = avma;

if ((format == 'g' && ex>=-32) || format == 'f') wr_float(x); else wr_exp(x);

if ((T->format == 'g' && ex>=-32)

|| T->format == 'f') wr_float(T,x); else wr_exp(T,x);

avma = ltop;

}

void

ecrire(GEN x, char f, long d, long fw)

{

if (typ(x)==t_INT)

wr_int(x,fw,0);

else

{

sp = &wr_space; format = f; decimals = d;

wr_real(x,0);

}

/********************************************************************/

/** **/

/** HEXADECIMAL OUTPUT **/

Line 896 vsigne(GEN x)

Line 941 vsigne(GEN x)

static void

voir2(GEN x, long nb, long bl)

{

long tx=typ(x),i,j,e,dx,lx=lg(x);

long tx,i,j,e,dx,lx;

if (!x) { pariputs("NULL\n"); return; }

tx = typ(x);

if (tx == t_INT && x == gzero) { pariputs("gzero\n"); return; }

if (tx == t_SMALL) {

pariputs("[SMALL ");

Line 906 voir2(GEN x, long nb, long bl)

Line 953 voir2(GEN x, long nb, long bl)

}

sorstring(VOIR_STRING1,(ulong)x);

lx = lg(x);

pariputsf("%s(lg=%ld%s):",type_name(tx)+2,lx,isclone(x)? ",CLONE" : "");

sorstring(VOIR_STRING2,x[0]);

if (! is_recursive_t(tx)) /* t_SMALL, t_INT, t_REAL, t_STR, t_VECSMALL */

{

if (tx == t_STR)

pariputs("chars:");

else if (tx == t_INT)

pariputsf("(%c,lgef=%ld):", vsigne(x), lgefint(x));

else if (tx == t_REAL)

pariputsf("(%c,expo=%ld):", vsigne(x), expo(x));

if (nb<0) nb = (tx==t_INT)? lgefint(x): lx;

if (tx == t_VECSMALL) nb = lx;

for (i=1; i < nb; i++) sorstring(VOIR_STRING2,x[i]);

Line 1095 texnome(char *v, long deg)

Line 1143 texnome(char *v, long deg)

void

etatpile(unsigned int n)

{

long av=avma,nu,i,l,m;

long nu, i, l, m;

gpmem_t av=avma;

GEN adr,adr1;

double r;

Line 1266 isdenom(GEN g)

Line 1315 isdenom(GEN g)

/* write a * v^d */

static void

wr_monome(GEN a, char *v, long d)

wr_monome(pariout_t *T, GEN a, char *v, long d)

{

long sig = isone(a);

if (sig) { sp_sign_sp(sig); monome(v,d); }

if (sig) { sp_sign_sp(T,sig); monome(v,d); }

else

{

sig = isfactor(a);

if (sig) { sp_sign_sp(sig); bruti(a,sig); }

if (sig) { sp_sign_sp(T,sig); bruti(a,T,sig); }

else

{

sp_plus_sp(); pariputc('('); bruti(a,sig); pariputc(')');

sp_sign_sp(T,1); pariputc('('); bruti(a,T,sig); pariputc(')');

}

if (d) { pariputc('*'); monome(v,d); }

}

static void

wr_texnome(GEN a, char *v, long d)

wr_texnome(pariout_t *T, GEN a, char *v, long d)

{

long sig = isone(a);

Line 1292 wr_texnome(GEN a, char *v, long d)

Line 1341 wr_texnome(GEN a, char *v, long d)

else

{

sig = isfactor(a);

if (sig) { putsigne(sig); texi(a,sig); }

if (sig) { putsigne(sig); texi(a,T,sig); }

else

{

pariputs(" + \\left("); texi(a,sig); pariputs("\\right) ");

pariputs(" + \\left("); texi(a,T,sig); pariputs("\\right) ");

}

if (d)

{

if (under_texmacs) pariputs("\\*");

if (GP_DATA && (GP_DATA->flags & TEXMACS)) pariputs("\\*");

texnome(v,d);

}

static void

wr_lead_monome(GEN a, char *v, long d, long nosign)

wr_lead_monome(pariout_t *T, GEN a, char *v, long d, int nosign)

{

long sig = isone(a);

if (sig)

Line 1316 wr_lead_monome(GEN a, char *v, long d, long nosign)

Line 1365 wr_lead_monome(GEN a, char *v, long d, long nosign)

}

else

{

if (isfactor(a)) bruti(a,nosign);

if (isfactor(a)) bruti(a,T,nosign);

else

{

pariputc('('); bruti(a,0); pariputc(')');

pariputc('('); bruti(a,T,0); pariputc(')');

}

if (d) { pariputc('*'); monome(v,d); }

}

static void

wr_lead_texnome(GEN a, char *v, long d, long nosign)

wr_lead_texnome(pariout_t *T, GEN a, char *v, long d, int nosign)

{

long sig = isone(a);

if (sig)

Line 1336 wr_lead_texnome(GEN a, char *v, long d, long nosign)

Line 1385 wr_lead_texnome(GEN a, char *v, long d, long nosign)

}

else

{

if (isfactor(a)) texi(a,nosign);

if (isfactor(a)) texi(a,T,nosign);

else

{

pariputs(" \\left("); texi(a,0); pariputs("\\right) ");

pariputs(" \\left("); texi(a,T,0); pariputs("\\right) ");

}

if (d)

{

if (under_texmacs) pariputs("\\*");

if (GP_DATA && (GP_DATA->flags & TEXMACS)) pariputs("\\*");

texnome(v,d);

}

static void

void

bruti(GEN g, long nosign)

bruti(GEN g, pariout_t *T, int nosign)

{

long tg,l,i,j,r;

GEN a,b;

Line 1369 bruti(GEN g, long nosign)

Line 1418 bruti(GEN g, long nosign)

switch(tg)

{

case t_SMALL: pariputsf("%ld",smalltos(g)); break;

case t_INT: wr_int(g,0,nosign); break;

case t_INT:

case t_REAL: wr_real(g,nosign); break;

if (!nosign && signe(g) < 0) pariputc('-');

wr_intpos(g); break;

case t_REAL: wr_real(T,g,nosign); break;

case t_INTMOD: case t_POLMOD:

pariputs(new_fun_set? "Mod(": "mod(");

bruti((GEN)g[2],0); comma_sp();

bruti((GEN)g[2],T,0); comma_sp(T);

bruti((GEN)g[1],0); pariputc(')'); break;

bruti((GEN)g[1],T,0); pariputc(')'); break;

case t_FRAC: case t_FRACN: case t_RFRAC: case t_RFRACN:

r = isfactor((GEN)g[1]); if (!r) pariputc('(');

bruti((GEN)g[1],nosign);

bruti((GEN)g[1],T,nosign);

if (!r) pariputc(')');

pariputc('/');

r = isdenom((GEN)g[2]); if (!r) pariputc('(');

bruti((GEN)g[2],0);

bruti((GEN)g[2],T,0);

if (!r) pariputc(')');

break;

Line 1391 bruti(GEN g, long nosign)

Line 1442 bruti(GEN g, long nosign)

a = (GEN)g[r+1]; b = (GEN)g[r+2]; v = r? "w": "I";

if (isnull(a))

{

wr_lead_monome(b,v,1,nosign);

wr_lead_monome(T,b,v,1,nosign);

return;

}

bruti(a,nosign);

bruti(a,T,nosign);

if (!isnull(b)) wr_monome(b,v,1);

if (!isnull(b)) wr_monome(T,b,v,1);

break;

case t_POL: v = get_var(ordvar[varn(g)], buf);

/* hack: we want g[i] = coeff of degree i. */

i = degpol(g); g += 2; while (isnull((GEN)g[i])) i--;

wr_lead_monome((GEN)g[i],v,i,nosign);

wr_lead_monome(T,(GEN)g[i],v,i,nosign);

while (i--)

{

a = (GEN)g[i];

if (!isnull_for_pol(a)) wr_monome(a,v,i);

if (!isnull_for_pol(a)) wr_monome(T,a,v,i);

}

break;

Line 1414 bruti(GEN g, long nosign)

Line 1465 bruti(GEN g, long nosign)

if (signe(g))

{ /* hack: we want g[i] = coeff of degree i. */

l = i + lg(g)-2; g += (2-i);

wr_lead_monome((GEN)g[i],v,i,nosign);

wr_lead_monome(T,(GEN)g[i],v,i,nosign);

while (++i < l)

{

a = (GEN)g[i];

if (!isnull_for_pol(a)) wr_monome(a,v,i);

if (!isnull_for_pol(a)) wr_monome(T,a,v,i);

}

sp_plus_sp();

sp_sign_sp(T,1);

}

pariputs("O("); monome(v,i); pariputc(')'); break;

case t_PADIC:

{

GEN p = (GEN)g[2];

gpmem_t av = avma;

i = valp(g); l = precp(g)+i;

g = (GEN)g[4]; v = GENtostr(p);

for (; i<l; i++)

Line 1436 bruti(GEN g, long nosign)

Line 1488 bruti(GEN g, long nosign)

{

if (!i || !is_pm1(a))

{

wr_int(a,0,1); if (i) pariputc('*');

wr_intpos(a); if (i) pariputc('*');

}

if (i) padic_nome(v,i);

sp_plus_sp();

sp_sign_sp(T,1);

}

if ((i & 0xff) == 0) g = gerepileuptoint(av,g);

}

pariputs("O("); padic_nome(v,i); pariputc(')');

free(v); break;

Line 1448 bruti(GEN g, long nosign)

Line 1501 bruti(GEN g, long nosign)

case t_QFR: case t_QFI: r = (tg == t_QFR);

if (new_fun_set) pariputs("Qfb("); else pariputs(r? "qfr(": "qfi(");

bruti((GEN)g[1],0); comma_sp();

bruti((GEN)g[1],T,0); comma_sp(T);

bruti((GEN)g[2],0); comma_sp();

bruti((GEN)g[2],T,0); comma_sp(T);

bruti((GEN)g[3],0);

bruti((GEN)g[3],T,0);

if (r) { comma_sp(); bruti((GEN)g[4],0); }

if (r) { comma_sp(T); bruti((GEN)g[4],T,0); }

pariputc(')'); break;

case t_VEC: case t_COL:

pariputc('['); l = lg(g);

for (i=1; i<l; i++)

{

bruti((GEN)g[i],0);

bruti((GEN)g[i],T,0);

if (i<l-1) comma_sp();

if (i<l-1) comma_sp(T);

}

pariputc(']'); if (tg==t_COL) pariputc('~');

break;

case t_VECSMALL: wr_vecsmall(g); break;

case t_VECSMALL: wr_vecsmall(T,g); break;

case t_LIST:

pariputs("List(["); l = lgef(g);

for (i=2; i<l; i++)

{

bruti((GEN)g[i],0);

bruti((GEN)g[i],T,0);

if (i<l-1) comma_sp();

if (i<l-1) comma_sp(T);

}

pariputs("])"); break;

Line 1489 bruti(GEN g, long nosign)

Line 1542 bruti(GEN g, long nosign)

if (l==2)

{

pariputs(new_fun_set? "Mat(": "mat(");

if (r == 2) { bruti(gcoeff(g,1,1),0); pariputc(')'); return; }

if (r == 2) { bruti(gcoeff(g,1,1),T,0); pariputc(')'); return; }

}

pariputc('[');

for (i=1; i<l; i++)

{

for (j=1; j<r; j++)

{

bruti(gcoeff(g,i,j),0);

bruti(gcoeff(g,i,j),T,0);

if (j<r-1) comma_sp();

if (j<r-1) comma_sp(T);

}

if (i<l-1) { pariputc(';'); sp(); }

if (i<l-1) { pariputc(';'); sp(T); }

}

pariputc(']'); if (l==2) pariputc(')');

break;

Line 1508 bruti(GEN g, long nosign)

Line 1561 bruti(GEN g, long nosign)

}

static void

void

matbruti(GEN g, long flag)

matbruti(GEN g, pariout_t *T)

{

long i,j,r,l;

if (typ(g) != t_MAT) { bruti(g,flag); return; }

if (typ(g) != t_MAT) { bruti(g,T,0); return; }

r=lg(g); if (r==1 || lg(g[1])==1) { pariputs("[;]\n"); return; }

pariputc('\n'); l = lg(g[1]);

Line 1522 matbruti(GEN g, long flag)

Line 1575 matbruti(GEN g, long flag)

pariputc('[');

for (j=1; j<r; j++)

{

bruti(gcoeff(g,i,j),0); if (j<r-1) pariputc(' ');

bruti(gcoeff(g,i,j),T,0); if (j<r-1) pariputc(' ');

}

if (i<l-1) pariputs("]\n\n"); else pariputs("]\n");

}

static void

sor_monome(GEN a, char *v, long d)

sor_monome(pariout_t *T, GEN a, char *v, long d)

{

long sig = isone(a);

if (sig) { putsigne(sig); monome(v,d); }

Line 1538 sor_monome(GEN a, char *v, long d)

Line 1591 sor_monome(GEN a, char *v, long d)

sig = isfactor(a);

if (sig) { putsigne(sig); if (sig < 0) a = gneg(a); }

else pariputs(" + ");

sori(a); if (d) { pariputc(' '); monome(v,d);}

sori(a,T); if (d) { pariputc(' '); monome(v,d);}

}

static void

sor_lead_monome(GEN a, char *v, long d)

sor_lead_monome(pariout_t *T, GEN a, char *v, long d)

{

long sig = isone(a);

if (sig)

Line 1553 sor_lead_monome(GEN a, char *v, long d)

Line 1606 sor_lead_monome(GEN a, char *v, long d)

}

else

{

sori(a);

sori(a,T);

if (d) { pariputc(' '); monome(v,d); }

}

static void

void

sori(GEN g)

sori(GEN g, pariout_t *T)

{

long tg=typ(g), i,j,r,l,close_paren;

GEN a,b;

char *v, buf[32];

if (tg == t_INT) { wr_int(T,g,0); return; }

if (tg != t_MAT && tg != t_COL) T->fieldw = 0;

switch (tg)

{

case t_SMALL: pariputsf("%ld",smalltos(g)); return;

case t_INT: wr_int(g,chmp,0); return;

case t_REAL: wr_real(T,g,0); return;

case t_REAL: wr_real(g,0); return;

case t_STR:

pariputc('"'); pariputs(GSTR(g)); pariputc('"'); return;

case t_LIST:

chmp=0; pariputs("List(");

pariputs("List(");

for (i=2; i<lgef(g); i++)

{

sori((GEN)g[i]); if (i<lgef(g)-1) pariputs(", ");

sori((GEN)g[i], T); if (i<lgef(g)-1) pariputs(", ");

}

pariputs(")\n"); return;

}

close_paren=0;

if (!is_matvec_t(tg)) chmp = 0;

if (!is_graphicvec_t(tg))

{

if (is_frac_t(tg) && gsigne(g) < 0) pariputc('-');

Line 1592 sori(GEN g)

Line 1645 sori(GEN g)

case t_INTMOD: case t_POLMOD:

a = (GEN)g[2]; b = (GEN)g[1];

if (tg == t_INTMOD && signe(a) < 0) a = addii(a,b);

sori(a); pariputs(" mod "); sori(b); break;

sori(a,T); pariputs(" mod "); sori(b,T); break;

case t_FRAC: case t_FRACN:

a=(GEN)g[1]; wr_int(a,chmp,1); pariputs(" /");

a=(GEN)g[1]; wr_int(T,a,1); pariputs(" /");

b=(GEN)g[2]; wr_int(b,chmp,1); break;

b=(GEN)g[2]; wr_int(T,b,1); break;

case t_COMPLEX: case t_QUAD: r = (tg==t_QUAD);

a = (GEN)g[r+1]; b = (GEN)g[r+2]; v = r? "w": "I";

if (isnull(a)) { sor_lead_monome(b,v,1); break; }

if (isnull(a)) { sor_lead_monome(T,b,v,1); break; }

sori(a); if (!isnull(b)) sor_monome(b,v,1);

sori(a,T); if (!isnull(b)) sor_monome(T,b,v,1);

break;

case t_PADIC:

Line 1616 sori(GEN g)

Line 1669 sori(GEN g)

{

if (!i || !is_pm1(a))

{

wr_int(a,chmp,1); pariputc(i? '*': ' ');

wr_int(T,a,1); pariputc(i? '*': ' ');

}

if (i) { padic_nome(v,i); pariputc(' '); }

pariputs("+ ");

Line 1631 sori(GEN g)

Line 1684 sori(GEN g)

if (!signe(g)) { pariputc('0'); break; }

v = get_var(ordvar[varn(g)],buf);

i = degpol(g); g += 2; while (isnull((GEN)g[i])) i--;

sor_lead_monome((GEN)g[i],v,i);

sor_lead_monome(T,(GEN)g[i],v,i);

while (i--)

{

a = (GEN)g[i]; if (!isnull_for_pol(a)) sor_monome(a,v,i);

a = (GEN)g[i]; if (!isnull_for_pol(a)) sor_monome(T,a,v,i);

}

break;

Line 1643 sori(GEN g)

Line 1696 sori(GEN g)

if (signe(g))

{ /* hack: we want g[i] = coeff of degree i. */

l = i + lg(g)-2; g += (2-i);

sor_lead_monome((GEN)g[i],v,i);

sor_lead_monome(T,(GEN)g[i],v,i);

while (++i < l)

{

a = (GEN)g[i]; if (!isnull_for_pol(a)) sor_monome(a,v,i);

a = (GEN)g[i]; if (!isnull_for_pol(a)) sor_monome(T,a,v,i);

}

pariputs(" + ");

}

Line 1655 sori(GEN g)

Line 1708 sori(GEN g)

pariputc(')'); break;

case t_RFRAC: case t_RFRACN:

if (initial)

if (T->initial)

{

char *v1, *v2;

long sd = 0, sn = 0, d,n;

long wd = term_width();

initial = 0;

T->initial = 0;

v1 = GENtostr0((GEN)g[1], &sori); n = strlen(v1);

v1 = GENtostr0((GEN)g[1], T, &sori); n = strlen(v1);

v2 = GENtostr0((GEN)g[2], &sori); d = strlen(v2);

v2 = GENtostr0((GEN)g[2], T, &sori); d = strlen(v2);

pariputc('\n');

i = max(n,d)+2;

Line 1682 sori(GEN g)

Line 1735 sori(GEN g)

blancs(sd+1); pariputs(v2);

pariputc('\n'); return;

}

pariputc('('); sori((GEN)g[1]); pariputs(" / "); sori((GEN)g[2]);

pariputc('('); sori((GEN)g[1],T); pariputs(" / "); sori((GEN)g[2],T);

pariputc(')'); return;

case t_QFR: case t_QFI: pariputc('{');

sori((GEN)g[1]); pariputs(", ");

sori((GEN)g[1],T); pariputs(", ");

sori((GEN)g[2]); pariputs(", ");

sori((GEN)g[2],T); pariputs(", ");

sori((GEN)g[3]);

sori((GEN)g[3],T);

if (tg == t_QFR) { pariputs(", "); sori((GEN)g[4]); }

if (tg == t_QFR) { pariputs(", "); sori((GEN)g[4],T); }

pariputs("}\n"); break;

case t_VEC:

case t_VEC: pariputc('[');

chmp=0; pariputc('[');

for (i=1; i<lg(g); i++)

{

sori((GEN)g[i]); if (i<lg(g)-1) pariputs(", ");

sori((GEN)g[i],T); if (i<lg(g)-1) pariputs(", ");

}

pariputc(']'); break;

case t_VECSMALL: wr_vecsmall(g); break;

case t_VECSMALL: wr_vecsmall(T,g); break;

case t_COL:

if (lg(g)==1) { pariputs("[]\n"); return; }

pariputc('\n');

for (i=1; i<lg(g); i++)

{

pariputc('['); sori((GEN)g[i]); pariputs("]\n");

pariputc('['); sori((GEN)g[i],T); pariputs("]\n");

}

break;

Line 1721 sori(GEN g)

Line 1773 sori(GEN g)

pariputc('[');

for (j=1; j<lx; j++)

{

sori(gcoeff(g,i,j)); if (j<lx-1) pariputc(' ');

sori(gcoeff(g,i,j),T); if (j<lx-1) pariputc(' ');

}

pariputs("]\n"); if (i<l-1) pariputc('\n');

}

Line 1739 sori(GEN g)

Line 1791 sori(GEN g)

/********************************************************************/

/* this follows bruti exactly */

static void

void

texi(GEN g, long nosign)

texi(GEN g, pariout_t *T, int nosign)

{

long tg,i,j,l,r;

GEN a,b;

Line 1757 texi(GEN g, long nosign)

Line 1809 texi(GEN g, long nosign)

tg = typ(g);

switch(tg)

{

case t_INT: wr_int(g,0,nosign); break;

case t_SMALL: pariputsf("%ld",smalltos(g)); break;

case t_REAL: wr_real(g,nosign); break;

case t_INT:

if (!nosign && signe(g) < 0) pariputc('-');

wr_intpos(g); break;

case t_REAL: wr_real(T,g,nosign); break;

case t_INTMOD: case t_POLMOD:

texi((GEN)g[2],0); pariputs(" mod ");

texi((GEN)g[2],T,0); pariputs(" mod ");

texi((GEN)g[1],0); break;

texi((GEN)g[1],T,0); break;

case t_FRAC: case t_FRACN: case t_RFRAC: case t_RFRACN:

texi((GEN)g[1],nosign); pariputs("\\over");

texi((GEN)g[1],T,nosign); pariputs("\\over");

texi((GEN)g[2],0); break;

texi((GEN)g[2],T,0); break;

case t_COMPLEX: case t_QUAD: r = (tg==t_QUAD);

a = (GEN)g[r+1]; b = (GEN)g[r+2]; v = r? "w": "I";

if (isnull(a))

{

wr_lead_texnome(b,v,1,nosign);

wr_lead_texnome(T,b,v,1,nosign);

break;

}

texi(a,nosign);

texi(a,T,nosign);

if (!isnull(b)) wr_texnome(b,v,1);

if (!isnull(b)) wr_texnome(T,b,v,1);

break;

case t_POL: v = get_texvar(ordvar[varn(g)],buf);

/* hack: we want g[i] = coeff of degree i. */

i = degpol(g); g += 2; while (isnull((GEN)g[i])) i--;

wr_lead_texnome((GEN)g[i],v,i,nosign);

wr_lead_texnome(T,(GEN)g[i],v,i,nosign);

while (i--)

{

a = (GEN)g[i];

if (!isnull_for_pol(a)) wr_texnome(a,v,i);

if (!isnull_for_pol(a)) wr_texnome(T,a,v,i);

}

break;

Line 1795 texi(GEN g, long nosign)

Line 1850 texi(GEN g, long nosign)

if (signe(g))

{ /* hack: we want g[i] = coeff of degree i. */

l = i + lg(g)-2; g += (2-i);

wr_lead_texnome((GEN)g[i],v,i,nosign);

wr_lead_texnome(T,(GEN)g[i],v,i,nosign);

while (++i < l)

{

a = (GEN)g[i];

if (!isnull_for_pol(a)) wr_texnome(a,v,i);

if (!isnull_for_pol(a)) wr_texnome(T,a,v,i);

}

pariputs("+ ");

}

Line 1817 texi(GEN g, long nosign)

Line 1872 texi(GEN g, long nosign)

{

if (!i || !is_pm1(a))

{

wr_int(a,0,1); if (i) pariputs("\\cdot");

wr_intpos(a); if (i) pariputs("\\cdot");

}

if (i) padic_texnome(v,i);

pariputc('+');

Line 1828 texi(GEN g, long nosign)

Line 1883 texi(GEN g, long nosign)

}

case t_QFR: case t_QFI: r = (tg == t_QFR);

if (new_fun_set) pariputs("Qfb("); else pariputs(r? "qfr(": "qfi(");

texi((GEN)g[1],0); pariputs(", ");

texi((GEN)g[1],T,0); pariputs(", ");

texi((GEN)g[2],0); pariputs(", ");

texi((GEN)g[2],T,0); pariputs(", ");

texi((GEN)g[3],0);

texi((GEN)g[3],T,0);

if (r) { pariputs(", "); texi((GEN)g[4],0); }

if (r) { pariputs(", "); texi((GEN)g[4],T,0); }

pariputc(')'); break;

case t_VEC:

pariputs("\\pmatrix{ "); l = lg(g);

for (i=1; i<l; i++)

{

texi((GEN)g[i],0); if (i<lg(g)-1) pariputc('&');

texi((GEN)g[i],T,0); if (i<lg(g)-1) pariputc('&');

}

pariputs("\\cr}\n"); break;

Line 1846 texi(GEN g, long nosign)

Line 1901 texi(GEN g, long nosign)

pariputs("\\pmatrix{ "); l = lgef(g);

for (i=2; i<l; i++)

{

texi((GEN)g[i],0); if (i<lgef(g)-1) pariputc('&');

texi((GEN)g[i],T,0); if (i<lgef(g)-1) pariputc('&');

}

pariputs("\\cr}\n"); break;

Line 1854 texi(GEN g, long nosign)

Line 1909 texi(GEN g, long nosign)

pariputs("\\pmatrix{ "); l = lg(g);

for (i=1; i<l; i++)

{

texi((GEN)g[i],0); pariputs("\\cr\n");

texi((GEN)g[i],T,0); pariputs("\\cr\n");

}

pariputc('}'); break;

Line 1871 texi(GEN g, long nosign)

Line 1926 texi(GEN g, long nosign)

{

for (j=1; j<r; j++)

{

texi(gcoeff(g,i,j),0); if (j<r-1) pariputc('&');

texi(gcoeff(g,i,j),T,0); if (j<r-1) pariputc('&');

}

pariputs("\\cr\n ");

}

Line 1883 texi(GEN g, long nosign)

Line 1938 texi(GEN g, long nosign)

/*******************************************************************/

/** **/

/** GP OUTPUT **/

/** **/

/*******************************************************************/

/* EXTERNAL PRETTYPRINTER */

/* Wait for prettinprinter to finish, to prevent new prompt from overwriting

* the output. Fill the output buffer, wait until it is read.

* Better than sleep(2): give possibility to print */

static void

prettyp_wait(void)

{

char *s = " \n";

int i = 400;

pariputs("\n\n"); pariflush(); /* start translation */

while (--i) pariputs(s);

pariputs("\n"); pariflush();

}

/* initialise external prettyprinter (tex2mail) */

static int

prettyp_init(void)

{

gp_pp *pp = GP_DATA->pp;

if (!pp->cmd) return 0;

if (!pp->file)

pp->file = try_pipe(pp->cmd, mf_OUT | mf_TEST);

if (pp->file) return 1;

err(warner,"broken prettyprinter: '%s'",pp->cmd);

free(pp->cmd); pp->cmd = NULL; return 0;

}

/* n = history number. if n = 0 no history */

static int

tex2mail_output(GEN z, long n)

{

pariout_t T = *(GP_DATA->fmt); /* copy */

FILE *o_out;

if (!prettyp_init()) return 0;

o_out = pari_outfile; /* save state */

/* Emit first: there may be lines before the prompt */

if (n) term_color(c_OUTPUT);

pariflush();

pari_outfile = GP_DATA->pp->file->file;

T.prettyp = f_TEX;

/* history number */

if (n)

{

char s[128];

if (*term_get_color(c_HIST) || *term_get_color(c_OUTPUT))

{

char col1[80];

strcpy(col1, term_get_color(c_HIST));

sprintf(s, "\\LITERALnoLENGTH{%s}\\%%%ld =\\LITERALnoLENGTH{%s} ",

col1, n, term_get_color(c_OUTPUT));

}

else

sprintf(s, "\\%%%ld = ", n);

pariputs_opt(s);

}

/* output */

gen_output(z, &T);

/* flush and restore */

prettyp_wait();

pari_outfile = o_out;

if (n) term_color(c_NONE);

return 1;

}

/* TEXMACS */

static void

texmacs_output(GEN z, long n)

{

pariout_t T = *(GP_DATA->fmt); /* copy */

char *sz;

T.prettyp = f_TEX;

T.fieldw = 0;

sz = GENtostr0(z, &T, &gen_output);

printf("%clatex:", DATA_BEGIN);

if (n)

printf("\\magenta\\%%%ld = $\\blue ", n);

else

printf("$\\blue ");

printf("%s$%c", sz,DATA_END); free(sz);

fflush(stdout);

}

/* REGULAR */

static void

normal_output(GEN z, long n)

{

long l = 0;

/* history number */

if (n)

{

char s[64];

term_color(c_HIST);

sprintf(s, "%%%ld = ", n);

pariputs_opt(s);

l = strlen(s);

}

/* output */

term_color(c_OUTPUT);

if (GP_DATA->lim_lines)

lim_lines_output(z, GP_DATA->fmt, l, GP_DATA->lim_lines);

else

gen_output(z, GP_DATA->fmt);

term_color(c_NONE); pariputc('\n');

}

void

gp_output(GEN z, gp_data *G)

{

if (G->flags & TEST) {

init80(0);

gen_output(z, G->fmt); pariputc('\n');

}

else if (G->flags & TEXMACS)

texmacs_output(z, G->hist->total);

else if (G->fmt->prettyp != f_PRETTY || !tex2mail_output(z, G->hist->total))

normal_output(z, G->hist->total);

pariflush();

}

/*******************************************************************/

/** **/

/** USER OUTPUT FUNCTIONS **/

/** **/

/*******************************************************************/

void

bruteall(GEN g, char f, long d, long flag)

gen_output(GEN x, pariout_t *T)

{

long av = avma;

gpmem_t av = avma;

void (*oldsp)() = sp;

GEN y = changevar(x, polvar);

if (!T) T = &DFLT_OUTPUT;

T->initial = 1;

switch(T->prettyp)

{

case f_PRETTYMAT: matbruti(y, T); break;

case f_PRETTY:

case f_PRETTYOLD: sori (y, T); break;

case f_RAW : bruti(y, T, 0); break;

case f_TEX : texi (y, T, 0); break;

}

avma = av;

}

sp = flag? &wr_space: &no_space;

static void

format = f; decimals = d;

_initout(pariout_t *T, char f, long sigd, long sp, long fieldw, int prettyp)

bruti(changevar(g,polvar),0);

{

sp = oldsp; avma = av;

T->format = f;

T->sigd = sigd;

T->sp = sp;

T->fieldw = fieldw;

T->initial = 1;

T->prettyp = prettyp;

}

void

bruteall(GEN g, char f, long d, long sp)

{

pariout_t T; _initout(&T,f,d,sp,0, f_RAW);

gen_output(g, &T);

}

void

matbrute(GEN g, char f, long d)

{

long av=avma; sp = &wr_space;

pariout_t T; _initout(&T,f,d,1,0, f_PRETTYMAT);

format = f; decimals = d;

gen_output(g, &T);

matbruti(changevar(g,polvar),0); avma=av;

}

void

sor(GEN g, char f, long d, long c)

{

long av=avma; sp = &wr_space;

pariout_t T; _initout(&T,f,d,1,c, f_PRETTYOLD);

format = f; decimals = d; chmp = c; initial = 1;

gen_output(g, &T);

sori(changevar(g,polvar)); avma = av;

}

void

texe(GEN g, char f, long d)

{

long av=avma; sp = &no_space;

pariout_t T; _initout(&T,f,d,0,0, f_TEX);

format = f; decimals = d;

gen_output(g, &T);

texi(changevar(g,polvar),0); avma=av;

}

void

brute(GEN g, char format, long decimals) { bruteall(g,format,decimals,1); }

brute(GEN g, char f, long d) { bruteall(g,f,d,1); }

void

outbrute(GEN g) { bruteall(g,'g',-1,1); }

Line 1968 outbeauterr(GEN x)

Line 2179 outbeauterr(GEN x)

}

void

bruterr(GEN x,char format,long decimals)

bruterr(GEN x,char format,long sigd)

{

PariOUT *out = pariOut; pariOut = pariErr;

bruteall(x,format,decimals,1); pariOut = out;

bruteall(x,format,sigd,1); pariOut = out;

}

void

Line 2103 pari_unlink(char *s)

Line 2314 pari_unlink(char *s)

fprintferr("I/O: removed file %s\n", s);

}

void

check_filtre(filtre_t *T)

{

if (T && T->in_string)

{

err(warner,"run-away string. Closing it");

T->in_string = 0;

}

if (T && T->in_comment)

{

err(warner,"run-away comment. Closing it");

T->in_comment = 0;

}

/* Remove one INFILE from the stack. Reset infile (to the most recent infile)

* Return -1, if we're trying to pop out stdin itself; 0 otherwise

* Check for leaked file handlers (temporary files)

Line 2111 int

Line 2337 int

popinfile()

{

pariFILE *f;

filtre(NULL,NULL, f_ENDFILE);

for (f = last_tmp_file; f; f = f->prev)

{

if (f->type & mf_IN) break;

Line 2159 try_pipe(char *cmd, int fl)

Line 2383 try_pipe(char *cmd, int fl)

#else

FILE *file;

char *f;

VOLATILE int flag = fl;

int flag = fl;

# ifdef __EMX__

if (_osmode == DOS_MODE) /* no pipes under DOS */

Line 2179 try_pipe(char *cmd, int fl)

Line 2403 try_pipe(char *cmd, int fl)

if (flag & mf_OUT) flag |= mf_PERM;

if (flag & (mf_TEST | mf_OUT))

{

jmp_buf env;

void *c;

int i;

if (DEBUGFILES) fprintferr("I/O: checking output pipe...\n");

if (setjmp(env)) return NULL;

CATCH(-1) { file = NULL; }

TRY {

c = err_catch(-1, env, NULL);

int i;

fprintf(file,"\n\n"); fflush(file);

for (i=1; i<1000; i++) fprintf(file," \n");

fprintf(file,"\n"); fflush(file);

err_leave(&c);

} ENDCATCH;

if (!file) return NULL;

}

f = cmd;

}

Line 2225 os_read(long fd, char ch[], long s)

Line 2447 os_read(long fd, char ch[], long s)

DWORD chRead;

ReadFile((HANDLE)fd, ch, s, &chRead, NULL);

#else

read(fd,ch,s);

(void)read(fd,ch,s);

#endif

}

Line 2262 os_getenv(char *s)

Line 2484 os_getenv(char *s)

/** **/

/*******************************************************************/

static char *last_filename = NULL;

static char **dir_list = NULL;

#ifdef HAS_OPENDIR

# include <dirent.h>

Line 2339 _expand_env(char *str)

Line 2560 _expand_env(char *str)

}

if (xnum > xlen - 3) /* need room for possibly two more elts */

{

long xnew = xlen << 1;

xlen <<= 1;

x = (char **)gprealloc((void*)x, xlen * sizeof(char*),

x = (char **)gprealloc((void*)x, xlen * sizeof(char*));

xnew * sizeof(char*));

xlen = xnew;

}

s0 = ++s; /* skip $ */

Line 2382 expand_tilde(char *s)

Line 2601 expand_tilde(char *s)

return _expand_env(_expand_tilde(s));

}

void

delete_dirs(gp_path *p)

{

char **v = p->dirs, **dirs;

if (v)

{

p->dirs = NULL; /* in case of error */

for (dirs = v; *dirs; dirs++) free(*dirs);

free(v);

}

#if defined __EMX__ || defined _WIN32

# define PATH_SEPARATOR ';'

#else

Line 2389 expand_tilde(char *s)

Line 2620 expand_tilde(char *s)

#endif

void

gp_expand_path(char *v)

gp_expand_path(gp_path *p)

{

char **path, **old, *s;

char **dirs, *s, *v = p->PATH;

int i, n = 0;

delete_dirs(p);

v = pari_strdup(v);

for (s=v; *s; s++)

if (*s == PATH_SEPARATOR) { *s = 0; n++; }

path = (char**) gpmalloc((n + 2)*sizeof(char *));

dirs = (char**) gpmalloc((n + 2)*sizeof(char *));

for (s=v, i=0; i<=n; i++)

{

char *end = s + strlen(s), *f = end;

while (f > s && *--f == '/') *f = 0;

path[i] = expand_tilde(s);

dirs[i] = expand_tilde(s);

s = end + 1; /* next path component */

}

path[i] = NULL; old = dir_list; dir_list = path;

free((void*)v);

if (old)

dirs[i] = NULL; p->dirs = dirs;

{

for (path=old; *path; path++) free(*path);

free(old);

}

/* name is a malloc'ed (existing) filename. Accept it as new infile

Line 2488 switchin(char *name0)

Line 2716 switchin(char *name0)

/* if name contains '/', don't use dir_list */

s=name; while (*s && *s != '/' && *s != '\\') s++;

if (*s) { if (try_name(name)) return; }

else

else if (GP_DATA)

{

char **tmp = dir_list;

char **tmp = GP_DATA->path->dirs;

for ( ; *tmp; tmp++)

{ /* make room for '/' and '\0', try_name frees it */

s = gpmalloc(2 + strlen(*tmp) + strlen(name));

Line 2501 switchin(char *name0)

Line 2729 switchin(char *name0)

err(openfiler,"input",name0);

}

static int is_magic_ok(FILE *f);

void

switchout(char *name)

{

if (name)

{

FILE *f = fopen(name, "a");

FILE *f = fopen(name, "r");

if (f)

{

if (is_magic_ok(f))

err(talker,"%s is a GP binary file. Please use writebin", name);

fclose(f);

}

f = fopen(name, "a");

if (!f) err(openfiler,"output",name);

pari_outfile = f;

}

Line 2532 switchout(char *name)

Line 2769 switchout(char *name)

#define _cfwrite(a,b,c) _fwrite((a),sizeof(char),(b),(c))

#define BIN_GEN 0

#define NAM_GEN 1

static long

rd_long(FILE *f)

Line 2610 rdGEN(FILE *f)

Line 2847 rdGEN(FILE *f)

}

GEN

readobj(FILE *f)

readobj(FILE *f, int *ptc)

{

int c = fgetc(f);

GEN x = NULL;

Line 2633 readobj(FILE *f)

Line 2870 readobj(FILE *f)

case EOF: break;

default: err(talker,"unknown code in readobj");

}

return x;

*ptc = c; return x;

}

#define MAGIC "\020\001\022\011-\007\020" /* ^P^A^R^I-^G^P */

Line 2657 static int

Line 2894 static int

is_sizeoflong_ok(FILE *f)

{

char c;

return (fread(&c,1,1, f) == 1 && c == sizeof(long));

return (fread(&c,1,1, f) == 1 && c == (char)sizeof(long));

}

static int

Line 2685 static void

Line 2922 static void

write_magic(FILE *f)

{

fprintf(f, MAGIC);

fprintf(f, "%c", sizeof(long));

fprintf(f, "%c", (char)sizeof(long));

wr_long(ENDIAN_CHECK, f);

wr_long(BINARY_VERSION, f);

}

Line 2693 write_magic(FILE *f)

Line 2930 write_magic(FILE *f)

int

file_is_binary(FILE *f)

{

int c = fgetc(f), r = isprint(c);

int c = fgetc(f); ungetc(c,f);

ungetc(c,f); return (r == 0);

return (isprint(c) == 0 && isspace(c) == 0);

}

void

Line 2716 writebin(char *name, GEN x)

Line 2953 writebin(char *name, GEN x)

{

entree *ep = varentries[v];

if (!ep) continue;

writenamedGEN(ep->value,ep->name,f);

writenamedGEN((GEN)ep->value,ep->name,f);

}

fclose(f);

}

/* read all objects in file and return last one */

/* read all objects in f. If f contains BIN_GEN that would be silently ignored

* [i.e f contains more than one objet, not all of them 'named GENs'], return

* them all in a vector with clone bit set (special marker). */

GEN

readbin(char *name, FILE *f)

{

GEN y, x = NULL;

gpmem_t av = avma;

check_magic(name,f);

GEN x,y,z;

while ((y = readobj(f))) x = y;

int cx,cy;

check_magic(name,f); x = y = z = NULL;

cx = 0; /* gcc -Wall */

while ((y = readobj(f, &cy)))

{

if (x && cx == BIN_GEN) z = z? concatsp(z, _vec(x)): _vec(x);

x = y; cx = cy;

}

if (z)

{

if (x && cx == BIN_GEN) z = z? concatsp(z, _vec(x)): _vec(x);

if (DEBUGLEVEL)

err(warner,"%ld unnamed objects read. Returning then in a vector",

lg(z)-1);

x = gerepilecopy(av, z);

setisclone(x); /* HACK */

}

return x;

}

/*******************************************************************/

/** **/

/** GP I/O **/

/** **/

/*******************************************************************/

/* print a sequence of (NULL terminated) GEN */

void

print0(GEN *g, long flag)

{

pariout_t T = GP_DATA? *(GP_DATA->fmt): DFLT_OUTPUT; /* copy */

T.prettyp = flag;

for( ; *g; g++)

if (typ(*g)==t_STR)

pariputs(GSTR(*g)); /* text surrounded by "" otherwise */

else

gen_output(*g, &T);

}

#define PR_NL() {added_newline = 1; pariputc('\n'); pariflush(); }

#define PR_NO() {added_newline = 0; pariflush(); }

void print (GEN *g) { print0(g, f_RAW); PR_NL(); }

void printp (GEN *g) { print0(g, f_PRETTYOLD); PR_NL(); }

void printtex(GEN *g) { print0(g, f_TEX); PR_NL(); }

void print1 (GEN *g) { print0(g, f_RAW); PR_NO(); }

void printp1 (GEN *g) { print0(g, f_PRETTYOLD); PR_NO(); }

void error0(GEN *g) { err(user, g); }

static char *

wr_check(char *s) {

char *t = expand_tilde(s);

if (GP_DATA && GP_DATA->flags & SECURE)

{

fprintferr("[secure mode]: about to write to '%s'. OK ? (^C if not)\n",t);

hit_return();

}

return t;

}

static void wr_init(char *s) { char *t=wr_check(s); switchout(t); free(t);}

void gpwritebin(char *s, GEN x) { char *t=wr_check(s); writebin(t, x); free(t);}

#define WR_NL() {pariputc('\n'); pariflush(); switchout(NULL); }

#define WR_NO() {pariflush(); switchout(NULL); }

void write0 (char *s, GEN *g) { wr_init(s); print0(g, f_RAW); WR_NL(); }

void writetex(char *s, GEN *g) { wr_init(s); print0(g, f_TEX); WR_NL(); }

void write1 (char *s, GEN *g) { wr_init(s); print0(g, f_RAW); WR_NO(); }

/*******************************************************************/

/** **/

/** HISTORY HANDLING **/

/** **/

/*******************************************************************/

/* history management function:

* p > 0, called from %p

* p <= 0, called from %` (p backquotes, possibly 0) */

GEN

gp_history(gp_hist *H, long p, char *old, char *entry)

{

GEN z;

if (p <= 0) p += H->total; /* count |p| entries starting from last */

if ((ulong)p > H->total)

err(talker2, "I can't see into the future", old, entry);

z = H->res[ (p-1) % H->size ];

if (!z || p <= 0 || p <= (long)(H->total - H->size))

err(talker2, "I can't remember before the big bang", old, entry);

return z;

}

GEN

set_hist_entry(gp_hist *H, GEN x)

{

int i = H->total % H->size;

H->total++;

if (H->res[i]) gunclone(H->res[i]);

return H->res[i] = gclone(x);

}

/*******************************************************************/

/** **/

/** TEMPORARY FILES **/

/** **/

/*******************************************************************/

Line 2804 env_ok(char *s)

Line 3139 env_ok(char *s)

}

static char*

pari_tmp_dir()

pari_tmp_dir(void)

{

char *s;

#ifdef WINCE

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>