Code coverage tests

This page documents the degree to which the PARI/GP source code is tested by our public test suite, distributed with the source distribution in directory src/test/. This is measured by the gcov utility; we then process gcov output using the lcov frond-end.

We test a few variants depending on Configure flags on the pari.math.u-bordeaux.fr machine (x86_64 architecture), and agregate them in the final report:

The target is to exceed 90% coverage for all mathematical modules (given that branches depending on DEBUGLEVEL or DEBUGMEM are not covered). This script is run to produce the results below.

LCOV - code coverage report
Current view: top level - language - es.c (source / functions) Hit Total Coverage
Test: PARI/GP v2.18.1 lcov report (development 30005-fc14bb602a) Lines: 2056 2792 73.6 %
Date: 2025-02-18 09:22:46 Functions: 254 310 81.9 %
Legend: Lines: hit not hit

          Line data    Source code
       1             : /* Copyright (C) 2000  The PARI group.
       2             : 
       3             : This file is part of the PARI/GP package.
       4             : 
       5             : PARI/GP is free software; you can redistribute it and/or modify it under the
       6             : terms of the GNU General Public License as published by the Free Software
       7             : Foundation; either version 2 of the License, or (at your option) any later
       8             : version. It is distributed in the hope that it will be useful, but WITHOUT
       9             : ANY WARRANTY WHATSOEVER.
      10             : 
      11             : Check the License for details. You should have received a copy of it, along
      12             : with the package; see the file 'COPYING'. If not, write to the Free Software
      13             : Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */
      14             : 
      15             : /*******************************************************************/
      16             : /**                                                               **/
      17             : /**                 INPUT/OUTPUT SUBROUTINES                      **/
      18             : /**                                                               **/
      19             : /*******************************************************************/
      20             : #ifdef _WIN32
      21             : #include "../systems/mingw/pwinver.h"
      22             : #include <windows.h>
      23             : #include <process.h> /* for getpid */
      24             : #include <fcntl.h>
      25             : #include <io.h>      /* for setmode */
      26             : #include "../systems/mingw/mingw.h"
      27             : #endif
      28             : #include "paricfg.h"
      29             : #ifdef HAS_STAT
      30             : #include <sys/stat.h>
      31             : #elif defined(HAS_OPENDIR)
      32             : #include <dirent.h>
      33             : #endif
      34             : #ifdef HAS_WAITPID
      35             : #  include <sys/wait.h>
      36             : #endif
      37             : 
      38             : #include "pari.h"
      39             : #include "paripriv.h"
      40             : #include "anal.h"
      41             : #ifdef __EMSCRIPTEN__
      42             : #include "../systems/emscripten/emscripten.h"
      43             : #endif
      44             : 
      45             : #define DEBUGLEVEL DEBUGLEVEL_io
      46             : 
      47             : typedef void (*OUT_FUN)(GEN, pariout_t *, pari_str *);
      48             : 
      49             : static void bruti_sign(GEN g, pariout_t *T, pari_str *S, int addsign);
      50             : static void matbruti(GEN g, pariout_t *T, pari_str *S);
      51             : static void texi_sign(GEN g, pariout_t *T, pari_str *S, int addsign);
      52             : 
      53     1161688 : static void bruti(GEN g, pariout_t *T, pari_str *S)
      54     1161688 : { bruti_sign(g,T,S,1); }
      55         319 : static void texi(GEN g, pariout_t *T, pari_str *S)
      56         319 : { texi_sign(g,T,S,1); }
      57             : 
      58             : void
      59           0 : pari_ask_confirm(const char *s)
      60             : {
      61           0 :   if (!cb_pari_ask_confirm)
      62           0 :     pari_err(e_MISC,"Can't ask for confirmation. Please define cb_pari_ask_confirm()");
      63           0 :   cb_pari_ask_confirm(s);
      64           0 : }
      65             : 
      66             : static char *
      67           0 : strip_last_nl(char *s)
      68             : {
      69           0 :   ulong l = strlen(s);
      70             :   char *t;
      71           0 :   if (l && s[l-1] != '\n') return s;
      72           0 :   if (l>1 && s[l-2] == '\r') l--;
      73           0 :   t = stack_malloc(l); memcpy(t, s, l-1); t[l-1] = 0;
      74           0 :   return t;
      75             : }
      76             : 
      77             : /********************************************************************/
      78             : /**                                                                **/
      79             : /**                        INPUT FILTER                            **/
      80             : /**                                                                **/
      81             : /********************************************************************/
      82             : #define ONE_LINE_COMMENT   2
      83             : #define MULTI_LINE_COMMENT 1
      84             : #define LBRACE '{'
      85             : #define RBRACE '}'
      86             : 
      87             : static int
      88        2365 : in_help(filtre_t *F)
      89             : {
      90             :   char c;
      91        2365 :   if (!F->buf) return (*F->s == '?');
      92        2358 :   c = *F->buf->buf;
      93        2358 :   return c? (c == '?'): (*F->s == '?');
      94             : }
      95             : /* Filter F->s into F->t */
      96             : static char *
      97     1004397 : filtre0(filtre_t *F)
      98             : {
      99     1004397 :   const char *s = F->s;
     100     1004397 :   char c, *t = F->t;
     101     1004397 :   int doctest = GP_DATA->doctest, more_input = F->more_input;
     102             : 
     103     1004397 :   if (odd(more_input)) F->more_input = 0;
     104     1004397 :   if (doctest && more_input <= 1)
     105             :   {
     106           0 :     int is_doctest = isspace((unsigned char)*s);
     107           0 :     while (isspace((unsigned char)*s)) s++;
     108           0 :     if (*s==0) goto END;
     109           0 :     if (*s=='?' && s[1]==' ') s+=2;
     110           0 :     else if (is_doctest)
     111           0 :       F->in_comment = ONE_LINE_COMMENT;
     112             :   }
     113   120829226 :   while ((c = *s++))
     114             :   {
     115   119825571 :     if (F->in_string)
     116             :     {
     117     6944186 :       *t++ = c; /* copy verbatim */
     118     6944186 :       switch(c)
     119             :       {
     120         648 :         case '\\': /* in strings, \ is the escape character */
     121         648 :           if (*s) *t++ = *s++;
     122         648 :           break;
     123             : 
     124      880274 :         case '"': F->in_string = 0;
     125             :       }
     126     6944186 :       continue;
     127             :     }
     128             : 
     129   112881385 :     if (F->in_comment)
     130             :     { /* look for comment's end */
     131        8735 :       if (F->in_comment == MULTI_LINE_COMMENT)
     132             :       {
     133       36726 :         while (c != '*' || *s != '/')
     134             :         {
     135       36051 :           if (!*s)
     136             :           {
     137         406 :             if (!F->more_input) F->more_input = 1;
     138         406 :             goto END;
     139             :           }
     140       35645 :           c = *s++;
     141             :         }
     142         675 :         s++;
     143             :       }
     144             :       else
     145      128601 :         while (c != '\n' && *s) c = *s++;
     146        8329 :       F->in_comment = 0;
     147        8329 :       continue;
     148             :     }
     149             : 
     150             :     /* weed out comments and spaces */
     151   112872650 :     if (c=='\\' && *s=='\\') { F->in_comment = ONE_LINE_COMMENT; continue; }
     152   112864996 :     if (isspace((unsigned char)c)) continue;
     153   110779738 :     *t++ = c;
     154   110779738 :     switch(c)
     155             :     {
     156      120367 :       case '/':
     157      120367 :         if (*s == '*') { t--; F->in_comment = MULTI_LINE_COMMENT; }
     158      120367 :         break;
     159             : 
     160        1044 :       case '\\':
     161        1044 :         if (!*s) {
     162           7 :           if (in_help(F)) break; /* '?...\' */
     163           7 :           t--;
     164           7 :           if (!F->more_input) F->more_input = 1;
     165           7 :           goto END;
     166             :         }
     167        1037 :         if (*s == '\r') s++; /* DOS */
     168        1037 :         if (*s == '\n') {
     169         336 :           if (in_help(F)) break; /* '?...\' */
     170         329 :           t--; s++;
     171         329 :           if (!*s)
     172             :           {
     173         329 :             if (!F->more_input) F->more_input = 3;
     174         329 :             goto END;
     175             :           }
     176             :         } /* skip \<CR> */
     177         701 :         break;
     178             : 
     179      880274 :       case '"': F->in_string = 1;
     180      880274 :         break;
     181             : 
     182        3469 :       case LBRACE:
     183        3469 :         t--;
     184        3469 :         if (F->wait_for_brace) pari_err_IMPL("embedded braces (in parser)");
     185        3469 :         F->more_input = 2;
     186        3469 :         F->wait_for_brace = 1;
     187        3469 :         break;
     188             : 
     189        3469 :       case RBRACE:
     190        3469 :         if (!F->wait_for_brace) pari_err(e_MISC,"unexpected closing brace");
     191        3469 :         F->more_input = 0; t--;
     192        3469 :         F->wait_for_brace = 0;
     193        3469 :         break;
     194             :     }
     195             :   }
     196             : 
     197     1003655 :   if (t != F->t) /* non empty input */
     198             :   {
     199      977259 :     c = t[-1]; /* last char */
     200      977259 :     if (c == '=') { if (!in_help(F)) F->more_input = 2; }
     201      975237 :     else if (! F->wait_for_brace) F->more_input = 0;
     202       42554 :     else if (c == RBRACE)       { F->more_input = 0; t--; F->wait_for_brace--;}
     203             :   }
     204             : 
     205       68950 : END:
     206     1004397 :   F->end = t; *t = 0; return F->t;
     207             : }
     208             : #undef ONE_LINE_COMMENT
     209             : #undef MULTI_LINE_COMMENT
     210             : 
     211             : char *
     212       11039 : gp_filter(const char *s)
     213             : {
     214             :   filtre_t T;
     215       11039 :   T.buf = NULL;
     216       11039 :   T.s = s;
     217       11039 :   T.t = (char*)stack_malloc(strlen(s)+1);
     218       11039 :   T.in_string = 0; T.more_input = 0;
     219       11039 :   T.in_comment= 0; T.wait_for_brace = 0;
     220       11039 :   return filtre0(&T);
     221             : }
     222             : 
     223             : void
     224      806084 : init_filtre(filtre_t *F, Buffer *buf)
     225             : {
     226      806084 :   F->buf = buf;
     227      806084 :   F->in_string  = 0;
     228      806084 :   F->in_comment = 0;
     229      806084 : }
     230             : 
     231             : /********************************************************************/
     232             : /**                                                                **/
     233             : /**                        INPUT METHODS                           **/
     234             : /**                                                                **/
     235             : /********************************************************************/
     236             : /* create */
     237             : Buffer *
     238       10799 : new_buffer(void)
     239             : {
     240       10799 :   Buffer *b = (Buffer*) pari_malloc(sizeof(Buffer));
     241       10799 :   b->len = 1024;
     242       10799 :   b->buf = (char*)pari_malloc(b->len);
     243       10799 :   return b;
     244             : }
     245             : /* delete */
     246             : void
     247       10799 : delete_buffer(Buffer *b)
     248             : {
     249       10799 :   if (!b) return;
     250       10799 :   pari_free((void*)b->buf); pari_free((void*)b);
     251             : }
     252             : /* resize */
     253             : void
     254        3409 : fix_buffer(Buffer *b, long newlbuf)
     255             : {
     256        3409 :   b->len = newlbuf;
     257        3409 :   pari_realloc_ip((void**)&b->buf, b->len);
     258        3409 : }
     259             : 
     260             : static int
     261      804141 : gp_read_stream_buf(FILE *fi, Buffer *b)
     262             : {
     263             :   input_method IM;
     264             :   filtre_t F;
     265             : 
     266      804141 :   init_filtre(&F, b);
     267             : 
     268      804141 :   IM.file = (void*)fi;
     269      804141 :   IM.myfgets = (fgets_t)&fgets;
     270      804141 :   IM.getline = &file_input;
     271      804141 :   IM.free = 0;
     272      804141 :   return input_loop(&F,&IM);
     273             : }
     274             : 
     275             : GEN
     276        8439 : gp_read_stream(FILE *fi)
     277             : {
     278        8439 :   Buffer *b = new_buffer();
     279        8439 :   GEN x = NULL;
     280        8439 :   while (gp_read_stream_buf(fi, b))
     281             :   {
     282        8439 :     if (*(b->buf)) { x = readseq(b->buf); break; }
     283             :   }
     284        8439 :   delete_buffer(b); return x;
     285             : }
     286             : 
     287             : static GEN
     288           0 : gp_read_from_input(input_method* IM, int loop, char *last)
     289             : {
     290           0 :   Buffer *b = new_buffer();
     291           0 :   GEN x = NULL;
     292             :   filtre_t F;
     293           0 :   if (last) *last = 0;
     294             :   for (;;)
     295           0 :   {
     296             :     char *s;
     297           0 :     init_filtre(&F, b);
     298           0 :     if (!input_loop(&F, IM)) break;
     299           0 :     s = b->buf;
     300           0 :     if (s[0])
     301             :     {
     302           0 :       if (gp_meta(s,0)) continue;
     303           0 :       x = closure_evalres(pari_compile_str(s));
     304           0 :       if (last) *last = s[strlen(s) - 1];
     305             :     }
     306           0 :     if (!loop) break;
     307             :   }
     308           0 :   delete_buffer(b);
     309           0 :   return x;
     310             : }
     311             : 
     312             : GEN
     313          19 : gp_read_file(const char *s)
     314             : {
     315          19 :   GEN x = gnil;
     316          19 :   FILE *f = switchin(s);
     317          12 :   if (file_is_binary(f))
     318             :   {
     319          12 :     x = readbin(s,f, NULL);
     320          12 :     if (!x) pari_err_FILE("input file",s);
     321             :   }
     322             :   else {
     323           0 :     pari_sp av = avma;
     324           0 :     Buffer *b = new_buffer();
     325           0 :     x = gnil;
     326             :     for (;;) {
     327           0 :       if (!gp_read_stream_buf(f, b)) break;
     328           0 :       if (!strcmp(b->buf,"\\qf")) break;
     329           0 :       if (*(b->buf)) { set_avma(av); x = readseq(b->buf); }
     330             :     }
     331           0 :     delete_buffer(b);
     332             :   }
     333          12 :   popinfile(); return x;
     334             : }
     335             : 
     336             : static char*
     337           0 : string_gets(char *s, int size, const char **ptr)
     338             : {
     339             :   /* f is actually a const char** */
     340           0 :   const char *in = *ptr;
     341             :   int i;
     342             :   char c;
     343             : 
     344             :   /* Copy from in to s */
     345           0 :   for (i = 0; i+1 < size && in[i] != 0;)
     346             :   {
     347           0 :     s[i] = c = in[i]; i++;
     348           0 :     if (c == '\n') break;
     349             :   }
     350           0 :   s[i] = 0;  /* Terminating 0 byte */
     351           0 :   if (i == 0) return NULL;
     352             : 
     353           0 :   *ptr += i;
     354           0 :   return s;
     355             : }
     356             : 
     357             : GEN
     358           0 : gp_read_str_multiline(const char *s, char *last)
     359             : {
     360             :   input_method IM;
     361           0 :   const char *ptr = s;
     362             :   GEN z;
     363             : 
     364           0 :   IM.file = (void*)(&ptr);
     365           0 :   IM.myfgets = (fgets_t)&string_gets;
     366           0 :   IM.getline = &file_input;
     367           0 :   IM.free = 0;
     368             : 
     369           0 :   z = gp_read_from_input(&IM, 1, last);
     370           0 :   return z ? z: gnil;
     371             : }
     372             : 
     373             : static void
     374           0 : gp_read_str_history(const char *s)
     375             : {
     376             :   input_method IM;
     377           0 :   const char *ptr = s;
     378           0 :   char last = 0;
     379           0 :   pari_sp av = avma;
     380           0 :   IM.file = (void*)(&ptr);
     381           0 :   IM.myfgets = (fgets_t)&string_gets;
     382           0 :   IM.getline = &file_input;
     383           0 :   IM.free = 0;
     384           0 :   for(;ptr[0];)
     385             :   {
     386             :     GEN z;
     387           0 :     timer_start(GP_DATA->T);
     388           0 :     walltimer_start(GP_DATA->Tw);
     389           0 :     pari_set_last_newline(1);
     390           0 :     z = gp_read_from_input(&IM, 0, &last);
     391           0 :     pari_alarm(0);
     392           0 :     if (!pari_last_was_newline()) pari_putc('\n');
     393           0 :     if (z)
     394             :     {
     395           0 :       long t = timer_delay(GP_DATA->T);
     396           0 :       long r = walltimer_delay(GP_DATA->Tw);
     397           0 :       if (t && GP_DATA->chrono)
     398             :       {
     399           0 :         if (pari_mt_nbthreads==1)
     400             :         {
     401           0 :           pari_puts("time = ");
     402           0 :           pari_puts(gp_format_time(t));
     403             :         }
     404             :         else
     405             :         {
     406           0 :           pari_puts("cpu time = ");
     407           0 :           pari_puts(gp_format_time(t));
     408           0 :           pari_puts(", real time = ");
     409           0 :           pari_puts(gp_format_time(r));
     410             :         }
     411           0 :         pari_puts(".\n");
     412             :       }
     413           0 :       if (GP_DATA->simplify) z = simplify_shallow(z);
     414           0 :       pari_add_hist(z, t, r);
     415           0 :       if (z != gnil && last!=';')
     416           0 :         gp_display_hist(pari_nb_hist());
     417             :     }
     418           0 :     set_avma(av);
     419           0 :     parivstack_reset();
     420             :   }
     421           0 : }
     422             : 
     423             : void
     424           0 : gp_embedded_init(long rsize, long vsize)
     425             : {
     426           0 :   pari_init(rsize, 1UL<<20);
     427           0 :   paristack_setsize(rsize, vsize);
     428           0 : }
     429             : 
     430             : long
     431           0 : gp_embedded(const char *s)
     432             : {
     433           0 :   long err = 0;
     434             :   struct gp_context state;
     435           0 :   gp_context_save(&state);
     436           0 :   timer_start(GP_DATA->T);
     437           0 :   timer_start(GP_DATA->Tw);
     438           0 :   pari_set_last_newline(1);
     439           0 :   pari_CATCH(CATCH_ALL)
     440             :   {
     441           0 :     pari_err_display(pari_err_last());
     442           0 :     err_printf("\n");
     443           0 :     gp_context_restore(&state);
     444           0 :     err = 1;
     445             :   } pari_TRY {
     446           0 :     gp_read_str_history(s);
     447           0 :   } pari_ENDCATCH;
     448           0 :   if (!pari_last_was_newline()) pari_putc('\n');
     449           0 :   set_avma(pari_mainstack->top);
     450           0 :   return err;
     451             : }
     452             : 
     453             : GEN
     454         305 : gp_readvec_stream(FILE *fi)
     455             : {
     456         305 :   pari_sp ltop = avma;
     457         305 :   Buffer *b = new_buffer();
     458         305 :   long i = 1, n = 16;
     459         305 :   GEN z = cgetg(n+1,t_VEC);
     460             :   for(;;)
     461             :   {
     462      795646 :     if (!gp_read_stream_buf(fi, b)) break;
     463      795341 :     if (!*(b->buf)) continue;
     464      795341 :     if (i>n)
     465             :     {
     466        2149 :       if (DEBUGLEVEL) err_printf("gp_readvec_stream: reaching %ld entries\n",n);
     467        2149 :       n <<= 1;
     468        2149 :       z = vec_lengthen(z,n);
     469             :     }
     470      795341 :     gel(z,i++) = readseq(b->buf);
     471             :   }
     472         305 :   if (DEBUGLEVEL) err_printf("gp_readvec_stream: found %ld entries\n",i-1);
     473         305 :   setlg(z,i); delete_buffer(b);
     474         305 :   return gerepilecopy(ltop,z);
     475             : }
     476             : 
     477             : GEN
     478           4 : gp_readvec_file(const char *s)
     479             : {
     480           4 :   GEN x = NULL;
     481           4 :   FILE *f = switchin(s);
     482           4 :   if (file_is_binary(f)) {
     483             :     int junk;
     484           0 :     x = readbin(s,f,&junk);
     485           0 :     if (!x) pari_err_FILE("input file",s);
     486             :   } else
     487           4 :     x = gp_readvec_stream(f);
     488           4 :   popinfile(); return x;
     489             : }
     490             : 
     491             : char *
     492      995620 : file_getline(Buffer *b, char **s0, input_method *IM)
     493             : {
     494      995620 :   const ulong MAX = (1UL << 31) - 1;
     495             :   ulong used0, used;
     496             : 
     497      995620 :   **s0 = 0; /* paranoia */
     498      995620 :   used0 = used = *s0 - b->buf;
     499             :   for(;;)
     500        3024 :   {
     501      998644 :     ulong left = b->len - used, l, read;
     502             :     char *s;
     503             : 
     504             :     /* If little space left, double the buffer size before next read. */
     505      998644 :     if (left < 512)
     506             :     {
     507        3395 :       fix_buffer(b, b->len << 1);
     508        3395 :       left = b->len - used;
     509        3395 :       *s0 = b->buf + used0;
     510             :     }
     511             :     /* # of chars read by fgets is an int; be careful */
     512      998644 :     read = minuu(left, MAX);
     513      998644 :     s = b->buf + used;
     514      998644 :     if (! IM->myfgets(s, (int)read, IM->file)) return **s0? *s0: NULL; /* EOF */
     515             : 
     516      996446 :     l = strlen(s);
     517      996446 :     if (l+1 < read || s[l-1] == '\n') return *s0; /* \n */
     518        3024 :     used += l;
     519             :   }
     520             : }
     521             : 
     522             : /* Read from file (up to '\n' or EOF) and copy at s0 (points in b->buf) */
     523             : char *
     524      995544 : file_input(char **s0, int junk, input_method *IM, filtre_t *F)
     525             : {
     526             :   (void)junk;
     527      995544 :   return file_getline(F->buf, s0, IM);
     528             : }
     529             : 
     530             : static void
     531        2186 : runaway_close(filtre_t *F)
     532             : {
     533        2186 :   if (F->in_string)
     534             :   {
     535           0 :     pari_warn(warner,"run-away string. Closing it");
     536           0 :     F->in_string = 0;
     537             :   }
     538        2186 :   if (F->in_comment)
     539             :   {
     540           0 :     pari_warn(warner,"run-away comment. Closing it");
     541           0 :     F->in_comment = 0;
     542             :   }
     543        2186 : }
     544             : /* Read a "complete line" and filter it. Return: 0 if EOF, 1 otherwise */
     545             : int
     546      947156 : input_loop(filtre_t *F, input_method *IM)
     547             : {
     548      947156 :   Buffer *b = (Buffer*)F->buf;
     549      947156 :   char *to_read, *s = b->buf;
     550             : 
     551             :   /* read first line */
     552      947156 :   if (! (to_read = IM->getline(&s,1, IM, F)) ) { runaway_close(F); return 0; }
     553             : 
     554             :   /* buffer is not empty, init filter */
     555      944970 :   F->in_string = 0;
     556      944970 :   F->more_input= 0;
     557      944970 :   F->wait_for_brace = 0;
     558             :   for(;;)
     559             :   {
     560      993358 :     if (GP_DATA->echo == 2) gp_echo_and_log("", strip_last_nl(to_read));
     561      993358 :     F->s = to_read;
     562      993358 :     F->t = s;
     563      993358 :     (void)filtre0(F); /* pre-processing of line, read by previous call to IM->getline */
     564      993358 :     if (IM->free) pari_free(to_read);
     565      993358 :     if (! F->more_input) break;
     566             : 
     567             :     /* read continuation line */
     568       48388 :     s = F->end;
     569       48388 :     to_read = IM->getline(&s,0, IM, F);
     570       48388 :     if (!to_read)
     571             :     {
     572           0 :       if (!*(b->buf)) runaway_close(F);
     573           0 :       break;
     574             :     }
     575             :   }
     576      944970 :   return 1;
     577             : }
     578             : 
     579             : /********************************************************************/
     580             : /**                                                                **/
     581             : /**                  GENERAL PURPOSE PRINTING                      **/
     582             : /**                                                                **/
     583             : /********************************************************************/
     584             : PariOUT *pariOut, *pariErr;
     585             : static void
     586      308289 : _fputs(const char *s, FILE *f ) {
     587             : #ifdef _WIN32
     588             :    win32_ansi_fputs(s, f);
     589             : #else
     590      308289 :   fputs(s, f);
     591             : #endif
     592      308289 : }
     593             : static void
     594    10533875 : _putc_log(char c) { if (pari_logfile) (void)putc(c, pari_logfile); }
     595             : static void
     596      308289 : _puts_log(const char *s)
     597             : {
     598      308289 :   FILE *f = pari_logfile;
     599             :   const char *p;
     600      308289 :   if (!f) return;
     601           0 :   if (pari_logstyle != logstyle_color)
     602           0 :     while ( (p = strchr(s, '\x1b')) )
     603             :     { /* skip ANSI color escape sequence */
     604           0 :       if ( p!=s ) fwrite(s, 1, p-s, f);
     605           0 :       s = strchr(p, 'm');
     606           0 :       if (!s) return;
     607           0 :       s++;
     608             :     }
     609           0 :   fputs(s, f);
     610             : }
     611             : static void
     612      253534 : _flush_log(void)
     613      253534 : { if (pari_logfile != NULL) (void)fflush(pari_logfile); }
     614             : 
     615             : static void
     616     9915736 : normalOutC(char c) { putc(c, pari_outfile); _putc_log(c); }
     617             : static void
     618         111 : normalOutS(const char *s) { _fputs(s, pari_outfile); _puts_log(s); }
     619             : static void
     620      213238 : normalOutF(void) { fflush(pari_outfile); _flush_log(); }
     621             : static PariOUT defaultOut = {normalOutC, normalOutS, normalOutF};
     622             : 
     623             : static void
     624      618139 : normalErrC(char c) { putc(c, pari_errfile); _putc_log(c); }
     625             : static void
     626      308178 : normalErrS(const char *s) { _fputs(s, pari_errfile); _puts_log(s); }
     627             : static void
     628       40296 : normalErrF(void) { fflush(pari_errfile); _flush_log(); }
     629             : static PariOUT defaultErr = {normalErrC, normalErrS, normalErrF};
     630             : 
     631             : /**                         GENERIC PRINTING                       **/
     632             : void
     633        1879 : resetout(int initerr)
     634             : {
     635        1879 :   pariOut = &defaultOut;
     636        1879 :   if (initerr) pariErr = &defaultErr;
     637        1879 : }
     638             : void
     639        1879 : initout(int initerr)
     640             : {
     641        1879 :   pari_infile = stdin;
     642        1879 :   pari_outfile = stdout;
     643        1879 :   pari_errfile = stderr;
     644        1879 :   resetout(initerr);
     645        1879 : }
     646             : 
     647             : static int last_was_newline = 1;
     648             : 
     649             : static void
     650     1148362 : set_last_newline(char c) { last_was_newline = (c == '\n'); }
     651             : 
     652             : void
     653      723775 : out_putc(PariOUT *out, char c) { set_last_newline(c); out->putch(c); }
     654             : void
     655      104021 : pari_putc(char c) { out_putc(pariOut, c); }
     656             : 
     657             : void
     658      427268 : out_puts(PariOUT *out, const char *s) {
     659      427268 :   if (*s) { set_last_newline(s[strlen(s)-1]); out->puts(s); }
     660      427268 : }
     661             : void
     662       61653 : pari_puts(const char *s) { out_puts(pariOut, s); }
     663             : 
     664             : int
     665      119663 : pari_last_was_newline(void) { return last_was_newline; }
     666             : void
     667      147661 : pari_set_last_newline(int last) { last_was_newline = last; }
     668             : 
     669             : void
     670      199541 : pari_flush(void) { pariOut->flush(); }
     671             : 
     672             : void
     673           0 : err_flush(void) { pariErr->flush(); }
     674             : 
     675             : static GEN
     676          12 : log10_2(void)
     677          12 : { return divrr(mplog2(LOWDEFAULTPREC), mplog(utor(10,LOWDEFAULTPREC))); }
     678             : 
     679             : /* e binary exponent, return exponent in base ten */
     680             : static long
     681      176812 : ex10(long e) {
     682             :   pari_sp av;
     683             :   GEN z;
     684      176812 :   if (e >= 0) {
     685      171733 :     if (e < 1e15) return (long)(e*LOG10_2);
     686           6 :     av = avma; z = mulur(e, log10_2());
     687           6 :     z = floorr(z); e = itos(z);
     688             :   }
     689             :   else /* e < 0 */
     690             :   {
     691        5079 :     if (e > -1e15) return (long)(-(-e*LOG10_2)-1);
     692           6 :     av = avma; z = mulsr(e, log10_2());
     693           6 :     z = floorr(z); e = itos(z) - 1;
     694             :   }
     695          12 :   return gc_long(av, e);
     696             : }
     697             : 
     698             : static char *
     699       22967 : zeros(char *b, long nb) { while (nb-- > 0) *b++ = '0'; *b = 0; return b; }
     700             : 
     701             : /* # of decimal digits, assume l > 0 */
     702             : static long
     703      752299 : numdig(ulong l)
     704             : {
     705      752299 :   if (l < 100000)
     706             :   {
     707      704825 :     if (l < 100)    return (l < 10)? 1: 2;
     708      320428 :     if (l < 10000)  return (l < 1000)? 3: 4;
     709      120980 :     return 5;
     710             :   }
     711       47474 :   if (l < 10000000)   return (l < 1000000)? 6: 7;
     712       16529 :   if (l < 1000000000) return (l < 100000000)? 8: 9;
     713           0 :   return 10;
     714             : }
     715             : 
     716             : /* let ndig <= 9, x < 10^ndig, write in p[-ndig..-1] the decimal digits of x */
     717             : static void
     718     1133740 : utodec(char *p, ulong x, long ndig)
     719             : {
     720     1133740 :   switch(ndig)
     721             :   {
     722      388343 :     case  9: *--p = x % 10 + '0'; x = x/10;
     723      397970 :     case  8: *--p = x % 10 + '0'; x = x/10;
     724      411951 :     case  7: *--p = x % 10 + '0'; x = x/10;
     725      428915 :     case  6: *--p = x % 10 + '0'; x = x/10;
     726      549895 :     case  5: *--p = x % 10 + '0'; x = x/10;
     727      642368 :     case  4: *--p = x % 10 + '0'; x = x/10;
     728      749343 :     case  3: *--p = x % 10 + '0'; x = x/10;
     729      881200 :     case  2: *--p = x % 10 + '0'; x = x/10;
     730     1133740 :     case  1: *--p = x % 10 + '0'; x = x/10;
     731             :   }
     732     1133740 : }
     733             : 
     734             : /* convert abs(x) != 0 to str. Prepend '-' if (sx < 0) */
     735             : static char *
     736      752299 : itostr_sign(GEN x, int sx, long *len)
     737             : {
     738             :   long l, d;
     739      752299 :   ulong *res = convi(x, &l);
     740             :   /* l 9-digits words (< 10^9) + (optional) sign + \0 */
     741      752299 :   char *s = (char*)new_chunk(nchar2nlong(l*9 + 1 + 1)), *t = s;
     742             : 
     743      752299 :   if (sx < 0) *t++ = '-';
     744      752299 :   d = numdig(*--res); t += d; utodec(t, *res, d);
     745     1133740 :   while (--l > 0) { t += 9; utodec(t, *--res, 9); }
     746      752299 :   *t = 0; *len = t - s; return s;
     747             : }
     748             : 
     749             : /********************************************************************/
     750             : /**                                                                **/
     751             : /**                        WRITE A REAL NUMBER                     **/
     752             : /**                                                                **/
     753             : /********************************************************************/
     754             : /* 19 digits (if 64 bits, at most 2^60-1) + 1 sign */
     755             : static const long MAX_EXPO_LEN = 20;
     756             : 
     757             : /* write z to buf, inserting '.' at 'point', 0 < point < strlen(z) */
     758             : static void
     759      160086 : wr_dec(char *buf, char *z, long point)
     760             : {
     761      160086 :   char *s = buf + point;
     762      160086 :   strncpy(buf, z, point); /* integer part */
     763      160086 :   *s++ = '.'; z += point;
     764     1265144 :   while ( (*s++ = *z++) ) /* empty */;
     765      160086 : }
     766             : 
     767             : static char *
     768         126 : zerotostr(void)
     769             : {
     770         126 :   char *s = (char*)new_chunk(1);
     771         126 :   s[0] = '0';
     772         126 :   s[1] = 0; return s;
     773             : }
     774             : 
     775             : /* write a real 0 of exponent ex in format f */
     776             : static char *
     777         661 : real0tostr_width_frac(long width_frac)
     778             : {
     779             :   char *buf, *s;
     780         661 :   if (width_frac == 0) return zerotostr();
     781         654 :   buf = s = stack_malloc(width_frac + 3);
     782         654 :   *s++ = '0';
     783         654 :   *s++ = '.';
     784         654 :   (void)zeros(s, width_frac);
     785         654 :   return buf;
     786             : }
     787             : 
     788             : /* write a real 0 of exponent ex */
     789             : static char *
     790        1581 : real0tostr(long ex, char format, char exp_char, long wanted_dec)
     791             : {
     792             :   char *buf, *buf0;
     793             : 
     794        1581 :   if (format == 'f') {
     795           0 :     long width_frac = wanted_dec;
     796           0 :     if (width_frac < 0) width_frac = (ex >= 0)? 0: (long)(-ex * LOG10_2);
     797           0 :     return real0tostr_width_frac(width_frac);
     798             :   } else {
     799        1581 :     buf0 = buf = stack_malloc(3 + MAX_EXPO_LEN + 1);
     800        1581 :     *buf++ = '0';
     801        1581 :     *buf++ = '.';
     802        1581 :     *buf++ = exp_char;
     803        1581 :     sprintf(buf, "%ld", ex10(ex) + 1);
     804             :   }
     805        1581 :   return buf0;
     806             : }
     807             : 
     808             : /* format f, width_frac >= 0: number of digits in fractional part, */
     809             : static char *
     810      142736 : absrtostr_width_frac(GEN x, int width_frac)
     811             : {
     812      142736 :   long beta, ls, point, lx, sx = signe(x);
     813             :   char *s, *buf;
     814             :   GEN z;
     815             : 
     816      142736 :   if (!sx) return real0tostr_width_frac(width_frac);
     817             : 
     818             :   /* x != 0 */
     819      142119 :   lx = realprec(x);
     820      142119 :   beta = width_frac;
     821      142119 :   if (beta) /* >= 0 */
     822             :   { /* z = |x| 10^beta, 10^b = 5^b * 2^b, 2^b goes into exponent */
     823      123982 :     if (beta > 4e9) lx++;
     824      142119 :     z = mulrr(x, rpowuu(5UL, (ulong)beta, lx+1));
     825      142119 :     setsigne(z, 1);
     826      142119 :     shiftr_inplace(z, beta);
     827             :   }
     828             :   else
     829           0 :     z = mpabs(x);
     830      142119 :   z = roundr_safe(z);
     831      142119 :   if (!signe(z)) return real0tostr_width_frac(width_frac);
     832             : 
     833      142075 :   s = itostr_sign(z, 1, &ls); /* ls > 0, number of digits in s */
     834      142075 :   point = ls - beta; /* position of . in s; <= ls, may be < 0 */
     835      142075 :   if (point > 0) /* write integer_part.fractional_part */
     836             :   {
     837             :     /* '.', trailing \0 */
     838      141575 :     buf = stack_malloc( ls + 1+1 );
     839      141575 :     if (ls == point)
     840           0 :       strcpy(buf, s); /* no '.' */
     841             :     else
     842      141575 :       wr_dec(buf, s, point);
     843             :   } else { /* point <= 0, fractional part must be written */
     844             :     char *t;
     845             :     /* '0', '.', zeroes, trailing \0 */
     846         500 :     buf = t = stack_malloc( 1 + 1 - point + ls + 1 );
     847         500 :     *t++ = '0';
     848         500 :     *t++ = '.';
     849         500 :     t = zeros(t, -point);
     850         500 :     strcpy(t, s);
     851             :   }
     852      142075 :   return buf;
     853             : }
     854             : 
     855             : /* Return t_REAL |x| in floating point format.
     856             :  * Allocate freely, the caller must clean the stack.
     857             :  *   FORMAT: E/e (exponential), F/f (floating point), G/g
     858             :  *   wanted_dec: number of significant digits to print (all if < 0).
     859             :  */
     860             : static char *
     861       34111 : absrtostr(GEN x, int sp, char FORMAT, long wanted_dec)
     862             : {
     863       34111 :   const char format = (char)tolower((unsigned char)FORMAT), exp_char = (format == FORMAT)? 'e': 'E';
     864       34111 :   long beta, ls, point, lx, sx = signe(x), ex = expo(x);
     865             :   char *s, *buf, *buf0;
     866             :   GEN z;
     867             : 
     868       34111 :   if (!sx) return real0tostr(ex, format, exp_char, wanted_dec);
     869             : 
     870             :   /* x != 0 */
     871       32530 :   lx = realprec(x);
     872       32530 :   if (wanted_dec >= 0)
     873             :   { /* reduce precision if possible */
     874       32530 :     long w = ndec2prec(wanted_dec); /* digits -> pari precision in words */
     875       32530 :     if (lx > w) lx = w; /* truncature with guard, no rounding */
     876             :   }
     877       32530 :   beta = ex10(lx - ex);
     878       32530 :   if (beta)
     879             :   { /* z = |x| 10^beta, 10^b = 5^b * 2^b, 2^b goes into exponent */
     880       32523 :     if (beta > 0)
     881             :     {
     882       30116 :       if (beta > 18) { lx++; x = rtor(x, lx); }
     883       30116 :       z = mulrr(x, rpowuu(5UL, (ulong)beta, lx+1));
     884             :     }
     885             :     else
     886             :     {
     887        2407 :       if (beta < -18) { lx++; x = rtor(x, lx); }
     888        2407 :       z = divrr(x, rpowuu(5UL, (ulong)-beta, lx+1));
     889             :     }
     890       32523 :     setsigne(z, 1);
     891       32523 :     shiftr_inplace(z, beta);
     892             :   }
     893             :   else
     894           7 :     z = x;
     895       32530 :   z = roundr_safe(z);
     896       32530 :   if (!signe(z)) return real0tostr(ex, format, exp_char, wanted_dec);
     897             : 
     898       32530 :   s = itostr_sign(z, 1, &ls); /* ls > 0, number of digits in s */
     899       32530 :   if (wanted_dec < 0)
     900           0 :     wanted_dec = ls;
     901       32530 :   else if (ls > wanted_dec)
     902             :   {
     903       24410 :     beta -= ls - wanted_dec;
     904       24410 :     ls = wanted_dec;
     905       24410 :     if (s[ls] >= '5') /* round up */
     906             :     {
     907             :       long i;
     908       17675 :       for (i = ls-1; i >= 0; s[i--] = '0')
     909       17668 :         if (++s[i] <= '9') break;
     910       11344 :       if (i < 0) { s[0] = '1'; beta--; }
     911             :     }
     912       24410 :     s[ls] = 0;
     913             :   }
     914             : 
     915             :   /* '.', " E", exponent, trailing \0 */
     916       32530 :   point = ls - beta; /* position of . in s; < 0 or > 0 */
     917       32530 :   if (beta <= 0 || format == 'e' || (format == 'g' && point-1 < -4))
     918             :   { /* e format */
     919        4170 :     buf0 = buf = stack_malloc(ls+1+2+MAX_EXPO_LEN + 1);
     920        4170 :     wr_dec(buf, s, 1); buf += ls + 1;
     921        4170 :     if (sp) *buf++ = ' ';
     922        4170 :     *buf++ = exp_char;
     923        4170 :     sprintf(buf, "%ld", point-1);
     924             :   }
     925       28360 :   else if (point > 0) /* f format, write integer_part.fractional_part */
     926             :   {
     927       14341 :     buf0 = buf = stack_malloc(ls+1 + 1);
     928       14341 :     wr_dec(buf, s, point); /* point < ls since beta > 0 */
     929             :   }
     930             :   else /* f format, point <= 0, write fractional part */
     931             :   {
     932       14019 :     buf0 = buf = stack_malloc(2-point+ls + 1);
     933       14019 :     *buf++ = '0';
     934       14019 :     *buf++ = '.';
     935       14019 :     buf = zeros(buf, -point);
     936       14019 :     strcpy(buf, s);
     937             :   }
     938       32530 :   return buf0;
     939             : }
     940             : 
     941             : /* vsnprintf implementation rewritten from snprintf.c to be found at
     942             :  *
     943             :  * http://www.nersc.gov/~scottc/misc/docs/snort-2.1.1-RC1/snprintf_8c-source.html
     944             :  * The original code was
     945             :  *   Copyright (C) 1998-2002 Martin Roesch <roesch@sourcefire.com>
     946             :  * available under the terms of the GNU GPL version 2 or later. It
     947             :  * was itself adapted from an original version by Patrick Powell. */
     948             : 
     949             : /* Modifications for format %Ps: R.Butel IMB/CNRS 2007/12/03 */
     950             : 
     951             : /* l = old len, L = new len */
     952             : static void
     953        2128 : str_alloc0(pari_str *S, long l, long L)
     954             : {
     955        2128 :   if (S->use_stack)
     956        2100 :     S->string = (char*) memcpy(stack_malloc(L), S->string, l);
     957             :   else
     958          28 :     pari_realloc_ip((void**)&S->string, L);
     959        2128 :   S->cur = S->string + l;
     960        2128 :   S->end = S->string + L;
     961        2128 :   S->size = L;
     962        2128 : }
     963             : /* make sure S is large enough to write l further words (<= l * 20 chars).
     964             :  * To avoid automatic extension in between av = avma / set_avma(av) pairs
     965             :  * [ would destroy S->string if (S->use_stack) ] */
     966             : static void
     967      611490 : str_alloc(pari_str *S, long l)
     968             : {
     969      611490 :   l *= 20;
     970      611490 :   if (S->end - S->cur <= l)
     971        1390 :     str_alloc0(S, S->cur - S->string, S->size + maxss(S->size, l));
     972      611490 : }
     973             : void
     974    15301044 : str_putc(pari_str *S, char c)
     975             : {
     976    15301044 :   *S->cur++ = c;
     977    15301044 :   if (S->cur == S->end) str_alloc0(S, S->size, S->size << 1);
     978    15301044 : }
     979             : 
     980             : void
     981      298095 : str_init(pari_str *S, int use_stack)
     982             : {
     983             :   char *s;
     984      298095 :   S->size = 1024;
     985      298095 :   S->use_stack = use_stack;
     986      298095 :   if (S->use_stack)
     987      207374 :     s = (char*)stack_malloc(S->size);
     988             :   else
     989       90721 :     s = (char*)pari_malloc(S->size);
     990      298094 :   *s = 0;
     991      298094 :   S->string = S->cur = s;
     992      298094 :   S->end = S->string + S->size;
     993      298094 : }
     994             : void
     995    14117833 : str_puts(pari_str *S, const char *s) { while (*s) str_putc(S, *s++); }
     996             : 
     997             : static void
     998      158064 : str_putscut(pari_str *S, const char *s, int cut)
     999             : {
    1000      158064 :   if (cut < 0) str_puts(S, s);
    1001             :   else {
    1002         140 :     while (*s && cut-- > 0) str_putc(S, *s++);
    1003             :   }
    1004      158064 : }
    1005             : 
    1006             : /* lbuf = strlen(buf), len < 0: unset */
    1007             : static void
    1008      288478 : outpad(pari_str *S, const char *buf, long lbuf, int sign, long ljust, long len, long zpad)
    1009             : {
    1010      288478 :   long padlen = len - lbuf;
    1011      288478 :   if (padlen < 0) padlen = 0;
    1012      288478 :   if (ljust) padlen = -padlen;
    1013      288478 :   if (padlen > 0)
    1014             :   {
    1015         357 :     if (zpad) {
    1016          56 :       if (sign) { str_putc(S, sign); --padlen; }
    1017         252 :       while (padlen > 0) { str_putc(S, '0'); --padlen; }
    1018             :     }
    1019             :     else
    1020             :     {
    1021         301 :       if (sign) --padlen;
    1022        1106 :       while (padlen > 0) { str_putc(S, ' '); --padlen; }
    1023         301 :       if (sign) str_putc(S, sign);
    1024             :     }
    1025             :   } else
    1026      288121 :     if (sign) str_putc(S, sign);
    1027      288478 :   str_puts(S, buf);
    1028      288835 :   while (padlen < 0) { str_putc(S, ' '); ++padlen; }
    1029      288478 : }
    1030             : 
    1031             : /* len < 0 or maxwidth < 0: unset */
    1032             : static void
    1033      158064 : fmtstr(pari_str *S, const char *buf, int ljust, int len, int maxwidth)
    1034             : {
    1035      158064 :   int padlen, lbuf = strlen(buf);
    1036             : 
    1037      158064 :   if (maxwidth >= 0 && lbuf > maxwidth) lbuf = maxwidth;
    1038             : 
    1039      158064 :   padlen = len - lbuf;
    1040      158064 :   if (padlen < 0) padlen = 0;
    1041      158064 :   if (ljust) padlen = -padlen;
    1042      158183 :   while (padlen > 0) { str_putc(S, ' '); --padlen; }
    1043      158064 :   str_putscut(S, buf, maxwidth);
    1044      158064 :   while (padlen < 0) { str_putc(S, ' '); ++padlen; }
    1045      158064 : }
    1046             : 
    1047             : /* abs(base) is 8, 10, 16. If base < 0, some "alternate" form
    1048             :  * -- print hex in uppercase
    1049             :  * -- prefix octal with 0
    1050             :  * signvalue = -1: unsigned, otherwise ' ' or '+'. Leaves a messy stack if
    1051             :  * S->use_stack */
    1052             : static void
    1053      145511 : fmtnum(pari_str *S, long lvalue, GEN gvalue, int base, int signvalue,
    1054             :        int ljust, int len, int zpad)
    1055             : {
    1056             :   int caps;
    1057             :   char *buf0, *buf;
    1058             :   long lbuf, mxl;
    1059      145511 :   GEN uvalue = NULL;
    1060      145511 :   ulong ulvalue = 0;
    1061      145511 :   pari_sp av = avma;
    1062             : 
    1063      145511 :   if (gvalue)
    1064             :   {
    1065             :     long s, l;
    1066        2254 :     if (typ(gvalue) != t_INT) {
    1067             :       long i, j, h;
    1068          70 :       l = lg(gvalue);
    1069          70 :       switch(typ(gvalue))
    1070             :       {
    1071          56 :         case t_COMPLEX:
    1072          56 :           fmtnum(S, 0, gel(gvalue,1), base, signvalue, ljust,len,zpad);
    1073          56 :           if (gsigne(gel(gvalue,2)) >= 0) str_putc(S, '+');
    1074          56 :           fmtnum(S, 0, gel(gvalue,2), base, signvalue, ljust,len,zpad);
    1075          56 :           str_putc(S, '*');
    1076          56 :           str_putc(S, 'I');
    1077          56 :           return;
    1078           0 :         case t_VEC:
    1079           0 :           str_putc(S, '[');
    1080           0 :           for (i = 1; i < l; i++)
    1081             :           {
    1082           0 :             fmtnum(S, 0, gel(gvalue,i), base, signvalue, ljust,len,zpad);
    1083           0 :             if (i < l-1) str_putc(S, ',');
    1084             :           }
    1085           0 :           str_putc(S, ']');
    1086           0 :           return;
    1087           0 :         case t_COL:
    1088           0 :           str_putc(S, '[');
    1089           0 :           for (i = 1; i < l; i++)
    1090             :           {
    1091           0 :             fmtnum(S, 0, gel(gvalue,i), base, signvalue, ljust,len,zpad);
    1092           0 :             if (i < l-1) str_putc(S, ',');
    1093             :           }
    1094           0 :           str_putc(S, ']');
    1095           0 :           str_putc(S, '~');
    1096           0 :           return;
    1097          14 :         case t_MAT:
    1098          14 :           if (l == 1)
    1099           0 :             str_puts(S, "[;]");
    1100             :           else
    1101             :           {
    1102          14 :             h = lgcols(gvalue);
    1103          63 :             for (i=1; i<h; i++)
    1104             :             {
    1105          49 :               str_putc(S, '[');
    1106         168 :               for (j=1; j<l; j++)
    1107             :               {
    1108         119 :                 fmtnum(S, 0, gcoeff(gvalue,i,j), base, signvalue, ljust,len,zpad);
    1109         119 :                 if (j<l-1) str_putc(S, ' ');
    1110             :               }
    1111          49 :               str_putc(S, ']');
    1112          49 :               str_putc(S, '\n');
    1113          49 :               if (i<h-1) str_putc(S, '\n');
    1114             :             }
    1115             :           }
    1116          14 :           return;
    1117             :       }
    1118           0 :       gvalue = gfloor( simplify_shallow(gvalue) );
    1119           0 :       if (typ(gvalue) != t_INT)
    1120           0 :         pari_err(e_MISC,"not a t_INT in integer format conversion: %Ps", gvalue);
    1121             :     }
    1122        2184 :     s = signe(gvalue);
    1123        2184 :     if (!s) { lbuf = 1; buf = zerotostr(); signvalue = 0; goto END; }
    1124             : 
    1125        2065 :     l = lgefint(gvalue);
    1126        2065 :     uvalue = gvalue;
    1127        2065 :     if (signvalue < 0)
    1128             :     {
    1129         651 :       if (s < 0) uvalue = addii(int2n(bit_accuracy(l)), gvalue);
    1130         651 :       signvalue = 0;
    1131             :     }
    1132             :     else
    1133             :     {
    1134        1414 :       if (s < 0) { signvalue = '-'; uvalue = absi(uvalue); }
    1135             :     }
    1136        2065 :     mxl = (l-2)* 22 + 1; /* octal at worst; 22 octal chars per 64bit word */
    1137             :   } else {
    1138      143257 :     ulvalue = lvalue;
    1139      143257 :     if (signvalue < 0)
    1140         749 :       signvalue = 0;
    1141             :     else
    1142      142508 :       if (lvalue < 0) { signvalue = '-'; ulvalue = - lvalue; }
    1143      143257 :     mxl = 22 + 1; /* octal at worst; 22 octal chars to write down 2^64 - 1 */
    1144             :   }
    1145      145322 :   if (base > 0) caps = 0; else { caps = 1; base = -base; }
    1146             : 
    1147      145322 :   buf0 = buf = stack_malloc(mxl) + mxl; /* fill from the right */
    1148      145322 :   *--buf = 0; /* trailing \0 */
    1149      145322 :   if (gvalue) {
    1150        2065 :     if (base == 10) {
    1151             :       long i, l, cnt;
    1152        1414 :       ulong *larray = convi(uvalue, &l);
    1153        1414 :       larray -= l;
    1154       10073 :       for (i = 0; i < l; i++) {
    1155        8659 :         cnt = 0;
    1156        8659 :         ulvalue = larray[i];
    1157             :         do {
    1158       66262 :           *--buf = '0' + ulvalue%10;
    1159       66262 :           ulvalue = ulvalue / 10;
    1160       66262 :           cnt++;
    1161       66262 :         } while (ulvalue);
    1162        8659 :         if (i + 1 < l)
    1163        8372 :           for (;cnt<9;cnt++) *--buf = '0';
    1164             :       }
    1165         651 :     } else if (base == 16) {
    1166         651 :       long i, l = lgefint(uvalue);
    1167         651 :       GEN up = int_LSW(uvalue);
    1168        2963 :       for (i = 2; i < l; i++, up = int_nextW(up)) {
    1169        2312 :         ulong ucp = (ulong)*up;
    1170             :         long j;
    1171       29696 :         for (j=0; j < BITS_IN_LONG/4; j++) {
    1172       28035 :           unsigned char cv = ucp & 0xF;
    1173       28035 :           *--buf = (caps? "0123456789ABCDEF":"0123456789abcdef")[cv];
    1174       28035 :           ucp >>= 4;
    1175       28035 :           if (ucp == 0 && i+1 == l) break;
    1176             :         }
    1177             :       } /* loop on hex digits in word */
    1178           0 :     } else if (base == 8) {
    1179           0 :       long i, l = lgefint(uvalue);
    1180           0 :       GEN up = int_LSW(uvalue);
    1181           0 :       ulong rem = 0;
    1182           0 :       int shift = 0;
    1183           0 :       int mask[3] = {0, 1, 3};
    1184           0 :       for (i = 2; i < l; i++, up = int_nextW(up)) {
    1185           0 :         ulong ucp = (ulong)*up;
    1186           0 :         long j, ldispo = BITS_IN_LONG;
    1187           0 :         if (shift) { /* 0, 1 or 2 */
    1188           0 :           unsigned char cv = ((ucp & mask[shift]) <<(3-shift)) + rem;
    1189           0 :           *--buf = "01234567"[cv];
    1190           0 :           ucp >>= shift;
    1191           0 :           ldispo -= shift;
    1192             :         };
    1193           0 :         shift = (shift + 3 - BITS_IN_LONG % 3) % 3;
    1194           0 :         for (j=0; j < BITS_IN_LONG/3; j++) {
    1195           0 :           unsigned char cv = ucp & 0x7;
    1196           0 :           if (ucp == 0 && i+1 == l) { rem = 0; break; };
    1197           0 :           *--buf = "01234567"[cv];
    1198           0 :           ucp >>= 3;
    1199           0 :           ldispo -= 3;
    1200           0 :           rem = ucp;
    1201           0 :           if (ldispo < 3) break;
    1202             :         }
    1203             :       } /* loop on hex digits in word */
    1204           0 :       if (rem) *--buf = "01234567"[rem];
    1205             :     }
    1206             :   } else { /* not a gvalue, thus a standard integer */
    1207             :     do {
    1208      356324 :       *--buf = (caps? "0123456789ABCDEF":"0123456789abcdef")[ulvalue % (unsigned)base ];
    1209      356324 :       ulvalue /= (unsigned)base;
    1210      356324 :     } while (ulvalue);
    1211             :   }
    1212             :   /* leading 0 if octal and alternate # form */
    1213      145322 :   if (caps && base == 8) *--buf = '0';
    1214      145322 :   lbuf = (buf0 - buf) - 1;
    1215      145441 : END:
    1216      145441 :   outpad(S, buf, lbuf, signvalue, ljust, len, zpad);
    1217      145441 :   if (!S->use_stack) set_avma(av);
    1218             : }
    1219             : 
    1220             : static GEN
    1221        1876 : v_get_arg(pari_str *S, GEN arg_vector, int *index, const char *save_fmt)
    1222             : {
    1223        1876 :   if (*index >= lg(arg_vector))
    1224             :   {
    1225           7 :     if (!S->use_stack) pari_free(S->string);
    1226           7 :     pari_err(e_MISC, "missing arg %d for printf format '%s'", *index, save_fmt);  }
    1227        1869 :   return gel(arg_vector, (*index)++);
    1228             : }
    1229             : 
    1230             : static int
    1231      286665 : dosign(int blank, int plus)
    1232             : {
    1233      286665 :   if (plus) return('+');
    1234      286651 :   if (blank) return(' ');
    1235      286651 :   return 0;
    1236             : }
    1237             : 
    1238             : /* x * 10 + 'digit whose char value is ch'. Do not check for overflow */
    1239             : static int
    1240      143478 : shift_add(int x, int ch)
    1241             : {
    1242      143478 :   if (x < 0) /* was unset */
    1243      143275 :     x = ch - '0';
    1244             :   else
    1245         203 :     x = x*10 + ch - '0';
    1246      143478 :   return x;
    1247             : }
    1248             : 
    1249             : static long
    1250      143037 : get_sigd(GEN gvalue, char ch, int maxwidth)
    1251             : {
    1252             :   long e;
    1253      143037 :   if (maxwidth < 0) return nbits2ndec(precreal);
    1254      143023 :   switch(ch)
    1255             :   {
    1256         147 :     case 'E': case 'e': return maxwidth+1;
    1257      142736 :     case 'F': case 'f':
    1258      142736 :       e = gexpo(gvalue);
    1259      142736 :       if (e == -(long)HIGHEXPOBIT) return 0;
    1260      142701 :       e = ex10(e); if (e < 0) e = 0;
    1261      142701 :       return e + 1 + maxwidth;
    1262             :   }
    1263         140 :   return maxwidth? maxwidth: 1; /* 'g', 'G' */
    1264             : }
    1265             : 
    1266             : static void
    1267      143121 : fmtreal(pari_str *S, GEN gvalue, int space, int signvalue, int FORMAT,
    1268             :         int maxwidth, int ljust, int len, int zpad)
    1269             : {
    1270      143121 :   pari_sp av = avma;
    1271             :   long sigd;
    1272             :   char *buf;
    1273             : 
    1274      143121 :   if (typ(gvalue) == t_REAL)
    1275      142834 :     sigd = get_sigd(gvalue, FORMAT, maxwidth);
    1276             :   else
    1277             :   {
    1278         287 :     long i, j, h, l = lg(gvalue);
    1279         287 :     switch(typ(gvalue))
    1280             :     {
    1281          42 :       case t_COMPLEX:
    1282          42 :         fmtreal(S, gel(gvalue,1), space, signvalue, FORMAT, maxwidth,
    1283             :                 ljust,len,zpad);
    1284          42 :         if (gsigne(gel(gvalue,2)) >= 0) str_putc(S, '+');
    1285          42 :         fmtreal(S, gel(gvalue,2), space, signvalue, FORMAT, maxwidth,
    1286             :                 ljust,len,zpad);
    1287          42 :         str_putc(S, 'I');
    1288          42 :         return;
    1289             : 
    1290          28 :       case t_VEC:
    1291          28 :         str_putc(S, '[');
    1292          84 :         for (i = 1; i < l; i++)
    1293             :         {
    1294          56 :           fmtreal(S, gel(gvalue,i), space, signvalue, FORMAT, maxwidth,
    1295             :                   ljust,len,zpad);
    1296          56 :           if (i < l-1) str_putc(S, ',');
    1297             :         }
    1298          28 :         str_putc(S, ']');
    1299          28 :         return;
    1300           0 :       case t_COL:
    1301           0 :         str_putc(S, '[');
    1302           0 :         for (i = 1; i < l; i++)
    1303             :         {
    1304           0 :           fmtreal(S, gel(gvalue,i), space, signvalue, FORMAT, maxwidth,
    1305             :                   ljust,len,zpad);
    1306           0 :           if (i < l-1) str_putc(S, ',');
    1307             :         }
    1308           0 :         str_putc(S, ']');
    1309           0 :         str_putc(S, '~');
    1310           0 :         return;
    1311          14 :       case t_MAT:
    1312          14 :         if (l == 1)
    1313           0 :           str_puts(S, "[;]");
    1314             :         else
    1315             :         {
    1316          14 :           h = lgcols(gvalue);
    1317          42 :           for (j=1; j<h; j++)
    1318             :           {
    1319          28 :             str_putc(S, '[');
    1320         105 :             for (i=1; i<l; i++)
    1321             :             {
    1322          77 :               fmtreal(S, gcoeff(gvalue,j,i), space, signvalue, FORMAT, maxwidth,
    1323             :                       ljust,len,zpad);
    1324          77 :               if (i<l-1) str_putc(S, ' ');
    1325             :             }
    1326          28 :             str_putc(S, ']');
    1327          28 :             str_putc(S, '\n');
    1328          28 :             if (j<h-1) str_putc(S, '\n');
    1329             :           }
    1330             :         }
    1331          14 :         return;
    1332             :     }
    1333         203 :     sigd = get_sigd(gvalue, FORMAT, maxwidth);
    1334         203 :     gvalue = gtofp(gvalue, maxss(ndec2prec(sigd), LOWDEFAULTPREC));
    1335         203 :     if (typ(gvalue) != t_REAL)
    1336             :     {
    1337           0 :       if (!S->use_stack) free(S->string);
    1338           0 :       pari_err(e_MISC,"impossible conversion to t_REAL: %Ps",gvalue);
    1339             :     }
    1340             :   }
    1341      143037 :   if ((FORMAT == 'f' || FORMAT == 'F') && maxwidth >= 0)
    1342      142736 :     buf = absrtostr_width_frac(gvalue, maxwidth);
    1343             :   else
    1344         301 :     buf = absrtostr(gvalue, space, FORMAT, sigd);
    1345      143037 :   if (signe(gvalue) < 0) signvalue = '-';
    1346      143037 :   outpad(S, buf, strlen(buf), signvalue, ljust, len, zpad);
    1347      143037 :   if (!S->use_stack) set_avma(av);
    1348             : }
    1349             : static long
    1350          77 : gtolong_OK(GEN x)
    1351             : {
    1352          77 :   switch(typ(x))
    1353             :   {
    1354          56 :     case t_INT: case t_REAL: case t_FRAC: return 1;
    1355           7 :     case t_COMPLEX: return gequal0(gel(x,2)) && gtolong_OK(gel(x,1));
    1356           7 :     case t_QUAD: return gequal0(gel(x,3)) && gtolong_OK(gel(x,2));
    1357             :   }
    1358           7 :   return 0;
    1359             : }
    1360             : /* Format handling "inspired" by the standard draft at
    1361             : -- http://www.open-std.org/jtc1/sc22/wg14/www/docs/n1124.pdf pages 274ff
    1362             :  * fmt is a standard printf format, except 'P' is a "length modifier"
    1363             :  * allowing GEN arguments. Use either the arg_vector or (if NULL) the va_list.
    1364             :  * Appent output to the pari_str S, which must be initialized; clean if
    1365             :  * !S->use_stack, else leaves objects of stack. */
    1366             : static void
    1367      226868 : str_arg_vprintf(pari_str *S, const char *fmt, GEN arg_vector, va_list args)
    1368             : {
    1369      226868 :   int GENflag = 0, longflag = 0, pointflag = 0;
    1370             :   int print_plus, print_blank, with_sharp, ch, ljust, len, maxwidth, zpad;
    1371             :   long lvalue;
    1372      226868 :   int index = 1;
    1373             :   GEN gvalue;
    1374      226868 :   const char *save_fmt = fmt;
    1375             : 
    1376     2316653 :   while ((ch = *fmt++) != '\0') {
    1377     2089806 :     switch(ch) {
    1378      446682 :       case '%':
    1379      446682 :         ljust = zpad = 0;
    1380      446682 :         len = maxwidth = -1;
    1381      446682 :         GENflag = longflag = pointflag = 0;
    1382      446682 :         print_plus = print_blank = with_sharp = 0;
    1383      898658 : nextch:
    1384      898658 :         ch = *fmt++;
    1385         378 :         switch(ch) {
    1386           0 :           case 0:
    1387           0 :             pari_err(e_MISC, "printf: end of format");
    1388             : /*------------------------------------------------------------------------
    1389             :                              -- flags
    1390             : ------------------------------------------------------------------------*/
    1391          42 :           case '-':
    1392          42 :             ljust = 1;
    1393          42 :             goto nextch;
    1394          14 :           case '+':
    1395          14 :             print_plus = 1;
    1396          14 :             goto nextch;
    1397          14 :           case '#':
    1398          14 :             with_sharp = 1;
    1399          14 :             goto nextch;
    1400           0 :           case ' ':
    1401           0 :             print_blank = 1;
    1402           0 :             goto nextch;
    1403         952 :           case '0':
    1404             :             /* appears as a flag: set zero padding */
    1405         952 :             if (len < 0 && !pointflag) { zpad = '0'; goto nextch; }
    1406             : 
    1407             :             /* else part of a field width or precision */
    1408             :             /* fall through */
    1409             : /*------------------------------------------------------------------------
    1410             :                        -- maxwidth or precision
    1411             : ------------------------------------------------------------------------*/
    1412             :           case '1':
    1413             :           case '2':
    1414             :           case '3':
    1415             :           case '4':
    1416             :           case '5':
    1417             :           case '6':
    1418             :           case '7':
    1419             :           case '8':
    1420             :           case '9':
    1421      143478 :             if (pointflag)
    1422      143030 :               maxwidth = shift_add(maxwidth, ch);
    1423             :             else
    1424         448 :               len = shift_add(len, ch);
    1425      143478 :             goto nextch;
    1426             : 
    1427          28 :           case '*':
    1428             :           {
    1429          28 :             int *t = pointflag? &maxwidth: &len;
    1430          28 :             if (arg_vector)
    1431             :             {
    1432          28 :               gvalue = v_get_arg(S, arg_vector, &index, save_fmt);
    1433          28 :               if (!gtolong_OK(gvalue) && !S->use_stack) pari_free(S->string);
    1434          28 :               *t = (int)gtolong(gvalue);
    1435             :             }
    1436             :             else
    1437           0 :               *t = va_arg(args, int);
    1438          28 :             goto nextch;
    1439             :           }
    1440      142932 :           case '.':
    1441      142932 :             if (pointflag)
    1442           0 :               pari_err(e_MISC, "two '.' in conversion specification");
    1443      142932 :             pointflag = 1;
    1444      142932 :             goto nextch;
    1445             : /*------------------------------------------------------------------------
    1446             :                        -- length modifiers
    1447             : ------------------------------------------------------------------------*/
    1448      144144 :           case 'l':
    1449      144144 :             if (GENflag)
    1450           0 :               pari_err(e_MISC, "P/l length modifiers in the same conversion");
    1451             : #if !defined(_WIN64)
    1452      144144 :             if (longflag)
    1453           0 :               pari_err_IMPL( "ll length modifier in printf");
    1454             : #endif
    1455      144144 :             longflag = 1;
    1456      144144 :             goto nextch;
    1457       20554 :           case 'P':
    1458       20554 :             if (longflag)
    1459           0 :               pari_err(e_MISC, "P/l length modifiers in the same conversion");
    1460       20554 :             if (GENflag)
    1461           0 :               pari_err(e_MISC, "'P' length modifier appears twice");
    1462       20554 :             GENflag = 1;
    1463       20554 :             goto nextch;
    1464           0 :           case 'h': /* dummy: va_arg promotes short into int */
    1465           0 :             goto nextch;
    1466             : /*------------------------------------------------------------------------
    1467             :                        -- conversions
    1468             : ------------------------------------------------------------------------*/
    1469         749 :           case 'u': /* not a signed conversion: print_(blank|plus) ignored */
    1470             : #define get_num_arg() \
    1471             :   if (arg_vector) { \
    1472             :     lvalue = 0; \
    1473             :     gvalue = v_get_arg(S, arg_vector, &index, save_fmt); \
    1474             :   } else { \
    1475             :     if (GENflag) { \
    1476             :       lvalue = 0; \
    1477             :       gvalue = va_arg(args, GEN); \
    1478             :     } else { \
    1479             :       lvalue = longflag? va_arg(args, long): va_arg(args, int); \
    1480             :       gvalue = NULL; \
    1481             :     } \
    1482             :   }
    1483         749 :             get_num_arg();
    1484         749 :             fmtnum(S, lvalue, gvalue, 10, -1, ljust, len, zpad);
    1485         749 :             break;
    1486           0 :           case 'o': /* not a signed conversion: print_(blank|plus) ignored */
    1487           0 :             get_num_arg();
    1488           0 :             fmtnum(S, lvalue, gvalue, with_sharp? -8: 8, -1, ljust, len, zpad);
    1489           0 :             break;
    1490      143768 :           case 'd':
    1491             :           case 'i':
    1492      143768 :             get_num_arg();
    1493      143761 :             fmtnum(S, lvalue, gvalue, 10,
    1494             :                    dosign(print_blank, print_plus), ljust, len, zpad);
    1495      143761 :             break;
    1496           0 :           case 'p':
    1497           0 :             str_putc(S, '0'); str_putc(S, 'x');
    1498           0 :             if (arg_vector)
    1499           0 :               lvalue = (long)v_get_arg(S, arg_vector, &index, save_fmt);
    1500             :             else
    1501           0 :               lvalue = (long)va_arg(args, void*);
    1502           0 :             fmtnum(S, lvalue, NULL, 16, -1, ljust, len, zpad);
    1503           0 :             break;
    1504          14 :           case 'x': /* not a signed conversion: print_(blank|plus) ignored */
    1505          14 :             if (with_sharp) { str_putc(S, '0'); str_putc(S, 'x'); }
    1506          14 :             get_num_arg();
    1507          14 :             fmtnum(S, lvalue, gvalue, 16, -1, ljust, len, zpad);
    1508          14 :             break;
    1509         756 :           case 'X': /* not a signed conversion: print_(blank|plus) ignored */
    1510         756 :             if (with_sharp) { str_putc(S, '0'); str_putc(S, 'X'); }
    1511         756 :             get_num_arg();
    1512         756 :             fmtnum(S, lvalue, gvalue,-16, -1, ljust, len, zpad);
    1513         756 :             break;
    1514      158064 :           case 's':
    1515             :           {
    1516             :             char *strvalue;
    1517      158064 :             pari_sp av = avma;
    1518             : 
    1519      158064 :             if (arg_vector) {
    1520         126 :               gvalue = v_get_arg(S, arg_vector, &index, save_fmt);
    1521         126 :               strvalue = NULL;
    1522             :             } else {
    1523      157938 :               if (GENflag) {
    1524       19805 :                 gvalue = va_arg(args, GEN);
    1525       19805 :                 strvalue = NULL;
    1526             :               } else {
    1527      138133 :                 gvalue = NULL;
    1528      138133 :                 strvalue = va_arg(args, char *);
    1529             :               }
    1530             :             }
    1531      158064 :             if (gvalue) strvalue = GENtostr_unquoted(gvalue);
    1532      158064 :             fmtstr(S, strvalue, ljust, len, maxwidth);
    1533      158064 :             if (!S->use_stack) set_avma(av);
    1534      158064 :             break;
    1535             :           }
    1536          42 :           case 'c':
    1537          42 :             gvalue = NULL;
    1538          42 :             if (arg_vector)
    1539          35 :               gvalue = v_get_arg(S, arg_vector, &index, save_fmt);
    1540           7 :             else if (GENflag)
    1541           0 :               gvalue = va_arg(args,GEN);
    1542             :             else
    1543             :             {
    1544           7 :               ch = va_arg(args, int);
    1545           7 :               str_putc(S, ch); break;
    1546             :             }
    1547          35 :             if (!gtolong_OK(gvalue) && !S->use_stack) free(S->string);
    1548          35 :             str_putc(S, (int)gtolong(gvalue));
    1549          28 :             break;
    1550             : 
    1551         378 :           case '%':
    1552         378 :             str_putc(S, ch);
    1553         378 :             continue;
    1554      142904 :           case 'g':
    1555             :           case 'G':
    1556             :           case 'e':
    1557             :           case 'E':
    1558             :           case 'f':
    1559             :           case 'F':
    1560             :           {
    1561      142904 :             pari_sp av = avma;
    1562      142904 :             if (arg_vector)
    1563         392 :               gvalue = simplify_shallow(v_get_arg(S, arg_vector, &index, save_fmt));
    1564             :             else {
    1565      142512 :               if (GENflag)
    1566           0 :                 gvalue = simplify_shallow( va_arg(args, GEN) );
    1567             :               else
    1568      142512 :                 gvalue = dbltor( va_arg(args, double) );
    1569             :             }
    1570      142904 :             fmtreal(S, gvalue, GP_DATA->fmt->sp, dosign(print_blank,print_plus),
    1571             :                     ch, maxwidth, ljust, len, zpad);
    1572      142904 :             if (!S->use_stack) set_avma(av);
    1573      142904 :             break;
    1574             :           }
    1575           7 :           default:
    1576           7 :             if (!S->use_stack) free(S->string);
    1577           7 :             pari_err(e_MISC, "invalid conversion or specification %c in format `%s'", ch, save_fmt);
    1578             :         } /* second switch on ch */
    1579      446283 :         break;
    1580     1643124 :       default:
    1581     1643124 :         str_putc(S, ch);
    1582     1643124 :         break;
    1583             :     } /* first switch on ch */
    1584             :   } /* while loop on ch */
    1585      226847 :   *S->cur = 0;
    1586      226847 : }
    1587             : 
    1588             : void
    1589          12 : decode_color(long n, long *c)
    1590             : {
    1591          12 :   c[1] = n & 0xf; n >>= 4; /* foreground */
    1592          12 :   c[2] = n & 0xf; n >>= 4; /* background */
    1593          12 :   c[0] = n & 0xf; /* attribute */
    1594          12 : }
    1595             : 
    1596             : #define COLOR_LEN 16
    1597             : /* start printing in "color" c */
    1598             : /* terminal has to support ANSI color escape sequences */
    1599             : void
    1600       67382 : out_term_color(PariOUT *out, long c)
    1601             : {
    1602             :   static char s[COLOR_LEN];
    1603       67382 :   out->puts(term_get_color(s, c));
    1604       67382 : }
    1605             : void
    1606         709 : term_color(long c) { out_term_color(pariOut, c); }
    1607             : 
    1608             : /* s must be able to store 12 chars (including final \0) */
    1609             : char *
    1610       82000 : term_get_color(char *s, long n)
    1611             : {
    1612             :   long c[3], a;
    1613       82000 :   if (!s) s = stack_malloc(COLOR_LEN);
    1614             : 
    1615       82000 :   if (disable_color) { *s = 0; return s; }
    1616          16 :   if (n == c_NONE || (a = gp_colors[n]) == c_NONE)
    1617           4 :     strcpy(s, "\x1b[0m"); /* reset */
    1618             :   else
    1619             :   {
    1620          12 :     decode_color(a,c);
    1621          12 :     if (c[1]<8) c[1] += 30; else c[1] += 82;
    1622          12 :     if (a & (1L<<12)) /* transparent background */
    1623          12 :       sprintf(s, "\x1b[%ld;%ldm", c[0], c[1]);
    1624             :     else
    1625             :     {
    1626           0 :       if (c[2]<8) c[2] += 40; else c[2] += 92;
    1627           0 :       sprintf(s, "\x1b[%ld;%ld;%ldm", c[0], c[1], c[2]);
    1628             :     }
    1629             :   }
    1630          16 :   return s;
    1631             : }
    1632             : 
    1633             : static long
    1634      173086 : strlen_real(const char *s)
    1635             : {
    1636      173086 :   const char *t = s;
    1637      173086 :   long len = 0;
    1638     1303151 :   while (*t)
    1639             :   {
    1640     1130065 :     if (t[0] == '\x1b' && t[1] == '[')
    1641             :     { /* skip ANSI escape sequence */
    1642           2 :       t += 2;
    1643          10 :       while (*t && *t++ != 'm') /* empty */;
    1644           2 :       continue;
    1645             :     }
    1646     1130063 :     t++; len++;
    1647             :   }
    1648      173086 :   return len;
    1649             : }
    1650             : 
    1651             : #undef COLOR_LEN
    1652             : 
    1653             : /********************************************************************/
    1654             : /**                                                                **/
    1655             : /**                  PRINTING BASED ON SCREEN WIDTH                **/
    1656             : /**                                                                **/
    1657             : /********************************************************************/
    1658             : #undef larg /* problems with SCO Unix headers (ioctl_arg) */
    1659             : #ifdef HAS_TIOCGWINSZ
    1660             : #  ifdef __sun
    1661             : #    include <sys/termios.h>
    1662             : #  endif
    1663             : #  include <sys/ioctl.h>
    1664             : #endif
    1665             : 
    1666             : static int
    1667       22700 : term_width_intern(void)
    1668             : {
    1669             : #ifdef _WIN32
    1670             :   return win32_terminal_width();
    1671             : #endif
    1672             : #ifdef HAS_TIOCGWINSZ
    1673             :   {
    1674             :     struct winsize s;
    1675       22700 :     if (!(GP_DATA->flags & (gpd_EMACS|gpd_TEXMACS))
    1676       22700 :      && !ioctl(0, TIOCGWINSZ, &s)) return s.ws_col;
    1677             :   }
    1678             : #endif
    1679             :   {
    1680             :     char *str;
    1681       22700 :     if ((str = os_getenv("COLUMNS"))) return atoi(str);
    1682             :   }
    1683             : #ifdef __EMX__
    1684             :   {
    1685             :     int scrsize[2];
    1686             :     _scrsize(scrsize); return scrsize[0];
    1687             :   }
    1688             : #endif
    1689       22700 :   return 0;
    1690             : }
    1691             : 
    1692             : static int
    1693           7 : term_height_intern(void)
    1694             : {
    1695             : #ifdef _WIN32
    1696             :   return win32_terminal_height();
    1697             : #endif
    1698             : #ifdef HAS_TIOCGWINSZ
    1699             :   {
    1700             :     struct winsize s;
    1701           7 :     if (!(GP_DATA->flags & (gpd_EMACS|gpd_TEXMACS))
    1702           7 :      && !ioctl(0, TIOCGWINSZ, &s)) return s.ws_row;
    1703             :   }
    1704             : #endif
    1705             :   {
    1706             :     char *str;
    1707           7 :     if ((str = os_getenv("LINES"))) return atoi(str);
    1708             :   }
    1709             : #ifdef __EMX__
    1710             :   {
    1711             :     int scrsize[2];
    1712             :     _scrsize(scrsize); return scrsize[1];
    1713             :   }
    1714             : #endif
    1715           7 :   return 0;
    1716             : }
    1717             : 
    1718             : #define DFT_TERM_WIDTH  80
    1719             : #define DFT_TERM_HEIGHT 20
    1720             : 
    1721             : int
    1722       22700 : term_width(void)
    1723             : {
    1724       22700 :   int n = term_width_intern();
    1725       22700 :   return (n>1)? n: DFT_TERM_WIDTH;
    1726             : }
    1727             : 
    1728             : int
    1729           7 : term_height(void)
    1730             : {
    1731           7 :   int n = term_height_intern();
    1732           7 :   return (n>1)? n: DFT_TERM_HEIGHT;
    1733             : }
    1734             : 
    1735             : static ulong col_index;
    1736             : 
    1737             : /* output string wrapped after MAX_WIDTH characters (for gp -test) */
    1738             : static void
    1739     9837882 : putc_lw(char c)
    1740             : {
    1741     9837882 :   if (c == '\n') col_index = 0;
    1742     9636811 :   else if (col_index >= GP_DATA->linewrap) { normalOutC('\n'); col_index = 1; }
    1743     9559003 :   else col_index++;
    1744     9837882 :   normalOutC(c);
    1745     9837882 : }
    1746             : static void
    1747     9928769 : puts_lw(const char *s) { while (*s) putc_lw(*s++); }
    1748             : 
    1749             : static PariOUT pariOut_lw= {putc_lw, puts_lw, normalOutF};
    1750             : 
    1751             : void
    1752       61914 : init_linewrap(long w) { col_index=0; GP_DATA->linewrap=w; pariOut=&pariOut_lw; }
    1753             : 
    1754             : static void
    1755        7920 : new_line(PariOUT *out, const char *prefix)
    1756             : {
    1757        7920 :   out_putc(out, '\n'); if (prefix) out_puts(out, prefix);
    1758        7920 : }
    1759             : 
    1760             : #define is_blank(c) ((c) == ' ' || (c) == '\n' || (c) == '\t')
    1761             : /* output: <prefix>< s wrapped at EOL >
    1762             :  *         <prefix>< ... > <str>
    1763             :  *                         ^---  (no \n at the end)
    1764             :  * If str is NULL, omit the arrow, end the text with '\n'.
    1765             :  * If prefix is NULL, use "" */
    1766             : void
    1767       18655 : print_prefixed_text(PariOUT *out, const char *s, const char *prefix,
    1768             :                     const char *str)
    1769             : {
    1770       18655 :   const long prelen = prefix? strlen_real(prefix): 0;
    1771       18655 :   const long W = term_width(), ls = strlen(s);
    1772       18655 :   long linelen = prelen;
    1773       18655 :   char *word = (char*)pari_malloc(ls + 3);
    1774             : 
    1775       18655 :   if (prefix) out_puts(out, prefix);
    1776             :   for(;;)
    1777      127990 :   {
    1778             :     long len;
    1779      146645 :     int blank = 0;
    1780      146645 :     char *u = word;
    1781      928173 :     while (*s && !is_blank(*s)) *u++ = *s++;
    1782      146645 :     *u = 0; /* finish "word" */
    1783      146645 :     len = strlen_real(word);
    1784      146645 :     linelen += len;
    1785      146645 :     if (linelen >= W) { new_line(out, prefix); linelen = prelen + len; }
    1786      146645 :     out_puts(out, word);
    1787      286468 :     while (is_blank(*s)) {
    1788      139823 :       switch (*s) {
    1789      137162 :         case ' ': break;
    1790           0 :         case '\t':
    1791           0 :           linelen = (linelen & ~7UL) + 8; out_putc(out, '\t');
    1792           0 :           blank = 1; break;
    1793        2661 :         case '\n':
    1794        2661 :           linelen = W;
    1795        2661 :           blank = 1; break;
    1796             :       }
    1797      139823 :       if (linelen >= W) { new_line(out, prefix); linelen = prelen; }
    1798      139823 :       s++;
    1799             :     }
    1800      146645 :     if (!*s) break;
    1801      127990 :     if (!blank) { out_putc(out, ' '); linelen++; }
    1802             :   }
    1803       18655 :   if (!str)
    1804        5466 :     out_putc(out, '\n');
    1805             :   else
    1806             :   {
    1807       13189 :     long i,len = strlen_real(str);
    1808       13189 :     int space = (*str == ' ' && str[1]);
    1809       13189 :     if (linelen + len >= W)
    1810             :     {
    1811          21 :       new_line(out, prefix); linelen = prelen;
    1812          21 :       if (space) { str++; len--; space = 0; }
    1813             :     }
    1814       13189 :     out_term_color(out, c_OUTPUT);
    1815       13189 :     out_puts(out, str);
    1816       13189 :     if (!len || str[len-1] != '\n') out_putc(out, '\n');
    1817       13189 :     if (space) { linelen++; len--; }
    1818       13189 :     out_term_color(out, c_ERR);
    1819       13189 :     if (prefix) { out_puts(out, prefix); linelen -= prelen; }
    1820      217212 :     for (i=0; i<linelen; i++) out_putc(out, ' ');
    1821       13189 :     out_putc(out, '^');
    1822      243938 :     for (i=0; i<len; i++) out_putc(out, '-');
    1823             :   }
    1824       18655 :   pari_free(word);
    1825       18655 : }
    1826             : 
    1827             : #define CONTEXT_LEN 46
    1828             : #define MAX_TERM_COLOR 16
    1829             : /* Outputs a beautiful error message (not \n terminated)
    1830             :  *   msg is errmessage to print.
    1831             :  *   s points to the offending chars.
    1832             :  *   entry tells how much we can go back from s[0] */
    1833             : void
    1834       13252 : print_errcontext(PariOUT *out,
    1835             :                  const char *msg, const char *s, const char *entry)
    1836             : {
    1837       13252 :   const long MAX_PAST = 25;
    1838       13252 :   long past = s - entry, future, lmsg;
    1839             :   char str[CONTEXT_LEN + 1 + 1], pre[MAX_TERM_COLOR + 8 + 1];
    1840             :   char *buf, *t;
    1841             : 
    1842       13252 :   if (!s || !entry) { print_prefixed_text(out, msg,"  ***   ",NULL); return; }
    1843             : 
    1844             :   /* message + context */
    1845       13189 :   lmsg = strlen(msg);
    1846             :   /* msg + past + ': ' + '...' + term_get_color + \0 */
    1847       13189 :   t = buf = (char*)pari_malloc(lmsg + MAX_PAST + 2 + 3 + MAX_TERM_COLOR + 1);
    1848       13189 :   memcpy(t, msg, lmsg); t += lmsg;
    1849       13189 :   strcpy(t, ": "); t += 2;
    1850       13189 :   if (past <= 0) past = 0;
    1851             :   else
    1852             :   {
    1853        1419 :     if (past > MAX_PAST) { past = MAX_PAST; strcpy(t, "..."); t += 3; }
    1854        1419 :     term_get_color(t, c_OUTPUT);
    1855        1419 :     t += strlen(t);
    1856        1419 :     memcpy(t, s - past, past); t[past] = 0;
    1857             :   }
    1858             : 
    1859             :   /* suffix (past arrow) */
    1860       13189 :   t = str; if (!past) *t++ = ' ';
    1861       13189 :   future = CONTEXT_LEN - past;
    1862       13189 :   strncpy(t, s, future); t[future] = 0;
    1863             :   /* prefix '***' */
    1864       13189 :   term_get_color(pre, c_ERR);
    1865       13189 :   strcat(pre, "  ***   ");
    1866             :   /* now print */
    1867       13189 :   print_prefixed_text(out, buf, pre, str);
    1868       13189 :   pari_free(buf);
    1869             : }
    1870             : 
    1871             : /********************************************************************/
    1872             : /**                                                                **/
    1873             : /**                    GEN <---> CHARACTER STRINGS                 **/
    1874             : /**                                                                **/
    1875             : /********************************************************************/
    1876             : static OUT_FUN
    1877      203259 : get_fun(long flag)
    1878             : {
    1879      203259 :   switch(flag) {
    1880      142903 :     case f_RAW : return bruti;
    1881         172 :     case f_TEX : return texi;
    1882       60184 :     default: return matbruti;
    1883             :   }
    1884             : }
    1885             : 
    1886             : /* not stack clean */
    1887             : static char *
    1888       71330 : stack_GENtostr_fun(GEN x, pariout_t *T, OUT_FUN out)
    1889             : {
    1890       71330 :   pari_str S; str_init(&S, 1);
    1891       71330 :   out(x, T, &S); *S.cur = 0;
    1892       71330 :   return S.string;
    1893             : }
    1894             : /* same but remove quotes "" around t_STR */
    1895             : static char *
    1896       25944 : stack_GENtostr_fun_unquoted(GEN x, pariout_t *T, OUT_FUN out)
    1897       25944 : { return (typ(x)==t_STR)? GSTR(x): stack_GENtostr_fun(x, T, out); }
    1898             : 
    1899             : /* stack-clean: pari-malloc'ed */
    1900             : static char *
    1901         732 : GENtostr_fun(GEN x, pariout_t *T, OUT_FUN out)
    1902             : {
    1903         732 :   pari_sp av = avma;
    1904         732 :   pari_str S; str_init(&S, 0);
    1905         732 :   out(x, T, &S); *S.cur = 0;
    1906         732 :   set_avma(av); return S.string;
    1907             : }
    1908             : /* returns a malloc-ed string, which should be freed after usage */
    1909             : /* Returns pari_malloc()ed string */
    1910             : char *
    1911           4 : GENtostr(GEN x)
    1912           4 : { return GENtostr_fun(x, GP_DATA->fmt, get_fun(GP_DATA->fmt->prettyp)); }
    1913             : char *
    1914           0 : GENtoTeXstr(GEN x) { return GENtostr_fun(x, GP_DATA->fmt, &texi); }
    1915             : char *
    1916       25944 : GENtostr_unquoted(GEN x)
    1917       25944 : { return stack_GENtostr_fun_unquoted(x, GP_DATA->fmt, &bruti); }
    1918             : /* alloc-ed on PARI stack */
    1919             : char *
    1920        3696 : GENtostr_raw(GEN x) { return stack_GENtostr_fun(x,GP_DATA->fmt,&bruti); }
    1921             : 
    1922             : GEN
    1923         728 : GENtoGENstr(GEN x)
    1924             : {
    1925         728 :   char *s = GENtostr_fun(x, GP_DATA->fmt, &bruti);
    1926         728 :   GEN z = strtoGENstr(s); pari_free(s); return z;
    1927             : }
    1928             : GEN
    1929           0 : GENtoGENstr_nospace(GEN x)
    1930             : {
    1931           0 :   pariout_t T = *(GP_DATA->fmt);
    1932             :   char *s;
    1933             :   GEN z;
    1934           0 :   T.sp = 0;
    1935           0 :   s = GENtostr_fun(x, &T, &bruti);
    1936           0 :   z = strtoGENstr(s); pari_free(s); return z;
    1937             : }
    1938             : 
    1939             : /********************************************************************/
    1940             : /**                                                                **/
    1941             : /**                         WRITE AN INTEGER                       **/
    1942             : /**                                                                **/
    1943             : /********************************************************************/
    1944             : char *
    1945        6804 : itostr(GEN x) {
    1946        6804 :   long sx = signe(x), l;
    1947        6804 :   return sx? itostr_sign(x, sx, &l): zerotostr();
    1948             : }
    1949             : 
    1950             : /* x != 0 t_INT, write abs(x) to S */
    1951             : static void
    1952      570890 : str_absint(pari_str *S, GEN x)
    1953             : {
    1954             :   pari_sp av;
    1955             :   long l;
    1956      570890 :   str_alloc(S, lgefint(x)); /* careful ! */
    1957      570890 :   av = avma;
    1958      570890 :   str_puts(S, itostr_sign(x, 1, &l)); set_avma(av);
    1959      570890 : }
    1960             : 
    1961             : #define putsigne_nosp(S, x) str_putc(S, (x>0)? '+' : '-')
    1962             : #define putsigne(S, x) str_puts(S, (x>0)? " + " : " - ")
    1963             : #define sp_sign_sp(T,S, x) ((T)->sp? putsigne(S,x): putsigne_nosp(S,x))
    1964             : #define semicolon_sp(T,S)  ((T)->sp? str_puts(S, "; "): str_putc(S, ';'))
    1965             : #define comma_sp(T,S)      ((T)->sp? str_puts(S, ", "): str_putc(S, ','))
    1966             : 
    1967             : /* print e to S (more efficient than sprintf) */
    1968             : static void
    1969      181732 : str_ulong(pari_str *S, ulong e)
    1970             : {
    1971      181732 :   if (e == 0) str_putc(S, '0');
    1972             :   else
    1973             :   {
    1974      175152 :     char buf[21], *p = buf + numberof(buf);
    1975      175152 :     *--p = 0;
    1976      175152 :     if (e > 9) {
    1977             :       do
    1978       37705 :         *--p = "0123456789"[e % 10];
    1979       37705 :       while ((e /= 10) > 9);
    1980             :     }
    1981      175152 :     *--p = "0123456789"[e];
    1982      175152 :     str_puts(S, p);
    1983             :   }
    1984      181732 : }
    1985             : static void
    1986      181732 : str_long(pari_str *S, long e)
    1987             : {
    1988      181732 :   if (e >= 0) str_ulong(S, (ulong)e);
    1989        2394 :   else { str_putc(S, '-'); str_ulong(S, -(ulong)e); }
    1990      181732 : }
    1991             : 
    1992             : static void
    1993        8068 : wr_vecsmall(pariout_t *T, pari_str *S, GEN g)
    1994             : {
    1995             :   long i, l;
    1996        8068 :   str_puts(S, "Vecsmall(["); l = lg(g);
    1997       40413 :   for (i=1; i<l; i++)
    1998             :   {
    1999       32345 :     str_long(S, g[i]);
    2000       32345 :     if (i<l-1) comma_sp(T,S);
    2001             :   }
    2002        8068 :   str_puts(S, "])");
    2003        8068 : }
    2004             : 
    2005             : /********************************************************************/
    2006             : /**                                                                **/
    2007             : /**                       HEXADECIMAL OUTPUT                       **/
    2008             : /**                                                                **/
    2009             : /********************************************************************/
    2010             : /* English ordinal numbers */
    2011             : char *
    2012           0 : uordinal(ulong i)
    2013             : {
    2014           0 :   const char *suff[] = {"st","nd","rd","th"};
    2015           0 :   char *s = stack_malloc(23);
    2016           0 :   long k = 3;
    2017           0 :   switch (i%10)
    2018             :   {
    2019           0 :     case 1: if (i%100!=11) k = 0;
    2020           0 :             break;
    2021           0 :     case 2: if (i%100!=12) k = 1;
    2022           0 :             break;
    2023           0 :     case 3: if (i%100!=13) k = 2;
    2024           0 :             break;
    2025             :   }
    2026           0 :   sprintf(s, "%lu%s", i, suff[k]); return s;
    2027             : }
    2028             : 
    2029             : static char
    2030           0 : vsigne(GEN x)
    2031             : {
    2032           0 :   long s = signe(x);
    2033           0 :   if (!s) return '0';
    2034           0 :   return (s > 0) ? '+' : '-';
    2035             : }
    2036             : 
    2037             : static void
    2038           0 : blancs(long nb) { while (nb-- > 0) pari_putc(' '); }
    2039             : 
    2040             : /* write an "address" */
    2041             : static void
    2042           0 : str_addr(pari_str *S, ulong x)
    2043           0 : { char s[128]; sprintf(s,"%0*lx", BITS_IN_LONG/4, x); str_puts(S, s); }
    2044             : static void
    2045           0 : dbg_addr(ulong x) { pari_printf("[&=%0*lx] ", BITS_IN_LONG/4, x); }
    2046             : /* write a "word" */
    2047             : static void
    2048           0 : dbg_word(ulong x) { pari_printf("%0*lx ", BITS_IN_LONG/4, x); }
    2049             : 
    2050             : /* bl: indent level */
    2051             : static void
    2052           0 : dbg(GEN x, long nb, long bl)
    2053             : {
    2054             :   long tx,i,j,e,dx,lx;
    2055             : 
    2056           0 :   if (!x) { pari_puts("NULL\n"); return; }
    2057           0 :   tx = typ(x);
    2058           0 :   if (tx == t_INT && x == gen_0) { pari_puts("gen_0\n"); return; }
    2059           0 :   dbg_addr((ulong)x);
    2060             : 
    2061           0 :   lx = lg(x);
    2062           0 :   pari_printf("%s(lg=%ld%s):",type_name(tx)+2,lx,isclone(x)? ",CLONE" : "");
    2063           0 :   dbg_word(x[0]);
    2064           0 :   if (! is_recursive_t(tx)) /* t_INT, t_REAL, t_STR, t_VECSMALL */
    2065             :   {
    2066           0 :     if (tx == t_STR)
    2067           0 :       pari_puts("chars:");
    2068           0 :     else if (tx == t_INT)
    2069             :     {
    2070           0 :       lx = lgefint(x);
    2071           0 :       pari_printf("(%c,lgefint=%ld):", vsigne(x), lx);
    2072             :     }
    2073           0 :     else if (tx == t_REAL)
    2074           0 :       pari_printf("(%c,expo=%ld):", vsigne(x), expo(x));
    2075           0 :     if (nb < 0) nb = lx;
    2076           0 :     for (i=1; i < nb; i++) dbg_word(x[i]);
    2077           0 :     pari_putc('\n'); return;
    2078             :   }
    2079             : 
    2080           0 :   if (tx == t_PADIC)
    2081           0 :     pari_printf("(precp=%ld,valp=%ld):", precp(x), valp(x));
    2082           0 :   else if (tx == t_POL)
    2083           0 :     pari_printf("(%c,varn=%ld):", vsigne(x), varn(x));
    2084           0 :   else if (tx == t_SER)
    2085           0 :     pari_printf("(%c,varn=%ld,prec=%ld,valser=%ld):",
    2086           0 :                vsigne(x), varn(x), lg(x)-2, valser(x));
    2087           0 :   else if (tx == t_LIST)
    2088             :   {
    2089           0 :     pari_printf("(subtyp=%ld,lmax=%ld):", list_typ(x), list_nmax(x));
    2090           0 :     x = list_data(x); lx = x? lg(x): 1;
    2091           0 :     tx = t_VEC; /* print list_data as vec */
    2092           0 :   } else if (tx == t_CLOSURE)
    2093           0 :     pari_printf("(arity=%ld%s):", closure_arity(x),
    2094           0 :                                   closure_is_variadic(x)?"+":"");
    2095           0 :   for (i=1; i<lx; i++) dbg_word(x[i]);
    2096           0 :   bl+=2; pari_putc('\n');
    2097           0 :   switch(tx)
    2098             :   {
    2099           0 :     case t_INTMOD: case t_POLMOD:
    2100             :     {
    2101           0 :       const char *s = (tx==t_INTMOD)? "int = ": "pol = ";
    2102           0 :       blancs(bl); pari_puts("mod = "); dbg(gel(x,1),nb,bl);
    2103           0 :       blancs(bl); pari_puts(s);        dbg(gel(x,2),nb,bl);
    2104           0 :       break;
    2105             :     }
    2106           0 :     case t_FRAC: case t_RFRAC:
    2107           0 :       blancs(bl); pari_puts("num = "); dbg(gel(x,1),nb,bl);
    2108           0 :       blancs(bl); pari_puts("den = "); dbg(gel(x,2),nb,bl);
    2109           0 :       break;
    2110             : 
    2111           0 :     case t_FFELT:
    2112           0 :       blancs(bl); pari_puts("pol = "); dbg(gel(x,2),nb,bl);
    2113           0 :       blancs(bl); pari_puts("mod = "); dbg(gel(x,3),nb,bl);
    2114           0 :       blancs(bl); pari_puts("p   = "); dbg(gel(x,4),nb,bl);
    2115           0 :       break;
    2116             : 
    2117           0 :     case t_COMPLEX:
    2118           0 :       blancs(bl); pari_puts("real = "); dbg(gel(x,1),nb,bl);
    2119           0 :       blancs(bl); pari_puts("imag = "); dbg(gel(x,2),nb,bl);
    2120           0 :       break;
    2121             : 
    2122           0 :     case t_PADIC:
    2123           0 :       blancs(bl); pari_puts("  p : "); dbg(padic_p(x),nb,bl);
    2124           0 :       blancs(bl); pari_puts("p^l : "); dbg(padic_pd(x),nb,bl);
    2125           0 :       blancs(bl); pari_puts("  I : "); dbg(padic_u(x),nb,bl);
    2126           0 :       break;
    2127             : 
    2128           0 :     case t_QUAD:
    2129           0 :       blancs(bl); pari_puts("pol = ");  dbg(gel(x,1),nb,bl);
    2130           0 :       blancs(bl); pari_puts("real = "); dbg(gel(x,2),nb,bl);
    2131           0 :       blancs(bl); pari_puts("imag = "); dbg(gel(x,3),nb,bl);
    2132           0 :       break;
    2133             : 
    2134           0 :     case t_POL: case t_SER:
    2135           0 :       e = (tx==t_SER)? valser(x): 0;
    2136           0 :       for (i=2; i<lx; i++)
    2137             :       {
    2138           0 :         blancs(bl); pari_printf("coef of degree %ld = ",e);
    2139           0 :         e++; dbg(gel(x,i),nb,bl);
    2140             :       }
    2141           0 :       break;
    2142             : 
    2143           0 :     case t_QFB: case t_VEC: case t_COL:
    2144           0 :       for (i=1; i<lx; i++)
    2145             :       {
    2146           0 :         blancs(bl); pari_printf("%s component = ",uordinal(i));
    2147           0 :         dbg(gel(x,i),nb,bl);
    2148             :       }
    2149           0 :       break;
    2150             : 
    2151           0 :     case t_CLOSURE:
    2152           0 :       blancs(bl); pari_puts("code = "); dbg(closure_get_code(x),nb,bl);
    2153           0 :       blancs(bl); pari_puts("operand = "); dbg(closure_get_oper(x),nb,bl);
    2154           0 :       blancs(bl); pari_puts("data = "); dbg(closure_get_data(x),nb,bl);
    2155           0 :       blancs(bl); pari_puts("dbg/frpc/fram = "); dbg(closure_get_dbg(x),nb,bl);
    2156           0 :       if (lg(x)>=7)
    2157             :       {
    2158           0 :         blancs(bl); pari_puts("text = "); dbg(closure_get_text(x),nb,bl);
    2159           0 :         if (lg(x)>=8)
    2160             :         {
    2161           0 :           blancs(bl); pari_puts("frame = "); dbg(closure_get_frame(x),nb,bl);
    2162             :         }
    2163             :       }
    2164           0 :       break;
    2165             : 
    2166           0 :     case t_ERROR:
    2167           0 :       blancs(bl);
    2168           0 :       pari_printf("error type = %s\n", numerr_name(err_get_num(x)));
    2169           0 :       for (i=2; i<lx; i++)
    2170             :       {
    2171           0 :         blancs(bl); pari_printf("%s component = ",uordinal(i-1));
    2172           0 :         dbg(gel(x,i),nb,bl);
    2173             :       }
    2174           0 :       break;
    2175             : 
    2176           0 :     case t_INFINITY:
    2177           0 :       blancs(bl); pari_printf("1st component = ");
    2178           0 :       dbg(gel(x,1),nb,bl);
    2179           0 :       break;
    2180             : 
    2181           0 :     case t_MAT:
    2182             :     {
    2183           0 :       GEN c = gel(x,1);
    2184           0 :       if (lx == 1) return;
    2185           0 :       if (typ(c) == t_VECSMALL)
    2186             :       {
    2187           0 :         for (i = 1; i < lx; i++)
    2188             :         {
    2189           0 :           blancs(bl); pari_printf("%s column = ",uordinal(i));
    2190           0 :           dbg(gel(x,i),nb,bl);
    2191             :         }
    2192             :       }
    2193             :       else
    2194             :       {
    2195           0 :         dx = lg(c);
    2196           0 :         for (i=1; i<dx; i++)
    2197           0 :           for (j=1; j<lx; j++)
    2198             :           {
    2199           0 :             blancs(bl); pari_printf("mat(%ld,%ld) = ",i,j);
    2200           0 :             dbg(gcoeff(x,i,j),nb,bl);
    2201             :           }
    2202             :       }
    2203             :     }
    2204             :   }
    2205             : }
    2206             : 
    2207             : void
    2208           0 : dbgGEN(GEN x, long nb) { dbg(x,nb,0); }
    2209             : 
    2210             : static void
    2211           0 : print_entree(entree *ep)
    2212             : {
    2213           0 :   pari_printf(" %s ",ep->name); dbg_addr((ulong)ep);
    2214           0 :   pari_printf(": hash = %ld [%ld]\n", ep->hash % functions_tblsz, ep->hash);
    2215           0 :   pari_printf("   menu = %2ld, code = %-10s",
    2216           0 :               ep->menu, ep->code? ep->code: "NULL");
    2217           0 :   if (ep->next)
    2218             :   {
    2219           0 :     pari_printf("next = %s ",(ep->next)->name);
    2220           0 :     dbg_addr((ulong)ep->next);
    2221             :   }
    2222           0 :   pari_puts("\n");
    2223           0 : }
    2224             : 
    2225             : /* s = digit n : list of entrees in functions_hash[n] (s = $: last entry)
    2226             :  *   = range m-n: functions_hash[m..n]
    2227             :  *   = identifier: entree for that identifier */
    2228             : void
    2229           0 : print_functions_hash(const char *s)
    2230             : {
    2231             :   long m, n, Max, Total;
    2232             :   entree *ep;
    2233             : 
    2234           0 :   if (isdigit((unsigned char)*s) || *s == '$')
    2235             :   {
    2236           0 :     m = functions_tblsz-1; n = atol(s);
    2237           0 :     if (*s=='$') n = m;
    2238           0 :     if (m<n) pari_err(e_MISC,"invalid range in print_functions_hash");
    2239           0 :     while (isdigit((unsigned char)*s)) s++;
    2240             : 
    2241           0 :     if (*s++ != '-') m = n;
    2242             :     else
    2243             :     {
    2244           0 :       if (*s !='$') m = minss(atol(s),m);
    2245           0 :       if (m<n) pari_err(e_MISC,"invalid range in print_functions_hash");
    2246             :     }
    2247             : 
    2248           0 :     for(; n<=m; n++)
    2249             :     {
    2250           0 :       pari_printf("*** hashcode = %lu\n",n);
    2251           0 :       for (ep=functions_hash[n]; ep; ep=ep->next) print_entree(ep);
    2252             :     }
    2253           0 :     return;
    2254             :   }
    2255           0 :   if (is_keyword_char(*s))
    2256             :   {
    2257           0 :     ep = is_entry(s);
    2258           0 :     if (!ep) pari_err(e_MISC,"no such function");
    2259           0 :     print_entree(ep); return;
    2260             :   }
    2261           0 :   if (*s=='-')
    2262             :   {
    2263           0 :     for (n=0; n<functions_tblsz; n++)
    2264             :     {
    2265           0 :       m=0;
    2266           0 :       for (ep=functions_hash[n]; ep; ep=ep->next) m++;
    2267           0 :       pari_printf("%3ld:%3ld ",n,m);
    2268           0 :       if (n%9 == 8) pari_putc('\n');
    2269             :     }
    2270           0 :     pari_putc('\n'); return;
    2271             :   }
    2272           0 :   Max = Total = 0;
    2273           0 :   for (n=0; n<functions_tblsz; n++)
    2274             :   {
    2275           0 :     long cnt = 0;
    2276           0 :     for (ep=functions_hash[n]; ep; ep=ep->next) { print_entree(ep); cnt++; }
    2277           0 :     Total += cnt;
    2278           0 :     if (cnt > Max) Max = cnt;
    2279             :   }
    2280           0 :   pari_printf("Total: %ld, Max: %ld\n", Total, Max);
    2281             : }
    2282             : 
    2283             : /********************************************************************/
    2284             : /**                                                                **/
    2285             : /**                        FORMATTED OUTPUT                        **/
    2286             : /**                                                                **/
    2287             : /********************************************************************/
    2288             : static const char *
    2289       97654 : get_var(long v, char *buf)
    2290             : {
    2291       97654 :   entree *ep = varentries[v];
    2292       97654 :   if (ep) return (char*)ep->name;
    2293           0 :   sprintf(buf,"t%d",(int)v); return buf;
    2294             : }
    2295             : 
    2296             : static void
    2297           0 : do_append(char **sp, char c, char *last, int count)
    2298             : {
    2299           0 :   if (*sp + count > last)
    2300           0 :     pari_err(e_MISC, "TeX variable name too long");
    2301           0 :   while (count--)
    2302           0 :     *(*sp)++ = c;
    2303           0 : }
    2304             : 
    2305             : static char *
    2306         105 : get_texvar(long v, char *buf, unsigned int len)
    2307             : {
    2308         105 :   entree *ep = varentries[v];
    2309         105 :   char *t = buf, *e = buf + len - 1;
    2310             :   const char *s;
    2311             : 
    2312         105 :   if (!ep) pari_err(e_MISC, "this object uses debugging variables");
    2313         105 :   s = ep->name;
    2314         105 :   if (strlen(s) >= len) pari_err(e_MISC, "TeX variable name too long");
    2315         210 :   while (isalpha((unsigned char)*s)) *t++ = *s++;
    2316         105 :   *t = 0;
    2317         105 :   if (isdigit((unsigned char)*s) || *s == '_') {
    2318           0 :     int seen1 = 0, seen = 0;
    2319             : 
    2320             :     /* Skip until the first non-underscore */
    2321           0 :     while (*s == '_') s++, seen++;
    2322             : 
    2323             :     /* Special-case integers and empty subscript */
    2324           0 :     if (*s == 0 || isdigit((unsigned char)*s))
    2325           0 :       seen++;
    2326             : 
    2327           0 :     do_append(&t, '_', e, 1);
    2328           0 :     do_append(&t, '{', e, 1);
    2329           0 :     do_append(&t, '[', e, seen - 1);
    2330             :     while (1) {
    2331           0 :       if (*s == '_')
    2332           0 :         seen1++, s++;
    2333             :       else {
    2334           0 :         if (seen1) {
    2335           0 :           do_append(&t, ']', e, (seen >= seen1 ? seen1 : seen) - 1);
    2336           0 :           do_append(&t, ',', e, 1);
    2337           0 :           do_append(&t, '[', e, seen1 - 1);
    2338           0 :           if (seen1 > seen)
    2339           0 :             seen = seen1;
    2340           0 :           seen1 = 0;
    2341             :         }
    2342           0 :         if (*s == 0)
    2343           0 :           break;
    2344           0 :         do_append(&t, *s++, e, 1);
    2345             :       }
    2346             :     }
    2347           0 :     do_append(&t, ']', e, seen - 1);
    2348           0 :     do_append(&t, '}', e, 1);
    2349           0 :     *t = 0;
    2350             :   }
    2351         105 :   return buf;
    2352             : }
    2353             : 
    2354             : void
    2355           0 : dbg_pari_heap(void)
    2356             : {
    2357             :   long nu, l, u, s;
    2358           0 :   pari_sp av = avma;
    2359           0 :   GEN adr = getheap();
    2360           0 :   pari_sp top = pari_mainstack->top, bot = pari_mainstack->bot;
    2361             : 
    2362           0 :   nu = (top-avma)/sizeof(long);
    2363           0 :   l = pari_mainstack->size/sizeof(long);
    2364           0 :   pari_printf("\n Top : %lx   Bottom : %lx   Current stack : %lx\n",
    2365             :               top, bot, avma);
    2366           0 :   pari_printf(" Used :                         %ld  long words  (%ld K)\n",
    2367           0 :               nu, nu/1024*sizeof(long));
    2368           0 :   pari_printf(" Available :                    %ld  long words  (%ld K)\n",
    2369           0 :               (l-nu), (l-nu)/1024*sizeof(long));
    2370           0 :   pari_printf(" Occupation of the PARI stack : %6.2f percent\n", 100.0*nu/l);
    2371           0 :   pari_printf(" %ld objects on heap occupy %ld long words\n\n",
    2372           0 :               itos(gel(adr,1)), itos(gel(adr,2)));
    2373           0 :   u = pari_var_next();
    2374           0 :   s = MAXVARN - pari_var_next_temp();
    2375           0 :   pari_printf(" %ld variable names used (%ld user + %ld private) out of %d\n\n",
    2376             :               u+s, u, s, MAXVARN);
    2377           0 :   set_avma(av);
    2378           0 : }
    2379             : 
    2380             : /* is to be printed as '0' */
    2381             : static long
    2382     3645933 : isnull(GEN g)
    2383             : {
    2384             :   long i;
    2385     3645933 :   switch (typ(g))
    2386             :   {
    2387     3052143 :     case t_INT:
    2388     3052143 :       return !signe(g);
    2389       12411 :     case t_COMPLEX:
    2390       12411 :       return isnull(gel(g,1)) && isnull(gel(g,2));
    2391       14707 :     case t_FFELT:
    2392       14707 :       return FF_equal0(g);
    2393        2072 :     case t_QUAD:
    2394        2072 :       return isnull(gel(g,2)) && isnull(gel(g,3));
    2395      100636 :     case t_FRAC: case t_RFRAC:
    2396      100636 :       return isnull(gel(g,1));
    2397      149951 :     case t_POL:
    2398      149972 :       for (i=lg(g)-1; i>1; i--)
    2399      144792 :         if (!isnull(gel(g,i))) return 0;
    2400        5180 :       return 1;
    2401             :   }
    2402      314013 :   return 0;
    2403             : }
    2404             : /* 0 coeff to be omitted in t_POL ? */
    2405             : static int
    2406     1747344 : isnull_for_pol(GEN g)
    2407             : {
    2408     1747344 :   switch(typ(g))
    2409             :   {
    2410        8064 :     case t_INTMOD: return !signe(gel(g,2));
    2411        5432 :     case t_POLMOD: return isnull_for_pol(gel(g,2));
    2412     1733848 :     default:       return isnull(g);
    2413             :   }
    2414             : }
    2415             : 
    2416             : /* return 1 or -1 if g is 1 or -1, 0 otherwise*/
    2417             : static long
    2418     1604929 : isone(GEN g)
    2419             : {
    2420             :   long i;
    2421     1604929 :   switch (typ(g))
    2422             :   {
    2423     1103119 :     case t_INT:
    2424     1103119 :       return (signe(g) && is_pm1(g))? signe(g): 0;
    2425        8330 :     case t_FFELT:
    2426        8330 :       return FF_equal1(g);
    2427       12047 :     case t_COMPLEX:
    2428       12047 :       return isnull(gel(g,2))? isone(gel(g,1)): 0;
    2429        1512 :     case t_QUAD:
    2430        1512 :       return isnull(gel(g,3))? isone(gel(g,2)): 0;
    2431       78565 :     case t_FRAC: case t_RFRAC:
    2432       78565 :       return isone(gel(g,1)) * isone(gel(g,2));
    2433      115273 :     case t_POL:
    2434      115273 :       if (!signe(g)) return 0;
    2435      115161 :       for (i=lg(g)-1; i>2; i--)
    2436      111402 :         if (!isnull(gel(g,i))) return 0;
    2437        3759 :       return isone(gel(g,2));
    2438             :   }
    2439      286083 :   return 0;
    2440             : }
    2441             : 
    2442             : /* if g is a "monomial", return its sign, 0 otherwise */
    2443             : static long
    2444      284439 : isfactor(GEN g)
    2445             : {
    2446             :   long i,deja,sig;
    2447      284439 :   switch(typ(g))
    2448             :   {
    2449      214159 :     case t_INT: case t_REAL:
    2450      214159 :       return (signe(g)<0)? -1: 1;
    2451       27727 :     case t_FRAC: case t_RFRAC:
    2452       27727 :       return isfactor(gel(g,1));
    2453        2072 :     case t_FFELT:
    2454        2072 :       return isfactor(FF_to_FpXQ_i(g));
    2455        2093 :     case t_COMPLEX:
    2456        2093 :       if (isnull(gel(g,1))) return isfactor(gel(g,2));
    2457        1421 :       if (isnull(gel(g,2))) return isfactor(gel(g,1));
    2458        1421 :       return 0;
    2459        1967 :     case t_PADIC:
    2460        1967 :       return !signe(padic_u(g));
    2461         532 :     case t_QUAD:
    2462         532 :       if (isnull(gel(g,2))) return isfactor(gel(g,3));
    2463         385 :       if (isnull(gel(g,3))) return isfactor(gel(g,2));
    2464         385 :       return 0;
    2465       24283 :     case t_POL: deja = 0; sig = 1;
    2466       69958 :       for (i=lg(g)-1; i>1; i--)
    2467       59780 :         if (!isnull_for_pol(gel(g,i)))
    2468             :         {
    2469       38388 :           if (deja) return 0;
    2470       24283 :           sig=isfactor(gel(g,i)); deja=1;
    2471             :         }
    2472       10178 :       return sig? sig: 1;
    2473         105 :     case t_SER:
    2474         490 :       for (i=lg(g)-1; i>1; i--)
    2475         469 :         if (!isnull(gel(g,i))) return 0;
    2476          21 :       return 1;
    2477           0 :     case t_CLOSURE:
    2478           0 :       return 0;
    2479             :   }
    2480       11501 :   return 1;
    2481             : }
    2482             : 
    2483             : /* return 1 if g is a "truc" (see anal.c) */
    2484             : static long
    2485       52472 : isdenom(GEN g)
    2486             : {
    2487             :   long i,deja;
    2488       52472 :   switch(typ(g))
    2489             :   {
    2490           0 :     case t_FRAC: case t_RFRAC:
    2491           0 :       return 0;
    2492           0 :     case t_COMPLEX: return isnull(gel(g,2));
    2493           0 :     case t_PADIC: return !signe(padic_u(g));
    2494           0 :     case t_QUAD: return isnull(gel(g,3));
    2495             : 
    2496        1687 :     case t_POL: deja = 0;
    2497       18214 :       for (i=lg(g)-1; i>1; i--)
    2498       17689 :         if (!isnull(gel(g,i)))
    2499             :         {
    2500        2289 :           if (deja) return 0;
    2501        1687 :           if (i==2) return isdenom(gel(g,2));
    2502        1687 :           if (!isone(gel(g,i))) return 0;
    2503        1127 :           deja=1;
    2504             :         }
    2505         525 :       return 1;
    2506           0 :     case t_SER:
    2507           0 :       for (i=lg(g)-1; i>1; i--)
    2508           0 :         if (!isnull(gel(g,i))) return 0;
    2509             :   }
    2510       50785 :   return 1;
    2511             : }
    2512             : 
    2513             : /********************************************************************/
    2514             : /**                                                                **/
    2515             : /**                           RAW OUTPUT                           **/
    2516             : /**                                                                **/
    2517             : /********************************************************************/
    2518             : /* ^e */
    2519             : static void
    2520         210 : texexpo(pari_str *S, long e)
    2521             : {
    2522         210 :   if (e != 1) {
    2523         105 :     str_putc(S, '^');
    2524         105 :     if (e >= 0 && e < 10)
    2525         105 :     { str_putc(S, '0' + e); }
    2526             :     else
    2527             :     {
    2528           0 :       str_putc(S, '{'); str_long(S, e); str_putc(S, '}');
    2529             :     }
    2530             :   }
    2531         210 : }
    2532             : static void
    2533      232635 : wrexpo(pari_str *S, long e)
    2534      232635 : { if (e != 1) { str_putc(S, '^'); str_long(S, e); } }
    2535             : 
    2536             : /* v^e */
    2537             : static void
    2538      232635 : VpowE(pari_str *S, const char *v, long e) { str_puts(S, v); wrexpo(S,e); }
    2539             : static void
    2540         210 : texVpowE(pari_str *S, const char *v, long e) { str_puts(S, v); texexpo(S,e); }
    2541             : static void
    2542      217698 : monome(pari_str *S, const char *v, long e)
    2543      217698 : { if (e) VpowE(S, v, e); else str_putc(S, '1'); }
    2544             : static void
    2545         203 : texnome(pari_str *S, const char *v, long e)
    2546         203 : { if (e) texVpowE(S, v, e); else str_putc(S, '1'); }
    2547             : 
    2548             : /* ( a ) */
    2549             : static void
    2550       15547 : paren(pariout_t *T, pari_str *S, GEN a)
    2551       15547 : { str_putc(S, '('); bruti(a,T,S); str_putc(S, ')'); }
    2552             : static void
    2553           0 : texparen(pariout_t *T, pari_str *S, GEN a)
    2554             : {
    2555           0 :   if (T->TeXstyle & TEXSTYLE_PAREN)
    2556           0 :     str_puts(S, " (");
    2557             :   else
    2558           0 :     str_puts(S, " \\left(");
    2559           0 :   texi(a,T,S);
    2560           0 :   if (T->TeXstyle & TEXSTYLE_PAREN)
    2561           0 :     str_puts(S, ") ");
    2562             :   else
    2563           0 :     str_puts(S, "\\right) ");
    2564           0 : }
    2565             : 
    2566             : /* * v^d */
    2567             : static void
    2568         140 : times_texnome(pari_str *S, const char *v, long d)
    2569         140 : { if (d) { str_puts(S, "\\*"); texnome(S,v,d); } }
    2570             : static void
    2571      176915 : times_monome(pari_str *S, const char *v, long d)
    2572      176915 : { if (d) { str_putc(S, '*'); monome(S,v,d); } }
    2573             : 
    2574             : /* write a * v^d */
    2575             : static void
    2576      173705 : wr_monome(pariout_t *T, pari_str *S, GEN a, const char *v, long d)
    2577             : {
    2578      173705 :   long sig = isone(a);
    2579             : 
    2580      173705 :   if (sig) {
    2581       31628 :     sp_sign_sp(T,S,sig); monome(S,v,d);
    2582             :   } else {
    2583      142077 :     sig = isfactor(a);
    2584      142077 :     if (sig) { sp_sign_sp(T,S,sig); bruti_sign(a,T,S,0); }
    2585       12740 :     else { sp_sign_sp(T,S,1); paren(T,S, a); }
    2586      142077 :     times_monome(S, v, d);
    2587             :   }
    2588      173705 : }
    2589             : static void
    2590         105 : wr_texnome(pariout_t *T, pari_str *S, GEN a, const char *v, long d)
    2591             : {
    2592         105 :   long sig = isone(a);
    2593             : 
    2594         105 :   str_putc(S, '\n'); /* Avoid TeX buffer overflow */
    2595         105 :   if (T->TeXstyle & TEXSTYLE_BREAK) str_puts(S, "\\PARIbreak ");
    2596             : 
    2597         105 :   if (sig) {
    2598          14 :     putsigne(S,sig); texnome(S,v,d);
    2599             :   } else {
    2600          91 :     sig = isfactor(a);
    2601          91 :     if (sig) { putsigne(S,sig); texi_sign(a,T,S,0); }
    2602           0 :     else { str_puts(S, " +"); texparen(T,S, a); }
    2603          91 :     times_texnome(S, v, d);
    2604             :   }
    2605         105 : }
    2606             : 
    2607             : static void
    2608       98522 : wr_lead_monome(pariout_t *T, pari_str *S, GEN a,const char *v, long d, int addsign)
    2609             : {
    2610       98522 :   long sig = isone(a);
    2611       98522 :   if (sig) {
    2612       63684 :     if (addsign && sig<0) str_putc(S, '-');
    2613       63684 :     monome(S,v,d);
    2614             :   } else {
    2615       34838 :     if (isfactor(a)) bruti_sign(a,T,S,addsign);
    2616        2807 :     else paren(T,S, a);
    2617       34838 :     times_monome(S, v, d);
    2618             :   }
    2619       98522 : }
    2620             : static void
    2621         119 : wr_lead_texnome(pariout_t *T, pari_str *S, GEN a,const char *v, long d, int addsign)
    2622             : {
    2623         119 :   long sig = isone(a);
    2624         119 :   if (sig) {
    2625          70 :     if (addsign && sig<0) str_putc(S, '-');
    2626          70 :     texnome(S,v,d);
    2627             :   } else {
    2628          49 :     if (isfactor(a)) texi_sign(a,T,S,addsign);
    2629           0 :     else texparen(T,S, a);
    2630          49 :     times_texnome(S, v, d);
    2631             :   }
    2632         119 : }
    2633             : 
    2634             : static void
    2635           0 : prints(GEN g, pariout_t *T, pari_str *S)
    2636           0 : { (void)T; str_long(S, (long)g); }
    2637             : 
    2638             : static void
    2639       14951 : quote_string(pari_str *S, char *s)
    2640             : {
    2641       14951 :   str_putc(S, '"');
    2642      513568 :   while (*s)
    2643             :   {
    2644      498617 :     char c=*s++;
    2645      498617 :     if (c=='\\' || c=='"' || c=='\033' || c=='\n' || c=='\t')
    2646             :     {
    2647        2454 :       str_putc(S, '\\');
    2648        2454 :       switch(c)
    2649             :       {
    2650        2146 :       case '\\': case '"': break;
    2651         308 :       case '\n':   c='n'; break;
    2652           0 :       case '\033': c='e'; break;
    2653           0 :       case '\t':   c='t'; break;
    2654             :       }
    2655             :     }
    2656      498617 :     str_putc(S, c);
    2657             :   }
    2658       14951 :   str_putc(S, '"');
    2659       14951 : }
    2660             : 
    2661             : static int
    2662     1388861 : print_0_or_pm1(GEN g, pari_str *S, int addsign)
    2663             : {
    2664             :   long r;
    2665     1388861 :   if (!g) { str_puts(S, "NULL"); return 1; }
    2666     1388861 :   if (isnull(g)) { str_putc(S, '0'); return 1; }
    2667     1169860 :   r = isone(g);
    2668     1169860 :   if (r)
    2669             :   {
    2670      191541 :     if (addsign && r<0) str_putc(S, '-');
    2671      191541 :     str_putc(S, '1'); return 1;
    2672             :   }
    2673      978319 :   return 0;
    2674             : }
    2675             : 
    2676             : static void
    2677        4613 : print_precontext(GEN g, pari_str *S, long tex)
    2678             : {
    2679        4613 :   if (lg(g)<8 || lg(gel(g,7))==1) return;
    2680             :   else
    2681             :   {
    2682           0 :     long i, n  = closure_arity(g);
    2683           0 :     str_puts(S,"(");
    2684           0 :     for(i=1; i<=n; i++)
    2685             :     {
    2686           0 :       str_puts(S,"v");
    2687           0 :       if (tex) str_puts(S,"_{");
    2688           0 :       str_ulong(S,i);
    2689           0 :       if (tex) str_puts(S,"}");
    2690           0 :       if (i < n) str_puts(S,",");
    2691             :     }
    2692           0 :     str_puts(S,")->");
    2693             :   }
    2694             : }
    2695             : 
    2696             : static void
    2697        5410 : print_context(GEN g, pariout_t *T, pari_str *S, long tex)
    2698             : {
    2699        5410 :   GEN str = closure_get_text(g);
    2700        5410 :   if (lg(g)<8 || lg(gel(g,7))==1) return;
    2701          83 :   if (typ(str)==t_VEC && lg(gel(closure_get_dbg(g),3)) >= 2)
    2702          83 :   {
    2703          83 :     GEN v = closure_get_frame(g), d = gmael(closure_get_dbg(g),3,1);
    2704          83 :     long i, l = lg(v), n=0;
    2705         186 :     for(i=1; i<l; i++)
    2706         103 :       if (gel(d,i))
    2707         103 :         n++;
    2708          83 :     if (n==0) return;
    2709          83 :     str_puts(S,"my(");
    2710         186 :     for(i=1; i<l; i++)
    2711         103 :       if (gel(d,i))
    2712             :       {
    2713         103 :         entree *ep = (entree*) gel(d,i);
    2714         103 :         GEN vi = gel(v,l-i);
    2715         103 :         str_puts(S,ep->name);
    2716         103 :         if (!isintzero(vi))
    2717             :         {
    2718         103 :           str_putc(S,'=');
    2719         103 :           if (tex) texi(gel(v,l-i),T,S); else bruti(gel(v,l-i),T,S);
    2720             :         }
    2721         103 :         if (--n)
    2722          20 :           str_putc(S,',');
    2723             :       }
    2724          83 :     str_puts(S,");");
    2725             :   }
    2726             :   else
    2727             :   {
    2728           0 :     GEN v = closure_get_frame(g);
    2729           0 :     long i, l = lg(v), n  = closure_arity(g);
    2730           0 :     str_puts(S,"(");
    2731           0 :     for(i=1; i<=n; i++)
    2732             :     {
    2733           0 :       str_puts(S,"v");
    2734           0 :       if (tex) str_puts(S,"_{");
    2735           0 :       str_ulong(S,i);
    2736           0 :       if (tex) str_puts(S,"}");
    2737           0 :       str_puts(S,",");
    2738             :     }
    2739           0 :     for(i=1; i<l; i++)
    2740             :     {
    2741           0 :       if (tex) texi(gel(v,i),T,S); else bruti(gel(v,i),T,S);
    2742           0 :       if (i<l-1)
    2743           0 :         str_putc(S,',');
    2744             :     }
    2745           0 :     str_puts(S,")");
    2746             :   }
    2747             : }
    2748             : static void
    2749         392 : mat0n(pari_str *S, long n)
    2750         392 : { str_puts(S, "matrix(0,"); str_long(S, n); str_putc(S, ')'); }
    2751             : 
    2752             : static const char *
    2753       10941 : cxq_init(GEN g, long tg, GEN *a, GEN *b, char *buf)
    2754             : {
    2755       10941 :   int r = (tg==t_QUAD);
    2756       10941 :   *a = gel(g,r+1);
    2757       10941 :   *b = gel(g,r+2); return r? get_var(varn(gel(g,1)), buf): "I";
    2758             : }
    2759             : 
    2760             : static void
    2761           0 : print_coef(GEN g, long i, long j, pariout_t *T, pari_str *S)
    2762           0 : { (void)T; str_long(S, coeff(g,i,j)); }
    2763             : static void
    2764      237543 : print_gcoef(GEN g, long i, long j, pariout_t *T, pari_str *S)
    2765             : {
    2766      237543 :   GEN gij = gcoeff(g, i, j);
    2767      237543 :   if (typ(gij)==t_CLOSURE)
    2768          28 :   { str_putc(S, '('); bruti(gij, T, S); str_putc(S, ')'); }
    2769             :   else
    2770      237515 :     bruti(gij, T, S);
    2771      237543 : }
    2772             : 
    2773             : static void
    2774      978042 : bruti_intern(GEN g, pariout_t *T, pari_str *S, int addsign)
    2775             : {
    2776      978042 :   long l,i,j,r, tg = typ(g);
    2777             :   GEN a,b;
    2778             :   const char *v;
    2779             :   char buf[32];
    2780             : 
    2781      978042 :   switch(tg)
    2782             :   {
    2783      556834 :     case t_INT:
    2784      556834 :       if (addsign && signe(g) < 0) str_putc(S, '-');
    2785      556834 :       str_absint(S, g); break;
    2786       33810 :     case t_REAL:
    2787             :     {
    2788             :       pari_sp av;
    2789       33810 :       str_alloc(S, lg(g)); /* careful! */
    2790       33810 :       av = avma;
    2791       33810 :       if (addsign && signe(g) < 0) str_putc(S, '-');
    2792       33810 :       str_puts(S, absrtostr(g, T->sp, (char)toupper((unsigned char)T->format), T->sigd) );
    2793       33810 :       set_avma(av); break;
    2794             :     }
    2795             : 
    2796       27832 :     case t_INTMOD: case t_POLMOD:
    2797       27832 :       str_puts(S, "Mod(");
    2798       27832 :       bruti(gel(g,2),T,S); comma_sp(T,S);
    2799       27832 :       bruti(gel(g,1),T,S); str_putc(S, ')'); break;
    2800             : 
    2801        4165 :     case t_FFELT:
    2802        4165 :       bruti_sign(FF_to_FpXQ_i(g),T,S,addsign);
    2803        4165 :       break;
    2804             : 
    2805       52472 :     case t_FRAC: case t_RFRAC:
    2806       52472 :       r = isfactor(gel(g,1)); if (!r) str_putc(S, '(');
    2807       52472 :       bruti_sign(gel(g,1),T,S,addsign);
    2808       52472 :       if (!r) str_putc(S, ')');
    2809       52472 :       str_putc(S, '/');
    2810       52472 :       r = isdenom(gel(g,2)); if (!r) str_putc(S, '(');
    2811       52472 :       bruti(gel(g,2),T,S);
    2812       52472 :       if (!r) str_putc(S, ')');
    2813       52472 :       break;
    2814             : 
    2815       10892 :     case t_COMPLEX: case t_QUAD: r = (tg==t_QUAD);
    2816       10892 :       v = cxq_init(g, tg, &a, &b, buf);
    2817       10892 :       if (isnull(a))
    2818             :       {
    2819        2247 :         wr_lead_monome(T,S,b,v,1,addsign);
    2820        5404 :         return;
    2821             :       }
    2822        8645 :       bruti_sign(a,T,S,addsign);
    2823        8645 :       if (!isnull(b)) wr_monome(T,S,b,v,1);
    2824        8645 :       break;
    2825             : 
    2826       92614 :     case t_POL: v = get_var(varn(g), buf);
    2827             :       /* hack: we want g[i] = coeff of degree i. */
    2828       92614 :       i = degpol(g); g += 2; while (isnull(gel(g,i))) i--;
    2829       92614 :       wr_lead_monome(T,S,gel(g,i),v,i,addsign);
    2830     1750323 :       while (i--)
    2831             :       {
    2832     1657709 :         a = gel(g,i);
    2833     1657709 :         if (!isnull_for_pol(a)) wr_monome(T,S,a,v,i);
    2834             :       }
    2835       92614 :       break;
    2836             : 
    2837        4032 :     case t_SER: v = get_var(varn(g), buf);
    2838        4032 :       i = valser(g);
    2839        4032 :       l = lg(g)-2;
    2840        4032 :       if (l)
    2841             :       {
    2842             :         /* See normalizeser(): Mod(0,2)*x^i*(1+O(x)), has valser = i+1 */
    2843        3661 :         if (l == 1 && !signe(g) && isexactzero(gel(g,2))) i--;
    2844             :         /* hack: we want g[i] = coeff of degree i */
    2845        3661 :         l += i; g -= i-2;
    2846        3661 :         wr_lead_monome(T,S,gel(g,i),v,i,addsign);
    2847       27881 :         while (++i < l)
    2848             :         {
    2849       24220 :           a = gel(g,i);
    2850       24220 :           if (!isnull_for_pol(a)) wr_monome(T,S,a,v,i);
    2851             :         }
    2852        3661 :         sp_sign_sp(T,S,1);
    2853             :       }
    2854        4032 :       str_puts(S, "O("); VpowE(S, v, i); str_putc(S, ')'); break;
    2855             : 
    2856        6783 :     case t_PADIC:
    2857             :     {
    2858        6783 :       GEN p = padic_p(g);
    2859             :       pari_sp av, av0;
    2860             :       char *ev;
    2861        6783 :       str_alloc(S, (precp(g)+1) * lgefint(p)); /* careful! */
    2862        6783 :       av0 = avma;
    2863        6783 :       ev = itostr(p);
    2864        6783 :       av = avma;
    2865        6783 :       i = valp(g); l = precp(g)+i;
    2866        6783 :       g = padic_u(g);
    2867       40082 :       for (; i<l; i++)
    2868             :       {
    2869       33299 :         g = dvmdii(g,p,&a);
    2870       33299 :         if (signe(a))
    2871             :         {
    2872       23100 :           if (!i || !is_pm1(a))
    2873             :           {
    2874       14049 :             str_absint(S, a); if (i) str_putc(S, '*');
    2875             :           }
    2876       23100 :           if (i) VpowE(S, ev,i);
    2877       23100 :           sp_sign_sp(T,S,1);
    2878             :         }
    2879       33299 :         if ((i & 0xff) == 0) g = gerepileuptoint(av,g);
    2880             :       }
    2881        6783 :       str_puts(S, "O("); VpowE(S, ev,i); str_putc(S, ')');
    2882        6783 :       set_avma(av0); break;
    2883             :     }
    2884             : 
    2885         637 :     case t_QFB:
    2886         637 :       str_puts(S, "Qfb(");
    2887         637 :       bruti(gel(g,1),T,S); comma_sp(T,S);
    2888         637 :       bruti(gel(g,2),T,S); comma_sp(T,S);
    2889         637 :       bruti(gel(g,3),T,S);
    2890         637 :       str_putc(S, ')'); break;
    2891             : 
    2892      139706 :     case t_VEC: case t_COL:
    2893      139706 :       str_putc(S, '['); l = lg(g);
    2894      598548 :       for (i=1; i<l; i++)
    2895             :       {
    2896      458842 :         bruti(gel(g,i),T,S);
    2897      458842 :         if (i<l-1) comma_sp(T,S);
    2898             :       }
    2899      139706 :       str_putc(S, ']'); if (tg==t_COL) str_putc(S, '~');
    2900      139706 :       break;
    2901        8068 :     case t_VECSMALL: wr_vecsmall(T,S,g); break;
    2902             : 
    2903         711 :     case t_LIST:
    2904         711 :       switch (list_typ(g))
    2905             :       {
    2906         599 :       case t_LIST_RAW:
    2907         599 :         str_puts(S, "List([");
    2908         599 :         g = list_data(g);
    2909         599 :         l = g? lg(g): 1;
    2910        1929 :         for (i=1; i<l; i++)
    2911             :         {
    2912        1330 :           bruti(gel(g,i),T,S);
    2913        1330 :           if (i<l-1) comma_sp(T,S);
    2914             :         }
    2915         599 :         str_puts(S, "])"); break;
    2916         112 :       case t_LIST_MAP:
    2917         112 :         str_puts(S, "Map(");
    2918         112 :         bruti(maptomat_shallow(g),T,S);
    2919         112 :         str_puts(S, ")"); break;
    2920             :       }
    2921         711 :       break;
    2922        6026 :     case t_STR:
    2923        6026 :       quote_string(S, GSTR(g)); break;
    2924        8925 :     case t_ERROR:
    2925             :       {
    2926        8925 :         char *s = pari_err2str(g);
    2927        8925 :         str_puts(S, "error(");
    2928        8925 :         quote_string(S, s); pari_free(s);
    2929        8925 :         str_puts(S, ")"); break;
    2930             :       }
    2931        5403 :     case t_CLOSURE:
    2932        5403 :       if (lg(g)>=7)
    2933             :       {
    2934        5403 :         GEN str = closure_get_text(g);
    2935        5403 :         if (typ(str)==t_STR)
    2936             :         {
    2937        4613 :           print_precontext(g, S, 0);
    2938        4613 :           str_puts(S, GSTR(str));
    2939        4613 :           print_context(g, T, S, 0);
    2940             :         }
    2941             :         else
    2942             :         {
    2943         790 :           str_putc(S,'(');   str_puts(S,GSTR(gel(str,1)));
    2944         790 :           str_puts(S,")->");
    2945         790 :           print_context(g, T, S, 0);
    2946         790 :           str_puts(S,GSTR(gel(str,2)));
    2947             :         }
    2948             :       }
    2949             :       else
    2950             :       {
    2951           0 :         str_puts(S,"{\""); str_puts(S,GSTR(closure_get_code(g)));
    2952           0 :         str_puts(S,"\","); wr_vecsmall(T,S,closure_get_oper(g));
    2953           0 :         str_putc(S,',');   bruti(gel(g,4),T,S);
    2954           0 :         str_putc(S,',');   bruti(gel(g,5),T,S);
    2955           0 :         str_putc(S,'}');
    2956             :       }
    2957        5403 :       break;
    2958         749 :     case t_INFINITY: str_puts(S, inf_get_sign(g) == 1? "+oo": "-oo");
    2959         749 :       break;
    2960             : 
    2961       18383 :     case t_MAT:
    2962             :     {
    2963             :       void (*print)(GEN,long,long,pariout_t *,pari_str *);
    2964             : 
    2965       18383 :       r = lg(g); if (r==1) { str_puts(S, "[;]"); return; }
    2966       17438 :       l = lgcols(g); if (l==1) { mat0n(S, r-1); return; }
    2967       17165 :       print = (typ(gel(g,1)) == t_VECSMALL)? print_coef: print_gcoef;
    2968       17165 :       if (l==2)
    2969             :       {
    2970        4480 :         str_puts(S, "Mat(");
    2971        4480 :         if (r == 2 && (print != print_gcoef || typ(gcoeff(g,1,1)) != t_MAT))
    2972        1939 :         { print(g, 1, 1,T, S); str_putc(S, ')'); return; }
    2973             :       }
    2974       15226 :       str_putc(S, '[');
    2975       68761 :       for (i=1; i<l; i++)
    2976             :       {
    2977      289139 :         for (j=1; j<r; j++)
    2978             :         {
    2979      235604 :           print(g, i, j, T, S);
    2980      235604 :           if (j<r-1) comma_sp(T,S);
    2981             :         }
    2982       53535 :         if (i<l-1) semicolon_sp(T,S);
    2983             :       }
    2984       15226 :       str_putc(S, ']'); if (l==2) str_putc(S, ')');
    2985       15226 :       break;
    2986             :     }
    2987             : 
    2988           0 :     default: str_addr(S, *g);
    2989             :   }
    2990             : }
    2991             : 
    2992             : static void
    2993     1388345 : bruti_sign(GEN g, pariout_t *T, pari_str *S, int addsign)
    2994             : {
    2995     1388345 :   if (!print_0_or_pm1(g, S, addsign))
    2996      977905 :     bruti_intern(g, T, S, addsign);
    2997     1388345 : }
    2998             : 
    2999             : static void
    3000       60184 : matbruti(GEN g, pariout_t *T, pari_str *S)
    3001             : {
    3002       60184 :   long i, j, r, w, l, *pad = NULL;
    3003             :   pari_sp av;
    3004             :   OUT_FUN print;
    3005             : 
    3006       60184 :   if (typ(g) != t_MAT) { bruti(g,T,S); return; }
    3007             : 
    3008        4354 :   r=lg(g); if (r==1) { str_puts(S, "[;]"); return; }
    3009        4123 :   l = lgcols(g); if (l==1) { mat0n(S, r-1); return; }
    3010        4004 :   str_putc(S, '\n');
    3011        4004 :   print = (typ(gel(g,1)) == t_VECSMALL)? prints: bruti;
    3012        4004 :   av = avma;
    3013        4004 :   w = term_width();
    3014        4004 :   if (2*r < w)
    3015             :   {
    3016        3997 :     long lgall = 2; /* opening [ and closing ] */
    3017             :     pari_sp av2;
    3018             :     pari_str str;
    3019        3997 :     pad = cgetg(l*r+1, t_VECSMALL); /* left on stack if (S->use_stack)*/
    3020        3997 :     av2 = avma;
    3021        3997 :     str_init(&str, 1);
    3022       14504 :     for (j=1; j<r; j++)
    3023             :     {
    3024       10808 :       GEN col = gel(g,j);
    3025       10808 :       long maxc = 0;
    3026       55475 :       for (i=1; i<l; i++)
    3027             :       {
    3028             :         long lgs;
    3029       44667 :         str.cur = str.string;
    3030       44667 :         print(gel(col,i),T,&str);
    3031       44667 :         lgs = str.cur - str.string;
    3032       44667 :         pad[j*l+i] = -lgs;
    3033       44667 :         if (maxc < lgs) maxc = lgs;
    3034             :       }
    3035       55475 :       for (i=1; i<l; i++) pad[j*l+i] += maxc;
    3036       10808 :       lgall += maxc + 1; /* column width, including separating space */
    3037       10808 :       if (lgall > w) { pad = NULL; break; } /* doesn't fit, abort padding */
    3038             :     }
    3039        3997 :     set_avma(av2);
    3040             :   }
    3041       16324 :   for (i=1; i<l; i++)
    3042             :   {
    3043       12320 :     str_putc(S, '[');
    3044       64498 :     for (j=1; j<r; j++)
    3045             :     {
    3046       52178 :       if (pad) {
    3047       39249 :         long white = pad[j*l+i];
    3048       78029 :         while (white-- > 0) str_putc(S, ' ');
    3049             :       }
    3050       52178 :       print(gcoeff(g,i,j),T,S); if (j<r-1) str_putc(S, ' ');
    3051             :     }
    3052       12320 :     if (i<l-1) str_puts(S, "]\n\n"); else str_puts(S, "]\n");
    3053             :   }
    3054        4004 :   if (!S->use_stack) set_avma(av);
    3055             : }
    3056             : 
    3057             : /********************************************************************/
    3058             : /**                                                                **/
    3059             : /**                           TeX OUTPUT                           **/
    3060             : /**                                                                **/
    3061             : /********************************************************************/
    3062             : /* this follows bruti_sign */
    3063             : static void
    3064         516 : texi_sign(GEN g, pariout_t *T, pari_str *S, int addsign)
    3065             : {
    3066             :   long tg,i,j,l,r;
    3067             :   GEN a,b;
    3068             :   const char *v;
    3069             :   char buf[67];
    3070             : 
    3071         516 :   if (print_0_or_pm1(g, S, addsign)) return;
    3072             : 
    3073         414 :   tg = typ(g);
    3074         414 :   switch(tg)
    3075             :   {
    3076         137 :     case t_INT: case t_REAL: case t_QFB:
    3077         137 :       bruti_intern(g, T, S, addsign); break;
    3078             : 
    3079           7 :     case t_INTMOD: case t_POLMOD:
    3080           7 :       texi(gel(g,2),T,S); str_puts(S, " mod ");
    3081           7 :       texi(gel(g,1),T,S); break;
    3082             : 
    3083          11 :     case t_FRAC:
    3084          11 :       if (addsign && isfactor(gel(g,1)) < 0) str_putc(S, '-');
    3085          11 :       str_puts(S, "\\frac{");
    3086          11 :       texi_sign(gel(g,1),T,S,0);
    3087          11 :       str_puts(S, "}{");
    3088          11 :       texi_sign(gel(g,2),T,S,0);
    3089          11 :       str_puts(S, "}"); break;
    3090             : 
    3091          14 :     case t_RFRAC:
    3092          14 :       str_puts(S, "\\frac{");
    3093          14 :       texi(gel(g,1),T,S); /* too complicated otherwise */
    3094          14 :       str_puts(S, "}{");
    3095          14 :       texi(gel(g,2),T,S);
    3096          14 :       str_puts(S, "}"); break;
    3097             : 
    3098           7 :     case t_FFELT:
    3099           7 :       bruti_sign(FF_to_FpXQ_i(g),T,S,addsign);
    3100           7 :       break;
    3101             : 
    3102          49 :     case t_COMPLEX: case t_QUAD: r = (tg==t_QUAD);
    3103          49 :       v = cxq_init(g, tg, &a, &b, buf);
    3104          49 :       if (isnull(a))
    3105             :       {
    3106          14 :         wr_lead_texnome(T,S,b,v,1,addsign);
    3107          14 :         break;
    3108             :       }
    3109          35 :       texi_sign(a,T,S,addsign);
    3110          35 :       if (!isnull(b)) wr_texnome(T,S,b,v,1);
    3111          35 :       break;
    3112             : 
    3113          98 :     case t_POL: v = get_texvar(varn(g), buf, sizeof(buf));
    3114             :       /* hack: we want g[i] = coeff of degree i. */
    3115          98 :       i = degpol(g); g += 2; while (isnull(gel(g,i))) i--;
    3116          98 :       wr_lead_texnome(T,S,gel(g,i),v,i,addsign);
    3117         294 :       while (i--)
    3118             :       {
    3119         196 :         a = gel(g,i);
    3120         196 :         if (!isnull_for_pol(a)) wr_texnome(T,S,a,v,i);
    3121             :       }
    3122          98 :       break;
    3123             : 
    3124           7 :     case t_SER: v = get_texvar(varn(g), buf, sizeof(buf));
    3125           7 :       i = valser(g);
    3126           7 :       if (lg(g)-2)
    3127             :       { /* hack: we want g[i] = coeff of degree i. */
    3128           7 :         l = i + lg(g)-2; g -= i-2;
    3129           7 :         wr_lead_texnome(T,S,gel(g,i),v,i,addsign);
    3130          14 :         while (++i < l)
    3131             :         {
    3132           7 :           a = gel(g,i);
    3133           7 :           if (!isnull_for_pol(a)) wr_texnome(T,S,a,v,i);
    3134             :         }
    3135           7 :         str_puts(S, "+ ");
    3136             :       }
    3137           7 :       str_puts(S, "O("); texnome(S,v,i); str_putc(S, ')'); break;
    3138             : 
    3139           7 :     case t_PADIC:
    3140             :     {
    3141           7 :       GEN p = padic_p(g);
    3142             :       pari_sp av;
    3143             :       char *ev;
    3144           7 :       str_alloc(S, (precp(g)+1) * lgefint(p)); /* careful! */
    3145           7 :       av = avma;
    3146           7 :       i = valp(g); l = precp(g)+i;
    3147           7 :       g = padic_u(g); ev = itostr(p);
    3148          21 :       for (; i<l; i++)
    3149             :       {
    3150          14 :         g = dvmdii(g,p,&a);
    3151          14 :         if (signe(a))
    3152             :         {
    3153           7 :           if (!i || !is_pm1(a))
    3154             :           {
    3155           7 :             str_absint(S, a); if (i) str_puts(S, "\\cdot");
    3156             :           }
    3157           7 :           if (i) texVpowE(S, ev,i);
    3158           7 :           str_putc(S, '+');
    3159             :         }
    3160             :       }
    3161           7 :       str_puts(S, "O("); texVpowE(S, ev,i); str_putc(S, ')');
    3162           7 :       set_avma(av); break;
    3163             :     }
    3164             : 
    3165           7 :     case t_VEC:
    3166           7 :       str_puts(S, "\\pmatrix{ "); l = lg(g);
    3167          21 :       for (i=1; i<l; i++)
    3168             :       {
    3169          14 :         texi(gel(g,i),T,S); if (i < l-1) str_putc(S, '&');
    3170             :       }
    3171           7 :       str_puts(S, "\\cr}\n"); break;
    3172             : 
    3173          14 :     case t_LIST:
    3174          14 :       switch(list_typ(g))
    3175             :       {
    3176           7 :       case t_LIST_RAW:
    3177           7 :         str_puts(S, "\\pmatrix{ ");
    3178           7 :         g = list_data(g);
    3179           7 :         l = g? lg(g): 1;
    3180          21 :         for (i=1; i<l; i++)
    3181             :         {
    3182          14 :           texi(gel(g,i),T,S); if (i < l-1) str_putc(S, '&');
    3183             :         }
    3184           7 :         str_puts(S, "\\cr}\n"); break;
    3185           7 :       case t_LIST_MAP:
    3186             :         {
    3187           7 :           pari_sp av = avma;
    3188           7 :           texi(maptomat_shallow(g),T,S);
    3189           7 :           set_avma(av);
    3190           7 :           break;
    3191             :         }
    3192             :       }
    3193          14 :       break;
    3194           7 :     case t_COL:
    3195           7 :       str_puts(S, "\\pmatrix{ "); l = lg(g);
    3196          21 :       for (i=1; i<l; i++)
    3197             :       {
    3198          14 :         texi(gel(g,i),T,S); str_puts(S, "\\cr\n");
    3199             :       }
    3200           7 :       str_putc(S, '}'); break;
    3201             : 
    3202           7 :     case t_VECSMALL:
    3203           7 :       str_puts(S, "\\pmatrix{ "); l = lg(g);
    3204          21 :       for (i=1; i<l; i++)
    3205             :       {
    3206          14 :         str_long(S, g[i]);
    3207          14 :         if (i < l-1) str_putc(S, '&');
    3208             :       }
    3209           7 :       str_puts(S, "\\cr}\n"); break;
    3210             : 
    3211           0 :     case t_STR:
    3212           0 :       str_puts(S, GSTR(g)); break;
    3213             : 
    3214           7 :     case t_CLOSURE:
    3215           7 :       if (lg(g)>=6)
    3216             :       {
    3217           7 :         GEN str = closure_get_text(g);
    3218           7 :         if (typ(str)==t_STR)
    3219             :         {
    3220           0 :           print_precontext(g, S, 1);
    3221           0 :           str_puts(S, GSTR(str));
    3222           0 :           print_context(g, T, S ,1);
    3223             :         }
    3224             :         else
    3225             :         {
    3226           7 :           str_putc(S,'(');          str_puts(S,GSTR(gel(str,1)));
    3227           7 :           str_puts(S,")\\mapsto ");
    3228           7 :           print_context(g, T, S ,1); str_puts(S,GSTR(gel(str,2)));
    3229             :         }
    3230             :       }
    3231             :       else
    3232             :       {
    3233           0 :         str_puts(S,"\\{\""); str_puts(S,GSTR(closure_get_code(g)));
    3234           0 :         str_puts(S,"\","); texi(gel(g,3),T,S);
    3235           0 :         str_putc(S,',');   texi(gel(g,4),T,S);
    3236           0 :         str_putc(S,',');   texi(gel(g,5),T,S); str_puts(S,"\\}");
    3237             :       }
    3238           7 :       break;
    3239          14 :     case t_INFINITY: str_puts(S, inf_get_sign(g) == 1? "+\\infty": "-\\infty");
    3240          14 :       break;
    3241             : 
    3242          21 :     case t_MAT:
    3243             :     {
    3244          21 :       str_puts(S, "\\pmatrix{\n "); r = lg(g);
    3245          21 :       if (r>1)
    3246             :       {
    3247          21 :         OUT_FUN print = (typ(gel(g,1)) == t_VECSMALL)? prints: texi;
    3248             : 
    3249          21 :         l = lgcols(g);
    3250          56 :         for (i=1; i<l; i++)
    3251             :         {
    3252          98 :           for (j=1; j<r; j++)
    3253             :           {
    3254          63 :             print(gcoeff(g,i,j),T,S); if (j<r-1) str_putc(S, '&');
    3255             :           }
    3256          35 :           str_puts(S, "\\cr\n ");
    3257             :         }
    3258             :       }
    3259          21 :       str_putc(S, '}'); break;
    3260             :     }
    3261             :   }
    3262             : }
    3263             : 
    3264             : /*******************************************************************/
    3265             : /**                                                               **/
    3266             : /**                        USER OUTPUT FUNCTIONS                  **/
    3267             : /**                                                               **/
    3268             : /*******************************************************************/
    3269             : static void
    3270           0 : _initout(pariout_t *T, char f, long sigd, long sp)
    3271             : {
    3272           0 :   T->format = f;
    3273           0 :   T->sigd = sigd;
    3274           0 :   T->sp = sp;
    3275           0 : }
    3276             : 
    3277             : static void
    3278       60173 : gen_output_fun(GEN x, pariout_t *T, OUT_FUN out)
    3279       60173 : { pari_sp av = avma; pari_puts( stack_GENtostr_fun(x,T,out) ); set_avma(av); }
    3280             : 
    3281             : void
    3282           0 : fputGEN_pariout(GEN x, pariout_t *T, FILE *out)
    3283             : {
    3284           0 :   pari_sp av = avma;
    3285           0 :   char *s = stack_GENtostr_fun(x, T, get_fun(T->prettyp));
    3286           0 :   if (*s) { set_last_newline(s[strlen(s)-1]); fputs(s, out); }
    3287           0 :   set_avma(av);
    3288           0 : }
    3289             : 
    3290             : void
    3291           0 : brute(GEN g, char f, long d)
    3292             : {
    3293           0 :   pariout_t T; _initout(&T,f,d,0);
    3294           0 :   gen_output_fun(g, &T, &bruti);
    3295           0 : }
    3296             : void
    3297           0 : matbrute(GEN g, char f, long d)
    3298             : {
    3299           0 :   pariout_t T; _initout(&T,f,d,1);
    3300           0 :   gen_output_fun(g, &T, &matbruti);
    3301           0 : }
    3302             : void
    3303           0 : texe(GEN g, char f, long d)
    3304             : {
    3305           0 :   pariout_t T; _initout(&T,f,d,0);
    3306           0 :   gen_output_fun(g, &T, &texi);
    3307           0 : }
    3308             : 
    3309             : void
    3310       60173 : gen_output(GEN x)
    3311             : {
    3312       60173 :   gen_output_fun(x, GP_DATA->fmt, get_fun(GP_DATA->fmt->prettyp));
    3313       60173 :   pari_putc('\n'); pari_flush();
    3314       60173 : }
    3315             : void
    3316           0 : output(GEN x)
    3317           0 : { brute(x,'g',-1); pari_putc('\n'); pari_flush(); }
    3318             : void
    3319           0 : outmat(GEN x)
    3320           0 : { matbrute(x,'g',-1); pari_putc('\n'); pari_flush(); }
    3321             : 
    3322             : /*******************************************************************/
    3323             : /**                            FILES                              **/
    3324             : /*******************************************************************/
    3325             : /* to cache '~' expansion */
    3326             : static char *homedir;
    3327             : /* last file read successfully from try_name() */
    3328             : static THREAD char *last_filename;
    3329             : /* stack of temporary files (includes all infiles + some output) */
    3330             : static THREAD pariFILE *last_tmp_file;
    3331             : /* stack of "permanent" (output) files */
    3332             : static THREAD pariFILE *last_file;
    3333             : 
    3334             : typedef struct gpfile
    3335             : {
    3336             :   const char *name;
    3337             :   FILE *fp;
    3338             :   int type;
    3339             :   long serial;
    3340             : } gpfile;
    3341             : 
    3342             : static THREAD gpfile *gp_file;
    3343             : static THREAD pari_stack s_gp_file;
    3344             : static THREAD long gp_file_serial;
    3345             : 
    3346             : #if defined(UNIX) || defined(__EMX__)
    3347             : #  include <fcntl.h>
    3348             : #  include <sys/stat.h> /* for open */
    3349             : #  ifdef __EMX__
    3350             : #    include <process.h>
    3351             : #  endif
    3352             : #  define HAVE_PIPES
    3353             : #endif
    3354             : #if defined(_WIN32)
    3355             : #  define HAVE_PIPES
    3356             : #endif
    3357             : #ifndef O_RDONLY
    3358             : #  define O_RDONLY 0
    3359             : #endif
    3360             : 
    3361             : pariFILE *
    3362       40012 : newfile(FILE *f, const char *name, int type)
    3363             : {
    3364       40012 :   pariFILE *file = (pariFILE*) pari_malloc(strlen(name) + 1 + sizeof(pariFILE));
    3365       40012 :   file->type = type;
    3366       40012 :   file->name = strcpy((char*)(file+1), name);
    3367       40012 :   file->file = f;
    3368       40012 :   file->next = NULL;
    3369       40012 :   if (type & mf_PERM)
    3370             :   {
    3371           0 :     file->prev = last_file;
    3372           0 :     last_file = file;
    3373             :   }
    3374             :   else
    3375             :   {
    3376       40012 :     file->prev = last_tmp_file;
    3377       40012 :     last_tmp_file = file;
    3378             :   }
    3379       40012 :   if (file->prev) (file->prev)->next = file;
    3380       40012 :   if (DEBUGLEVEL)
    3381           0 :     if (strcmp(name,"stdin") || DEBUGLEVEL > 9)
    3382           0 :       err_printf("I/O: new pariFILE %s (code %d) \n",name,type);
    3383       40012 :   return file;
    3384             : }
    3385             : 
    3386             : static void
    3387       40012 : pari_kill_file(pariFILE *f)
    3388             : {
    3389       40012 :   if ((f->type & mf_PIPE) == 0)
    3390             :   {
    3391       40004 :     if (f->file != stdin && fclose(f->file))
    3392           0 :       pari_warn(warnfile, "close", f->name);
    3393             :   }
    3394             : #ifdef HAVE_PIPES
    3395             :   else
    3396             :   {
    3397           8 :     if (f->type & mf_FALSE)
    3398             :     {
    3399           0 :       if (f->file != stdin && fclose(f->file))
    3400           0 :         pari_warn(warnfile, "close", f->name);
    3401           0 :       if (unlink(f->name)) pari_warn(warnfile, "delete", f->name);
    3402             :     }
    3403             :     else
    3404           8 :       if (pclose(f->file) < 0) pari_warn(warnfile, "close pipe", f->name);
    3405             :   }
    3406             : #endif
    3407       40012 :   if (DEBUGLEVEL)
    3408           0 :     if (strcmp(f->name,"stdin") || DEBUGLEVEL > 9)
    3409           0 :       err_printf("I/O: closing file %s (code %d) \n",f->name,f->type);
    3410       40012 :   pari_free(f);
    3411       40012 : }
    3412             : 
    3413             : void
    3414       39935 : pari_fclose(pariFILE *f)
    3415             : {
    3416       39935 :   if (f->next) (f->next)->prev = f->prev;
    3417       39935 :   else if (f == last_tmp_file) last_tmp_file = f->prev;
    3418           0 :   else if (f == last_file) last_file = f->prev;
    3419       39935 :   if (f->prev) (f->prev)->next = f->next;
    3420       39935 :   pari_kill_file(f);
    3421       39935 : }
    3422             : 
    3423             : static pariFILE *
    3424           0 : pari_open_file(FILE *f, const char *s, const char *mode)
    3425             : {
    3426           0 :   if (!f) pari_err_FILE("requested file", s);
    3427           0 :   if (DEBUGLEVEL)
    3428           0 :     if (strcmp(s,"stdin") || DEBUGLEVEL > 9)
    3429           0 :       err_printf("I/O: opening file %s (mode %s)\n", s, mode);
    3430           0 :   return newfile(f,s,0);
    3431             : }
    3432             : 
    3433             : pariFILE *
    3434           0 : pari_fopen_or_fail(const char *s, const char *mode)
    3435             : {
    3436           0 :   return pari_open_file(fopen(s, mode), s, mode);
    3437             : }
    3438             : pariFILE *
    3439           0 : pari_fopen(const char *s, const char *mode)
    3440             : {
    3441           0 :   FILE *f = fopen(s, mode);
    3442           0 :   return f? pari_open_file(f, s, mode): NULL;
    3443             : }
    3444             : 
    3445             : void
    3446      112204 : pari_fread_chars(void *b, size_t n, FILE *f)
    3447             : {
    3448      112204 :   if (fread(b, sizeof(char), n, f) < n)
    3449           0 :     pari_err_FILE("input file [fread]", "FILE*");
    3450      112204 : }
    3451             : 
    3452             : /* FIXME: HAS_FDOPEN & allow standard open() flags */
    3453             : #ifdef UNIX
    3454             : /* open tmpfile s (a priori for writing) avoiding symlink attacks */
    3455             : pariFILE *
    3456           0 : pari_safefopen(const char *s, const char *mode)
    3457             : {
    3458           0 :   long fd = open(s, O_CREAT|O_EXCL|O_RDWR, S_IRUSR|S_IWUSR);
    3459             : 
    3460           0 :   if (fd == -1) pari_err(e_MISC,"tempfile %s already exists",s);
    3461           0 :   return pari_open_file(fdopen(fd, mode), s, mode);
    3462             : }
    3463             : #else
    3464             : pariFILE *
    3465             : pari_safefopen(const char *s, const char *mode)
    3466             : {
    3467             :   return pari_fopen_or_fail(s, mode);
    3468             : }
    3469             : #endif
    3470             : 
    3471             : void
    3472           0 : pari_unlink(const char *s)
    3473             : {
    3474           0 :   if (unlink(s)) pari_warn(warner, "I/O: can\'t remove file %s", s);
    3475           0 :   else if (DEBUGLEVEL)
    3476           0 :     err_printf("I/O: removed file %s\n", s);
    3477           0 : }
    3478             : 
    3479             : /* Remove one INFILE from the stack. Reset pari_infile (to the most recent
    3480             :  * infile)
    3481             :  * Return -1, if we're trying to pop out stdin itself; 0 otherwise
    3482             :  * Check for leaked file handlers (temporary files) */
    3483             : int
    3484      338804 : popinfile(void)
    3485             : {
    3486      338804 :   pariFILE *f = last_tmp_file, *g;
    3487      338504 :   while (f)
    3488             :   {
    3489          20 :     if (f->type & mf_IN) break;
    3490           0 :     pari_warn(warner, "I/O: leaked file descriptor (%d): %s", f->type, f->name);
    3491           0 :     g = f; f = f->prev; pari_fclose(g);
    3492             :   }
    3493      338504 :   last_tmp_file = f; if (!f) return -1;
    3494          20 :   pari_fclose(last_tmp_file);
    3495          20 :   for (f = last_tmp_file; f; f = f->prev)
    3496           0 :     if (f->type & mf_IN) { pari_infile = f->file; return 0; }
    3497          20 :   pari_infile = stdin; return 0;
    3498             : }
    3499             : 
    3500             : /* delete all "temp" files open since last reference point F */
    3501             : void
    3502       13436 : tmp_restore(pariFILE *F)
    3503             : {
    3504       13436 :   pariFILE *f = last_tmp_file;
    3505       13436 :   int first = 1;
    3506       13450 :   while (f)
    3507             :   {
    3508          35 :     pariFILE *g = f->prev;
    3509          35 :     if (f == F) break;
    3510          14 :     pari_fclose(f); f = g;
    3511             :   }
    3512       13436 :   for (; f; f = f->prev) {
    3513          21 :     if (f->type & mf_IN) {
    3514          21 :       pari_infile = f->file;
    3515          21 :       if (DEBUGLEVEL>1)
    3516             :       {
    3517           0 :         first = 0;
    3518           0 :         err_printf("restoring pari_infile to %s\n", f->name);
    3519             :       }
    3520          21 :       break;
    3521             :     }
    3522             :   }
    3523       13436 :   if (!f) {
    3524       13415 :     pari_infile = stdin;
    3525       13415 :     if (DEBUGLEVEL>1 && (!first || DEBUGLEVEL > 9))
    3526             :     {
    3527           7 :       first = 0;
    3528           7 :       err_printf("gp_context_restore: restoring pari_infile to stdin\n");
    3529             :     }
    3530             :   }
    3531       13436 :   if (!first && DEBUGLEVEL>1) err_printf("done\n");
    3532       13436 : }
    3533             : 
    3534             : void
    3535      143312 : filestate_save(struct pari_filestate *file)
    3536             : {
    3537      143312 :   file->file = last_tmp_file;
    3538      143312 :   file->serial = gp_file_serial;
    3539      143312 : }
    3540             : 
    3541             : static void
    3542      347434 : filestate_close(long serial)
    3543             : {
    3544             :   long i;
    3545      347450 :   for (i = 0; i < s_gp_file.n; i++)
    3546          16 :     if (gp_file[i].fp && gp_file[i].serial >= serial)
    3547          16 :       gp_fileclose(i);
    3548      347434 :   gp_file_serial = serial;
    3549      347434 : }
    3550             : 
    3551             : void
    3552       12991 : filestate_restore(struct pari_filestate *file)
    3553             : {
    3554       12991 :   tmp_restore(file->file);
    3555       12991 :   filestate_close(file->serial);
    3556       12991 : }
    3557             : 
    3558             : static void
    3559      669866 : kill_file_stack(pariFILE **s)
    3560             : {
    3561      669866 :   pariFILE *f = *s;
    3562      669943 :   while (f)
    3563             :   {
    3564          77 :     pariFILE *t = f->prev;
    3565          77 :     pari_kill_file(f);
    3566          77 :     *s = f = t; /* have to update *s in case of ^C */
    3567             :   }
    3568      669866 : }
    3569             : 
    3570             : void
    3571          49 : killallfiles(void)
    3572             : {
    3573          49 :   kill_file_stack(&last_tmp_file);
    3574          49 :   pari_infile = stdin;
    3575          49 : }
    3576             : 
    3577             : void
    3578        1879 : pari_init_homedir(void)
    3579             : {
    3580        1879 :   homedir = NULL;
    3581        1879 : }
    3582             : 
    3583             : void
    3584        1869 : pari_close_homedir(void)
    3585             : {
    3586        1869 :   if (homedir) pari_free(homedir);
    3587        1869 : }
    3588             : 
    3589             : void
    3590      337931 : pari_init_files(void)
    3591             : {
    3592      337931 :   last_filename = NULL;
    3593      337931 :   last_tmp_file = NULL;
    3594      337931 :   last_file=NULL;
    3595      337931 :   pari_stack_init(&s_gp_file, sizeof(*gp_file), (void**)&gp_file);
    3596      337930 :   gp_file_serial = 0;
    3597      337930 : }
    3598             : 
    3599             : void
    3600      337010 : pari_thread_close_files(void)
    3601             : {
    3602      337010 :   popinfile(); /* look for leaks */
    3603      336143 :   kill_file_stack(&last_file);
    3604      335412 :   if (last_filename) pari_free(last_filename);
    3605      335412 :   kill_file_stack(&last_tmp_file);
    3606      334547 :   filestate_close(-1);
    3607      334278 :   pari_stack_delete(&s_gp_file);
    3608      334165 : }
    3609             : 
    3610             : void
    3611        1869 : pari_close_files(void)
    3612             : {
    3613        1869 :   if (pari_logfile) { fclose(pari_logfile); pari_logfile = NULL; }
    3614        1869 :   pari_infile = stdin;
    3615        1869 : }
    3616             : 
    3617             : static int
    3618           0 : ok_pipe(FILE *f)
    3619             : {
    3620           0 :   if (DEBUGLEVEL) err_printf("I/O: checking output pipe...\n");
    3621           0 :   pari_CATCH(CATCH_ALL) {
    3622           0 :     return 0;
    3623             :   }
    3624             :   pari_TRY {
    3625             :     int i;
    3626           0 :     fprintf(f,"\n\n"); fflush(f);
    3627           0 :     for (i=1; i<1000; i++) fprintf(f,"                  \n");
    3628           0 :     fprintf(f,"\n"); fflush(f);
    3629           0 :   } pari_ENDCATCH;
    3630           0 :   return 1;
    3631             : }
    3632             : 
    3633             : pariFILE *
    3634           8 : try_pipe(const char *cmd, int fl)
    3635             : {
    3636             : #ifndef HAVE_PIPES
    3637             :   pari_err(e_ARCH,"pipes");
    3638             :   return NULL;/*LCOV_EXCL_LINE*/
    3639             : #else
    3640             :   FILE *file;
    3641             :   const char *f;
    3642           8 :   VOLATILE int flag = fl;
    3643             : 
    3644             : #  ifdef __EMX__
    3645             :   if (_osmode == DOS_MODE) /* no pipes under DOS */
    3646             :   {
    3647             :     pari_sp av = avma;
    3648             :     char *s;
    3649             :     if (flag & mf_OUT) pari_err(e_ARCH,"pipes");
    3650             :     f = pari_unique_filename("pipe");
    3651             :     s = stack_malloc(strlen(cmd)+strlen(f)+4);
    3652             :     sprintf(s,"%s > %s",cmd,f);
    3653             :     file = system(s)? NULL: fopen(f,"r");
    3654             :     flag |= mf_FALSE; pari_free(f); set_avma(av);
    3655             :   }
    3656             :   else
    3657             : #  endif
    3658             :   {
    3659           8 :     file = (FILE *) popen(cmd, (flag & mf_OUT)? "w": "r");
    3660           8 :     if (flag & mf_OUT) {
    3661           0 :       if (!ok_pipe(file)) return NULL;
    3662           0 :       flag |= mf_PERM;
    3663             :     }
    3664           8 :     f = cmd;
    3665             :   }
    3666           8 :   if (!file) pari_err(e_MISC,"[pipe:] '%s' failed",cmd);
    3667           8 :   return newfile(file, f, mf_PIPE|flag);
    3668             : #endif
    3669             : }
    3670             : 
    3671             : char *
    3672       26493 : os_getenv(const char *s)
    3673             : {
    3674             : #ifdef HAS_GETENV
    3675       26493 :   return getenv(s);
    3676             : #else
    3677             :   (void) s; return NULL;
    3678             : #endif
    3679             : }
    3680             : 
    3681             : GEN
    3682           8 : gp_getenv(const char *s)
    3683             : {
    3684           8 :   char *t = os_getenv(s);
    3685           8 :   return t?strtoGENstr(t):gen_0;
    3686             : }
    3687             : 
    3688             : /* FIXME: HAS_GETPWUID */
    3689             : #if defined(UNIX) || defined(__EMX__)
    3690             : #include <pwd.h>
    3691             : #include <sys/types.h>
    3692             : /* user = "": use current uid */
    3693             : char *
    3694        3750 : pari_get_homedir(const char *user)
    3695             : {
    3696             :   struct passwd *p;
    3697        3750 :   char *dir = NULL;
    3698             : 
    3699        3750 :   if (!*user)
    3700             :   {
    3701        3746 :     if (homedir) dir = homedir;
    3702             :     else
    3703             :     {
    3704        1871 :       p = getpwuid(geteuid());
    3705        1871 :       if (p)
    3706             :       {
    3707        1871 :         dir = p->pw_dir;
    3708        1871 :         homedir = pari_strdup(dir); /* cache result */
    3709             :       }
    3710             :     }
    3711             :   }
    3712             :   else
    3713             :   {
    3714           4 :     p = getpwnam(user);
    3715           4 :     if (p) dir = p->pw_dir;
    3716             :     /* warn, but don't kill session on startup (when expanding path) */
    3717           4 :     if (!dir) pari_warn(warner,"can't expand ~%s", user? user: "");
    3718             :   }
    3719        3750 :   return dir;
    3720             : }
    3721             : #else
    3722             : char *
    3723             : pari_get_homedir(const char *user) { (void) user; return NULL; }
    3724             : #endif
    3725             : 
    3726             : /*******************************************************************/
    3727             : /**                                                               **/
    3728             : /**                   GP STANDARD INPUT AND OUTPUT                **/
    3729             : /**                                                               **/
    3730             : /*******************************************************************/
    3731             : #ifdef HAS_STAT
    3732             : static int
    3733          55 : is_dir_stat(const char *name)
    3734             : {
    3735             :   struct stat buf;
    3736          55 :   if (stat(name, &buf)) return 0;
    3737          55 :   return S_ISDIR(buf.st_mode);
    3738             : }
    3739             : #elif defined(HAS_OPENDIR)
    3740             : /* slow, but more portable than stat + S_ISDIR */
    3741             : static int
    3742             : is_dir_opendir(const char *name)
    3743             : {
    3744             :   DIR *d = opendir(name);
    3745             :   if (d) { (void)closedir(d); return 1; }
    3746             :   return 0;
    3747             : }
    3748             : #endif
    3749             : 
    3750             : 
    3751             : /* Does name point to a directory? */
    3752             : int
    3753          55 : pari_is_dir(const char *name)
    3754             : {
    3755             : #ifdef HAS_STAT
    3756          55 :   return is_dir_stat(name);
    3757             : #elif defined(HAS_OPENDIR)
    3758             :   return is_dir_opendir(name);
    3759             : #else
    3760             :   (void) name; return 0;
    3761             : #endif
    3762             : }
    3763             : 
    3764             : /* Does name point to a regular file? */
    3765             : /* If unknown, assume that it is indeed regular. */
    3766             : int
    3767          94 : pari_is_file(const char *name)
    3768             : {
    3769             : #ifdef HAS_STAT
    3770             :   struct stat buf;
    3771          94 :   if (stat(name, &buf)) return 1;
    3772          67 :   return S_ISREG(buf.st_mode);
    3773             : #else
    3774             :   (void) name; return 1;
    3775             : #endif
    3776             : }
    3777             : 
    3778             : int
    3779        1879 : pari_stdin_isatty(void)
    3780             : {
    3781             : #ifdef HAS_ISATTY
    3782        1879 :   return isatty( fileno(stdin) );
    3783             : #else
    3784             :   return 1;
    3785             : #endif
    3786             : }
    3787             : 
    3788             : /* expand tildes in filenames, return a malloc'ed buffer */
    3789             : static char *
    3790        5756 : _path_expand(const char *s)
    3791             : {
    3792             :   const char *t;
    3793        5756 :   char *ret, *dir = NULL;
    3794             : 
    3795        5756 :   if (*s != '~') return pari_strdup(s);
    3796        3750 :   s++; /* skip ~ */
    3797        3766 :   t = s; while (*t && *t != '/') t++;
    3798        3750 :   if (t == s)
    3799        3746 :     dir = pari_get_homedir("");
    3800             :   else
    3801             :   {
    3802           4 :     char *user = pari_strndup(s, t - s);
    3803           4 :     dir = pari_get_homedir(user);
    3804           4 :     pari_free(user);
    3805             :   }
    3806        3750 :   if (!dir) return pari_strdup(s);
    3807        3750 :   ret = (char*)pari_malloc(strlen(dir) + strlen(t) + 1);
    3808        3750 :   sprintf(ret,"%s%s",dir,t); return ret;
    3809             : }
    3810             : 
    3811             : /* expand environment variables in str, return a malloc'ed buffer
    3812             :  * assume no \ remain and str can be freed */
    3813             : static char *
    3814        5756 : _expand_env(char *str)
    3815             : {
    3816        5756 :   long i, l, len = 0, xlen = 16, xnum = 0;
    3817        5756 :   char *s = str, *s0 = s;
    3818        5756 :   char **x = (char **)pari_malloc(xlen * sizeof(char*));
    3819             : 
    3820       44559 :   while (*s)
    3821             :   {
    3822             :     char *env;
    3823       38803 :     if (*s != '$') { s++; continue; }
    3824          12 :     l = s - s0;
    3825          12 :     if (l) { x[xnum++] = pari_strndup(s0, l); len += l; }
    3826          12 :     if (xnum > xlen - 3) /* need room for possibly two more elts */
    3827             :     {
    3828           0 :       xlen <<= 1;
    3829           0 :       pari_realloc_ip((void**)&x, xlen * sizeof(char*));
    3830             :     }
    3831             : 
    3832          12 :     s0 = ++s; /* skip $ */
    3833          48 :     while (is_keyword_char(*s)) s++;
    3834          12 :     l = s - s0; env = pari_strndup(s0, l);
    3835          12 :     s0 = os_getenv(env);
    3836          12 :     if (!s0) pari_warn(warner,"undefined environment variable: %s",env);
    3837             :     else
    3838             :     {
    3839          12 :       l = strlen(s0);
    3840          12 :       if (l) { x[xnum++] = pari_strndup(s0,l); len += l; }
    3841             :     }
    3842          12 :     pari_free(env); s0 = s;
    3843             :   }
    3844        5756 :   l = s - s0;
    3845        5756 :   if (l) { x[xnum++] = pari_strndup(s0,l); len += l; }
    3846             : 
    3847        5756 :   s = (char*)pari_malloc(len+1); *s = 0;
    3848       11528 :   for (i = 0; i < xnum; i++) { (void)strcat(s, x[i]); pari_free(x[i]); }
    3849        5756 :   pari_free(str); pari_free(x); return s;
    3850             : }
    3851             : 
    3852             : char *
    3853        5756 : path_expand(const char *s)
    3854             : {
    3855             : #ifdef _WIN32
    3856             :   char *ss, *p;
    3857             :   ss = pari_strdup(s);
    3858             :   for (p = ss; *p != 0; ++p)
    3859             :     if (*p == '\\') *p = '/';
    3860             :   p = _expand_env(_path_expand(ss));
    3861             :   pari_free(ss);
    3862             :   return p;
    3863             : #else
    3864        5756 :   return _expand_env(_path_expand(s));
    3865             : #endif
    3866             : }
    3867             : 
    3868             : #ifdef HAS_STRFTIME
    3869             : #  include <time.h>
    3870             : void
    3871           4 : strftime_expand(const char *s, char *buf, long max)
    3872             : {
    3873             :   time_t t;
    3874           4 :   BLOCK_SIGINT_START
    3875           4 :   t = time(NULL);
    3876           4 :   (void)strftime(buf,max,s,localtime(&t));
    3877           4 :   BLOCK_SIGINT_END
    3878           4 : }
    3879             : #else
    3880             : void
    3881             : strftime_expand(const char *s, char *buf, long max)
    3882             : { strcpy(buf,s); }
    3883             : #endif
    3884             : 
    3885             : /* name is a malloc'ed (existing) filename. Accept it as new pari_infile
    3886             :  * (unzip if needed). */
    3887             : static pariFILE *
    3888       39913 : pari_get_infile(const char *name, FILE *file)
    3889             : {
    3890             : #ifdef ZCAT
    3891       39913 :   long l = strlen(name);
    3892       39913 :   const char *end = name + l-1;
    3893             : 
    3894       39913 :   if (l > 2 && (!strncmp(end-1,".Z",2)
    3895             : #ifdef GNUZCAT
    3896       39913 :              || !strncmp(end-2,".gz",3)
    3897             : #endif
    3898             :   ))
    3899             :   { /* compressed file (compress or gzip) */
    3900           0 :     char *cmd = stack_malloc(strlen(ZCAT) + l + 4);
    3901           0 :     sprintf(cmd,"%s \"%s\"",ZCAT,name);
    3902           0 :     fclose(file);
    3903           0 :     return try_pipe(cmd, mf_IN);
    3904             :   }
    3905             : #endif
    3906       39913 :   return newfile(file, name, mf_IN);
    3907             : }
    3908             : 
    3909             : pariFILE *
    3910       39956 : pari_fopengz(const char *s)
    3911             : {
    3912       39956 :   pari_sp av = avma;
    3913             :   char *name;
    3914             :   long l;
    3915       39956 :   FILE *f = fopen(s, "r");
    3916             :   pariFILE *pf;
    3917             : 
    3918       39956 :   if (f) return pari_get_infile(s, f);
    3919             : 
    3920             : #ifdef __EMSCRIPTEN__
    3921             :   if (pari_is_dir(pari_datadir))
    3922             :   {
    3923             :     pari_emscripten_wget(s);
    3924             :     f = fopen(s, "r");
    3925             :     if (f) return pari_get_infile(s, f);
    3926             :   }
    3927             : #endif
    3928          63 :   l = strlen(s);
    3929          63 :   name = stack_malloc(l + 3 + 1);
    3930          63 :   strcpy(name, s); (void)sprintf(name + l, ".gz");
    3931          63 :   f = fopen(name, "r");
    3932          63 :   pf = f ? pari_get_infile(name, f): NULL;
    3933          63 :   set_avma(av); return pf;
    3934             : }
    3935             : 
    3936             : static FILE*
    3937          20 : try_open(char *s)
    3938             : {
    3939          20 :   if (!pari_is_dir(s)) return fopen(s, "r");
    3940           0 :   pari_warn(warner,"skipping directory %s",s);
    3941           0 :   return NULL;
    3942             : }
    3943             : 
    3944             : void
    3945          20 : forpath_init(forpath_t *T, gp_path *path, const char *s)
    3946             : {
    3947          20 :   T->s = s;
    3948          20 :   T->ls = strlen(s);
    3949          20 :   T->dir = path->dirs;
    3950          20 : }
    3951             : char *
    3952          20 : forpath_next(forpath_t *T)
    3953             : {
    3954          20 :   char *t, *dir = T->dir[0];
    3955             : 
    3956          20 :   if (!dir) return NULL; /* done */
    3957             :   /* room for dir + '/' + s + '\0' */
    3958          20 :   t = (char*)pari_malloc(strlen(dir) + T->ls + 2);
    3959          20 :   if (!t) return NULL; /* can't happen but kills a warning */
    3960          20 :   sprintf(t,"%s/%s", dir, T->s);
    3961          20 :   T->dir++; return t;
    3962             : }
    3963             : 
    3964             : /* If a file called "name" exists (possibly after appending ".gp")
    3965             :  * record it in the file_stack (as a pipe if compressed).
    3966             :  * name is malloc'ed, we free it before returning
    3967             :  */
    3968             : static FILE *
    3969          20 : try_name(char *name)
    3970             : {
    3971          20 :   pari_sp av = avma;
    3972          20 :   char *s = name;
    3973          20 :   FILE *file = try_open(name);
    3974             : 
    3975          20 :   if (!file)
    3976             :   { /* try appending ".gp" to name */
    3977           0 :     s = stack_malloc(strlen(name)+4);
    3978           0 :     sprintf(s, "%s.gp", name);
    3979           0 :     file = try_open(s);
    3980             :   }
    3981          20 :   if (file)
    3982             :   {
    3983          20 :     if (! last_tmp_file)
    3984             :     {  /* empty file stack, record this name */
    3985          20 :       if (last_filename) pari_free(last_filename);
    3986          20 :       last_filename = pari_strdup(s);
    3987             :     }
    3988          20 :     file = pari_infile = pari_get_infile(s,file)->file;
    3989             :   }
    3990          20 :   pari_free(name); set_avma(av);
    3991          20 :   return file;
    3992             : }
    3993             : static FILE *
    3994           7 : switchin_last(void)
    3995             : {
    3996           7 :   char *s = last_filename;
    3997             :   FILE *file;
    3998           7 :   if (!s) pari_err(e_MISC,"You never gave me anything to read!");
    3999           0 :   file = try_open(s);
    4000           0 :   if (!file) pari_err_FILE("input file",s);
    4001           0 :   return pari_infile = pari_get_infile(s,file)->file;
    4002             : }
    4003             : 
    4004             : /* return 1 if s starts by '/' or './' or '../' */
    4005             : static int
    4006          20 : path_is_absolute(char *s)
    4007             : {
    4008             : #ifdef _WIN32
    4009             :   if( (*s >= 'A' && *s <= 'Z') ||
    4010             :       (*s >= 'a' && *s <= 'z') )
    4011             :   {
    4012             :       return *(s+1) == ':';
    4013             :   }
    4014             : #endif
    4015          20 :   if (*s == '/') return 1;
    4016          20 :   if (*s++ != '.') return 0;
    4017           0 :   if (*s == '/') return 1;
    4018           0 :   if (*s++ != '.') return 0;
    4019           0 :   return *s == '/';
    4020             : }
    4021             : 
    4022             : /* If name = "", re-read last file */
    4023             : FILE *
    4024          27 : switchin(const char *name)
    4025             : {
    4026             :   FILE *f;
    4027             :   char *s;
    4028             : 
    4029          27 :   if (!*name) return switchin_last();
    4030          20 :   s = path_expand(name);
    4031             :   /* if s is an absolute path, don't use dir_list */
    4032          20 :   if (path_is_absolute(s)) { if ((f = try_name(s))) return f; }
    4033             :   else
    4034             :   {
    4035             :     char *t;
    4036             :     forpath_t T;
    4037          20 :     forpath_init(&T, GP_DATA->path, s);
    4038          20 :     while ( (t = forpath_next(&T)) )
    4039          20 :       if ((f = try_name(t))) { pari_free(s); return f; }
    4040           0 :     pari_free(s);
    4041             :   }
    4042           0 :   pari_err_FILE("input file",name);
    4043             :   return NULL; /*LCOV_EXCL_LINE*/
    4044             : }
    4045             : 
    4046             : static int is_magic_ok(FILE *f);
    4047             : 
    4048             : static FILE *
    4049          94 : switchout_get_FILE(const char *name)
    4050             : {
    4051             :   FILE* f;
    4052             :   /* only for ordinary files (to avoid blocking on pipes). */
    4053          94 :   if (pari_is_file(name))
    4054             :   {
    4055          94 :     f = fopen(name, "r");
    4056          94 :     if (f)
    4057             :     {
    4058          67 :       int magic = is_magic_ok(f);
    4059          67 :       fclose(f);
    4060          67 :       if (magic) pari_err_FILE("binary output file [ use writebin ! ]", name);
    4061             :     }
    4062             :   }
    4063          94 :   f = fopen(name, "a");
    4064          94 :   if (!f) pari_err_FILE("output file",name);
    4065          94 :   return f;
    4066             : }
    4067             : 
    4068             : void
    4069           0 : switchout(const char *name)
    4070             : {
    4071           0 :   if (name)
    4072           0 :     pari_outfile = switchout_get_FILE(name);
    4073           0 :   else if (pari_outfile != stdout)
    4074             :   {
    4075           0 :     fclose(pari_outfile);
    4076           0 :     pari_outfile = stdout;
    4077             :   }
    4078           0 : }
    4079             : 
    4080             : /*******************************************************************/
    4081             : /**                                                               **/
    4082             : /**                SYSTEM, READSTR/EXTERNSTR/EXTERN               **/
    4083             : /**                                                               **/
    4084             : /*******************************************************************/
    4085             : static void
    4086          40 : check_secure(const char *s)
    4087             : {
    4088          40 :   if (GP_DATA->secure)
    4089           0 :     pari_err(e_MISC, "[secure mode]: system commands not allowed\nTried to run '%s'",s);
    4090          40 : }
    4091             : 
    4092             : long
    4093          28 : gpsystem(const char *s)
    4094             : {
    4095          28 :   int x = -1;
    4096             : #ifdef HAS_SYSTEM
    4097          28 :   check_secure(s);
    4098          28 :   x = system(s);
    4099          28 :   if (x < 0) pari_err(e_MISC, "system(\"%s\") failed", s);
    4100             : #if (defined(WIFEXITED)&&defined(WEXITSTATUS))
    4101          28 :   x = WIFEXITED(x)? WEXITSTATUS(x): -1; /* POSIX */
    4102             : #  endif
    4103             : #else
    4104             :   pari_err(e_ARCH,"system");
    4105             : #endif
    4106          28 :   return (long)x;
    4107             : }
    4108             : 
    4109             : static GEN
    4110           8 : get_lines(FILE *F)
    4111             : {
    4112           8 :   pari_sp av = avma;
    4113           8 :   long i, nz = 16;
    4114           8 :   GEN z = cgetg(nz + 1, t_VEC);
    4115           8 :   Buffer *b = new_buffer();
    4116             :   input_method IM;
    4117           8 :   IM.myfgets = (fgets_t)&fgets;
    4118           8 :   IM.file = (void*)F;
    4119           8 :   for(i = 1;;)
    4120          20 :   {
    4121          28 :     char *s = b->buf, *e;
    4122          28 :     if (!file_getline(b, &s, &IM)) break;
    4123          20 :     if (i > nz) { nz <<= 1; z = vec_lengthen(z, nz); }
    4124          20 :     e = s + strlen(s)-1;
    4125          20 :     if (*e == '\n') *e = 0;
    4126          20 :     gel(z,i++) = strtoGENstr(s);
    4127             :   }
    4128           8 :   delete_buffer(b); setlg(z, i);
    4129           8 :   return gerepilecopy(av, z);
    4130             : }
    4131             : 
    4132             : GEN
    4133           4 : externstr(const char *s)
    4134             : {
    4135             :   pariFILE *F;
    4136             :   GEN z;
    4137           4 :   check_secure(s);
    4138           4 :   F = try_pipe(s, mf_IN);
    4139           4 :   z = get_lines(F->file);
    4140           4 :   pari_fclose(F); return z;
    4141             : }
    4142             : GEN
    4143           4 : gpextern(const char *s)
    4144             : {
    4145             :   pariFILE *F;
    4146             :   GEN z;
    4147           4 :   check_secure(s);
    4148           4 :   F = try_pipe(s, mf_IN);
    4149           4 :   z = gp_read_stream(F->file);
    4150           4 :   pari_fclose(F); return z ? z : gnil;
    4151             : }
    4152             : 
    4153             : GEN
    4154           4 : readstr(const char *s)
    4155             : {
    4156           4 :   GEN z = get_lines(switchin(s));
    4157           4 :   popinfile(); return z;
    4158             : }
    4159             : 
    4160             : /*******************************************************************/
    4161             : /**                                                               **/
    4162             : /**                    I/O IN BINARY FORM                         **/
    4163             : /**                                                               **/
    4164             : /*******************************************************************/
    4165             : static void
    4166          72 : pari_fread_longs(void *a, size_t c, FILE *d)
    4167          72 : { if (fread(a,sizeof(long),c,d) < c)
    4168           0 :     pari_err_FILE("input file [fread]", "FILE*"); }
    4169             : 
    4170             : static void
    4171         104 : _fwrite(const void *a, size_t b, size_t c, FILE *d)
    4172         104 : { if (fwrite(a,b,c,d) < c) pari_err_FILE("output file [fwrite]", "FILE*"); }
    4173             : static void
    4174          96 : _lfwrite(const void *a, size_t b, FILE *c) { _fwrite(a,sizeof(long),b,c); }
    4175             : static void
    4176           8 : _cfwrite(const void *a, size_t b, FILE *c) { _fwrite(a,sizeof(char),b,c); }
    4177             : 
    4178             : enum { BIN_GEN, NAM_GEN, VAR_GEN, RELINK_TABLE };
    4179             : 
    4180             : static long
    4181          56 : rd_long(FILE *f) { long L; pari_fread_longs(&L, 1UL, f); return L; }
    4182             : static void
    4183          80 : wr_long(long L, FILE *f) { _lfwrite(&L, 1UL, f); }
    4184             : 
    4185             : /* append x to file f */
    4186             : static void
    4187          16 : wrGEN(GEN x, FILE *f)
    4188             : {
    4189          16 :   GENbin *p = copy_bin_canon(x);
    4190          16 :   size_t L = p->len;
    4191             : 
    4192          16 :   wr_long(L,f);
    4193          16 :   if (L)
    4194             :   {
    4195          16 :     wr_long((long)p->x,f);
    4196          16 :     wr_long((long)p->base,f);
    4197          16 :     _lfwrite(GENbinbase(p), L,f);
    4198             :   }
    4199          16 :   pari_free((void*)p);
    4200          16 : }
    4201             : 
    4202             : static void
    4203           8 : wrstr(const char *s, FILE *f)
    4204             : {
    4205           8 :   size_t L = strlen(s)+1;
    4206           8 :   wr_long(L,f);
    4207           8 :   _cfwrite(s, L, f);
    4208           8 : }
    4209             : 
    4210             : static char *
    4211           8 : rdstr(FILE *f)
    4212             : {
    4213           8 :   size_t L = (size_t)rd_long(f);
    4214             :   char *s;
    4215           8 :   if (!L) return NULL;
    4216           8 :   s = (char*)pari_malloc(L);
    4217           8 :   pari_fread_chars(s, L, f); return s;
    4218             : }
    4219             : 
    4220             : static void
    4221           8 : writeGEN(GEN x, FILE *f)
    4222             : {
    4223           8 :   fputc(BIN_GEN,f);
    4224           8 :   wrGEN(x, f);
    4225           8 : }
    4226             : 
    4227             : static void
    4228           8 : writenamedGEN(GEN x, const char *s, FILE *f)
    4229             : {
    4230           8 :   fputc(x ? NAM_GEN : VAR_GEN,f);
    4231           8 :   wrstr(s, f);
    4232           8 :   if (x) wrGEN(x, f);
    4233           8 : }
    4234             : 
    4235             : /* read a GEN from file f */
    4236             : static GEN
    4237          16 : rdGEN(FILE *f)
    4238             : {
    4239          16 :   size_t L = (size_t)rd_long(f);
    4240             :   GENbin *p;
    4241             : 
    4242          16 :   if (!L) return gen_0;
    4243          16 :   p = (GENbin*)pari_malloc(sizeof(GENbin) + L*sizeof(long));
    4244          16 :   p->len  = L;
    4245          16 :   p->x    = (GEN)rd_long(f);
    4246          16 :   p->base = (GEN)rd_long(f);
    4247          16 :   p->rebase = &shiftaddress_canon;
    4248          16 :   pari_fread_longs(GENbinbase(p), L,f);
    4249          16 :   return bin_copy(p);
    4250             : }
    4251             : 
    4252             : /* read a binary object in file f. Set *ptc to the object "type":
    4253             :  * BIN_GEN: an anonymous GEN x; return x.
    4254             :  * NAM_GEN: a named GEN x, with name v; set 'v to x (changevalue) and return x
    4255             :  * VAR_GEN: a name v; create the (unassigned) variable v and return gnil
    4256             :  * RELINK_TABLE: a relinking table for gen_relink(), to replace old adresses
    4257             :  * in * the original session by new incarnations in the current session.
    4258             :  * H is the current relinking table
    4259             :  * */
    4260             : static GEN
    4261          28 : readobj(FILE *f, int *ptc, hashtable *H)
    4262             : {
    4263          28 :   int c = fgetc(f);
    4264          28 :   GEN x = NULL;
    4265          28 :   switch(c)
    4266             :   {
    4267           8 :     case BIN_GEN:
    4268           8 :       x = rdGEN(f);
    4269           8 :       if (H) gen_relink(x, H);
    4270           8 :       break;
    4271           8 :     case NAM_GEN:
    4272             :     case VAR_GEN:
    4273             :     {
    4274           8 :       char *s = rdstr(f);
    4275           8 :       if (!s) pari_err(e_MISC,"malformed binary file (no name)");
    4276           8 :       if (c == NAM_GEN)
    4277             :       {
    4278           8 :         x = rdGEN(f);
    4279           8 :         if (H) gen_relink(x, H);
    4280           8 :         err_printf("setting %s\n",s);
    4281           8 :         changevalue(varentries[fetch_user_var(s)], x);
    4282             :       }
    4283             :       else
    4284             :       {
    4285           0 :         pari_var_create(fetch_entry(s));
    4286           0 :         x = gnil;
    4287             :       }
    4288           8 :       break;
    4289             :     }
    4290           0 :     case RELINK_TABLE:
    4291           0 :       x = rdGEN(f); break;
    4292          12 :     case EOF: break;
    4293           0 :     default: pari_err(e_MISC,"unknown code in readobj");
    4294             :   }
    4295          28 :   *ptc = c; return x;
    4296             : }
    4297             : 
    4298             : #define MAGIC "\020\001\022\011-\007\020" /* ^P^A^R^I-^G^P */
    4299             : #ifdef LONG_IS_64BIT
    4300             : #  define ENDIAN_CHECK 0x0102030405060708L
    4301             : #else
    4302             : #  define ENDIAN_CHECK 0x01020304L
    4303             : #endif
    4304             : static const long BINARY_VERSION = 1; /* since 2.2.9 */
    4305             : 
    4306             : static int
    4307          79 : is_magic_ok(FILE *f)
    4308             : {
    4309          79 :   pari_sp av = avma;
    4310          79 :   size_t L = strlen(MAGIC);
    4311          79 :   char *s = stack_malloc(L);
    4312          79 :   return gc_int(av, fread(s,1,L, f) == L && strncmp(s,MAGIC,L) == 0);
    4313             : }
    4314             : 
    4315             : static int
    4316          12 : is_sizeoflong_ok(FILE *f)
    4317             : {
    4318             :   char c;
    4319          12 :   return (fread(&c,1,1, f) == 1 && c == (char)sizeof(long));
    4320             : }
    4321             : 
    4322             : static int
    4323          24 : is_long_ok(FILE *f, long L)
    4324             : {
    4325             :   long c;
    4326          24 :   return (fread(&c,sizeof(long),1, f) == 1 && c == L);
    4327             : }
    4328             : 
    4329             : /* return 1 if valid binary file */
    4330             : static int
    4331          12 : check_magic(const char *name, FILE *f)
    4332             : {
    4333          12 :   if (!is_magic_ok(f))
    4334           0 :     pari_warn(warner, "%s is not a GP binary file",name);
    4335          12 :   else if (!is_sizeoflong_ok(f))
    4336           0 :     pari_warn(warner, "%s not written for a %ld bit architecture",
    4337             :                name, sizeof(long)*8);
    4338          12 :   else if (!is_long_ok(f, ENDIAN_CHECK))
    4339           0 :     pari_warn(warner, "unexpected endianness in %s",name);
    4340          12 :   else if (!is_long_ok(f, BINARY_VERSION))
    4341           0 :     pari_warn(warner, "%s written by an incompatible version of GP",name);
    4342          12 :   else return 1;
    4343           0 :   return 0;
    4344             : }
    4345             : 
    4346             : static void
    4347          12 : write_magic(FILE *f)
    4348             : {
    4349          12 :   fprintf(f, MAGIC);
    4350          12 :   fprintf(f, "%c", (char)sizeof(long));
    4351          12 :   wr_long(ENDIAN_CHECK, f);
    4352          12 :   wr_long(BINARY_VERSION, f);
    4353          12 : }
    4354             : 
    4355             : int
    4356          16 : file_is_binary(FILE *f)
    4357             : {
    4358          16 :   int r, c = fgetc(f);
    4359          16 :   ungetc(c,f);
    4360          16 :   r = (c != EOF && isprint((unsigned char)c) == 0 && isspace((unsigned char)c) == 0);
    4361             : #ifdef _WIN32
    4362             :   if (r) { setmode(fileno(f), _O_BINARY); rewind(f); }
    4363             : #endif
    4364          16 :   return r;
    4365             : }
    4366             : 
    4367             : void
    4368          12 : writebin(const char *name, GEN x)
    4369             : {
    4370          12 :   FILE *f = fopen(name,"rb");
    4371          12 :   pari_sp av = avma;
    4372             :   GEN V;
    4373          12 :   int already = f? 1: 0;
    4374             : 
    4375          12 :   if (f) {
    4376           0 :     int ok = check_magic(name,f);
    4377           0 :     fclose(f);
    4378           0 :     if (!ok) pari_err_FILE("binary output file",name);
    4379             :   }
    4380          12 :   f = fopen(name,"ab");
    4381          12 :   if (!f) pari_err_FILE("binary output file",name);
    4382          12 :   if (!already) write_magic(f);
    4383             : 
    4384          12 :   V = copybin_unlink(x);
    4385          12 :   if (lg(gel(V,1)) > 1)
    4386             :   {
    4387           0 :     fputc(RELINK_TABLE,f);
    4388           0 :     wrGEN(V, f);
    4389             :   }
    4390          12 :   if (x) writeGEN(x,f);
    4391             :   else
    4392             :   {
    4393           4 :     long v, maxv = pari_var_next();
    4394          44 :     for (v=0; v<maxv; v++)
    4395             :     {
    4396          40 :       entree *ep = varentries[v];
    4397          40 :       if (!ep) continue;
    4398           8 :       writenamedGEN((GEN)ep->value,ep->name,f);
    4399             :     }
    4400             :   }
    4401          12 :   set_avma(av); fclose(f);
    4402          12 : }
    4403             : 
    4404             : /* read all objects in f. If f contains BIN_GEN that would be silently ignored
    4405             :  * [i.e f contains more than one objet, not all of them 'named GENs'], return
    4406             :  * them all in a vector and set 'vector'. */
    4407             : GEN
    4408          12 : readbin(const char *name, FILE *f, int *vector)
    4409             : {
    4410          12 :   pari_sp av = avma;
    4411          12 :   hashtable *H = NULL;
    4412             :   pari_stack s_obj;
    4413             :   GEN obj, x, y;
    4414             :   int cy;
    4415          12 :   if (vector) *vector = 0;
    4416          12 :   if (!check_magic(name,f)) return NULL;
    4417          12 :   pari_stack_init(&s_obj, sizeof(GEN), (void**)&obj);
    4418             :   /* HACK: push codeword so as to be able to treat s_obj.data as a t_VEC */
    4419          12 :   pari_stack_pushp(&s_obj, (void*) (evaltyp(t_VEC)|_evallg(1)));
    4420          12 :   x = gnil;
    4421          28 :   while ((y = readobj(f, &cy, H)))
    4422             :   {
    4423          16 :     x = y;
    4424          16 :     switch(cy)
    4425             :     {
    4426           8 :       case BIN_GEN:
    4427           8 :         pari_stack_pushp(&s_obj, (void*)y); break;
    4428           0 :       case RELINK_TABLE:
    4429           0 :         if (H) hash_destroy(H);
    4430           0 :         H = hash_from_link(gel(y,1),gel(y,2), 0);
    4431             :     }
    4432             :   }
    4433          12 :   if (H) hash_destroy(H);
    4434          12 :   switch(s_obj.n) /* >= 1 */
    4435             :   {
    4436           4 :     case 1: break; /* nothing but the codeword */
    4437           8 :     case 2: x = gel(obj,1); break; /* read a single BIN_GEN */
    4438           0 :     default: /* more than one BIN_GEN */
    4439           0 :       setlg(obj, s_obj.n);
    4440           0 :       if (DEBUGLEVEL)
    4441           0 :         pari_warn(warner,"%ld unnamed objects read. Returning then in a vector",
    4442           0 :                   s_obj.n - 1);
    4443           0 :       x = gerepilecopy(av, obj);
    4444           0 :       if (vector) *vector = 1;
    4445             :   }
    4446          12 :   pari_stack_delete(&s_obj);
    4447          12 :   return x;
    4448             : }
    4449             : 
    4450             : /*******************************************************************/
    4451             : /**                                                               **/
    4452             : /**                             GP I/O                            **/
    4453             : /**                                                               **/
    4454             : /*******************************************************************/
    4455             : /* print a vector of GENs, in output context 'out', using 'sep' as a
    4456             :  * separator between sucessive entries [ NULL = no separator ]*/
    4457             : 
    4458             : static void
    4459      143082 : str_print0(pari_str *S, const char *sep, GEN g, long flag)
    4460             : {
    4461      143082 :   pari_sp av = avma;
    4462      143082 :   OUT_FUN f = get_fun(flag);
    4463      143082 :   long i, l = lg(g);
    4464      430304 :   for (i = 1; i < l; i++)
    4465             :   {
    4466      287222 :     GEN x = gel(g,i);
    4467      287222 :     if (typ(x) == t_STR) str_puts(S, GSTR(x)); else f(x, GP_DATA->fmt, S);
    4468      287222 :     if (sep && i+1 < l) str_puts(S, sep);
    4469      287222 :     if (!S->use_stack) set_avma(av);
    4470             :   }
    4471      143082 :   *(S->cur) = 0;
    4472      143082 : }
    4473             : 
    4474             : void
    4475      111521 : out_print0(PariOUT *out, const char *sep, GEN g, long flag)
    4476             : {
    4477      111521 :   pari_sp av = avma;
    4478             :   pari_str S;
    4479      111521 :   str_init(&S,1);
    4480      111521 :   str_print0(&S, sep, g, flag);
    4481      111521 :   str_putc(&S,'\n'); *(S.cur) = 0;
    4482      111521 :   out_puts(out, S.string);
    4483      111521 :   set_avma(av);
    4484      111521 : }
    4485             : 
    4486             : void
    4487       20251 : out_print1(PariOUT *out, const char *sep, GEN g, long flag)
    4488             : {
    4489       20251 :   pari_sp av = avma;
    4490             :   pari_str S;
    4491       20251 :   str_init(&S,1);
    4492       20251 :   str_print0(&S, sep, g, flag);
    4493       20251 :   out_puts(out, S.string);
    4494       20251 :   set_avma(av);
    4495       20251 : }
    4496             : 
    4497             : /* see print0(). Returns pari_malloc()ed string */
    4498             : char *
    4499       11202 : RgV_to_str(GEN g, long flag)
    4500             : {
    4501       11202 :   pari_str S; str_init(&S,0);
    4502       11202 :   str_print0(&S, NULL, g, flag);
    4503       11202 :   return S.string;
    4504             : }
    4505             : 
    4506             : static GEN
    4507       11190 : Str_fun(GEN g, long flag) {
    4508       11190 :   char *t = RgV_to_str(g, flag);
    4509       11190 :   GEN z = strtoGENstr(t);
    4510       11190 :   pari_free(t); return z;
    4511             : }
    4512       11064 : GEN Str(GEN g)    { return Str_fun(g, f_RAW); }
    4513         126 : GEN strtex(GEN g) { return Str_fun(g, f_TEX); }
    4514             : GEN
    4515          12 : strexpand(GEN g) {
    4516          12 :   char *s = RgV_to_str(g, f_RAW), *t = path_expand(s);
    4517          12 :   GEN z = strtoGENstr(t);
    4518          12 :   pari_free(t); pari_free(s); return z;
    4519             : }
    4520             : 
    4521             : /* display s, followed by the element of g */
    4522             : char *
    4523          14 : pari_sprint0(const char *s, GEN g, long flag)
    4524             : {
    4525          14 :   pari_str S; str_init(&S, 0);
    4526          14 :   str_puts(&S, s);
    4527          14 :   str_print0(&S, NULL, g, flag);
    4528          14 :   return S.string;
    4529             : }
    4530             : 
    4531             : static void
    4532          94 : print0_file(FILE *out, GEN g, long flag)
    4533             : {
    4534          94 :   pari_sp av = avma;
    4535          94 :   pari_str S; str_init(&S, 1);
    4536          94 :   str_print0(&S, NULL, g, flag);
    4537          94 :   fputs(S.string, out);
    4538          94 :   set_avma(av);
    4539          94 : }
    4540             : 
    4541             : static void
    4542      110555 : printfl_0(GEN g, long flag) { out_print0(pariOut, NULL, g, flag); }
    4543             : static void
    4544       20223 : printfl_1(GEN g, long flag) { out_print1(pariOut, NULL, g, flag); }
    4545             : void
    4546         966 : printsep(const char *s, GEN g)
    4547         966 : { out_print0(pariOut, s, g, f_RAW); pari_flush(); }
    4548             : void
    4549          21 : printsep1(const char *s, GEN g)
    4550          21 : { out_print1(pariOut, s, g, f_RAW); pari_flush(); }
    4551             : 
    4552             : static char *
    4553       78773 : sm_dopr(const char *fmt, GEN arg_vector, va_list args)
    4554             : {
    4555       78773 :   pari_str s; str_init(&s, 0);
    4556       78772 :   str_arg_vprintf(&s, fmt, arg_vector, args);
    4557       78751 :   return s.string;
    4558             : }
    4559             : char *
    4560       77310 : pari_vsprintf(const char *fmt, va_list ap)
    4561       77310 : { return sm_dopr(fmt, NULL, ap); }
    4562             : 
    4563             : /* dummy needed to pass an empty va_list to sm_dopr */
    4564             : static char *
    4565        1463 : dopr_arg_vector(GEN arg_vector, const char* fmt, ...)
    4566             : {
    4567             :   va_list ap;
    4568             :   char *s;
    4569        1463 :   va_start(ap, fmt);
    4570        1463 :   s = sm_dopr(fmt, arg_vector, ap);
    4571        1442 :   va_end(ap); return s;
    4572             : }
    4573             : /* GP only */
    4574             : void
    4575         742 : printf0(const char *fmt, GEN args)
    4576         742 : { char *s = dopr_arg_vector(args, fmt);
    4577         721 :   pari_puts(s); pari_free(s); pari_flush(); }
    4578             : /* GP only */
    4579             : GEN
    4580         721 : strprintf(const char *fmt, GEN args)
    4581         721 : { char *s = dopr_arg_vector(args, fmt);
    4582         721 :   GEN z = strtoGENstr(s); pari_free(s); return z; }
    4583             : 
    4584             : void
    4585       14179 : out_vprintf(PariOUT *out, const char *fmt, va_list ap)
    4586             : {
    4587       14179 :   char *s = pari_vsprintf(fmt, ap);
    4588       14179 :   out_puts(out, s); pari_free(s);
    4589       14179 : }
    4590             : void
    4591         743 : pari_vprintf(const char *fmt, va_list ap) { out_vprintf(pariOut, fmt, ap); }
    4592             : 
    4593             : void
    4594         347 : err_printf(const char* fmt, ...)
    4595             : {
    4596         347 :   va_list args; va_start(args, fmt);
    4597         347 :   out_vprintf(pariErr,fmt,args); va_end(args);
    4598         347 : }
    4599             : 
    4600             : /* variadic version of printf0 */
    4601             : void
    4602       12336 : out_printf(PariOUT *out, const char *fmt, ...)
    4603             : {
    4604       12336 :   va_list args; va_start(args,fmt);
    4605       12336 :   out_vprintf(out,fmt,args); va_end(args);
    4606       12336 : }
    4607             : void
    4608         743 : pari_printf(const char *fmt, ...) /* variadic version of printf0 */
    4609             : {
    4610         743 :   va_list args; va_start(args,fmt);
    4611         743 :   pari_vprintf(fmt,args); va_end(args);
    4612         743 : }
    4613             : 
    4614             : GEN
    4615        1986 : gvsprintf(const char *fmt, va_list ap)
    4616             : {
    4617        1986 :   char *s = pari_vsprintf(fmt, ap);
    4618        1985 :   GEN z = strtoGENstr(s);
    4619        1985 :   pari_free(s); return z;
    4620             : }
    4621             : 
    4622             : char *
    4623       18985 : pari_sprintf(const char *fmt, ...) /* variadic version of strprintf */
    4624             : {
    4625             :   char *s;
    4626             :   va_list ap;
    4627       18985 :   va_start(ap, fmt);
    4628       18985 :   s = pari_vsprintf(fmt, ap);
    4629       18985 :   va_end(ap); return s;
    4630             : }
    4631             : 
    4632             : void
    4633      148096 : str_printf(pari_str *S, const char *fmt, ...)
    4634             : {
    4635      148096 :   va_list ap; va_start(ap, fmt);
    4636      148096 :   str_arg_vprintf(S, fmt, NULL, ap);
    4637      148096 :   va_end(ap);
    4638      148096 : }
    4639             : 
    4640             : char *
    4641       42160 : stack_sprintf(const char *fmt, ...)
    4642             : {
    4643             :   char *s, *t;
    4644             :   va_list ap;
    4645       42160 :   va_start(ap, fmt);
    4646       42160 :   s = pari_vsprintf(fmt, ap);
    4647       42160 :   va_end(ap);
    4648       42160 :   t = stack_strdup(s);
    4649       42160 :   pari_free(s); return t;
    4650             : }
    4651             : 
    4652             : GEN
    4653        1603 : gsprintf(const char *fmt, ...) /* variadic version of gvsprintf */
    4654             : {
    4655             :   GEN s;
    4656             :   va_list ap;
    4657        1603 :   va_start(ap, fmt);
    4658        1603 :   s = gvsprintf(fmt, ap);
    4659        1603 :   va_end(ap); return s;
    4660             : }
    4661             : 
    4662             : /* variadic version of fprintf0. FIXME: fprintf0 not yet available */
    4663             : void
    4664           0 : pari_vfprintf(FILE *file, const char *fmt, va_list ap)
    4665             : {
    4666           0 :   char *s = pari_vsprintf(fmt, ap);
    4667           0 :   fputs(s, file); pari_free(s);
    4668           0 : }
    4669             : void
    4670           0 : pari_fprintf(FILE *file, const char *fmt, ...)
    4671             : {
    4672           0 :   va_list ap; va_start(ap, fmt);
    4673           0 :   pari_vfprintf(file, fmt, ap); va_end(ap);
    4674           0 : }
    4675             : 
    4676      110506 : void print   (GEN g) { printfl_0(g, f_RAW); pari_flush(); }
    4677           7 : void printp  (GEN g) { printfl_0(g, f_PRETTYMAT); pari_flush(); }
    4678          42 : void printtex(GEN g) { printfl_0(g, f_TEX); pari_flush(); }
    4679       20223 : void print1  (GEN g) { printfl_1(g, f_RAW); pari_flush(); }
    4680             : 
    4681             : void
    4682          14 : error0(GEN g)
    4683             : {
    4684          14 :   if (lg(g)==2 && typ(gel(g,1))==t_ERROR) pari_err(0, gel(g,1));
    4685          14 :   else pari_err(e_USER, g);
    4686           0 : }
    4687             : 
    4688           7 : void warning0(GEN g) { pari_warn(warnuser, g); }
    4689             : 
    4690             : static void
    4691         122 : wr_check(const char *t) {
    4692         122 :   if (GP_DATA->secure)
    4693             :   {
    4694           0 :     char *msg = pari_sprintf("[secure mode]: about to write to '%s'",t);
    4695           0 :     pari_ask_confirm(msg);
    4696           0 :     pari_free(msg);
    4697             :   }
    4698         122 : }
    4699             : 
    4700             : /* write to file s */
    4701             : static void
    4702          94 : wr(const char *s, GEN g, long flag, int addnl)
    4703             : {
    4704          94 :   char *t = path_expand(s);
    4705             :   FILE *out;
    4706             : 
    4707          94 :   wr_check(t);
    4708          94 :   out = switchout_get_FILE(t);
    4709          94 :   print0_file(out, g, flag);
    4710          94 :   if (addnl) fputc('\n', out);
    4711          94 :   fflush(out);
    4712          94 :   if (fclose(out)) pari_warn(warnfile, "close", t);
    4713          94 :   pari_free(t);
    4714          94 : }
    4715          82 : void write0  (const char *s, GEN g) { wr(s, g, f_RAW, 1); }
    4716           4 : void writetex(const char *s, GEN g) { wr(s, g, f_TEX, 1); }
    4717           8 : void write1  (const char *s, GEN g) { wr(s, g, f_RAW, 0); }
    4718          12 : void gpwritebin(const char *s, GEN x)
    4719             : {
    4720          12 :   char *t = path_expand(s);
    4721          12 :   wr_check(t); writebin(t, x); pari_free(t);
    4722          12 : }
    4723             : 
    4724             : /*******************************************************************/
    4725             : /**                                                               **/
    4726             : /**                       HISTORY HANDLING                        **/
    4727             : /**                                                               **/
    4728             : /*******************************************************************/
    4729             : /* history management function:
    4730             :  *   p > 0, called from %p or %#p
    4731             :  *   p <= 0, called from %` or %#` (|p| backquotes, possibly 0) */
    4732             : static gp_hist_cell *
    4733       60227 : history(long p)
    4734             : {
    4735       60227 :   gp_hist *H = GP_DATA->hist;
    4736       60227 :   ulong t = H->total, s = H->size;
    4737             :   gp_hist_cell *c;
    4738             : 
    4739       60227 :   if (!t) pari_err(e_MISC,"The result history is empty");
    4740             : 
    4741       60227 :   if (p <= 0) p += t; /* count |p| entries starting from last */
    4742       60227 :   if (p <= 0 || p <= (long)(t - s) || (ulong)p > t)
    4743             :   {
    4744          14 :     long pmin = (long)(t - s) + 1;
    4745          14 :     if (pmin <= 0) pmin = 1;
    4746          14 :     pari_err(e_MISC,"History result %%%ld not available [%%%ld-%%%lu]",
    4747             :              p,pmin,t);
    4748             :   }
    4749       60213 :   c = H->v + ((p-1) % s);
    4750       60213 :   if (!c->z)
    4751           7 :     pari_err(e_MISC,"History result %%%ld has been deleted (histsize changed)", p);
    4752       60206 :   return c;
    4753             : }
    4754             : GEN
    4755       60177 : pari_get_hist(long p) { return history(p)->z; }
    4756             : long
    4757           0 : pari_get_histtime(long p) { return history(p)->t; }
    4758             : long
    4759           0 : pari_get_histrtime(long p) { return history(p)->r; }
    4760             : GEN
    4761          25 : pari_histtime(long p) { return mkvec2s(history(p)->t, history(p)->r); }
    4762             : 
    4763             : void
    4764      105959 : pari_add_hist(GEN x, long time, long rtime)
    4765             : {
    4766      105959 :   gp_hist *H = GP_DATA->hist;
    4767      105959 :   ulong i = H->total % H->size;
    4768      105959 :   H->total++;
    4769      105959 :   guncloneNULL(H->v[i].z);
    4770      105959 :   H->v[i].t = time;
    4771      105959 :   H->v[i].r = rtime;
    4772      105959 :   H->v[i].z = gclone(x);
    4773      105959 : }
    4774             : 
    4775             : ulong
    4776           0 : pari_nb_hist(void)
    4777             : {
    4778           0 :   return GP_DATA->hist->total;
    4779             : }
    4780             : 
    4781             : /*******************************************************************/
    4782             : /**                                                               **/
    4783             : /**                       TEMPORARY FILES                         **/
    4784             : /**                                                               **/
    4785             : /*******************************************************************/
    4786             : 
    4787             : #ifndef R_OK
    4788             : #  define R_OK 4
    4789             : #  define W_OK 2
    4790             : #  define X_OK 1
    4791             : #  define F_OK 0
    4792             : #endif
    4793             : 
    4794             : #ifdef __EMX__
    4795             : #include <io.h>
    4796             : static int
    4797             : unix_shell(void)
    4798             : {
    4799             :   char *base, *sh = getenv("EMXSHELL");
    4800             :   if (!sh) {
    4801             :     sh = getenv("COMSPEC");
    4802             :     if (!sh) return 0;
    4803             :   }
    4804             :   base = _getname(sh);
    4805             :   return (stricmp (base, "cmd.exe") && stricmp (base, "4os2.exe")
    4806             :        && stricmp (base, "command.com") && stricmp (base, "4dos.com"));
    4807             : }
    4808             : #endif
    4809             : 
    4810             : /* check if s has rwx permissions for us */
    4811             : static int
    4812           0 : pari_is_rwx(const char *s)
    4813             : {
    4814             : /* FIXME: HAS_ACCESS */
    4815             : #if defined(UNIX) || defined (__EMX__)
    4816           0 :   return access(s, R_OK | W_OK | X_OK) == 0;
    4817             : #else
    4818             :   (void) s; return 1;
    4819             : #endif
    4820             : }
    4821             : 
    4822             : #if defined(UNIX) || defined (__EMX__)
    4823             : #include <sys/types.h>
    4824             : #include <sys/stat.h>
    4825             : static int
    4826           0 : pari_file_exists(const char *s)
    4827             : {
    4828           0 :   int id = open(s, O_CREAT|O_EXCL|O_RDWR, S_IRUSR|S_IWUSR);
    4829           0 :   return id < 0 || close(id);
    4830             : }
    4831             : static int
    4832           0 : pari_dir_exists(const char *s) { return mkdir(s, 0777); }
    4833             : #elif defined(_WIN32)
    4834             : static int
    4835             : pari_file_exists(const char *s) { return GetFileAttributesA(s) != ~0UL; }
    4836             : static int
    4837             : pari_dir_exists(const char *s) { return mkdir(s); }
    4838             : #else
    4839             : static int
    4840             : pari_file_exists(const char *s) { return 0; }
    4841             : static int
    4842             : pari_dir_exists(const char *s) { return 0; }
    4843             : #endif
    4844             : 
    4845             : static char *
    4846           0 : env_ok(const char *s)
    4847             : {
    4848           0 :   char *t = os_getenv(s);
    4849           0 :   if (t && !pari_is_rwx(t))
    4850             :   {
    4851           0 :     pari_warn(warner,"%s is set (%s), but is not writable", s,t);
    4852           0 :     t = NULL;
    4853             :   }
    4854           0 :   if (t && !pari_is_dir(t))
    4855             :   {
    4856           0 :     pari_warn(warner,"%s is set (%s), but is not a directory", s,t);
    4857           0 :     t = NULL;
    4858             :   }
    4859           0 :   return t;
    4860             : }
    4861             : 
    4862             : static const char*
    4863           0 : pari_tmp_dir(void)
    4864             : {
    4865             :   char *s;
    4866           0 :   s = env_ok("GPTMPDIR"); if (s) return s;
    4867           0 :   s = env_ok("TMPDIR"); if (s) return s;
    4868             : #if defined(_WIN32) || defined(__EMX__)
    4869             :   s = env_ok("TMP"); if (s) return s;
    4870             :   s = env_ok("TEMP"); if (s) return s;
    4871             : #endif
    4872             : #if defined(UNIX) || defined(__EMX__)
    4873           0 :   if (pari_is_rwx("/tmp")) return "/tmp";
    4874           0 :   if (pari_is_rwx("/var/tmp")) return "/var/tmp";
    4875             : #endif
    4876           0 :   return ".";
    4877             : }
    4878             : 
    4879             : /* loop through 26^2 variants [suffix 'aa' to 'zz'] */
    4880             : static int
    4881           0 : get_file(char *buf, int test(const char *), const char *suf)
    4882             : {
    4883           0 :   char c, d, *end = buf + strlen(buf) - 1;
    4884           0 :   if (suf) end -= strlen(suf);
    4885           0 :   for (d = 'a'; d <= 'z'; d++)
    4886             :   {
    4887           0 :     end[-1] = d;
    4888           0 :     for (c = 'a'; c <= 'z'; c++)
    4889             :     {
    4890           0 :       *end = c;
    4891           0 :       if (! test(buf)) return 1;
    4892           0 :       if (DEBUGLEVEL) err_printf("I/O: file %s exists!\n", buf);
    4893             :     }
    4894             :   }
    4895           0 :   return 0;
    4896             : }
    4897             : 
    4898             : #if defined(__EMX__) || defined(_WIN32)
    4899             : static void
    4900             : swap_slash(char *s)
    4901             : {
    4902             : #ifdef __EMX__
    4903             :   if (!unix_shell())
    4904             : #endif
    4905             :   {
    4906             :     char *t;
    4907             :     for (t=s; *t; t++)
    4908             :       if (*t == '/') *t = '\\';
    4909             :   }
    4910             : }
    4911             : #endif
    4912             : 
    4913             : /* s truncated to 8 chars, suf possibly NULL */
    4914             : static char *
    4915           0 : init_unique(const char *s, const char *suf)
    4916             : {
    4917           0 :   const char *pre = pari_tmp_dir();
    4918             :   char *buf, salt[64];
    4919             :   size_t lpre, lsalt, lsuf;
    4920             : #ifdef UNIX
    4921           0 :   sprintf(salt,"-%ld-%ld", (long)getuid(), (long)getpid());
    4922             : #else
    4923             :   sprintf(salt,"-%ld", (long)time(NULL));
    4924             : #endif
    4925           0 :   lsuf = suf? strlen(suf): 0;
    4926           0 :   lsalt = strlen(salt);
    4927           0 :   lpre = strlen(pre);
    4928             :   /* room for prefix + '/' + s + salt + suf + '\0' */
    4929           0 :   buf = (char*) pari_malloc(lpre + 1 + 8 + lsalt + lsuf + 1);
    4930           0 :   strcpy(buf, pre);
    4931           0 :   if (buf[lpre-1] != '/') { (void)strcat(buf, "/"); lpre++; }
    4932             : #if defined(__EMX__) || defined(_WIN32)
    4933             :   swap_slash(buf);
    4934             : #endif
    4935           0 :   sprintf(buf + lpre, "%.8s%s", s, salt);
    4936           0 :   if (lsuf) strcat(buf, suf);
    4937           0 :   if (DEBUGLEVEL) err_printf("I/O: prefix for unique file/dir = %s\n", buf);
    4938           0 :   return buf;
    4939             : }
    4940             : 
    4941             : /* Return a "unique filename" built from the string s, possibly the user id
    4942             :  * and the process pid (on Unix systems). A "temporary" directory name is
    4943             :  * prepended. The name returned is pari_malloc'ed. It is DOS-safe
    4944             :  * (s truncated to 8 chars) */
    4945             : char*
    4946           0 : pari_unique_filename_suffix(const char *s, const char *suf)
    4947             : {
    4948           0 :   char *buf = init_unique(s, suf);
    4949           0 :   if (pari_file_exists(buf) && !get_file(buf, pari_file_exists, suf))
    4950           0 :     pari_err(e_MISC,"couldn't find a suitable name for a tempfile (%s)",s);
    4951           0 :   return buf;
    4952             : }
    4953             : char*
    4954           0 : pari_unique_filename(const char *s)
    4955           0 : { return pari_unique_filename_suffix(s, NULL); }
    4956             : 
    4957             : /* Create a "unique directory" and return its name built from the string
    4958             :  * s, the user id and process pid (on Unix systems). A "temporary"
    4959             :  * directory name is prepended. The name returned is pari_malloc'ed.
    4960             :  * It is DOS-safe (truncated to 8 chars) */
    4961             : char*
    4962           0 : pari_unique_dir(const char *s)
    4963             : {
    4964           0 :   char *buf = init_unique(s, NULL);
    4965           0 :   if (pari_dir_exists(buf) && !get_file(buf, pari_dir_exists, NULL))
    4966           0 :     pari_err(e_MISC,"couldn't find a suitable name for a tempdir (%s)",s);
    4967           0 :   return buf;
    4968             : }
    4969             : 
    4970             : static long
    4971          56 : get_free_gp_file(void)
    4972             : {
    4973          56 :   long i, l = s_gp_file.n;
    4974          56 :   for (i=0; i<l; i++)
    4975           0 :     if (!gp_file[i].fp)
    4976           0 :       return i;
    4977          56 :   return pari_stack_new(&s_gp_file);
    4978             : }
    4979             : 
    4980             : static void
    4981         320 : check_gp_file(const char *s, long n)
    4982             : {
    4983         320 :   if (n < 0 || n >= s_gp_file.n || !gp_file[n].fp)
    4984          20 :     pari_err_FILEDESC(s, n);
    4985         300 : }
    4986             : 
    4987             : static long
    4988          56 : new_gp_file(const char *s, FILE *f, int t)
    4989             : {
    4990             :   long n;
    4991          56 :   n = get_free_gp_file();
    4992          56 :   gp_file[n].name = pari_strdup(s);
    4993          56 :   gp_file[n].fp = f;
    4994          56 :   gp_file[n].type = t;
    4995          56 :   gp_file[n].serial = gp_file_serial++;
    4996          56 :   if (DEBUGLEVEL) err_printf("fileopen:%ld (%ld)\n", n, gp_file[n].serial);
    4997          56 :   return n;
    4998             : }
    4999             : 
    5000             : #if defined(ZCAT) && defined(HAVE_PIPES)
    5001             : static long
    5002          36 : check_compress(const char *name)
    5003             : {
    5004          36 :   long l = strlen(name);
    5005          36 :   const char *end = name + l-1;
    5006          36 :   if (l > 2 && (!strncmp(end-1,".Z",2)
    5007             : #ifdef GNUZCAT
    5008          36 :              || !strncmp(end-2,".gz",3)
    5009             : #endif
    5010             :   ))
    5011             :   { /* compressed file (compress or gzip) */
    5012           0 :     char *cmd = stack_malloc(strlen(ZCAT) + l + 4);
    5013           0 :     sprintf(cmd,"%s \"%s\"",ZCAT,name);
    5014           0 :     return gp_fileextern(cmd);
    5015             :   }
    5016          36 :   return -1;
    5017             : }
    5018             : #endif
    5019             : 
    5020             : long
    5021          52 : gp_fileopen(const char *s, const char *mode)
    5022             : {
    5023             :   FILE *f;
    5024          52 :   if (mode[0]==0 || mode[1]!=0)
    5025           0 :     pari_err_TYPE("fileopen",strtoGENstr(mode));
    5026          52 :   switch (mode[0])
    5027             :   {
    5028          36 :   case 'r':
    5029             : #if defined(ZCAT) && defined(HAVE_PIPES)
    5030             :     {
    5031          36 :       long n = check_compress(s);
    5032          36 :       if (n >= 0) return n;
    5033             :     }
    5034             : #endif
    5035          36 :     f = fopen(s, "r");
    5036          36 :     if (!f) pari_err_FILE("requested file", s);
    5037          36 :     return new_gp_file(s, f, mf_IN);
    5038          16 :   case 'w':
    5039             :   case 'a':
    5040          16 :     wr_check(s);
    5041          16 :     f = fopen(s, mode[0]=='w' ? "w": "a");
    5042          16 :     if (!f) pari_err_FILE("requested file", s);
    5043          16 :     return new_gp_file(s, f, mf_OUT);
    5044           0 :   default:
    5045           0 :     pari_err_TYPE("fileopen",strtoGENstr(mode));
    5046             :     return -1; /* LCOV_EXCL_LINE */
    5047             :   }
    5048             : }
    5049             : 
    5050             : long
    5051           4 : gp_fileextern(const char *s)
    5052             : {
    5053             : #ifndef HAVE_PIPES
    5054             :   pari_err(e_ARCH,"pipes");
    5055             :   return NULL;/*LCOV_EXCL_LINE*/
    5056             : #else
    5057             :   FILE *f;
    5058           4 :   check_secure(s);
    5059           4 :   f = popen(s, "r");
    5060           4 :   if (!f) pari_err(e_MISC,"[pipe:] '%s' failed",s);
    5061           4 :   return new_gp_file(s,f, mf_PIPE);
    5062             : #endif
    5063             : }
    5064             : 
    5065             : void
    5066          56 : gp_fileclose(long n)
    5067             : {
    5068          56 :   check_gp_file("fileclose", n);
    5069          56 :   if (DEBUGLEVEL) err_printf("fileclose(%ld)\n",n);
    5070          56 :   if (gp_file[n].type == mf_PIPE)
    5071           4 :     pclose(gp_file[n].fp);
    5072             :   else
    5073          52 :     fclose(gp_file[n].fp);
    5074          56 :   pari_free((void*)gp_file[n].name);
    5075          56 :   gp_file[n].name = NULL;
    5076          56 :   gp_file[n].fp = NULL;
    5077          56 :   gp_file[n].type = mf_FALSE;
    5078          56 :   gp_file[n].serial = -1;
    5079         112 :   while (s_gp_file.n > 0 && !gp_file[s_gp_file.n-1].fp)
    5080          56 :     s_gp_file.n--;
    5081          56 : }
    5082             : 
    5083             : void
    5084          44 : gp_fileflush(long n)
    5085             : {
    5086          44 :   check_gp_file("fileflush", n);
    5087          40 :   if (DEBUGLEVEL) err_printf("fileflush(%ld)\n",n);
    5088          40 :   if (gp_file[n].type == mf_OUT) (void)fflush(gp_file[n].fp);
    5089          40 : }
    5090             : void
    5091          52 : gp_fileflush0(GEN gn)
    5092             : {
    5093             :   long i;
    5094          52 :   if (gn)
    5095             :   {
    5096          48 :     if (typ(gn) != t_INT) pari_err_TYPE("fileflush",gn);
    5097          44 :     gp_fileflush(itos(gn));
    5098             :   }
    5099           8 :   else for (i = 0; i < s_gp_file.n; i++)
    5100           4 :     if (gp_file[i].fp && gp_file[i].type == mf_OUT) gp_fileflush(i);
    5101          44 : }
    5102             : 
    5103             : GEN
    5104          64 : gp_fileread(long n)
    5105             : {
    5106             :   Buffer *b;
    5107             :   FILE *fp;
    5108             :   GEN z;
    5109             :   int t;
    5110          64 :   check_gp_file("fileread", n);
    5111          60 :   t = gp_file[n].type;
    5112          60 :   if (t!=mf_IN && t!=mf_PIPE)
    5113           4 :     pari_err_FILEDESC("fileread",n);
    5114          56 :   fp = gp_file[n].fp;
    5115          56 :   b = new_buffer();
    5116             :   while(1)
    5117             :   {
    5118          56 :     if (!gp_read_stream_buf(fp, b)) { delete_buffer(b); return gen_0; }
    5119          48 :     if (*(b->buf)) break;
    5120             :   }
    5121          48 :   z = strtoGENstr(b->buf);
    5122          48 :   delete_buffer(b);
    5123          48 :   return z;
    5124             : }
    5125             : 
    5126             : void
    5127          48 : gp_filewrite(long n, const char *s)
    5128             : {
    5129             :   FILE *fp;
    5130          48 :   check_gp_file("filewrite", n);
    5131          44 :   if (gp_file[n].type!=mf_OUT)
    5132           4 :     pari_err_FILEDESC("filewrite",n);
    5133          40 :   fp = gp_file[n].fp;
    5134          40 :   fputs(s, fp);
    5135          40 :   fputc('\n',fp);
    5136          40 : }
    5137             : 
    5138             : void
    5139          52 : gp_filewrite1(long n, const char *s)
    5140             : {
    5141             :   FILE *fp;
    5142          52 :   check_gp_file("filewrite1", n);
    5143          48 :   if (gp_file[n].type!=mf_OUT)
    5144           4 :     pari_err_FILEDESC("filewrite1",n);
    5145          44 :   fp = gp_file[n].fp;
    5146          44 :   fputs(s, fp);
    5147          44 : }
    5148             : 
    5149             : GEN
    5150          56 : gp_filereadstr(long n)
    5151             : {
    5152             :   Buffer *b;
    5153             :   char *s, *e;
    5154             :   GEN z;
    5155             :   int t;
    5156             :   input_method IM;
    5157          56 :   check_gp_file("filereadstr", n);
    5158          52 :   t = gp_file[n].type;
    5159          52 :   if (t!=mf_IN && t!=mf_PIPE)
    5160           4 :     pari_err_FILEDESC("fileread",n);
    5161          48 :   b = new_buffer();
    5162          48 :   IM.myfgets = (fgets_t)&fgets;
    5163          48 :   IM.file = (void*) gp_file[n].fp;
    5164          48 :   s = b->buf;
    5165          48 :   if (!file_getline(b, &s, &IM)) { delete_buffer(b); return gen_0; }
    5166          44 :   e = s + strlen(s)-1;
    5167          44 :   if (*e == '\n') *e = 0;
    5168          44 :   z = strtoGENstr(s);
    5169          44 :   delete_buffer(b);
    5170          44 :   return z;
    5171             : }
    5172             : 
    5173             : /*******************************************************************/
    5174             : /**                                                               **/
    5175             : /**                             INSTALL                           **/
    5176             : /**                                                               **/
    5177             : /*******************************************************************/
    5178             : 
    5179             : #ifdef HAS_DLOPEN
    5180             : #include <dlfcn.h>
    5181             : 
    5182             : /* see try_name() */
    5183             : static void *
    5184           0 : try_dlopen(const char *s, int flag)
    5185           0 : { void *h = dlopen(s, flag); pari_free((void*)s); return h; }
    5186             : 
    5187             : /* like dlopen, but using default(sopath) */
    5188             : static void *
    5189          20 : gp_dlopen(const char *name, int flag)
    5190             : {
    5191             :   void *handle;
    5192             :   char *s;
    5193             : 
    5194          20 :   if (!name) return dlopen(NULL, flag);
    5195           0 :   s = path_expand(name);
    5196             : 
    5197             :   /* if sopath empty or path is absolute, use dlopen */
    5198           0 :   if (!GP_DATA || *(GP_DATA->sopath->PATH)==0 || path_is_absolute(s))
    5199           0 :     return try_dlopen(s, flag);
    5200             :   else
    5201             :   {
    5202             :     forpath_t T;
    5203             :     char *t;
    5204           0 :     forpath_init(&T, GP_DATA->sopath, s);
    5205           0 :     while ( (t = forpath_next(&T)) )
    5206             :     {
    5207           0 :       if ( (handle = try_dlopen(t,flag)) ) { pari_free(s); return handle; }
    5208           0 :       (void)dlerror(); /* clear error message */
    5209             :     }
    5210           0 :     pari_free(s);
    5211             :   }
    5212           0 :   return NULL;
    5213             : }
    5214             : 
    5215             : static void *
    5216          20 : install0(const char *name, const char *lib)
    5217             : {
    5218             :   void *handle;
    5219             : 
    5220             : #ifndef RTLD_GLOBAL /* OSF1 has dlopen but not RTLD_GLOBAL*/
    5221             : #  define RTLD_GLOBAL 0
    5222             : #endif
    5223          20 :   handle = gp_dlopen(lib, RTLD_LAZY|RTLD_GLOBAL);
    5224             : 
    5225          20 :   if (!handle)
    5226             :   {
    5227           0 :     const char *s = dlerror(); if (s) err_printf("%s\n\n",s);
    5228           0 :     if (lib) pari_err(e_MISC,"couldn't open dynamic library '%s'",lib);
    5229           0 :     pari_err(e_MISC,"couldn't open dynamic symbol table of process");
    5230             :   }
    5231          20 :   return dlsym(handle, name);
    5232             : }
    5233             : #else
    5234             : #  ifdef _WIN32
    5235             : static HMODULE
    5236             : try_LoadLibrary(const char *s)
    5237             : { void *h = LoadLibrary(s); pari_free((void*)s); return h; }
    5238             : 
    5239             : /* like LoadLibrary, but using default(sopath) */
    5240             : static HMODULE
    5241             : gp_LoadLibrary(const char *name)
    5242             : {
    5243             :   HMODULE handle;
    5244             :   char *s = path_expand(name);
    5245             : 
    5246             :   /* if sopath empty or path is absolute, use LoadLibrary */
    5247             :   if (!GP_DATA || *(GP_DATA->sopath->PATH)==0 || path_is_absolute(s))
    5248             :     return try_LoadLibrary(s);
    5249             :   else
    5250             :   {
    5251             :     forpath_t T;
    5252             :     char *t;
    5253             :     forpath_init(&T, GP_DATA->sopath, s);
    5254             :     while ( (t = forpath_next(&T)) )
    5255             :       if ( (handle = try_LoadLibrary(t)) ) { pari_free(s); return handle; }
    5256             :     pari_free(s);
    5257             :   }
    5258             :   return NULL;
    5259             : }
    5260             : static void *
    5261             : install0(const char *name, const char *lib)
    5262             : {
    5263             :   HMODULE handle;
    5264             :   if (lib == pari_library_path)
    5265             :   {
    5266             :     handle = GetModuleHandleA(NULL);
    5267             :     void * fun = (void *) GetProcAddress(handle,name);
    5268             :     if (fun) return fun;
    5269             :   }
    5270             :   handle = gp_LoadLibrary(lib);
    5271             :   if (!handle)
    5272             :   {
    5273             :     if (lib) pari_err(e_MISC,"couldn't open dynamic library '%s'",lib);
    5274             :     pari_err(e_MISC,"couldn't open dynamic symbol table of process");
    5275             :   }
    5276             :   return (void *) GetProcAddress(handle,name);
    5277             : }
    5278             : #  else
    5279             : static void *
    5280             : install0(const char *name, const char *lib)
    5281             : { pari_err(e_ARCH,"install"); return NULL; }
    5282             : #endif
    5283             : #endif
    5284             : 
    5285             : static char *
    5286          20 : dft_help(const char *gp, const char *s, const char *code)
    5287          20 : { return stack_sprintf("%s: installed function\nlibrary name: %s\nprototype: %s" , gp, s, code); }
    5288             : 
    5289             : void
    5290          20 : gpinstall(const char *s, const char *code, const char *gpname, const char *lib)
    5291             : {
    5292          20 :   pari_sp av = avma;
    5293          20 :   const char *gp = *gpname? gpname: s;
    5294             :   int update_help;
    5295             :   void *f;
    5296             :   entree *ep;
    5297          20 :   if (GP_DATA->secure)
    5298             :   {
    5299           0 :     char *msg = pari_sprintf("[secure mode]: about to install '%s'", s);
    5300           0 :     pari_ask_confirm(msg);
    5301           0 :     pari_free(msg);
    5302             :   }
    5303          20 :   f = install0(s, *lib ?lib :pari_library_path);
    5304          20 :   if (!f)
    5305             :   {
    5306           0 :     if (*lib) pari_err(e_MISC,"can't find symbol '%s' in library '%s'",s,lib);
    5307           0 :     pari_err(e_MISC,"can't find symbol '%s' in dynamic symbol table of process",s);
    5308             :   }
    5309          20 :   ep = is_entry(gp);
    5310             :   /* Delete help if 1) help is the default (don't delete user addhelp)
    5311             :    * and 2) default help changes */
    5312          12 :   update_help = (ep && ep->valence == EpINSTALL && ep->help
    5313          12 :       && strcmp(ep->code, code)
    5314          32 :       && !strcmp(ep->help, dft_help(gp,s,ep->code)));
    5315          20 :   ep = install(f,gp,code);
    5316           8 :   if (update_help || !ep->help) addhelp(gp, dft_help(gp,s,code));
    5317           8 :   mt_broadcast(snm_closure(is_entry("install"),
    5318             :                            mkvec4(strtoGENstr(s),strtoGENstr(code),
    5319             :                                   strtoGENstr(gp),strtoGENstr(lib))));
    5320           8 :   set_avma(av);
    5321           8 : }

Generated by: LCOV version 1.16