/*******************************************************************/
/**                                                               **/
/**                 INPUT/OUTPUT SUBROUTINES                      **/
/**                                                               **/
/**                    copyright Babe Cool                        **/
/**                                                               **/
/*******************************************************************/
/* $Id: es.c,v 2.0.0.2 1997/12/14 20:11:49 karim Exp karim $ */
#include <sys/types.h>
#include "genpari.h"
#include "anal.h"

/********************************************************************/
/**                                                                **/
/**                        INPUT FILTER                            **/
/**                                                                **/
/********************************************************************/

/* s must be writable. s1 contains the filtered out string */
int
filtre(char *s, int status)
{
  static int in_string, in_comment = 0;
  char c, *s1 = s;

  switch(status)
  {
    case f_COMMENT: return in_comment;
    case f_INIT: in_string = 0; break;
  }
  while ((c = *s++))
  {
    if (in_string) *s1++ = c; /* here copy verbatim */
    else if (in_comment)
    {
      while (c != '*' || *s != '/')
      {
        if (!*s) { *s1=0; return 0; }
        c = *s++;
      }
      s++; in_comment=0; continue;
    }
    else 
    { /* weed out comments and spaces */
      while (c == '\\' && *s == '\\')  /* one-line comment */
      {
	while (*++s && *s != '\n');
	if (!*s) { *s1=0; return 0; }
	c = *s++;
      }
      if (isspace(c)) continue; 
      *s1++ = (compatible == OLDALL && isupper(c))? tolower(c): c;
    }
    switch(c)
    {
      case '/': 
        if (*s != '*' || in_string) break;
        /* start multi-line comment */
        s1--; in_comment = 1; break;

      case '\\':  
        if (!in_string) break;
        if (!*s) return 0;     /* this will result in an error */
        *s1++ = *s++; break; /* in strings, \ is the escape character */
        /*  \" does not end a string. But \\" does */

      case '"':
        in_string = !in_string;
    }
  }
  *s1 = 0; return 0;
}

/********************************************************************/
/**                                                                **/
/**                  GENERAL PURPOSE PRINTING                      **/
/**                                                                **/
/********************************************************************/
PariOUT *pariOut, *pariErr;

static void
normalOutC(char c)
{
  putc(c, outfile);
  if (logfile) putc(c, logfile);
}
static void
normalOutS(char *s)
{
  fputs(s, outfile);
  if (logfile) fputs(s, logfile);
}
static void
normalOutF(void)
{
  fflush(outfile);
  if (logfile) fflush(logfile);
}
PariOUT defaultOut = {normalOutC, normalOutS, normalOutF, NULL};

static void
normalErrC(char c)
{
  putc(c, errfile);
  if (logfile) putc(c, logfile);
}
static void
normalErrS(char *s)
{
  fputs(s, errfile);
  if (logfile) fputs(s, logfile);
}
static void
normalErrF(void)
{
  fflush(errfile);
  if (logfile) fflush(logfile);
}
PariOUT defaultErr = {normalErrC, normalErrS, normalErrF, NULL};

void
initout(void)
{
  pariOut = &defaultOut;
  pariErr = &defaultErr;
}

void
pariputc(char c) { pariOut->putch(c); }

void
pariputs(char *s) { pariOut->puts(s); }

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

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

/* format is standard printf format, except %Z is a GEN (cast to long) */
void
vpariputs(char* format, va_list args)
{
  char buf[1024], str[128], *f = format, *s = str;
  long nb = 0;

  while (*f)
  {
    if (*f != '%') *s++ = *f++;
    else
    {
      if (f[1] != 'Z') { *s++ = *f++; *s++ = *f++; }
      else
      {
        strcpy(s,"\001%016ld\001"); /* brace with unprobable characters */
        nb++; s += 8; f += 2; /* skip %Z */
      }
    }
  }
  *s = 0; vsprintf(buf,str,args); s = buf;
  if (nb)
    for (f=s; *f; f++)
      if (*f == '\001' && f[17] == '\001')
      {
        if (!nb) err(talker,"dangerous chars in vpariputs");
        *f = 0; f[17] = 0; /* remove the bracing chars */
        pariOut->puts(s); brute((GEN)atol(f+1),'g',-1);
        f += 18; s = f; nb--;
      }
  pariOut->puts(s); 
}

void
pariputsf(char *format, ...)
{
  va_list args;

  va_start(args,format); vpariputs(format,args);
  va_end(args);
}

/* output string wrapped after MAX_WIDTH characters (for gp -test) */
static col_index;
#define MAX_WIDTH 74

static void
putc80(char c)
{
  if (c == '\n') col_index = -1;
  else if (col_index == MAX_WIDTH) 
    { putc('\n',outfile); col_index = 0; }
  putc(c, outfile); col_index++;
}
static void
puts80(char *s)
{
  long i,len = strlen(s);
  for(i=0; i<len; i++) putc80(s[i]);
}
PariOUT pariOut80= {putc80, puts80, normalOutF, NULL};

void
init80(long n)
{ 
  col_index = n; pariOut = &pariOut80;
}

/* start printing in color c (on white background) */
/* very crude, will only work with color_xterm */
void
term_color(int c)
{
  pariputs(term_get_color(c));
}

char *
term_get_color(int c)
{
  static char s[16];

  if (disable_color) return "";
  if (c == c_NONE) return "\033[0m"; /* reset */

  c = gp_colors[c];
  if (c<8) c += 30; else c += 82;
  sprintf(s, "\033[0;%d;%dm", c, 107);
  return s;
}

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

static void
zeros(long nb)
{
  while (nb-- > 0) pariputc('0');
}

static long
coinit(long grandmot)
{
  char cha[10], *p = cha + 9;
  int i;

  *p = 0;
  do { *--p = grandmot%10 + '0'; grandmot /= 10; } while (grandmot);
  pariputs(p); i = (cha - p) + 9; return i;
}

