===================================================================
RCS file: /home/cvs/OpenXM_contrib/pari-2.2/src/language/Attic/es.c,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -p -r1.1 -r1.2
--- OpenXM_contrib/pari-2.2/src/language/Attic/es.c	2001/10/02 11:17:10	1.1
+++ OpenXM_contrib/pari-2.2/src/language/Attic/es.c	2002/09/11 07:27:03	1.2
@@ -1,4 +1,4 @@
-/* $Id: es.c,v 1.1 2001/10/02 11:17:10 noro Exp $
+/* $Id: es.c,v 1.2 2002/09/11 07:27:03 noro Exp $
 
 Copyright (C) 2000  The PARI group.
 
@@ -22,21 +22,13 @@ 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 != ' ');
@@ -48,94 +40,120 @@ 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)
- * Otherwise, if t == NULL, allocate enough room, filter then return t.
- *            if not return pointer to ending '\0' in t.
- */
+/* Filter F->s into F->t */
 char *
-filtre(char *s0, char *t0, int flag)
+filtre0(filtre_t *F)
 {
-  static int in_string, in_comment = 0;
-  char c, *s, *t;
-  int downcase, return_end;
+  const int downcase = F->downcase;
+  char c, *s = F->s, *t;
 
-  if (flag & f_INIT) in_string = 0;
-  switch(flag)
+  if (!F->t) F->t = gpmalloc(strlen(s)+1);
+  t = F->t;
+
+  if (F->more_input == 1) F->more_input = 0;
+
+  if (! F->in_comment)
   {
-    case f_ENDFILE:
-      if (in_string)
-      {
-        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;
+    while (isspace((int)*s)) s++; /* Skip space */
+    if (*s == LBRACE) { s++; F->more_input = 2; F->wait_for_brace = 1; }
   }
 
-  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 */
-    else if (in_comment)
+    if (F->in_string)
     {
-      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')
-        {
-          if (!*s) { in_comment=0; goto END; }
-          c = *s++;
-        }
-      in_comment=0; continue;
+        while (c != '\n' && *s) c = *s++;
+      F->in_comment = 0;
+      continue;
     }
-    else
-    { /* weed out comments and spaces */
-      if (c=='\\' && *s=='\\') { in_comment = ONE_LINE_COMMENT; continue; }
-      if (isspace((int)c)) continue;
-      *t++ = downcase? tolower(c): c;
-    }
+
+    /* weed out comments and spaces */
+    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;
-        /* start multi-line comment */
-        t--; in_comment = MULTI_LINE_COMMENT; break;
+        if (*s == '*') { t--; F->in_comment = MULTI_LINE_COMMENT; }
+        break;
 
       case '\\':
-        if (!in_string) break;
-        if (!*s) goto END;     /* this will result in an error */
-        *t++ = *s++; break; /* in strings, \ is the escape character */
-        /*  \" does not end a string. But \\" does */
+        if (!*s) {
+          if (t[-2] == '?') break; /* '?\' */
+          t--;
+          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 '"':
-        in_string = !in_string;
+      case '"': F->in_string = 1;
     }
   }
+
+  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)
 {
@@ -149,7 +167,7 @@ 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__)
@@ -227,13 +245,15 @@ 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;
-
+  long nb = 0, bufsize = 1023;
+  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++;
@@ -247,17 +267,36 @@ 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
@@ -326,13 +365,13 @@ 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))
-      return s.ws_col;
+    if (!(GP_DATA && (GP_DATA->flags & (EMACS|TEXMACS)))
+     && !ioctl(0, TIOCGWINSZ, &s)) return s.ws_col;
   }
 #endif
 #ifdef UNIX
@@ -351,13 +390,13 @@ 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))
-      return s.ws_row;
+    if (!(GP_DATA && (GP_DATA->flags & (EMACS|TEXMACS)))
+     && !ioctl(0, TIOCGWINSZ, &s)) return s.ws_row;
   }
 #endif
 #ifdef UNIX
@@ -379,14 +418,14 @@ 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;
@@ -410,7 +449,7 @@ puts80(char *s)
 }
 PariOUT pariOut80= {putc80, puts80, normalOutF, NULL};
 
-void
+static void
 init80(long n)
 {
   col_index = n; pariOut = &pariOut80;
@@ -448,16 +487,18 @@ 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;
-  if (!s) { pariOut = &defaultOut; return; }
+  PariOUT *tmp = pariOut;
   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))
@@ -566,9 +607,8 @@ 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->string = gprealloc(str->string, t, s); \
-    str->size = t; \
+    str->size = s + l + STEPSIZE; \
+    str->string = gprealloc(str->string, str->size); \
   } \
 }
 
