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.8.0 lcov report (development 18946-c0ba5ba) Lines: 1522 2535 60.0 %
Date: 2016-05-25 Functions: 201 292 68.8 %
Legend: Lines: hit not hit | Branches: + taken - not taken # not executed Branches: 956 1902 50.3 %

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

Generated by: LCOV version 1.9