static void
comilieu(long grandmot)
{
  char cha[10], *p = cha + 9;

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

static void
cofin(long grandmot, long decim)
{
  char cha[10], *p = cha + 9;

  for (; p > cha; grandmot /= 10) *--p = grandmot%10 + '0';
  cha[decim] = 0; pariputs(cha);
}

static long
nbdch(long l)
{
  if (l<10) return 1;
  if (l<100) return 2;
  if (l<1000) return 3;
  if (l<10000) return 4;
  if (l<100000) return 5;
  if (l<1000000) return 6;
  if (l<10000000) return 7;
  if (l<100000000) return 8;
  if (l<1000000000) return 9;
  return 10; /* not reached */
}


/********************************************************************/
/**                                                                **/
/**                    GEN <---> CHARACTER STRINGS                 **/
/**                                                                **/
/********************************************************************/

typedef struct outString {
  char *string;
  ulong len,size;
} outString;
static outString OutStr;

#define STEPSIZE 1024
static void
check_output_length(long len)
{
  if (OutStr.len + len >= OutStr.size)
  {
    len += OutStr.size + STEPSIZE;
    OutStr.string = gprealloc(OutStr.string, len, OutStr.size);
    OutStr.size = len;
  }
}

static void
outstr_putc(char c)
{
  check_output_length(1);
  OutStr.string[OutStr.len++] = c;
}
static void
outstr_puts(char *s)
{
  long len=strlen(s);

  check_output_length(len);
  strcpy(OutStr.string+OutStr.len,s);
  OutStr.len += len;
}
static void
outstr_flush(void) { /* empty */ }
PariOUT pariOut2Str = {outstr_putc, outstr_puts, outstr_flush, NULL};

/* returns a malloc-ed string, which should be freed after usage */
char *
GENtostr(GEN x)
{
  PariOUT *tmp = pariOut;

  if (typ(x) == t_STR)
  {
    char *s1 = GSTR(x), *s = gpmalloc(1+strlen(s1));
    strcpy(s,s1); return s;
  }
  pariOut = &pariOut2Str;
  OutStr.len = 0; OutStr.size=0; OutStr.string=NULL;
  bruteall(x,'g',-1,1);
  OutStr.string[OutStr.len] = 0;

  pariOut = tmp; return OutStr.string;
}

GEN
gtostr(GEN x)
{
  char *s=GENtostr(x);
  x = strtoGEN(s,strlen(s));
  free(s); return x;
}

/********************************************************************/
/**                                                                **/
/**                         WRITE A NUMBER                         **/
/**                                                                **/
/********************************************************************/

/* Affiche le nombre x
 * format (utilise si x reel)
 * e: format exponentiel
 * f: virgule flottante
 * g: comme f sauf si x trop petit.
 */
static void
ecrireall(GEN x, char format, long dec, long chmp, long keep_spaces)
{
  long *res,*re, ltop,i, sx=signe(x);
  GEN p1;

  if (typ(x) == t_INT) /* ecriture d'un entier */
  {
    if (!sx) { pariputc('0'); return; }

    re = res = convi(x);
    i = nbdch(*--re); while (*--re >= 0) i+=9;
    if (sx!=1) { i++; blancs(chmp-i); pariputc('-'); }
    else blancs(chmp-i);
    coinit(*--res); while (*--res >= 0) comilieu(*res);
    return;
  }

  switch (format) /* ecriture d'un reel */
  {
    case 'f':
    {
      long d,e,decmax,deceff,arrondi[3];
      GEN enti,frac,modifie;

      if (!sx) /*  reel 0 */
      {
	long len = 1+((-expo(x))>>TWOPOTBITS_IN_LONG);

	pariputs("0."); if (len<0) len=0;
	if (dec<0) dec=(long)(pariK*len);
	zeros(dec); return;
      }
      /* reel non nul */

      /*  on arrondit si il y a lieu */
      for (i=0; i<=2; i++) arrondi[i]=x[i];
      ltop=avma; setlg(arrondi,3);
      if (dec>0)
      {
	arrondi[1] = (long) (arrondi[1]-((double)BITS_IN_LONG/pariK)*dec-2);
	modifie=mpadd(x,arrondi);
      }
      else modifie=x;

      if (expo(modifie) >= bit_accuracy(lg(modifie)))
      {
	ecrireall(x,'e',dec,chmp,keep_spaces); return;
      }
      if (sx<0) pariputc('-');

      /* partie entiere */
      enti=gcvtoi(modifie,&e); if (e>0) err(talker,"bug in ecrireall");
      res=convi(enti); d=coinit(*(--res));
      while (*(--res) >= 0) { d += 9; comilieu(*res); }
      pariputc('.');

      /* partie fractionnaire */
      frac=subri(modifie,enti);
      if (!signe(frac))
      {
	if (dec<0) dec=(long) (-expo(frac)*L2SL10+1);
	dec -= d; if (dec>0) zeros(dec);
	avma=ltop; return;
      }

      if (!signe(enti))
      {
	for(;;)
	{
	  p1=mulsr(1000000000,frac); if (expo(p1)>=0) break; 
          zeros(9); frac=p1;
	}
	for(;;)
	{
	  p1=mulsr(10,frac); if (expo(p1)>=0) break;
	  zeros(1); frac=p1;
	}
	d=0;
      }
      res = (long *) confrac(frac); decmax = d + *res++;
      if (dec<0) dec=decmax;
      deceff=dec-decmax; dec -= d;
      while (dec>8)
      {
	if (dec>deceff) comilieu(*res++); else zeros(9);
	dec -= 9;
      }
      if (dec>0)
      {
	if (dec>deceff) cofin(*res,dec); else zeros(dec);
      }
      avma=ltop; break;
    }

    case 'e':
    {
      char *s = keep_spaces? " ": "";
      long ex=expo(x);
      GEN dix;
      
      ex = (ex>=0)? (long)(ex*L2SL10) : (long)(-(-ex*L2SL10)-1);
      if (!sx) { pariputsf("0.E%ld", ex+1); return; }

      ltop=avma; dix=cgetr(lg(x)+1); affsr(10,dix);
      p1 = (ex>0)? divrr(x,gpuigs(dix,ex)): mulrr(x,gpuigs(dix,-ex));
      if (absr_cmp(p1, dix) >= 0) { p1=divrr(p1,dix); ex++; }
      ecrireall(p1,'f',dec,chmp,keep_spaces);
      pariputsf("%sE%ld",s,ex); avma=ltop; break;
    }

    case 'g':
      ecrireall(x,(expo(x) >= -32)? 'f': 'e',dec,chmp,keep_spaces); break;

    default: err(talker,"inexistent format");
  }
}

void
ecrire(GEN x, char format, long dec, long chmp)
{
  ecrireall(x,format,dec,chmp,1);
}

#if 0
/* OBSOLETE (see GENtostr())*/
/* Convert g (which must be a PARI integer) to a (decimal) string in buf.
 * Return buf. The array buf must be large enough to hold g.
 */
char *
gitoascii(GEN g, char* buf)
{
  const long ltop = avma;

  GEN gleft = gabs(g,0);
  GEN gbillion = stoi(1000000000L);  /* Do 9 digits at a time */
  long i, irem, nchar = 0;

  if (typ(g) != t_INT) err(talker, "non-integer argument to gitoascii");

  for(;;)
  {
    GEN gqr = gdiventres(gleft, gbillion);

    irem = itos((GEN)gqr[2]); 	/* Remainder */
    gleft = (GEN)gqr[1]; 	/* Quotient */

    if (!signe(gleft)) break;

    for (i = 0; i <= 8; i++)
    {
      buf[nchar++] = (char)(irem % 10) + '0';
      irem /= 10;
    }
  } /* while */

  do
  {
    buf[nchar++] = (char)(irem % 10) + '0';
    irem /= 10;
  }
  while (irem != 0);

  if (signe(g) < 0)
    buf[nchar++] = '-'; 	/* Check for negative number */
  buf[nchar] = '\0'; 		/* String terminator */

  for (i = 0; 2*i < nchar; i++)
  {
    char ch = buf[i];
    buf[i] = buf[nchar-1-i];
    buf[nchar-1-i] = ch;	/* Reverse order of digits */
  }
  avma = ltop; return buf;
}
#endif

/********************************************************************/
/**                                                                **/
/**                       HEXADECIMAL OUTPUT                       **/
/**                                                                **/
/********************************************************************/

static void
sorstring(char* b, long x)
{
#ifdef LONG_IS_64BIT
  pariputsf(b,(ulong)x>>32,x & MAXHALFULONG);
#else
  pariputsf(b,x);
#endif
}

static void
voir2(GEN x, long nb, long bl)
{
  long tx=typ(x),i,j,e,dx,lx=lg(x);

  bl+=2;
  sorstring(VOIR_STRING1,(ulong)x);
  switch(tx)
  {
    case t_INT:
      if (nb<0) nb=lgefint(x); /* fall through */
    case t_REAL: case t_STR:
      if (nb<0) nb=lg(x);
      for (i=0; i<nb; i++) sorstring(VOIR_STRING2,x[i]);
      pariputc('\n'); break;

    case t_INTMOD:
      for (i=0; i<3; i++) sorstring(VOIR_STRING2,x[i]);
      pariputc('\n');
      blancs(bl); pariputs("mod = "); voir2((GEN)x[1],lgefint(x[1]),bl);
      blancs(bl);
      if (tx==3) pariputs("int = "); else pariputs("pol = ");
      voir2((GEN)x[2],lgefint(x[2]),bl); break;

    case t_POLMOD:
      for (i=0; i<3; i++) sorstring(VOIR_STRING2,x[i]);
      pariputc('\n');
      blancs(bl); pariputs("mod = "); voir2((GEN)x[1],lgef(x[1]),bl);
      blancs(bl);
      if (tx==3) pariputs("int = "); else pariputs("pol = ");
      voir2((GEN)x[2],lgef(x[2]),bl); break;

    case t_FRAC: case t_FRACN:
      for (i=0; i<3; i++) sorstring(VOIR_STRING2,x[i]);
      pariputc('\n');
      blancs(bl); pariputs("num = "); voir2((GEN)x[1],lgefint(x[1]),bl);
      blancs(bl); pariputs("den = "); voir2((GEN)x[2],lgefint(x[2]),bl);
      break;

    case t_RFRAC: case t_RFRACN:
      for (i=0; i<3; i++) sorstring(VOIR_STRING2,x[i]);
      pariputc('\n');
      blancs(bl); pariputs("num = "); voir2((GEN)x[1],nb,bl);
      blancs(bl); pariputs("den = "); voir2((GEN)x[2],nb,bl);
      break;

    case t_COMPLEX:
      for (i=0; i<3; i++) sorstring(VOIR_STRING2,x[i]);
      pariputc('\n');
      blancs(bl); pariputs("real = "); voir2((GEN)x[1],nb,bl);
      blancs(bl); pariputs("imag = "); voir2((GEN)x[2],nb,bl);
      break;

    case t_PADIC:
      for (i=0; i<5; i++) sorstring(VOIR_STRING2,x[i]);
      pariputc('\n');
      blancs(bl); pariputs("  p : "); voir2((GEN)x[2] ,lgefint(x[2]),bl);
      blancs(bl); pariputs("p^l : "); voir2((GEN)x[3] ,lgefint(x[3]),bl);
      blancs(bl); pariputs("  I : "); voir2((GEN)x[4] ,lgefint(x[3]),bl);
      break;

    case t_QUAD:
      for (i=0; i<4; i++) sorstring(VOIR_STRING2,x[i]);
      pariputc('\n');
      blancs(bl); pariputs("polynomial="); voir2((GEN)x[1],nb,bl);
      blancs(bl); pariputs("real = "); voir2((GEN)x[2],nb,bl);
      blancs(bl); pariputs("imag = "); voir2((GEN)x[3],nb,bl);
      break;

    case t_POL:
      for (i=0; i<lgef(x); i++) sorstring(VOIR_STRING2,x[i]);
      pariputc('\n');
      for (i=2; i<lgef(x); i++)
      {
	blancs(bl); pariputsf("coef of degree %ld = ",i-2);
	voir2((GEN)x[i],nb, bl);
      }
      break;

    case t_SER:
      for (i=0; i<lx; i++) sorstring(VOIR_STRING2,x[i]);
      pariputc('\n'); e=valp(x);
      if (signe(x))
        for (i=2; i<lx; i++)
	{
	  blancs(bl); pariputsf("coef of degree %ld = ",e+i-2);
	  voir2((GEN)x[i],nb, bl);
	}
      break;

    case t_QFR: case t_QFI: case t_VEC: case t_COL:
      for (i=0; i<lx; i++) sorstring(VOIR_STRING2,x[i]);
      pariputc('\n');
      for (i=1; i<lx; i++)
      {
	blancs(bl); pariputsf("%ld-th component = ",i);
	voir2((GEN)x[i],nb,bl);
      }
      break;

    case t_LIST:
      for (i=0; i<lgef(x); i++) sorstring(VOIR_STRING2,x[i]);
      pariputc('\n');
      for (i=2; i<lgef(x); i++)
      {
	blancs(bl); pariputsf("%ld-th component = ",i);
	voir2((GEN)x[i],nb,bl);
      }
      break;

    case t_MAT:
      for (i=0; i<lx; i++) sorstring(VOIR_STRING2,x[i]);
      pariputc('\n'); if (lx==1) return;
      dx=lg((GEN)x[1]);
      for (i=1; i<dx; i++)
	for (j=1; j<lx; j++)
	{
	  blancs(bl); pariputsf("mat(%ld,%ld) = ",i,j);
	  voir2(gcoeff(x,i,j) ,nb, bl);
	}
  }
}

void
voir(GEN x, long nb)
{
  voir2(x,nb,0);
}

/********************************************************************/
/**                                                                **/
/**                        FORMATTED OUTPUT                        **/
/**                                                                **/
/********************************************************************/
static void 
printvar(long v)
{
  entree *ep = varentries[v];

  if (ep)
    pariputs(ep->name);
  else
  {
    if (v==MAXVARN) pariputc('#');
    else
      pariputsf("#<%d>",(int)v);
  }
}

static void 
printtexvar(long v)
{
  entree *ep = varentries[v];
  long subscript = 0;
  char *s;

  if (!ep)
    err(talker, "this object uses debugging variables");
  s = ep->name;
  while(isalpha(*s)) pariputc(*s++);
  if (isdigit(*s)) { subscript=1; pariputs("_{"); }
  pariputs(s);
  if (subscript) pariputc('}');
}

static void
sori(GEN g, char format, long dec, long chmp)
{
  long tg=typ(g), v,i,j,e,l,l1,l2,n,close_paren;

  if (tg == t_STR)
  {
    pariputc('"'); pariputs(GSTR(g)); pariputc('"');
    return;
  }
  if (!is_intreal_t(tg) && !is_matvec_t(tg)) chmp=0;
  if (gcmp0(g) && !is_matvec_t(tg))
  {
    switch(tg)
    {
      case t_REAL:
        ecrire(g,format,dec,chmp); break;
      case t_INTMOD: case t_POLMOD:
	pariputs("(0 mod "); sori((GEN)g[1],format,-1,chmp);
	pariputc(')'); break;
      case t_PADIC:
	pariputs(" 0+O("); ecrire((GEN)g[2],format,dec,chmp);
	pariputsf("^%ld)",valp(g)); break;
      case t_SER:
	pariputs(" 0+O("); printvar(ordvar[varn(g)]);
	pariputsf("^%ld)\n",valp(g)); break;
      default: blancs(chmp-1); pariputc('0');
    }
    return;
  }
  if (gcmp1(g))
  {
    switch(tg)
    {
      case t_REAL:
        ecrire(g,format,dec,chmp); break;
      case t_INTMOD: case t_POLMOD:
	pariputs("(1 mod "); sori((GEN)g[1],format,-1,chmp);
	pariputc(')'); break;
      case t_PADIC:
	pariputs("1+O("); ecrire((GEN)g[2],format,dec,chmp);
	pariputsf("^%ld)",precp(g)); break;
      case t_SER:
	pariputs("1+O("); printvar(ordvar[varn(g)]);
	pariputsf("^%ld)\n",lg(g)-2); break;
      default: blancs(chmp-1); pariputc('1');
    }
    return;
  }
  if (is_frac_t(tg) && gcmp1((GEN)g[2]))
  {
    ecrire((GEN)g[1],format,dec,chmp); return;
  }

  close_paren=0;
  if (!is_intreal_t(tg) && ! is_graphicvec_t(tg))
  {
    if (is_frac_t(tg) && gsigne(g)<0) pariputc('-');
    if (! is_rfrac_t(tg) && tg != t_LIST) { pariputc('('); close_paren=1; }
  }
  switch(tg)
  {
    GEN p,a,b;
    long sa;

    case t_INT: case t_REAL:
      ecrire(g,format,dec,chmp); break;
    case t_INTMOD:
      if (signe((GEN)g[2])<0)
      {
	sori(addii((GEN)g[2],(GEN)g[1]),format,-1,chmp);
      }
      else sori((GEN)g[2],format,dec,chmp);
      pariputs(" mod ");
      sori((GEN)g[1],format,dec,chmp);
      break;
	
    case t_POLMOD:
      sori((GEN)g[2],format,dec,chmp);
      pariputs(" mod ");
      sori((GEN)g[1],format,dec,chmp);
      break;
	
    case t_FRAC: case t_FRACN:
      a=(GEN)g[1]; sa=signe(a); b=(GEN)g[2];
      setsigne(a,1); ecrire(a,format,dec,chmp); setsigne(a,sa);
      if (!gcmp1(b))
      {
	long sb=signe(b);

        pariputs(" /");
        setsigne(b,1); ecrire(b,format,dec,chmp); setsigne(b,sb);
      }
      break;

    case t_COMPLEX: case t_QUAD:
    {
      char *pos, *neg;
      if (tg == t_QUAD)
        { a=(GEN)g[2]; b=(GEN)g[3]; pos=" w"; neg="-w"; }
      else
	{ a=(GEN)g[1]; b=(GEN)g[2]; pos=" I"; neg="-I"; }
      if (!gcmp0(a)) sori(a,format,dec,chmp);
      if (signe(b)>0 && !gcmp0(a)) pariputs(" +"); else pariputc(' ');
      if (!gcmp0(b))
      {
	if (gcmp1(b)) pariputs(pos);
	else
	{
	  if (gcmp_1(b)) pariputs(neg);
	  else { sori(b,format,dec,chmp); pariputs(pos); }
	}
      }
      break;
    }

    case t_POL:
    {
      long i0=gval(g,varn(g))+2;
      
      l=lgef(g)-1; v=ordvar[varn(g)];
      for (i=l; i>=i0; i--)
      {
	a=(GEN)g[i];
	if (!gcmp0(a))
	{
	  long ta=typ(a);
	  
	  if (i==l && gcmp_1(a) && l>2 && ! is_mod_t(ta)) pariputc('-');
	  if ((!gcmp1(a) && !gcmp_1(a)) || i==2 || is_mod_t(ta))
	    sori(a,format,dec,chmp);
	  if (i==3) { pariputc(' '); printvar(v); pariputc(' '); }
	  else if (i>3)
	  { 
	    pariputc(' '); printvar(v); pariputsf("^%ld ",i-2);
	  }
	}
	if (i>i0)
	{
	  b=(GEN)g[i-1];
	  if (!gcmp0(b))
	  {
	    long tb=typ(b);

	    if (i>3 && gcmp_1(b) && ! is_mod_t(tb)) pariputc('-');
	    else
	      if (signe(b)>0 || (!is_intreal_t(tb) && !is_frac_t(tb)))
		pariputc('+');
	  }
	}
      }
      break;
    }

    case t_PADIC:
    {
      GEN b1, a1=(GEN)g[4];

      e=valp(g); l=precp(g); p=(GEN)g[2];
      for (i=0; i<l; i++)
      {
	a1=dvmdii(a1,p,&b1);
	if (signe(b1))
	{
	  if (e+i==0 || !gcmp1(b1))
	  {
	    ecrire(b1,format,dec,chmp);
	    if (e+i) pariputc('*'); else pariputc(' ');
	  }
	  if (e+i==1) { ecrire(p,format,dec,chmp); pariputc(' '); }
	  else if (e+i) { ecrire(p,format,dec,chmp); pariputsf("^%ld ",e+i); }
	  pariputc('+');
	}
      }
      pariputs(" O(");
      if (e+l == 0) pariputs(" 1)");
      else
      {
	ecrire(p,format,dec,chmp);
	if (e+l != 1) pariputsf("^%ld)",e+l);
      }
      break;
    }
	
    case t_SER:
      e=valp(g)-2; v=ordvar[varn(g)];
      l=lg(g); if (!signe(g)) l=2;
      for (i=2; i<l; i++)
      {
	long ta,tb;

	a=(GEN)g[i];
	if (!gcmp0(a))
	{
	  ta=typ(a);
	  if (e+i==0 || (!gcmp1(a) && !gcmp_1(a)) || is_mod_t(ta))
	  {
	    sori(a,format,dec,chmp);
	    if (!(e+i)) pariputc(' ');
	  }
	  else if (gcmp_1(a)) pariputc('-');
	  if (e+i==1) { pariputc(' '); printvar(v); pariputc(' '); }
	  else if (e+i>1)
	  { 
	    pariputc(' '); printvar(v);
	    pariputsf("^%ld ",e+i);
	  }
	}
        if (i<l-1)
        {
          b = (GEN) g[i+1]; tb=typ(b);
          if (signe(b)>0 || (!is_intreal_t(tb) && !is_frac_t(tb)))
            pariputc('+');
        }
      }
      if (e+l==0) pariputs("+ O(1)");
      else if (e+l==1) { pariputs("+ O("); printvar(v); pariputc(')'); }
      else
      {
	pariputs("+ O("); printvar(v); pariputsf("^%ld)",e+l);
      }
      break;
	
    case t_RFRAC: case t_RFRACN:
      pariputs("\n\n"); l1=lg((GEN)g[1]); l2=lg((GEN)g[2]);
      l= (l1>l2) ? l1-2 : l2-2;
      sori((GEN)g[1],format,dec,chmp); pariputc('\n');
      for (n=1; n<l; n++)
	pariputs("----------"); pariputc('\n');
      sori((GEN)g[2],format,dec,chmp); break;
	
    case t_QFR: case t_QFI: pariputc('{');
      sori((GEN)g[1],format,dec,chmp); pariputc(',');
      sori((GEN)g[2],format,dec,chmp); pariputc(',');
      sori((GEN)g[3],format,dec,chmp);
      if (tg == t_QFR) { pariputc(','); sori((GEN)g[4],format,dec,chmp); }
      pariputs(" }\n"); break;
	
    case t_VEC:
      chmp=0; pariputc('[');
      for (i=1; i<lg(g); i++)
      {
	sori((GEN)g[i],format,dec,chmp);
	if (i<lg(g)-1) pariputc(',');
      }
      pariputs("]\n"); break;

    case t_LIST:
      chmp=0; pariputs("List(");
      for (i=2; i<lgef(g); i++)
      {
	sori((GEN)g[i],format,dec,chmp);
	if (i<lgef(g)-1) pariputs(", ");
      }
      pariputs(")\n"); break;
      
    case t_COL:
      if (lg(g)==1) { pariputs("[]\n"); return; }
      for (i=1; i<lg(g); i++)
      {
        pariputc('[');
        sori((GEN)g[i],format,dec,chmp);
        pariputs("]\n");
      }
      break;
	
    case t_MAT:
    {
      long dx, lx=lg(g);

      pariputs("\n\n");
      if (lx==1) { pariputs("[;]\n"); return; }
      dx=lg((GEN)g[1]);
      for (i=1; i<dx; i++)
      {
	pariputc('[');
	for (j=1; j<lx; j++)
	{
	  sori(gcoeff(g,i,j),format,dec,chmp);
	  if (j<lx-1) pariputc(' ');
	 }
	if (i<dx-1) pariputs("]\n\n"); else pariputs("]\n");
      }
      break;
    }
    default: sorstring(VOIR_STRING2,*g);
  }
  if (close_paren) pariputc(')');
}

void
etatpile(unsigned int n)
{
  long av=avma,nu,i,l,m;
  GEN adr,adr1;
  double r;

  nu = (top-avma)/BYTES_IN_LONG;
  l = (top-bot)/BYTES_IN_LONG;
  r = 100.0*nu/l;
  pariputsf("\n Top : %lx   Bottom : %lx   Current stack : %lx\n",
          top, bot, avma);

  pariputsf(" Used :                         %ld  long words  (%ld K)\n",
           nu, nu/1024*BYTES_IN_LONG);

  pariputsf(" Available :                    %ld  long words  (%ld K)\n",
           (l-nu), (l-nu)/1024*BYTES_IN_LONG);

  pariputsf(" Occupation of the PARI stack : %6.2f percent\n",r);

  adr=getheap();
  pariputsf(" %ld objects on heap occupy %ld long words\n\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);
  if (!n) return;

  if (n>nu) n=nu; adr=(GEN)avma; adr1=adr+n;
  while (adr<adr1)
  {
    sorstring(VOIR_STRING3,(ulong)adr);
    l=lg(adr); m = (adr==polvar) ? MAXVARN : 0;
    for (i=0; i<l && adr<adr1; i++,adr++) sorstring(VOIR_STRING2,*adr);
    pariputc('\n'); adr=polvar+m;
  }
  pariputc('\n');
}

/********************************************************************/
/**                                                                **/
/**                           RAW OUTPUT                           **/
/**                                                                **/
/********************************************************************/

static long
isnull(GEN g)
{
  long i;
  switch (typ(g))
  {
    case t_INT:
      return !signe(g);
    case t_COMPLEX:
      return isnull((GEN)g[1]) && isnull((GEN)g[2]);
    case t_QUAD:
      return isnull((GEN)g[2]) && isnull((GEN)g[3]);
    case t_POLMOD:
      return isnull((GEN)g[2]);
    case t_FRAC: case t_FRACN: case t_RFRAC: case t_RFRACN:
      return isnull((GEN)g[1]);
    case t_POL:
      for (i=lgef(g)-1; i>1; i--)
	if (!isnull((GEN)g[i])) return 0;
      return 1;
  }
  return 0;
}

static long
isnull_for_pol(GEN g)
{
  if (typ(g)==t_INTMOD) return !signe(g[2]);
  return isnull(g);
}

/* return 1 or -1 if g is 1 or -1 (as a GEN), 0 otherwise*/
static long
isone(GEN g)
{
  long i,sig;
  switch (typ(g))
  {
    case t_INT:
      if (!signe(g)) return 0;
      return is_pm1(g)? signe(g): 0;
    case t_COMPLEX:
      return isnull((GEN)g[2]) * isone((GEN)g[1]);
    case t_QUAD:
      return isnull((GEN)g[3]) * isone((GEN)g[2]);
    case t_FRAC: case t_FRACN: case t_RFRAC: case t_RFRACN:
      return isone((GEN)g[1]) * isone((GEN)g[2]);
    case t_POL:
      if (!signe(g)) return 0;
      sig = isone((GEN)g[2]); if (!sig) return 0;
      for (i=lgef(g)-1; i>2; i--)
	if (!isnull((GEN)g[i])) return 0;
      return sig;
  }
  return 0;
}

/* if g is a monomial, return its sign, 0 otherwise */
static long
isfactor(GEN g)
{
  long i,deja=0,sig=1;
  switch(typ(g))
  {
    case t_INT: case t_REAL:
      return (signe(g)<0)? -1: 1;
    case t_FRAC: case t_FRACN: case t_RFRAC: case t_RFRACN:
      return isfactor((GEN)g[1]);
    case t_COMPLEX:
      if (isnull((GEN)g[1])) return isfactor((GEN)g[2]);
      return isnull((GEN)g[2])? isfactor((GEN)g[1]): 0;
    case t_PADIC:
      return !signe((GEN)g[4]);
    case t_QUAD:
      if (isnull((GEN)g[2])) return isfactor((GEN)g[3]);
      return isnull((GEN)g[3])? isfactor((GEN)g[2]): 0;
    case t_POL:
      for (i=lgef(g)-1; i>1; i--)
        if (!isnull((GEN)g[i]))
	{
	  if (deja) return 0;
	  sig=isfactor((GEN)g[i]); deja=1;
	}
      return sig? sig: 1;
    case t_SER:
      if (!signe(g)) return 1;
      for (i=lg(g)-1; i>1; i--)
        if (!isnull((GEN)g[i])) return 0;
  }
  return 1;
}

/* return 1 if g is a "truc" (see anal.c) */
static long
isdenom(GEN g)
{
  long i,deja=0;
  switch(typ(g))
  {
    case t_FRAC: case t_FRACN: case t_RFRAC: case t_RFRACN:
      return 0;
    case t_COMPLEX:
      return isnull((GEN)g[2]);
    case t_PADIC:
      return !signe((GEN)g[4]);
    case t_QUAD:
      return isnull((GEN)g[3]);
    case t_POL:
      for (i=lgef(g)-1; i>1; i--)
        if (!isnull((GEN)g[i]))
	{
	  if (deja) return 0;
	  if (i==2) return isdenom((GEN)g[2]);
	  if (!isone((GEN)g[i])) return 0;
	  deja=1;
	}
      return 1;
    case t_SER:
      if (!signe(g)) return 1;
      for (i=lg(g)-1; i>1; i--)
	if (!isnull((GEN)g[i])) return 0;
  }
  return 1;
}

static void
monome(long v, long deg)
{
  if (deg)
  {
    printvar(v);
    if (deg!=1) pariputsf("^%ld",deg);
  }
  else pariputc('1');
}

static void
texnome(long v, long deg)
{
  if (deg)
  {
    printtexvar(v);
    if (deg!=1) pariputsf("^{%ld}",deg);
  }
  else pariputc('1');
}

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

static void
brutiall(GEN g, char format, long dec, long nosign, long keep_spaces)
{
  long tg, e,l,sig,i,j,r,v;
  GEN p;

  if (isnull(g)) { pariputc('0'); return; }
  sig=isone(g);
  if (sig)
  {
    if (!nosign && sig<0) pariputc('-');
    pariputc('1'); return;
  }

  tg = typ(g);
  switch(tg)
  {
    case t_INT: case t_REAL:
      if (nosign && signe(g)<0) g=mpabs(g);
      ecrireall(g,format,dec,0,keep_spaces); break;

    case t_INTMOD: case t_POLMOD:
      pariputs(new_fun_set? "Mod(": "mod(");
      brutiall((GEN)g[2],format,dec,0,keep_spaces);
      pariputs(keep_spaces?", ":",");
      brutiall((GEN)g[1],format,dec,0,keep_spaces); pariputc(')'); break;

    case t_FRAC: case t_FRACN: case t_RFRAC: case t_RFRACN:
      if (!(sig=isfactor((GEN)g[1]))) pariputc('(');
      brutiall((GEN)g[1],format,dec,nosign,keep_spaces);
      if (!sig) pariputc(')');
      pariputc('/');
      if (!(sig=isdenom((GEN)g[2]))) pariputc('(');
      brutiall((GEN)g[2],format,dec,0,keep_spaces);
      if (!sig) pariputc(')');
      break;

    case t_COMPLEX: case t_QUAD:
      r = (tg==t_QUAD);
      if (isnull((GEN)g[r+1]))
      {
        if ((sig=isone((GEN)g[r+2])))
	{
	  if (!nosign && sig<0) pariputc('-');
	  pariputc(r ? 'w' : 'I'); return;
	}
	if (!(sig=isfactor((GEN)g[r+2]))) pariputc('(');
	brutiall((GEN)g[r+2],format,dec,nosign,keep_spaces);
	if (!sig) pariputc(')');
	pariputc('*'); pariputc(r ? 'w' : 'I'); return;
      }
      brutiall((GEN)g[r+1],format,dec,nosign,keep_spaces);
      if (!isnull((GEN)g[r+2]))
      {
	if ((sig=isone((GEN)g[r+2])))
	{
	  putsignb(sig,keep_spaces); pariputc(r ? 'w' : 'I');
	  return;
	}
	if ((sig=isfactor((GEN)g[r+2]))) putsignb(sig,keep_spaces);
	else pariputs(keep_spaces?" + (":"+(");
	brutiall((GEN)g[r+2],format,dec,1,keep_spaces);
	if (!sig) pariputc(')');
	pariputc('*'); pariputc(r ? 'w' : 'I'); return;
      }
      break;

    case t_POL:
      v=ordvar[varn(g)]; i=lgef(g)-1;
      while (isnull((GEN)g[i])) i--;
      sig=isone((GEN)g[i]);
      if (sig)
      {
	if (!nosign && sig<0) pariputc('-');
	monome(v,i-2);
      }
      else
      {
	if (isfactor((GEN)g[i]))
	  brutiall((GEN)g[i],format,dec,nosign,keep_spaces);
	else
	{
	  pariputc('(');
	  brutiall((GEN)g[i],format,dec,0,keep_spaces);
	  pariputc(')');
	 }
	if (i>2) { pariputc('*'); monome(v,i-2); }
      }
      for (; --i>1; )
        if (!isnull_for_pol((GEN)g[i]))
          if ((sig=isone((GEN)g[i])))
          { 
            putsignb(sig,keep_spaces);
            monome(v,i-2);
          }
          else
          {
            if ((sig=isfactor((GEN)g[i]))) putsignb(sig,keep_spaces);
            else pariputs(keep_spaces?" + (":"+(");
            brutiall((GEN)g[i],format,dec,sig,keep_spaces);
            if (!sig) pariputc(')');
            if (i>2) { pariputc('*'); monome(v,i-2); }
          }
      break;

    case t_PADIC:
    {
      GEN b1, a1=(GEN)g[4];

      e=valp(g); l=precp(g); p=(GEN)g[2];
      for (i=0; i<l; i++)
      {
	a1=dvmdii(a1,p,&b1);
	if (signe(b1))
	{
	  if (e+i==0 || !gcmp1(b1))
	  {
	    ecrireall(b1,format,0,0,keep_spaces);
	    if (e+i) pariputc('*');
	  }
	  if (e+i)
	  {
	    ecrireall(p,format,0,0,keep_spaces);
	    if (e+i != 1) pariputsf("^%ld",e+i);
	  }
	  pariputs(keep_spaces?" + ":"+");
	}
      }
      pariputs("O("); ecrireall(p,format,0,0,keep_spaces);
      if (e+l != 1) pariputsf("^%ld",e+l);
      pariputc(')'); break;
    }

    case t_SER:
      e=valp(g)-2; v=ordvar[varn(g)];
      if (signe(g))
      {
	l=lg(g);
	if ((sig=isone((GEN)g[2])))
	{ 
	  if (sig<0) pariputc('-');
	  monome(v,2+e);
	}
	else
	{
	  if (!(sig=isfactor((GEN)g[2]))) pariputc('(');
	  brutiall((GEN)g[2],format,dec,nosign,keep_spaces);
	  if (!sig) pariputc(')');
	  if (valp(g)) { pariputc('*'); monome(v,valp(g)); }
	}
	for (i=3; i<l; i++) 
          if (!isnull_for_pol((GEN)g[i]))
            if ((sig=isone((GEN)g[i])))
            { 
              putsignb(sig,keep_spaces); monome(v,i+e);
            }
            else
            {
              if ((sig=isfactor((GEN)g[i]))) putsignb(sig,keep_spaces);
              else pariputs(keep_spaces?" + (":"+(");
              brutiall((GEN)g[i],format,dec,sig,keep_spaces);
              if (!sig) pariputc(')');
              if (i+e != 0) { pariputc('*'); monome(v,i+e); }
            }
	pariputs(keep_spaces?" + ":"+");
      }
      else l=2;
      pariputs("O("); printvar(v);
      if (e+l != 1) pariputsf("^%ld",e+l);
      pariputc(')'); break;

    case t_QFR: case t_QFI:
      r = (tg == t_QFR);
      if (new_fun_set) pariputs("Qfb(");else pariputs(r? "qfr(": "qfi(");
      brutiall((GEN)g[1],format,dec,0,keep_spaces);
      pariputs(keep_spaces?", ":",");
      brutiall((GEN)g[2],format,dec,0,keep_spaces);
      pariputs(keep_spaces?", ":",");
      brutiall((GEN)g[3],format,dec,0,keep_spaces);
      if (r)
      {
	pariputs(keep_spaces?", ":",");
	brutiall((GEN)g[4],format,dec,0,keep_spaces);
      }
      pariputc(')'); break;

    case t_VEC: case t_COL:
      pariputc('[');
      for (i=1; i<lg(g); i++)
      {
	brutiall((GEN)g[i],format,dec,0,keep_spaces);
	if (i<lg(g)-1) pariputs(keep_spaces?", ":",");
      }
      pariputc(']'); if (tg==t_COL) pariputc('~');
      break;

    case t_LIST:
      pariputs("List([");
      for (i=2; i<lgef(g); i++)
      {
	brutiall((GEN)g[i],format,dec,0,keep_spaces);
	if (i<lgef(g)-1) pariputs(keep_spaces?", ":",");
      }
      pariputs("])");
      break;

    case t_STR:
      pariputc('"'); pariputs(GSTR(g)); pariputc('"');
      return;
      
    case t_MAT:
      if (lg(g)==1) { pariputs("[;]"); return; }

      l=lg((GEN)g[1]);
      if (l==1)
      {
	pariputsf("matrix(0,%ld,j,k,0)",lg(g)-1); return;
      }

      if (l==2) pariputs(new_fun_set? "Mat(": "mat(");
      pariputc('[');
      for (i=1; i<l; i++)
      {
	for (j=1; j<lg(g); j++)
	{
	  brutiall(gcoeff(g,i,j),format,dec,0,keep_spaces);
	  if (j<lg(g)-1) pariputs(keep_spaces?", ":",");
	}
	if (i<lg((GEN)g[1])-1) pariputs(keep_spaces?"; ":";");
      }
      if (l==2) pariputs("])"); else pariputc(']');
      break;

    default: sorstring(VOIR_STRING2,*g);
  }
}

static void
matbruti(GEN g, char format, long dec, long flag)
{
  long i,j,lx,l;

  if (typ(g) != t_MAT) { brutiall(g,format,dec,flag,1); return; }

  pariputc('\n'); lx=lg(g);
  if (lx==1) { pariputs("[;]\n"); return; }
  l=lg((GEN)g[1]);
  for (i=1; i<l; i++)
  {
    pariputc('[');
    for (j=1; j<lx; j++)
    {
      brutiall(gcoeff(g,i,j),format,dec,0,1);
      if (j<lx-1) pariputc(' ');
    }
    if (i<l-1) pariputs("]\n\n");
    else pariputs("]\n");
  }
}

/********************************************************************/
/**                                                                **/
/**                           TeX OUTPUT                           **/
/**                                                                **/
/********************************************************************/

static void
texi(GEN g, char format, long dec, long nosign)
{
  long tg,e,l,sig,i,j,r,v;
  GEN a1,b1,p;

  pariputc('{');
  if (isnull(g)) { pariputs("0}"); return; }
  sig=isone(g);
  if (sig)
  {
    if (!nosign && sig<0) pariputc('-');
    pariputs("1}");
    return;
  }
  tg=typ(g);
  switch(tg)
  {
    case t_INT: case t_REAL:
      if (nosign && signe(g) < 0) g=mpabs(g);
      ecrire(g,format,dec,0); break;
    case t_INTMOD: case t_POLMOD:
      texi((GEN)g[2],format,dec,0); pariputs("mod");
      texi((GEN)g[1],format,dec,0); break;
    case t_FRAC: case t_FRACN: case t_RFRAC: case t_RFRACN:
      texi((GEN)g[1],format,dec,nosign);
      pariputs("\\over"); texi((GEN)g[2],format,dec,0);
      break;
    case t_COMPLEX: case t_QUAD:
      r = (tg==t_QUAD);
      if (isnull((GEN)g[r+1]))
        if ((sig=isone((GEN)g[r+2])))
	{
	  if (!nosign && sig<0) pariputc('-');
	  pariputc(r ? 'w' : 'I');
	}
        else
	{
	  if (!(sig=isfactor((GEN)g[r+2]))) pariputc('(');
	  texi((GEN)g[r+2],format,dec,nosign);
	  if (!sig) pariputc(')');
	  pariputc(r ? 'w' : 'I');
	}
      else
      {
	texi((GEN)g[r+1],format,dec,nosign);
	if (!isnull((GEN)g[r+2]))
	  if ((sig=isone((GEN)g[r+2])))
	    { putsigne(sig); pariputc(r ? 'w' : 'I'); }
	  else
	  {
	    if ((sig=isfactor((GEN)g[r+2]))) putsigne(sig);
	    else pariputs("+(");
	    texi((GEN)g[r+2],format,dec,1);
	    if (!sig) pariputc(')');
	    pariputc(r ? 'w' : 'I');
	  }
      }
      break;
    case t_POL:
      v=ordvar[varn(g)]; i=lgef(g)-1;
      while (isnull((GEN)g[i])) i--;
      if ((sig=isone((GEN)g[i])))
	{ if (!nosign&&(sig<0)) pariputc('-'); texnome(v,i-2); }
      else
      {
	if (isfactor((GEN)g[i])) texi((GEN)g[i],format,dec,nosign);
	else
	{
	  pariputc('(');
	  texi((GEN)g[i],format,dec,0);
	  pariputc(')');
	 }
	if (i>2) texnome(v,i-2);
      }
      for (; --i>1; ) if (!isnull((GEN)g[i]))
        if ((sig=isone((GEN)g[i]))) { putsigne(sig); texnome(v,i-2); }
        else
	{
	  if ((sig=isfactor((GEN)g[i]))) putsigne(sig); else pariputs("+(");
	  texi((GEN)g[i],format,dec,sig);
	  if (!sig) pariputc(')');
	  if (i>2) texnome(v,i-2);
	 }
      break;
    case t_PADIC:
      a1=(GEN)g[4]; p=(GEN)g[2]; e=valp(g); l=precp(g)+e;
      for (; e<l; e++)
      {
	a1=dvmdii(a1,p,&b1);
	if (signe(b1))
	{
	  if (!e || !gcmp1(b1))
	  {
	    ecrire(b1,format,0,0);
	    if (e) pariputs("\\cdot");
	  }
	  if (e)
	  {
	    ecrire(p,format,0,0);
	    if (e!=1) pariputsf("^{%ld}",e);
	  }
	  pariputc('+');
	}
      }
      pariputs("O(");
      ecrire(p,format,0,0);
      if (e!=1) pariputsf("^{%ld}",e);
      pariputc(')');
      break;

    case t_SER:
      e=valp(g)-2; v=ordvar[varn(g)];
      if (signe(g))
      {
	l=lg(g);
	if ((sig=isone((GEN)g[2])))
	{
	  if (sig<0) pariputc('-');
	  texnome(v,2+e);
	}
	else
	{
	  if (!(sig=isfactor((GEN)g[2]))) pariputc('(');
	  texi((GEN)g[2],format,dec,nosign);
	  if (!sig) pariputc(')');
	  if (valp(g)) texnome(v,valp(g));
	}
	for (i=3; i<l; i++) if (!isnull((GEN)g[i]))
	  if ((sig=isone((GEN)g[i]))) { putsigne(sig); texnome(v,i+e); }
	  else
	  {
	    if ((sig=isfactor((GEN)g[i]))) putsigne(sig); else pariputs(" + (");
	    texi((GEN)g[i],format,dec,sig);
	    if (!sig) pariputc(')');
	    if (i+e) texnome(v,i+e);
	  }
	pariputc('+');
      }
      else  l=2;
      pariputs("O("); printtexvar(v);
      if ((e+l)!=1) pariputsf("^{%ld})",e+l); break;

    case t_QFR:
      if (new_fun_set) pariputs("Qfb(");else pariputs("qfr("); 
      texi((GEN)g[1],format,dec,0); pariputs(", ");
      texi((GEN)g[2],format,dec,0); pariputs(", ");
      texi((GEN)g[3],format,dec,0);
      pariputs(", "); texi((GEN)g[4],format,dec,0);
      pariputc(')'); break;

    case t_QFI:
      if (new_fun_set) pariputs("Qfb("); else pariputs("qfi(");
      texi((GEN)g[1],format,dec,0); pariputs(", ");
      texi((GEN)g[2],format,dec,0); pariputs(", "); 
      texi((GEN)g[3],format,dec,0);
      pariputc(')'); break;

    case t_VEC:
      pariputs("\\pmatrix{ ");
      for (i=1; i<lg(g); i++)
      {
	texi((GEN)g[i],format,dec,0);
	if (i<lg(g)-1) pariputc('&');
      }
      pariputs("\\cr}\n"); break;

    case t_LIST:
      pariputs("\\pmatrix{ ");
      for (i=2; i<lgef(g); i++)
      {
	texi((GEN)g[i],format,dec,0);
	if (i<lgef(g)-1) pariputc('&');
      }
      pariputs("\\cr}\n"); break;
      
    case t_COL:
      pariputs("\\pmatrix{ ");
      for (i=1; i<lg(g); i++)
      {
	texi((GEN)g[i],format,dec,0);
	pariputs("\\cr\n");
      }
      pariputc('}'); break;

    case t_MAT:
      pariputs("\\pmatrix{\n ");
      if (lg(g)>1) for (i=1; i<lg((GEN)g[1]); i++)
      {
	for (j=1; j<lg(g); j++)
	{
	  texi((GEN)((GEN)g[j])[i],format,dec,0);
	  if (j<lg(g)-1) pariputc('&');
	}
	pariputs("\\cr\n ");
      }
      pariputc('}'); break;

    case t_STR:
      pariputs("\\mbox{"); pariputs(GSTR(g)); pariputc('}');
  }
  pariputc('}');
}

/*******************************************************************/
/**                                                               **/
/**                        USER OUTPUT FUNCTIONS                  **/
/**                                                               **/
/*******************************************************************/

void
bruteall(GEN g, char format, long dec, long flag)
{
  long av=avma;
  brutiall(changevar(g,polvar),format,dec,0,flag);
  avma=av;
}

void
matbrute(GEN g, char format, long dec)
{
  long av=avma;
  matbruti(changevar(g,polvar),format,dec,0);
  avma=av;
}

void
sor(GEN g, char format, long dec, long chmp)
{
  long av=avma;
  sori(changevar(g,polvar),format,dec,chmp);
  avma = av;
}

void
texe(GEN g, char format, long dec)
{
  long av=avma;
  texi(changevar(g,polvar),format,dec,0);
  avma=av;
}

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

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

void
output(GEN x)
{
  outbrute(x); pariputc('\n'); pariflush();
}

void
outmat(GEN x)
{
  matbrute(x,'g',-1); pariputc('\n'); pariflush();
}

void
outbeaut(GEN x)
{
  sor(x,'g',-1,0); pariputc('\n'); pariflush();
}

void
outerr(GEN x)
{
  PariOUT *out = pariOut; pariOut = pariErr;
  output(x); pariOut = out;
}

void
outbeauterr(GEN x)
{
  PariOUT *out = pariOut; pariOut = pariErr;
  outbeaut(x); pariOut = out;
}

void
bruterr(GEN x,char format,long dec)
{
  PariOUT *out = pariOut; pariOut = pariErr;
  bruteall(x,format,dec,1); pariOut = out;
}

void
fprintferr(char* format, ...)
{
  va_list args;
  PariOUT *out = pariOut; pariOut = pariErr;

  va_start(args, format); vpariputs(format,args);
  va_end(args); pariOut = out;
}

/*******************************************************************/
/**                                                               **/
/**                   GP STANDARD INPUT AND OUTPUT                **/
/**                                                               **/
/*******************************************************************/
#define MAX_NAME_LEN 255
static int file_depth = 0;
static int is_pipe;

#ifndef UNIX
  char *
  expand_tilde(char *s, char *name) { return s; }

  FILE *
  try_pipe(char *cmd) { err(archer); return NULL; }
#else
#  define _INCLUDE_POSIX_SOURCE
#  include <unistd.h>
#  include <pwd.h>

  FILE *
  try_pipe(char *cmd)
  {
    FILE *file = (FILE *) popen(cmd,"r");

    if (!file) err(talker,"%s failed !",cmd);
    is_pipe=1; return file;
  }

 /* expand tildes in string s (filename). Put result in name
  * if name == NULL malloc it
  */
  char *
  expand_tilde(char *s, char *name)
  {
    int len, do_malloc = (name==NULL);
    struct passwd *p;
    char *u;

    if (*s != '~') return s;
    s++; u = s; /* skip ~ */
    if (!*s || *s == '/') p = getpwuid(geteuid());
    else
    {
      while (*u && *u != '/') u++;
      len=u-s;
      if (do_malloc) name = gpmalloc(len+1);
      else if (len >= MAX_NAME_LEN)
	err(talker,"name too long in expand_tilde");
      strncpy(name,s,len); name[len]=0;
      p = getpwnam(name);
    }
    if (!p) err(talker2,"unknown user ",s,s-1);
    len = strlen(p->pw_dir) + strlen(u);
    if (do_malloc) /* pb for Mac: we don't know oldsize !! */
      name = gprealloc(name,len,MAX_NAME_LEN);
    else if (len >= MAX_NAME_LEN)
      err(talker,"name too long in expand_tilde");
    strcpy(name,p->pw_dir); strcat(name,u); return name;
  }
#endif

char **
gp_expand_path(char *v)
{
  static char *dir_list[128];
  static int dir_list_len = 0;
  char s[MAX_NAME_LEN+1], name[MAX_NAME_LEN+1];
  char *str1, *str2, **f;
  int vpos = 0, dpos = 0;

  if (v)
  {
    while (v[vpos])
    {
      /* Next PATH member */
      int spos = 0;

      while (v[vpos])
      {
	if (v[vpos] == ':' && (vpos > 0 && v[vpos-1] != '\\') ) break;
	if (spos > MAX_NAME_LEN)
	  err(talker,"dirname too long in gp_expand_path");
	s[spos++] = v[vpos++];
      }
      /* suppress trailing '/'s */
      s[spos]=0; while (spos > 0 && s[spos-1] == '/') s[--spos]=0;
      str1 = expand_tilde(s,name); str2 = gpmalloc(strlen(str1)+1);
      strcpy(str2,str1);
      if (dpos < dir_list_len)
	free(dir_list[dpos]);
      else
	dir_list_len++;
      dir_list[dpos++]=str2;
      if (v[vpos]) vpos++; /* skip ':' */
    }
    f=dir_list+dpos; while (*f) free(*f++);
    dir_list[dpos]=NULL;
  }
  return dir_list;
}

/* we know that "name" exist. "file" is associated to it via fopen */
static FILE*
try_zcat(char *name, FILE *file)
{
  char cmd[256], *end = name + strlen(name)-1;

  if ( !strncmp(end-1,".Z",2)
#ifdef GNUZCAT
    || !strncmp(end-2,".gz",3)
#endif
  )
  { /* compressed file (compress or gzip) */
    sprintf(cmd,"%s %s",ZCAT,name);
    fclose(file); file = try_pipe(cmd);
  }
  return file;
}

/* we know that file "name" exists. Accept it (unzip if needed). */
static long
accept_file(char *name, FILE *file)
{
  static char last_filename[MAX_NAME_LEN+1];

  if (!name) return (long) last_filename;

  is_pipe = 0;
#ifdef ZCAT
  file = try_zcat(name,file);
#endif
  if (!file_depth)
  {
    strncpy(last_filename,name,255);
    last_filename[255] = 0;
  }
  return switchin(file);
}

static int
try_name(char *name)
{
  static char s[256];
  FILE *file;

  file = fopen(name, "r");
  if (file) return accept_file(name,file);

  /* try appending ".gp" to name */
  sprintf(s, "%s.gp", name); name = s;
  file = fopen(name, "r");
  if (file) return accept_file(name,file);
  return -1;
}

/* Change input stream. If (file = NULL), pop out last file on stack. */
long
switchin(FILE *file)
{
#define MAXFILES 5
  static FILE *stack[MAXFILES+1];
  static char file_is_pipe[MAXFILES+1];

  if (!file)
  {
    if (!file_depth) return -1;

#ifdef UNIX
    if (file_is_pipe[file_depth])
      pclose(infile);
    else
#endif
      fclose(infile);
    infile = stack[--file_depth];
    return file_depth;
  }
  if (file_depth == MAXFILES) 
    err(talker,"too many nested files");

  stack[file_depth++] = infile;
  file_is_pipe[file_depth] = is_pipe;
  infile = file; return file_depth;
}

/* If name = "", re-read last file */
long
switchin_byname(char *name)
{
  static char namecopy[MAX_NAME_LEN+1];
  static int no_init=1;
  int depth;
  char *s;

  if (*name)
    name = expand_tilde(name,namecopy);
  else
  {
    if (no_init) err(talker,"You never gave me anything to read !");
    name = (char *)accept_file(NULL,NULL);
  }

  /* if name contains '/',  we do not use dir_list */
  s=name; while (*s && *s != '/') s++;
  if (*s)
  {
    depth = try_name(name);
    if (depth>=0) { no_init=0; return depth; }
  }
  else
  {
    char *f, **tmp = gp_expand_path(NULL);

    for ( ; *tmp; tmp++)
    {
      f=gpmalloc(2+strlen(*tmp)+strlen(name)); /* make room for '/' and '\0' */
      sprintf(f,"%s/%s",*tmp,name);

      depth = try_name(f); free(f);
      if (depth>=0) { no_init=0; return depth; }
    }
  }
  err(openfiler,"input",name);
  return 0;
}

void
switchout(char *name)
{
  if (name)
  {
    FILE *f = fopen(name, "a");
    if (!f) err(openfiler,"output",name);
    outfile = f;
  }
  else
  {
    fclose(outfile);
    outfile = stdout;
  }
}