@@ -608,35 +648,36 @@ 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;
-  OutStr->len = 0; OutStr->size=0; OutStr->string=NULL;
-  do_out(x); OutStr->string[OutStr->len] = 0;
+  pariOut = &pariOut2Str;
+  newStr.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_plus_sp() sp(), pariputc('+'), sp()
-#define comma_sp() pariputc(','), sp()
+#define sp_sign_sp(T,x) ((T)->sp? putsigne(x): putsigne_nosp(x))
+#define sp(T) do { if ((T)->sp) pariputc(' '); } while(0);
+#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(' '); }
 
@@ -653,19 +694,21 @@ 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)
 {
@@ -702,56 +745,67 @@ 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; }
-  setsigne(x,1); re = res = convi(x);
-  setsigne(x,sx);
+/* write int. T->fieldw: field width (pad with ' ') */
+static void
+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);
-  else
-     { i++; blancs(fw-i); pariputc('-'); }
-  coinit(*--res); while (*--res >= 0) comilieu(*res);
+  minus = (sx < 0 && !nosign);
+  if (minus) i++;
+
+  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 */
 
@@ -778,7 +832,7 @@ wr_float(GEN x)
   if (!s)
   {
     while (!*res) { res++; pariputs("000000000"); }
-    d = coinit2(*res++);
+    d = coinit2(*res++, dec);
   }
 
   /* d = # significant digits already printed */
@@ -789,38 +843,40 @@ 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);
-  long ex = expo(x);
+  GEN dix = stor(10, lg(x)+1);
+  long e = expo(x);
 
-  ex = (ex>=0)? (long)(ex*L2SL10): (long)(-(-ex*L2SL10)-1);
-  affsr(10,dix); if (ex) x = mulrr(x,gpuigs(dix,-ex));
-  if (absr_cmp(x, dix) >= 0) { x=divrr(x,dix); ex++; }
-  wr_float(x); sp(); pariputsf("E%ld",ex);
+  e = (e>=0)? (long)(e*L2SL10): (long)(-(-e*L2SL10)-1);
+  if (e) x = mulrr(x, gpowgs(dix,-e));
+  if (absr_cmp(x, dix) >= 0) { x = divrr(x,dix); e++; }
+  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
     {
@@ -831,22 +887,11 @@ 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                       **/
@@ -896,8 +941,10 @@ 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 ");
@@ -906,16 +953,17 @@ 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:");
+    if (tx == t_STR) 
+      pariputs("chars:");
     else if (tx == t_INT)
-	pariputsf("(%c,lgef=%ld):", vsigne(x), lgefint(x));
+      pariputsf("(%c,lgef=%ld):", vsigne(x), lgefint(x));
     else if (tx == t_REAL)
-	pariputsf("(%c,expo=%ld):", vsigne(x), expo(x));
+      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]);
@@ -1095,7 +1143,8 @@ 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;
 
@@ -1266,25 +1315,25 @@ 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);
 
@@ -1292,21 +1341,21 @@ 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)
@@ -1316,17 +1365,17 @@ 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)
@@ -1336,21 +1385,21 @@ 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
-bruti(GEN g, long nosign)
+void
+bruti(GEN g, pariout_t *T, int nosign)
 {
   long tg,l,i,j,r;
   GEN a,b;
@@ -1369,21 +1418,23 @@ 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_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:
       pariputs(new_fun_set? "Mod(": "mod(");
-      bruti((GEN)g[2],0); comma_sp();
-      bruti((GEN)g[1],0); pariputc(')'); break;
+      bruti((GEN)g[2],T,0); comma_sp(T);
+      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;
 
@@ -1391,21 +1442,21 @@ 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);
-      if (!isnull(b)) wr_monome(b,v,1);
+      bruti(a,T,nosign);
+      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;
 
@@ -1414,19 +1465,20 @@ 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++)
@@ -1436,11 +1488,12 @@ 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;
@@ -1448,29 +1501,29 @@ 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[2],0); comma_sp();
-      bruti((GEN)g[3],0);
-      if (r) { comma_sp(); bruti((GEN)g[4],0); }
+      bruti((GEN)g[1],T,0); comma_sp(T);
+      bruti((GEN)g[2],T,0); comma_sp(T);
+      bruti((GEN)g[3],T,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);
-        if (i<l-1) comma_sp();
+        bruti((GEN)g[i],T,0);
+        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);
-        if (i<l-1) comma_sp();
+        bruti((GEN)g[i],T,0);
+        if (i<l-1) comma_sp(T);
       }
       pariputs("])"); break;
 
@@ -1489,17 +1542,17 @@ 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);
-          if (j<r-1) comma_sp();
+	  bruti(gcoeff(g,i,j),T,0);
+          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;
@@ -1508,12 +1561,12 @@ bruti(GEN g, long nosign)
   }
 }
 
