Code coverage tests

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

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

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

LCOV - code coverage report
Current view: top level - language - es.c (source / functions) Hit Total Coverage
Test: PARI/GP v2.16.2 lcov report (development 29115-f22e516b23) Lines: 2069 2774 74.6 %
Date: 2024-03-28 08:06:56 Functions: 255 310 82.3 %
Legend: Lines: hit not hit

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

Generated by: LCOV version 1.14