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

Generated by: LCOV version 1.11