-static void
-matbruti(GEN g, long flag)
+void
+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]);
@@ -1522,14 +1575,14 @@ 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); }
@@ -1538,12 +1591,12 @@ 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)
@@ -1553,35 +1606,35 @@ sor_lead_monome(GEN a, char *v, long d)
   }
   else
   {
-    sori(a);
+    sori(a,T);
     if (d) { pariputc(' '); monome(v,d); }
   }
 }
 
-static void
-sori(GEN g)
+void
+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(g,0); return;
+    case t_REAL: wr_real(T,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('-');
@@ -1592,16 +1645,16 @@ 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(" /");
-      b=(GEN)g[2]; wr_int(b,chmp,1); break;
+      a=(GEN)g[1]; wr_int(T,a,1); pariputs(" /");
+      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; }
-      sori(a); if (!isnull(b)) sor_monome(b,v,1);
+      if (isnull(a)) { sor_lead_monome(T,b,v,1); break; }
+      sori(a,T); if (!isnull(b)) sor_monome(T,b,v,1);
       break;
 
     case t_PADIC:
@@ -1616,7 +1669,7 @@ 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("+ ");
@@ -1631,10 +1684,10 @@ 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;
 	
@@ -1643,10 +1696,10 @@ 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(" + ");
       }
@@ -1655,15 +1708,15 @@ 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;
-      v1 = GENtostr0((GEN)g[1], &sori); n = strlen(v1);
-      v2 = GENtostr0((GEN)g[2], &sori); d = strlen(v2);
+      T->initial = 0;
+      v1 = GENtostr0((GEN)g[1], T, &sori); n = strlen(v1);
+      v2 = GENtostr0((GEN)g[2], T, &sori); d = strlen(v2);
 
       pariputc('\n');
       i = max(n,d)+2;
@@ -1682,31 +1735,30 @@ 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[2]); pariputs(", ");
-      sori((GEN)g[3]);
-      if (tg == t_QFR) { pariputs(", "); sori((GEN)g[4]); }
+      sori((GEN)g[1],T); pariputs(", ");
+      sori((GEN)g[2],T); pariputs(", ");
+      sori((GEN)g[3],T);
+      if (tg == t_QFR) { pariputs(", "); sori((GEN)g[4],T); }
       pariputs("}\n"); break;
 	
-    case t_VEC:
-      chmp=0; pariputc('[');
+    case t_VEC: 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;
 	
@@ -1721,7 +1773,7 @@ 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');
       }
@@ -1739,8 +1791,8 @@ sori(GEN g)
 /********************************************************************/
 
 /* this follows bruti exactly */
-static void
-texi(GEN g, long nosign)
+void
+texi(GEN g, pariout_t *T, int nosign)
 {
   long tg,i,j,l,r;
   GEN a,b;
@@ -1757,36 +1809,39 @@ texi(GEN g, long nosign)
   tg = typ(g);
   switch(tg)
   {
-    case t_INT: wr_int(g,0,nosign); break;
-    case t_REAL: wr_real(g,nosign); break;
+    case t_SMALL: pariputsf("%ld",smalltos(g)); 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[1],0); break;
+      texi((GEN)g[2],T,0); pariputs(" mod ");
+      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[2],0); break;
+      texi((GEN)g[1],T,nosign); pariputs("\\over");
+      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);
-      if (!isnull(b)) wr_texnome(b,v,1);
+      texi(a,T,nosign);
+      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;
 
@@ -1795,11 +1850,11 @@ 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("+ ");
       }
@@ -1817,7 +1872,7 @@ 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('+');
@@ -1828,17 +1883,17 @@ 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[2],0); pariputs(", ");
-      texi((GEN)g[3],0);
-      if (r) { pariputs(", "); texi((GEN)g[4],0); }
+      texi((GEN)g[1],T,0); pariputs(", ");
+      texi((GEN)g[2],T,0); pariputs(", ");
+      texi((GEN)g[3],T,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;
 
@@ -1846,7 +1901,7 @@ 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;
 
@@ -1854,7 +1909,7 @@ 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;
 
@@ -1871,7 +1926,7 @@ 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 ");
         }
