Code coverage tests

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

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

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

LCOV - code coverage report
Current view: top level - language - es.c (source / functions) Hit Total Coverage
Test: PARI/GP v2.10.0 lcov report (development 20459-9710128) Lines: 1486 2524 58.9 %
Date: 2017-03-30 05:32:39 Functions: 197 291 67.7 %
Legend: Lines: hit not hit

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

Generated by: LCOV version 1.11