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

Generated by: LCOV version 1.13