@@ -1883,48 +1938,204 @@ 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;
-  void (*oldsp)() = sp;
+  gpmem_t av = avma;
+  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;
-  format = f; decimals = d;
-  bruti(changevar(g,polvar),0);
-  sp = oldsp; avma = av;
+static void
+_initout(pariout_t *T, char f, long sigd, long sp, long fieldw, int prettyp)
+{
+  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;
-  format = f; decimals = d;
-  matbruti(changevar(g,polvar),0); avma=av;
+  pariout_t T; _initout(&T,f,d,1,0, f_PRETTYMAT);
+  gen_output(g, &T);
 }
 
 void
 sor(GEN g, char f, long d, long c)
 {
-  long av=avma; sp = &wr_space;
-  format = f; decimals = d; chmp = c; initial = 1;
-  sori(changevar(g,polvar)); avma = av;
+  pariout_t T; _initout(&T,f,d,1,c, f_PRETTYOLD);
+  gen_output(g, &T);
 }
 
 void
 texe(GEN g, char f, long d)
 {
-  long av=avma; sp = &no_space;
-  format = f; decimals = d;
-  texi(changevar(g,polvar),0); avma=av;
+  pariout_t T; _initout(&T,f,d,0,0, f_TEX);
+  gen_output(g, &T);
 }
 
 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); }
@@ -1968,10 +2179,10 @@ 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
@@ -2103,6 +2314,21 @@ 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)
@@ -2111,8 +2337,6 @@ int
 popinfile()
 {
   pariFILE *f;
-
-  filtre(NULL,NULL, f_ENDFILE);
   for (f = last_tmp_file; f; f = f->prev)
   {
     if (f->type & mf_IN) break;
@@ -2159,7 +2383,7 @@ 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 */
@@ -2179,17 +2403,15 @@ 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;
-
-      c = err_catch(-1, env, NULL);
-      fprintf(file,"\n\n"); fflush(file);
-      for (i=1; i<1000; i++) fprintf(file,"                  \n");
-      fprintf(file,"\n"); fflush(file);
-      err_leave(&c);
+      CATCH(-1) { file = NULL; }
+      TRY {
+        int i;
+        fprintf(file,"\n\n"); fflush(file);
+        for (i=1; i<1000; i++) fprintf(file,"                  \n");
+        fprintf(file,"\n"); fflush(file);
+      } ENDCATCH;
+      if (!file) return NULL;
     }
     f = cmd;
   }
@@ -2225,7 +2447,7 @@ 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
 }
 
@@ -2262,7 +2484,6 @@ os_getenv(char *s)
 /**                                                               **/
 /*******************************************************************/
 static char *last_filename = NULL;
-static char **dir_list = NULL;
 
 #ifdef HAS_OPENDIR
 #  include <dirent.h>
@@ -2339,10 +2560,8 @@ _expand_env(char *str)
     }
     if (xnum > xlen - 3) /* need room for possibly two more elts */
     {
-      long xnew = xlen << 1;
-      x = (char **)gprealloc((void*)x, xlen * sizeof(char*),
-                                       xnew * sizeof(char*));
-      xlen = xnew;
+      xlen <<= 1;
+      x = (char **)gprealloc((void*)x, xlen * sizeof(char*));
     }
 
     s0 = ++s; /* skip $ */
@@ -2382,6 +2601,18 @@ 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
@@ -2389,29 +2620,26 @@ 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;
-  if (old)
-  {
-    for (path=old; *path; path++) free(*path);
-    free(old);
-  }
+  free((void*)v);
+  dirs[i] = NULL; p->dirs = dirs;
 }
 
 /* name is a malloc'ed (existing) filename. Accept it as new infile
@@ -2488,9 +2716,9 @@ 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));
@@ -2501,12 +2729,21 @@ 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;
   }
@@ -2532,7 +2769,7 @@ switchout(char *name)
 #define _cfwrite(a,b,c) _fwrite((a),sizeof(char),(b),(c))
 
 #define BIN_GEN 0
-#define NAM_GEN  1
+#define NAM_GEN 1
 
 static long
 rd_long(FILE *f)
@@ -2610,7 +2847,7 @@ rdGEN(FILE *f)
 }
 
 GEN
-readobj(FILE *f)
+readobj(FILE *f, int *ptc)
 {
   int c = fgetc(f);
   GEN x = NULL;
@@ -2633,7 +2870,7 @@ 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 */
@@ -2657,7 +2894,7 @@ 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
@@ -2685,7 +2922,7 @@ 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);
 }
@@ -2693,8 +2930,8 @@ write_magic(FILE *f)
 int
 file_is_binary(FILE *f)
 {
-  int c = fgetc(f), r = isprint(c);
-  ungetc(c,f); return (r == 0);
+  int c = fgetc(f); ungetc(c,f);
+  return (isprint(c) == 0 && isspace(c) == 0);
 }
 
 void
@@ -2716,24 +2953,122 @@ 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;
-  check_magic(name,f);
-  while ((y = readobj(f))) x = y;
+  gpmem_t av = avma;
+  GEN x,y,z;
+  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                         **/
 /**                                                               **/
 /*******************************************************************/
@@ -2804,7 +3139,7 @@ env_ok(char *s)
 }
 
 static char*
-pari_tmp_dir()
+pari_tmp_dir(void)
 {
   char *s;
 #ifdef WINCE